hbytes/hbytes.c

   1 /*
   2  *
   3  */
   4
   5 #include "hbytes.h"
   6
   7 int staticerr(Tcl_Interp *ip, const char *m) {
   8   Tcl_SetResult(ip, (char*)m, TCL_STATIC);
   9   return TCL_ERROR;
  10 }
  11
  12 static void hbytes_setintern(Tcl_Obj *o, const Byte *array, int l) {
  13   Byte *np;
  14
  15   HBYTES(o)->start= np= l ? TALLOC(l) : 0;
  16   memcpy(np, array, l);
  17   HBYTES(o)->end= np + l;
  18   o->typePtr = &hbytes_type;
  19 }
  20
  21 static void hbytes_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
  22   hbytes_setintern(src, HBYTES(src)->start, HBYTES_LEN(src));
  23 }
  24
  25 Tcl_Obj *hbytes_set(Tcl_Obj *overwrite, const Byte *array, int l) {
  26   if (!overwrite) overwrite= Tcl_NewObj();
  27   objfreeir(overwrite);
  28   Tcl_InvalidateStringRep(overwrite);
  29   hbytes_setintern(overwrite, array, l);
  30   return overwrite;
  31 }
  32
  33 static void hbytes_t_free(Tcl_Obj *o) {
  34   TFREE(HBYTES(o)->start);
  35 }
  36
  37 static void hbytes_t_ustr(Tcl_Obj *o) {
  38   int l;
  39   char *str;
  40   const Byte *byte;
  41
  42   l= HBYTES_LEN(o);
  43   byte= HBYTES(o)->start;
  44   str= o->bytes= TALLOC(l*2+1);
  45   o->length= l*2;
  46   while (l>0) {
  47     sprintf(str,"%02x",*byte);
  48     str+=2; byte++; l--;
  49   }
  50 }
  51
  52 void objfreeir(Tcl_Obj *o) {
  53   if (o->typePtr && o->typePtr->freeIntRepProc)
  54     o->typePtr->freeIntRepProc(o);
  55 }
  56
  57 static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
  58   char *str, *ep, *os;
  59   Byte *startbytes, *bytes;
  60   int l;
  61   char cbuf[3];
  62
  63   os= str= Tcl_GetStringFromObj(o,&l);  assert(str);
  64   if (l & 1) return staticerr(ip, "hbytes: conversion from hex:"
  65                               " odd length in hex");
  66
  67   startbytes= bytes= l ? TALLOC(l*2) : 0;
  68   cbuf[2]= 0;
  69   while (l>0) {
  70     cbuf[0]= *str++;
  71     cbuf[1]= *str++;
  72     *bytes++= strtoul(cbuf,&ep,16);
  73     if (ep != cbuf+2) {
  74       TFREE(startbytes);
  75 fprintf(stderr,">%d|%s|%s<\n",l,os,cbuf);
  76       return staticerr(ip, "hbytes: conversion from hex:"
  77                        " bad hex digit");
  78     }
  79     l -= 2;
  80   }
  81   objfreeir(o);
  82
  83   HBYTES(o)->start= startbytes;
  84   HBYTES(o)->end= bytes;
  85   o->typePtr = &hbytes_type;
  86   return TCL_OK;
  87 }
  88
  89 Tcl_ObjType hbytes_type = {
  90   "hbytes",
  91   hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
  92 };
  93
  94 static Tcl_Obj *hb_getvar(Tcl_Interp *ip, Tcl_Obj *varname) {
  95   int ec;
  96   Tcl_Obj *value;
  97
  98   value= Tcl_ObjGetVar2(ip,varname,0,TCL_LEAVE_ERR_MSG);
  99   if (!value) return 0;
 100
 101   ec= Tcl_ConvertToType(ip,value,&hbytes_type);
 102   if (ec) return 0;
 103
 104   return value;
 105 }
 106
 107 static int hc_bin(ClientData cd, Tcl_Interp *ip, int objc,
 108                   Tcl_Obj *const *objv) {
 109   Tcl_Obj *varname, *value, *result;
 110   const char *str;
 111   int l;
 112
 113   varname= objv[0];
 114   switch (objc) {
 115   case 1:
 116     value= hb_getvar(ip,varname);  if (!value) return TCL_ERROR;
 117     result= Tcl_NewStringObj(HBYTES(value)->start, HBYTES_LEN(value));
 118     assert(result);
 119     Tcl_SetObjResult(ip,result);
 120     return TCL_OK;
 121   case 2:
 122     value= objv[1];
 123     str= Tcl_GetStringFromObj(value,&l);
 124     value= hbytes_set(0,str,l);
 125     value= Tcl_ObjSetVar2(ip,varname,0, value, TCL_LEAVE_ERR_MSG);
 126     if (!value) return TCL_ERROR;
 127     Tcl_ResetResult(ip);
 128     return TCL_OK;
 129   }
 130   abort();
 131 }
 132
 133 typedef struct {
 134   const char *name;
 135   int minargs, maxargs;
 136   Tcl_ObjCmdProc *func;
 137 } SubCommand;
 138
 139 static const SubCommand subcommands[] = {
 140   { "bin", 1, 2, hc_bin },
 141   { 0 }
 142 };
 143
 144 static int hb_proc(ClientData cd, Tcl_Interp *ip, int objc,
 145                    Tcl_Obj *const *objv) {
 146   const SubCommand *sc;
 147
 148   if (objc<2) return staticerr(ip, "hbytes: need subcommand");
 149   sc= enum_lookup_cached(ip,objv[1],subcommands,"hbytes subcommand");
 150   if (!sc) return TCL_ERROR;
 151   objc -= 2;
 152   objv += 2;
 153   if (objc < sc->minargs)
 154     return staticerr(ip, "too few args");
 155   if (sc->maxargs >=0 && objc > sc->maxargs)
 156     return staticerr(ip,"too many args");
 157   return sc->func((void*)sc,ip,objc,objv);
 158 }
 159
 160 int Hbytes_Init(Tcl_Interp *ip) {
 161   Tcl_RegisterObjType(&hbytes_type);
 162   Tcl_RegisterObjType(&enum_nearlytype);
 163   Tcl_CreateObjCommand(ip,"hbytes", hb_proc,0,0);
 164   return TCL_OK;
 165 }