chiark / gitweb /
macroisation, checkin before perlgen
authorian <ian>
Fri, 30 Aug 2002 18:09:02 +0000 (18:09 +0000)
committerian <ian>
Fri, 30 Aug 2002 18:09:02 +0000 (18:09 +0000)
base/chiark-tcl.h
hbytes/hbytes.c
hbytes/hbytes.h

index 5aca162..c6fe050 100644 (file)
@@ -1,9 +1,8 @@
 /*
  */
 /*
- *
- *  hbytes bin VAR                               => binary string
- *  hbytes bin VAR VALUE                         => set
+ *  hbytes raw2h BINARY                          => hex
+ *  hbytes h2raw HEX                             => binary
  *
  *  hbytes prefix VAR [VALUE ...]         = set VAR [concat VALUE ... $VAR]
  *  hbytes append VAR [VALUE ...]         = set VAR [concat $VAR VALUE ...]
  *  hbytes chopto VAR NEWVARLENGTH               => suffix (removed from VAR)
  *                                                  (too short? error)
  *
- *  hbytes pkcs5 pv|uv VAR ALG                   => worked?  (always 1 for p)
+ *  hbytes pkcs5 pa|ua VAR ALG                   => worked?  (always 1 for p)
  *  hbytes pkcs5 pn|un VAR BLOCKSIZE             => worked?  (always 1 for p)
  *  hbytes blockcipher e|d VAR ALG MODE [IV]     => IV
+ *
  *  hbytes hash ALG VALUE                        => hash
  *  hbytes hmac ALG VALUE KEY [MACLENGTH]        => mac
  *
index 99bddfe..d4a33f5 100644 (file)
@@ -104,24 +104,76 @@ static Tcl_Obj *hb_getvar(Tcl_Interp *ip, Tcl_Obj *varname) {
   return value;
 }
 
-static int hc_bin(ClientData cd, Tcl_Interp *ip, int objc,
-                 Tcl_Obj *const *objv) {
-  Tcl_Obj *varname, *value, *result;
+HC_DEFINE(raw2h) {
+  HC_DECLS;
+  Tcl_Obj *raw, *value;
   const char *str;
   int l;
 
+  HC_ARG_O(raw);
+  HC_ARGS_E;
+  str= Tcl_GetStringFromObj(raw,&l);
+  value= hbytes_set(0,str,l);
+  Tcl_SetObjResult(ip,value);
+  HC_FINI;
+}
+
+HC_DEFINE(h2raw) {
+  Tcl_Obj *value, *result;
+  
+  HC_ARG_H(value);
+  HC_ARGS_E;
+  result= Tcl_NewStringObj(HBYTES(value)->start, HBYTES_LEN(value));
+  Tcl_SetObjResult(ip,result);
+  HC_FINI;
+}
+
+HC_DEFINE(pkcs5) {
+  typedef struct {
+    const char *spec;
+    int pad, algname;
+  } PadKindInfo;
+  static const PadKindInfo padkindinfos[0]= {
+    { "pa", 1, 1 },
+    { "pn", 1, 0 },
+    { "ua", 0, 1 },
+    { "un", 0, 0 },
+    { 0 }
+  };
+
+  HC_DECLS_HBV;
+  Tcl_Obj *v;
+  int blocksize;
+  const PadKindInfo *pk;
+  const BlockCipherInfo *bc;
+
+  HC_ARG_ENUM(pk, padkindinfos);
+  HC_ARG_HBV;
+  if (!pk->algname) HC_ARG_INTRANGE(blocksize, 1,255);
+  else { HC_ARG_ENUM(bc, blockciphers); blocksize= bc->blocksize; }
+  HC_ARGS_E;
+
+  /* do nothing :-) */
+
+  HC_FINI_HBV;
+}
+  
+static int hc_raw2h(ClientData cd, Tcl_Interp *ip, int objc,
+                   Tcl_Obj *const *objv) {
+  
+  Tcl_Obj *varname, *value, *result;
+
   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);
+      HC_MINARGS(1);
+
     value= Tcl_ObjSetVar2(ip,varname,0, value, TCL_LEAVE_ERR_MSG);
     if (!value) return TCL_ERROR;
     Tcl_ResetResult(ip);
@@ -136,8 +188,14 @@ typedef struct {
   Tcl_ObjCmdProc *func;
 } SubCommand;
 
+#define SUBCOMMANDS                            \
+    DO(raw2h)                                  \
+    DO(h2raw)                                  \
+    DO(pkcs5)
+
 static const SubCommand subcommands[] = {
-  { "bin", 1, 2, hc_bin },
+#define DO(c) { #c, hc_##c },
+  SUBCOMMANDS
   { 0 }
 };
 
index 5aca162..c6fe050 100644 (file)
@@ -1,9 +1,8 @@
 /*
  */
 /*
- *
- *  hbytes bin VAR                               => binary string
- *  hbytes bin VAR VALUE                         => set
+ *  hbytes raw2h BINARY                          => hex
+ *  hbytes h2raw HEX                             => binary
  *
  *  hbytes prefix VAR [VALUE ...]         = set VAR [concat VALUE ... $VAR]
  *  hbytes append VAR [VALUE ...]         = set VAR [concat $VAR VALUE ...]
  *  hbytes chopto VAR NEWVARLENGTH               => suffix (removed from VAR)
  *                                                  (too short? error)
  *
- *  hbytes pkcs5 pv|uv VAR ALG                   => worked?  (always 1 for p)
+ *  hbytes pkcs5 pa|ua VAR ALG                   => worked?  (always 1 for p)
  *  hbytes pkcs5 pn|un VAR BLOCKSIZE             => worked?  (always 1 for p)
  *  hbytes blockcipher e|d VAR ALG MODE [IV]     => IV
+ *
  *  hbytes hash ALG VALUE                        => hash
  *  hbytes hmac ALG VALUE KEY [MACLENGTH]        => mac
  *