--- /dev/null
+/*
+ *
+ */
+
+#include "hbytes.h"
+
+int staticerr(Tcl_Interp *ip, const char *m) {
+ Tcl_SetResult(ip, (char*)m, TCL_STATIC);
+ return TCL_ERROR;
+}
+
+static void hbytes_setintern(Tcl_Obj *o, const Byte *array, int l) {
+ Byte *np;
+
+ HBYTES(o)->start= np= l ? TALLOC(l) : 0;
+ memcpy(np, array, l);
+ HBYTES(o)->end= np + l;
+ o->typePtr = &hbytes_type;
+}
+
+static void hbytes_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
+ hbytes_setintern(src, HBYTES(src)->start, HBYTES_LEN(src));
+}
+
+Tcl_Obj *hbytes_set(Tcl_Obj *overwrite, const Byte *array, int l) {
+ if (!overwrite) overwrite= Tcl_NewObj();
+ objfreeir(overwrite);
+ Tcl_InvalidateStringRep(overwrite);
+ hbytes_setintern(overwrite, array, l);
+ return overwrite;
+}
+
+static void hbytes_t_free(Tcl_Obj *o) {
+ TFREE(HBYTES(o)->start);
+}
+
+static void hbytes_t_ustr(Tcl_Obj *o) {
+ int l;
+ char *str;
+ const Byte *byte;
+
+ l= HBYTES_LEN(o);
+ byte= HBYTES(o)->start;
+ str= o->bytes= TALLOC(l*2+1);
+ o->length= l*2;
+ while (l>0) {
+ sprintf(str,"%02x",*byte);
+ str+=2; byte++; l--;
+ }
+}
+
+void objfreeir(Tcl_Obj *o) {
+ if (o->typePtr && o->typePtr->freeIntRepProc)
+ o->typePtr->freeIntRepProc(o);
+}
+
+static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
+ char *str, *ep, *os;
+ Byte *startbytes, *bytes;
+ int l;
+ char cbuf[3];
+
+ os= str= Tcl_GetStringFromObj(o,&l); assert(str);
+ if (l & 1) return staticerr(ip, "hbytes: conversion from hex:"
+ " odd length in hex");
+
+ startbytes= bytes= l ? TALLOC(l*2) : 0;
+ cbuf[2]= 0;
+ while (l>0) {
+ cbuf[0]= *str++;
+ cbuf[1]= *str++;
+ *bytes++= strtoul(cbuf,&ep,16);
+ if (ep != cbuf+2) {
+ TFREE(startbytes);
+fprintf(stderr,">%d|%s|%s<\n",l,os,cbuf);
+ return staticerr(ip, "hbytes: conversion from hex:"
+ " bad hex digit");
+ }
+ l -= 2;
+ }
+ objfreeir(o);
+
+ HBYTES(o)->start= startbytes;
+ HBYTES(o)->end= bytes;
+ o->typePtr = &hbytes_type;
+ return TCL_OK;
+}
+
+Tcl_ObjType hbytes_type = {
+ "hbytes",
+ hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
+};
+
+static Tcl_Obj *hb_getvar(Tcl_Interp *ip, Tcl_Obj *varname) {
+ int ec;
+ Tcl_Obj *value;
+
+ value= Tcl_ObjGetVar2(ip,varname,0,TCL_LEAVE_ERR_MSG);
+ if (!value) return 0;
+
+ ec= Tcl_ConvertToType(ip,value,&hbytes_type);
+ if (ec) return 0;
+
+ return value;
+}
+
+static int hc_bin(ClientData cd, Tcl_Interp *ip, int objc,
+ Tcl_Obj *const *objv) {
+ Tcl_Obj *varname, *value, *result;
+ const char *str;
+ int l;
+
+ varname= objv[0];
+ switch (objc) {
+ case 1:
+ value= hb_getvar(ip,varname); if (!value) return TCL_ERROR;
+ result= Tcl_NewStringObj(HBYTES(value)->start, HBYTES_LEN(value));
+ assert(result);
+ Tcl_SetObjResult(ip,result);
+ return TCL_OK;
+ case 2:
+ value= objv[1];
+ str= Tcl_GetStringFromObj(value,&l);
+ value= hbytes_set(0,str,l);
+ value= Tcl_ObjSetVar2(ip,varname,0, value, TCL_LEAVE_ERR_MSG);
+ if (!value) return TCL_ERROR;
+ Tcl_ResetResult(ip);
+ return TCL_OK;
+ }
+ abort();
+}
+
+typedef struct {
+ const char *name;
+ int minargs, maxargs;
+ Tcl_ObjCmdProc *func;
+} SubCommand;
+
+static const SubCommand subcommands[] = {
+ { "bin", 1, 2, hc_bin },
+ { 0 }
+};
+
+static int hb_proc(ClientData cd, Tcl_Interp *ip, int objc,
+ Tcl_Obj *const *objv) {
+ const SubCommand *sc;
+
+ if (objc<2) return staticerr(ip, "hbytes: need subcommand");
+ sc= enum_lookup_cached(ip,objv[1],subcommands,"hbytes subcommand");
+ if (!sc) return TCL_ERROR;
+ objc -= 2;
+ objv += 2;
+ if (objc < sc->minargs)
+ return staticerr(ip, "too few args");
+ if (sc->maxargs >=0 && objc > sc->maxargs)
+ return staticerr(ip,"too many args");
+ return sc->func((void*)sc,ip,objc,objv);
+}
+
+int Hbytes_Init(Tcl_Interp *ip) {
+ Tcl_RegisterObjType(&hbytes_type);
+ Tcl_RegisterObjType(&enum_nearlytype);
+ Tcl_CreateObjCommand(ip,"hbytes", hb_proc,0,0);
+ return TCL_OK;
+}