chiark / gitweb /
many improvements: use Get/SetAssocData for idtables to avoid globals, and adns bindi...
[chiark-tcl.git] / hbytes / hook.c
1 /*
2  */
3
4 #include <errno.h>
5
6 #include "hbytes.h"
7 #include "tables.h"
8
9 int staticerr(Tcl_Interp *ip, const char *m, const char *ec) {
10   Tcl_SetResult(ip, (char*)m, TCL_STATIC);
11   if (ec) Tcl_SetObjErrorCode(ip, Tcl_NewStringObj(ec,-1));
12   return TCL_ERROR;
13 }
14
15 int posixerr(Tcl_Interp *ip, int errnoval, const char *m) {
16   const char *em;
17   
18   Tcl_ResetResult(ip);
19   errno= errnoval;
20   em= Tcl_PosixError(ip);
21   Tcl_AppendResult(ip, m, ": ", em, (char*)0);
22   return TCL_ERROR;
23 }
24
25 int newfdposixerr(Tcl_Interp *ip, int fd, const char *m) {
26   int e;
27   e= errno;
28   close(fd);
29   return posixerr(ip,e,m);
30 }
31
32 void objfreeir(Tcl_Obj *o) {
33   if (o->typePtr && o->typePtr->freeIntRepProc)
34     o->typePtr->freeIntRepProc(o);
35   o->typePtr= 0;
36 }  
37
38 int do_hbytes_rep_info(ClientData cd, Tcl_Interp *ip,
39                        Tcl_Obj *obj, Tcl_Obj **result) {
40   const char *tn;
41   int nums[3], i, lnl;
42   Tcl_Obj *objl[4];
43
44   if (obj->typePtr == &hbytes_type) {
45     HBytes_Value *v= OBJ_HBYTES(obj);
46     memset(nums,0,sizeof(nums));
47     nums[1]= hbytes_len(v);
48   
49     if (HBYTES_ISEMPTY(v)) tn= "empty";
50     else if (HBYTES_ISSENTINEL(v)) tn= "sentinel!";
51     else if (HBYTES_ISSIMPLE(v)) tn= "simple";
52     else {
53       HBytes_ComplexValue *cx= v->begin_complex;
54       tn= "complex";
55       nums[0]= cx->prespace;
56       nums[2]= cx->avail - cx->len;
57     }
58     lnl= 3;
59   } else {
60     tn= "other";
61     lnl= 0;
62   }
63     
64   objl[0]= Tcl_NewStringObj((char*)tn,-1);
65   for (i=0; i<lnl; i++) objl[i+1]= Tcl_NewIntObj(nums[i]);
66   *result= Tcl_NewListObj(lnl+1,objl);
67     
68   return TCL_OK;
69 }
70
71 static void hbytes_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
72   hbytes_array(OBJ_HBYTES(dup),
73                hbytes_data(OBJ_HBYTES(src)),
74                hbytes_len(OBJ_HBYTES(src)));
75   dup->typePtr= &hbytes_type;
76 }
77
78 static void hbytes_t_free(Tcl_Obj *o) {
79   hbytes_free(OBJ_HBYTES(o));
80 }
81
82 void obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
83                                 int l, const char *prefix) {
84   char *str;
85   int pl;
86
87   pl= strlen(prefix);
88   o->length= l*2+pl;
89   str= o->bytes= TALLOC(o->length+1);
90   
91   memcpy(str,prefix,pl);
92   str += pl;
93
94   while (l>0) {
95     sprintf(str,"%02x",*byte);
96     str+=2; byte++; l--;
97   }
98   *str= 0;
99 }
100
101 void obj_updatestr_array(Tcl_Obj *o, const Byte *byte, int l) {
102   obj_updatestr_array_prefix(o,byte,l,"");
103 }
104
105 void obj_updatestr_vstringls(Tcl_Obj *o, ...) {
106   va_list al;
107   char *p;
108   const char *part;
109   int l, pl;
110
111   va_start(al,o);
112   for (l=0; (part= va_arg(al, const char*)); )
113     l+= va_arg(al, int);
114   va_end(al);
115   
116   o->length= l;
117   o->bytes= TALLOC(l+1);
118
119   va_start(al,o);
120   for (p= o->bytes; (part= va_arg(al, const char*)); p += pl) {
121     pl= va_arg(al, int);
122     memcpy(p, part, pl);
123   }
124   va_end(al);
125
126   *p= 0;
127 }
128
129 void obj_updatestr_string(Tcl_Obj *o, const char *str) {
130   obj_updatestr_vstringls(o, str, strlen(str), (char*)0);
131 }
132
133 static void hbytes_t_ustr(Tcl_Obj *o) {
134   obj_updatestr_array(o,
135                       hbytes_data(OBJ_HBYTES(o)),
136                       hbytes_len(OBJ_HBYTES(o)));
137 }
138
139 static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
140   char *str, *ep, *os;
141   Byte *startbytes, *bytes;
142   int l;
143   char cbuf[3];
144
145   if (o->typePtr == &ulong_type) {
146     uint32_t ul;
147
148     ul= htonl(*(const uint32_t*)&o->internalRep.longValue);
149     hbytes_array(OBJ_HBYTES(o), (const Byte*)&ul, 4);
150
151   } else {
152   
153     os= str= Tcl_GetStringFromObj(o,&l);  assert(str);
154     objfreeir(o);
155
156     if (l & 1) return staticerr(ip, "hbytes: conversion from hex:"
157                                 " odd length in hex", "HBYTES SYNTAX");
158
159     startbytes= bytes= hbytes_arrayspace(OBJ_HBYTES(o), l/2);
160
161     cbuf[2]= 0;
162     while (l>0) {
163       cbuf[0]= *str++;
164       cbuf[1]= *str++;
165       *bytes++= strtoul(cbuf,&ep,16);
166       if (ep != cbuf+2) {
167         hbytes_free(OBJ_HBYTES(o));
168         return staticerr(ip, "hbytes: conversion from hex:"
169                          " bad hex digit", "HBYTES SYNTAX");
170       }
171       l -= 2;
172     }
173
174   }
175
176   o->typePtr = &hbytes_type;
177   return TCL_OK;
178 }
179
180 Tcl_ObjType hbytes_type = {
181   "hbytes",
182   hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
183 };
184
185 int do_hbytes_raw2h(ClientData cd, Tcl_Interp *ip,
186                     Tcl_Obj *binary, HBytes_Value *result) {
187   const unsigned char *str;
188   int l;
189
190   str= Tcl_GetByteArrayFromObj(binary,&l);
191   hbytes_array(result, str, l);
192   return TCL_OK;
193 }
194
195 int do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
196                     HBytes_Value hex, Tcl_Obj **result) {
197   *result= Tcl_NewByteArrayObj(hbytes_data(&hex), hbytes_len(&hex));
198   return TCL_OK;
199 }
200
201 int do_hbytes_length(ClientData cd, Tcl_Interp *ip,
202                      HBytes_Value v, int *result) {
203   *result= hbytes_len(&v);
204   return TCL_OK;
205 }
206
207 int do_hbytes_random(ClientData cd, Tcl_Interp *ip,
208                      int length, HBytes_Value *result) {
209   Byte *space;
210   int rc;
211   
212   space= hbytes_arrayspace(result, length);
213   rc= get_urandom(ip, space, length);
214   if (rc) { hbytes_free(result); return rc; }
215   return TCL_OK;
216 }  
217   
218 int do_hbytes_overwrite(ClientData cd, Tcl_Interp *ip,
219                         HBytes_Var v, int start, HBytes_Value sub) {
220   int sub_l;
221
222   sub_l= hbytes_len(&sub);
223   if (start < 0)
224     return staticerr(ip, "hbytes overwrite start -ve",
225                      "HBYTES LENGTH RANGE");
226   if (start + sub_l > hbytes_len(v.hb))
227     return staticerr(ip, "hbytes overwrite out of range",
228                      "HBYTES LENGTH UNDERRUN");
229   memcpy(hbytes_data(v.hb) + start, hbytes_data(&sub), sub_l);
230   return TCL_OK;
231 }
232
233 int do_hbytes_trimleft(ClientData cd, Tcl_Interp *ip, HBytes_Var v) {
234   const Byte *o, *p, *e;
235   o= p= hbytes_data(v.hb);
236   e= p + hbytes_len(v.hb);
237
238   while (p<e && !*p) p++;
239   if (p != o)
240     hbytes_unprepend(v.hb, p-o);
241
242   return TCL_OK;
243 }
244
245 int do_hbytes_repeat(ClientData cd, Tcl_Interp *ip,
246                      HBytes_Value sub, int count, HBytes_Value *result) {
247   int sub_l;
248   Byte *data;
249   const Byte *sub_d;
250
251   sub_l= hbytes_len(&sub);
252   if (count < 0) return staticerr(ip, "hbytes repeat count -ve",
253                                   "HBYTES LENGTH RANGE");
254   if (count > INT_MAX/sub_l) return staticerr(ip, "hbytes repeat too long", 0);
255
256   data= hbytes_arrayspace(result, sub_l*count);
257   sub_d= hbytes_data(&sub);
258   while (count) {
259     memcpy(data, sub_d, sub_l);
260     count--; data += sub_l;
261   }
262   return TCL_OK;
263 }  
264
265 int do_hbytes_xor(ClientData cd, Tcl_Interp *ip,
266                   HBytes_Var v, HBytes_Value d) {
267   int l;
268   Byte *dest;
269   const Byte *source;
270
271   l= hbytes_len(v.hb);
272   if (hbytes_len(&d) != l) return
273     staticerr(ip, "hbytes xor lengths do not match", "HBYTES LENGTH MISMATCH");
274
275   dest= hbytes_data(v.hb);
276   source= hbytes_data(&d);
277   memxor(dest,source,l);
278   return TCL_OK;
279 }
280   
281 int do_hbytes_zeroes(ClientData cd, Tcl_Interp *ip,
282                      int length, HBytes_Value *result) {
283   Byte *space;
284   space= hbytes_arrayspace(result, length);
285   memset(space,0,length);
286   return TCL_OK;
287 }
288
289 int do_hbytes_compare(ClientData cd, Tcl_Interp *ip,
290                       HBytes_Value a, HBytes_Value b, int *result) {
291   int al, bl, minl, r;
292
293   al= hbytes_len(&a);
294   bl= hbytes_len(&b);
295   minl= al<bl ? al : bl;
296
297   r= memcmp(hbytes_data(&a), hbytes_data(&b), minl);
298   
299   if (r<0) *result= -2;
300   else if (r>0) *result= +2;
301   else {
302     if (al<bl) *result= -1;
303     else if (al>bl) *result= +1;
304     else *result= 0;
305   }
306   return TCL_OK;
307 }
308
309 int do_hbytes_range(ClientData cd, Tcl_Interp *ip,
310                     HBytes_Value v, int start, int size,
311                     HBytes_Value *result) {
312   const Byte *data;
313   int l;
314
315   l= hbytes_len(&v);
316   if (start<0 || size<0)
317     return staticerr(ip,"hbytes range subscript(s) -ve","HBYTES LENGTH RANGE");
318   if (l<start+size)
319     return staticerr(ip, "hbytes range subscripts too big",
320                      "HBYTES LENGTH UNDERRUN");
321
322   data= hbytes_data(&v);
323   hbytes_array(result, data+start, size);
324   return TCL_OK;
325 }
326
327 int do_hbytes_mask_map(ClientData cd, Tcl_Interp *ip,
328                       const MaskMap_SubCommand *subcmd,
329                       int objc, Tcl_Obj *const *objv) {
330   return subcmd->func(0,ip,objc,objv);
331 }
332
333 /* hbytes representing uint16_t's */
334
335 int do_hbytes_h2ushort(ClientData cd, Tcl_Interp *ip,
336                        HBytes_Value hex, long *result) {
337   const Byte *data;
338   int l;
339
340   l= hbytes_len(&hex);
341   if (l>2)
342     return staticerr(ip, "hbytes h2ushort input more than 4 hex digits",
343                      "HBYTES VALUE OVERFLOW");
344
345   data= hbytes_data(&hex);
346   *result= data[l-1] | (l>1 ? data[0]<<8 : 0);
347   return TCL_OK;
348 }
349
350 int do_hbytes_ushort2h(ClientData cd, Tcl_Interp *ip,
351                        long input, HBytes_Value *result) {
352   uint16_t us;
353
354   if (input > 0x0ffff)
355     return staticerr(ip, "hbytes ushort2h input >2^16",
356                      "HBYTES VALUE OVERFLOW");
357
358   us= htons(input);
359   hbytes_array(result,(const Byte*)&us,2);
360   return TCL_OK;
361 }
362
363 /* toplevel functions */
364
365 int do_toplevel_hbytes(ClientData cd, Tcl_Interp *ip,
366                        const HBytes_SubCommand *subcmd,
367                        int objc, Tcl_Obj *const *objv) {
368   return subcmd->func(0,ip,objc,objv);
369 }
370
371 int do_toplevel_dgram_socket(ClientData cd, Tcl_Interp *ip,
372                              const DgramSocket_SubCommand *subcmd,
373                              int objc, Tcl_Obj *const *objv) {
374   return subcmd->func(0,ip,objc,objv);
375 }
376
377 int do_toplevel_tuntap_socket_raw(ClientData cd, Tcl_Interp *ip,
378                                   const TunSocket_SubCommand *subcmd,
379                                   int objc, Tcl_Obj *const *objv) {
380   return subcmd->func(0,ip,objc,objv);
381 }
382
383 int do_toplevel_ulong(ClientData cd, Tcl_Interp *ip,
384                       const ULong_SubCommand *subcmd,
385                       int objc, Tcl_Obj *const *objv) {
386   return subcmd->func(0,ip,objc,objv);
387 }
388
389 int do_toplevel_adns(ClientData cd, Tcl_Interp *ip,
390                       const Adns_SubCommand *subcmd,
391                       int objc, Tcl_Obj *const *objv) {
392   return subcmd->func(0,ip,objc,objv);
393 }
394
395 #define URANDOM "/dev/urandom"
396
397 int get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
398   static FILE *urandom;
399
400   int r, esave;
401
402   if (!urandom) {
403     urandom= fopen(URANDOM,"rb");
404     if (!urandom) return posixerr(ip,errno,"open " URANDOM);
405   }
406   r= fread(buffer,1,l,urandom);
407   if (r==l) return 0;
408
409   esave= errno;
410   fclose(urandom); urandom=0;
411
412   if (ferror(urandom)) {
413     return posixerr(ip,errno,"read " URANDOM);
414   } else {
415     assert(feof(urandom));
416     return staticerr(ip, URANDOM " gave eof!", 0);
417   }
418 }
419
420 int Hbytes_Init(Tcl_Interp *ip) {
421   const TopLevel_Command *cmd;
422
423   Tcl_RegisterObjType(&hbytes_type);
424   Tcl_RegisterObjType(&blockcipherkey_type);
425   Tcl_RegisterObjType(&enum_nearlytype);
426   Tcl_RegisterObjType(&enum1_nearlytype);
427   Tcl_RegisterObjType(&sockaddr_type);
428   Tcl_RegisterObjType(&tabledataid_nearlytype);
429   Tcl_RegisterObjType(&ulong_type);
430   Tcl_RegisterObjType(&maskmap_type);
431
432   for (cmd=toplevel_commands;
433        cmd->name;
434        cmd++)
435     Tcl_CreateObjCommand(ip, (char*)cmd->name, cmd->func, 0,0);
436
437   return TCL_OK;
438 }