File: hook.c

package info (click to toggle)
chiark-tcl 1.3.7
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 592 kB
  • sloc: ansic: 4,542; perl: 415; makefile: 129; tcl: 106; sh: 38
file content (320 lines) | stat: -rw-r--r-- 8,035 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
/*
 * hbytes - hex-stringrep efficient byteblocks for Tcl
 * Copyright 2006-2012 Ian Jackson
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License as
 * published by the Free Software Foundation; either version 2 of the
 * License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this library; if not, see <http://www.gnu.org/licenses/>.
 */


#include <errno.h>

#include "chiark_tcl_hbytes.h"

int cht_do_hbytes_rep_info(ClientData cd, Tcl_Interp *ip,
		       Tcl_Obj *obj, Tcl_Obj **result) {
  const char *tn;
  int nums[3], i, lnl;
  Tcl_Obj *objl[4];

  if (obj->typePtr == &cht_hbytes_type) {
    HBytes_Value *v= OBJ_HBYTES(obj);
    memset(nums,0,sizeof(nums));
    nums[1]= cht_hb_len(v);
  
    if (HBYTES_ISEMPTY(v)) tn= "empty";
    else if (HBYTES_ISSENTINEL(v)) tn= "sentinel!";
    else if (HBYTES_ISSIMPLE(v)) tn= "simple";
    else {
      HBytes_ComplexValue *cx= v->begin_complex;
      tn= "complex";
      nums[0]= cx->prespace;
      nums[2]= cx->avail - cx->len;
    }
    lnl= 3;
  } else {
    tn= "other";
    lnl= 0;
  }
    
  objl[0]= Tcl_NewStringObj((char*)tn,-1);
  for (i=0; i<lnl; i++) objl[i+1]= Tcl_NewIntObj(nums[i]);
  *result= Tcl_NewListObj(lnl+1,objl);
    
  return TCL_OK;
}

static void hbytes_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
  cht_hb_array(OBJ_HBYTES(dup),
	       cht_hb_data(OBJ_HBYTES(src)),
	       cht_hb_len(OBJ_HBYTES(src)));
  dup->typePtr= &cht_hbytes_type;
}

static void hbytes_t_free(Tcl_Obj *o) {
  cht_hb_free(OBJ_HBYTES(o));
}

void cht_obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
				int l, const char *prefix) {
  char *str;
  int pl;

  pl= strlen(prefix);
  assert(l < INT_MAX/2 - 1 - pl);
  o->length= l*2+pl;
  str= o->bytes= TALLOC(o->length+1);
  
  memcpy(str,prefix,pl);
  str += pl;

  while (l>0) {
    sprintf(str,"%02x",*byte);
    str+=2; byte++; l--;
  }
  *str= 0;
}

void cht_obj_updatestr_array(Tcl_Obj *o, const Byte *byte, int l) {
  cht_obj_updatestr_array_prefix(o,byte,l,"");
}

static void hbytes_t_ustr(Tcl_Obj *o) {
  cht_obj_updatestr_array(o,
		      cht_hb_data(OBJ_HBYTES(o)),
		      cht_hb_len(OBJ_HBYTES(o)));
}

static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
  char *str, *ep;
  Byte *bytes;
  int l;
  char cbuf[3];

  if (o->typePtr == &cht_ulong_type) {
    uint32_t ul;

    ul= htonl(*(const uint32_t*)&o->internalRep.longValue);
    cht_hb_array(OBJ_HBYTES(o), (const Byte*)&ul, 4);

  } else {
  
    str= Tcl_GetStringFromObj(o,&l);  assert(str);
    cht_objfreeir(o);

    if (l & 1) return cht_staticerr(ip, "hbytes: conversion from hex:"
				" odd length in hex", "HBYTES SYNTAX");

    bytes= cht_hb_arrayspace(OBJ_HBYTES(o), l/2);

    cbuf[2]= 0;
    while (l>0) {
      cbuf[0]= *str++;
      cbuf[1]= *str++;
      *bytes++= strtoul(cbuf,&ep,16);
      if (ep != cbuf+2) {
	cht_hb_free(OBJ_HBYTES(o));
	return cht_staticerr(ip, "hbytes: conversion from hex:"
			 " bad hex digit", "HBYTES SYNTAX");
      }
      l -= 2;
    }

  }

  o->typePtr = &cht_hbytes_type;
  return TCL_OK;
}

Tcl_ObjType cht_hbytes_type = {
  "hbytes",
  hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
};

int cht_do_hbytes_raw2h(ClientData cd, Tcl_Interp *ip,
		    Tcl_Obj *binary, HBytes_Value *result) {
  const unsigned char *str;
  int l;

  str= Tcl_GetByteArrayFromObj(binary,&l);
  cht_hb_array(result, str, l);
  return TCL_OK;
}

int cht_do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
		    HBytes_Value hex, Tcl_Obj **result) {
  *result= Tcl_NewByteArrayObj(cht_hb_data(&hex), cht_hb_len(&hex));
  return TCL_OK;
}

int cht_do_hbytes_length(ClientData cd, Tcl_Interp *ip,
		     HBytes_Value v, int *result) {
  *result= cht_hb_len(&v);
  return TCL_OK;
}

int cht_do_hbytes_random(ClientData cd, Tcl_Interp *ip,
		     int length, HBytes_Value *result) {
  Byte *space;
  int rc;
  
  space= cht_hb_arrayspace(result, length);
  rc= cht_get_urandom(ip, space, length);
  if (rc) { cht_hb_free(result); return rc; }
  return TCL_OK;
}  
  
int cht_do_hbytes_overwrite(ClientData cd, Tcl_Interp *ip,
			HBytes_Var v, int start, HBytes_Value sub) {
  int sub_l;

  sub_l= cht_hb_len(&sub);
  if (start < 0)
    return cht_staticerr(ip, "hbytes overwrite start -ve",
		     "HBYTES LENGTH RANGE");
  if (start + sub_l > cht_hb_len(v.hb))
    return cht_staticerr(ip, "hbytes overwrite out of range",
		     "HBYTES LENGTH UNDERRUN");
  memcpy(cht_hb_data(v.hb) + start, cht_hb_data(&sub), sub_l);
  return TCL_OK;
}

int cht_do_hbytes_trimleft(ClientData cd, Tcl_Interp *ip, HBytes_Var v) {
  const Byte *o, *p, *e;
  o= p= cht_hb_data(v.hb);
  e= p + cht_hb_len(v.hb);

  while (p<e && !*p) p++;
  if (p != o)
    cht_hb_unprepend(v.hb, p-o);

  return TCL_OK;
}

int cht_do_hbytes_repeat(ClientData cd, Tcl_Interp *ip,
		     HBytes_Value sub, int count, HBytes_Value *result) {
  int sub_l;
  Byte *data;
  const Byte *sub_d;

  sub_l= cht_hb_len(&sub);
  if (count < 0) return cht_staticerr(ip, "hbytes repeat count -ve",
				  "HBYTES LENGTH RANGE");
  if (count > INT_MAX/sub_l) return cht_staticerr(ip, "hbytes repeat too long", 0);

  data= cht_hb_arrayspace(result, sub_l*count);
  sub_d= cht_hb_data(&sub);
  while (count) {
    memcpy(data, sub_d, sub_l);
    count--; data += sub_l;
  }
  return TCL_OK;
}  

int cht_do_hbytes_xor(ClientData cd, Tcl_Interp *ip,
		  HBytes_Var v, HBytes_Value d) {
  int l;
  Byte *dest;
  const Byte *source;

  l= cht_hb_len(v.hb);
  if (cht_hb_len(&d) != l) return
    cht_staticerr(ip, "hbytes xor lengths do not match", "HBYTES LENGTH MISMATCH");

  dest= cht_hb_data(v.hb);
  source= cht_hb_data(&d);
  memxor(dest,source,l);
  return TCL_OK;
}
  
int cht_do_hbytes_zeroes(ClientData cd, Tcl_Interp *ip,
		     int length, HBytes_Value *result) {
  Byte *space;
  space= cht_hb_arrayspace(result, length);
  memset(space,0,length);
  return TCL_OK;
}

int cht_do_hbytes_compare(ClientData cd, Tcl_Interp *ip,
		      HBytes_Value a, HBytes_Value b, int *result) {
  int al, bl, minl, r;

  al= cht_hb_len(&a);
  bl= cht_hb_len(&b);
  minl= al<bl ? al : bl;

  r= memcmp(cht_hb_data(&a), cht_hb_data(&b), minl);
  
  if (r<0) *result= -2;
  else if (r>0) *result= +2;
  else {
    if (al<bl) *result= -1;
    else if (al>bl) *result= +1;
    else *result= 0;
  }
  return TCL_OK;
}

int cht_do_hbytes_range(ClientData cd, Tcl_Interp *ip,
		    HBytes_Value v, int start, int size,
		    HBytes_Value *result) {
  const Byte *data;
  int l;

  l= cht_hb_len(&v);
  if (start<0 || size<0)
    return cht_staticerr(ip,"hbytes range subscript(s) -ve","HBYTES LENGTH RANGE");
  if (l<start+size)
    return cht_staticerr(ip, "hbytes range subscripts too big",
		     "HBYTES LENGTH UNDERRUN");

  data= cht_hb_data(&v);
  cht_hb_array(result, data+start, size);
  return TCL_OK;
}

/* hbytes representing uint16_t's */

int cht_do_hbytes_h2ushort(ClientData cd, Tcl_Interp *ip,
		       HBytes_Value hex, long *result) {
  const Byte *data;
  int l;

  l= cht_hb_len(&hex);
  if (l>2)
    return cht_staticerr(ip, "hbytes h2ushort input more than 4 hex digits",
		     "HBYTES VALUE OVERFLOW");

  data= cht_hb_data(&hex);
  *result= data[l-1] | (l>1 ? data[0]<<8 : 0);
  return TCL_OK;
}

int cht_do_hbytes_ushort2h(ClientData cd, Tcl_Interp *ip,
		       long input, HBytes_Value *result) {
  uint16_t us;

  if (input > 0x0ffff)
    return cht_staticerr(ip, "hbytes ushort2h input >2^16",
		     "HBYTES VALUE OVERFLOW");

  us= htons(input);
  cht_hb_array(result,(const Byte*)&us,2);
  return TCL_OK;
}

/* toplevel functions */

CHT_INIT(hbytes,
	 CHTI_TYPE(cht_hbytes_type) CHTI_TYPE(cht_ulong_type),
	 CHTI_COMMANDS(cht_hbytestoplevel_entries))