void hbytes_set(HBytes_Value *upd, const Byte *array, int l);
Tcl_Obj *hbytes_set_obj(Tcl_Obj *overwrite, const Byte *array, int l);
+/* from parse.c */
+
+typedef struct {
+ HBytes_Value *hb;
+ Tcl_Obj *obj, *var;
+} HBytes_Var;
+
+void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);
+
/* from enum.c */
extern Tcl_ObjType enum_nearlytype;
+extern Tcl_ObjType enum1_nearlytype;
const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
- size_t entrysize, const void *firstentry,
+ const void *firstentry, size_t entrysize,
const char *what);
#define enum_lookup_cached(ip,o,table,what) \
(enum_lookup_cached_func((ip),(o), \
* set to the error message.
*/
+int enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+ const char *opts, const char *what);
+ /* -1 => error */
+
/* from crypto.c */
typedef struct {
*
*/
+#include <string.h>
+
#include "hbytes.h"
static void enum_nt_dup(Tcl_Obj *src, Tcl_Obj *dup) {
0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
};
+Tcl_ObjType enum1_nearlytype = {
+ "enum1-nearly",
+ 0, enum_nt_dup, enum_nt_ustr, enum_nt_sfa
+};
+
const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
- size_t entrysize, const void *firstentry,
+ const void *firstentry, size_t entrysize,
const char *what) {
const char *supplied, *found;
const char *ep;
Tcl_AppendResult(ip, " ",found,(char*)0);
return 0;
}
+
+int enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+ const char *opts, const char *what) {
+ const char *supplied, *fp;
+
+ if (o->typePtr != &enum1_nearlytype ||
+ o->internalRep.twoPtrValue.ptr1 != opts) {
+
+ supplied= Tcl_GetStringFromObj(o,0); assert(supplied);
+
+ if (!(strlen(supplied) == 1 &&
+ (fp= strchr(opts, supplied[0])))) {
+ Tcl_ResetResult(ip);
+ Tcl_AppendResult(ip, "invalid ",what,
+ " - must be one character from: ", opts);
+ return -1;
+ }
+
+ objfreeir(o);
+ o->typePtr= &enum1_nearlytype;
+ o->internalRep.twoPtrValue.ptr1= (void*)opts;
+ o->internalRep.twoPtrValue.ptr2= (void*)fp;
+ }
+ return (const char*)o->internalRep.twoPtrValue.ptr2 - opts;
+}
- sc= enum_lookup_cached(ip,objv[1],subcommands,"hbytes subcommand");
+/*
+ */
+#include "tables.h"
-static Tcl_Obj *hb_getvar(Tcl_Interp *ip, Tcl_Obj *varname) {
- int ec;
- Tcl_Obj *value;
+int pat_charfrom(Tcl_Interp *ip, Tcl_Obj *obj, int *val,
+ const char *opts, const char *what) {
+ *val= enum1_lookup_cached_func(ip,obj,opts,what);
+ if (*val==-1) return TCL_ERROR;
+ return TCL_OK;
+}
+
+int pat_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val,
+ const void *opts, size_t sz, const char *what) {
+ *val= enum_lookup_cached_func(ip,obj,opts,sz,what);
+ if (!*val) return TCL_ERROR;
+ return TCL_OK;
+}
- value= Tcl_ObjGetVar2(ip,varname,0,TCL_LEAVE_ERR_MSG);
- if (!value) return 0;
+int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) {
+ *val= obj;
+ return TCL_OK;
+}
- ec= Tcl_ConvertToType(ip,value,&hbytes_type);
- if (ec) return 0;
+int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
+ int rc;
+ Tcl_Obj *val;
+
+ Tcl_IncrRefCount(var);
+ agg->var= var;
+
+ val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
+ if (!val) return TCL_ERROR;
+ if (Tcl_IsShared(val)) val= Tcl_DuplicateObj(val);
+ Tcl_IncrRefCount(val);
+ agg->obj= val;
+
+ rc= Tcl_ConvertToType(ip,val,&hbytes_type);
+ if (rc) return rc;
- return value;
+ agg->hb= &HBYTES(val);
+ return TCL_OK;
}
+void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg) {
+ Tcl_Obj *ro;
+
+ if (!rc) {
+ assert(agg->obj);
+ ro= Tcl_ObjSetVar2(ip,agg->var,0,agg->obj,TCL_LEAVE_ERR_MSG);
+ if (!ro) rc= TCL_ERROR;
+ }
+ if (agg->obj) Tcl_DecrRefCount(agg->obj);
+ if (agg->var) Tcl_DecrRefCount(agg->var);
+}
+
+int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {
+ int rc;
+ rc= Tcl_ConvertToType(ip,obj,&hbytes_type); if (rc) return rc;
+ *val= HBYTES(obj);
+ return TCL_OK;
+}
+
+Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) {
+ return hbytes_set_obj(0, val.start, HBYTES_LEN(val));
+}
Type hb: HBytes_Value @
Init hb @.start=0; @.end=0;
-Type hbv: HBytes_Value *@
+Type hbv: HBytes_Var @
+Init hbv @.hb=0; @.obj=0; @.var=0;
+Fini hbv fini_hbv(ip, rc, &@);
H-Include "hbytes.h"
Untabled
hbytes
- subcmd enum(ParserCommandTableEntry,pcmdtab_hbytes)
+ subcmd enum(HBytes_SubCommand, "hbytes subcommand")
obj ...
-Table hbytes
+Table hbytes HBytes_SubCommand
raw2h
binary obj
=> hb
length int
=> hb
pkcs5
- meth enum(PadMethodInfo,padmethodinfos)
+ meth enum(PadMethod, "hbytes pad subcommand")
obj ...
blockcipher
- encrypt charfrom("de")
+ encrypt charfrom("de","encrypt/decrypt")
v hbv
- alg enum(BlockCipherAlgInfo,blockcipheralginfos)
- mode enum(BlockCipherModeInfo,blockciphermodeinfos)
+ alg enum(BlockCipherAlgInfo, "alg")
+ mode enum(BlockCipherModeInfo, "mode")
?iv hb
=> hb
hash
- alg enum(HashAlgInfo,hashalginfos)
+ alg enum(HashAlgInfo, "hash alg")
message hb
=> hb
hmac
- alg enum(HashAlgInfo,hashalginfos)
+ alg enum(HashAlgInfo, "hash alg for hmac")
message hb
key hb
maclen int
=> hb
-Table padmethod
- Of PadMethodInfo
+Table padmethod PadMethod
pa 1, 0
-EntryExtra PadMethodInfo
+EntryExtra PadMethod
int pad, algname;
unshift @i, $this_indent;
}
- if (@i==0 && m/^Table\s+(\w+)$/) {
+ if (@i==0 && m/^Table\s+(\w+)\s+(\w+)$/) {
zilch();
$c_table= $1;
- $table_x{$c_table}{C}= 'ParserCommandTableEntry';
- $entrytype_x{ParserCommandTableEntry}= '';
+ $table_x{$c_table}{C}= $2;
+ $entrytype_x{$2}= '';
} elsif (@i==0 && m/^Untabled$/) {
zilch();
$c_table= '';
} elsif (@i==0 && m/^(C|H)\-Include\s+(\S.*)$/) {
o(lc $1, 30, "#include $2\n");
- } elsif (@i==1 && m/^Of\s+(\w+)$/ && defined $c_table) {
- die unless length $c_table;
- $table_x{$c_table}{C}= $1;
- $entrytype_x{$1}= '';
} elsif (@i==0 && m/^EntryExtra\s+(\w+)$/) {
zilch();
$c_entryextra= $1;
$types{$typename}= { C => $ctype, X => $xtypeargs };
} elsif (@i==0 && s/^Init\s+(\w+)\s+(\S.*)//) {
$type_init{$1}= $2;
+ } elsif (@i==0 && s/^Fini\s+(\w+)\s+(\S.*)//) {
+ $type_fini{$1}= $2;
} else {
badsyntax($wh,$., sprintf
"bad directive (indent level %d)", scalar @i);
$type= $types{$t};
$c= $type->{C};
$xta= $type->{X};
- $decl= "int pat_$t(Tcl_Interp*, Tcl_Obj*, ";
- $decl .= subst_in_decl('*', $c, "type $t");
+ $decl= "int pat_$t(Tcl_Interp *ip, Tcl_Obj *obj, ";
+ $decl .= subst_in_decl('*val', $c, "type $t");
$decl .= ", $xta", if length $xta;
$decl .= ");\n";
o('h',160, $decl);
- $decl= "Tcl_Obj *ret_$t(Tcl_Interp*, ".subst_in_decl('',$c).");\n";
+ $decl= "Tcl_Obj *ret_$t(Tcl_Interp *ip, ".subst_in_decl('val',$c).");\n";
o('h',170, $decl);
}
$pa_vars .= " const void *v_$n= 0;\n";
$paarg= "&v_$n";
$pafin= "\n a_$n= v_$n; ";
- $a =~ m/\,/ or die; $a = "$', sizeof($`)";
- o('h', 210, "extern const $` $'".'[]'.";\n");
+ $a =~ m/\,/ or die "invalid enum type \`$a'\n";
+ $a_tab = lc($`).'s';
+ $a = "$a_tab, sizeof($`), $'";
+ o('h', 210, "extern const $` $a_tab".'[]'.";\n");
+ }
+ if (exists $type_fini{$t}) {
+ $pa_fini .= ' '.subst_in("a_$n", $type_fini{$t})."\n";
}
$pa_body .= " rc= pat_$t(ip, *objv++, $paarg";
$pa_body .= ", ".$a if length $a;
o('h',100, $do_decl.";\n") or die $!;
- $op_tab .= sprintf(" { %-20s, %-50s%s },\n",
- "\"$c_entry\"",
+ $op_tab .= sprintf(" { %-20s %-40s%s },\n",
+ "\"$c_entry\",",
"pa_${c_table}_${c_entry}",
$r_entry->{I});
}
if (length $c_table) {
- $decl= "const $x_table->{C} pcmdtab_$c_table".'[]';
+ $decl= "const $x_table->{C} ".lc($x_table->{C}).'s[]';
o('h', 500, "extern $decl;\n");
o('c', 100,
"$decl = {\n".
o(h, 400,
"void setstringresult(Tcl_Interp*, const char*);\n".
- "int pat_enum(Tcl_Interp*, Tcl_Obj*, const void**, const void*, size_t);\n");
+ "int pat_enum(Tcl_Interp*, Tcl_Obj*, const void**,".
+ " const void*, size_t, const char *what);\n");
o(h, 999,
"#endif /*INCLUDED_\U${prefix}_H*/\n");
my ($n, $t, $ta) = @_;
my ($type);
if ($t eq 'enum') {
- $ta =~ m/\,/ or die "enum with bad args \`$ta'\n";
+ $ta =~ m/\,/ or die "invalid enum type \`$t'\n";
$c= "const $` *@";
} else {
defined $types{$t} or die "unknown type $t\n";
}
__DATA__
-Type int: int
-Type obj: Tcl_Obj *@
-Type charfrom(const char*): int
+Type int: int
+Type obj: Tcl_Obj *@
+
+Type charfrom(const char *opts, const char *what): int
OBJS= tables.o \
hbytes.o \
- enum.o
+ enum.o \
+ parse.o
HDRS= hbytes.h \
$(AUTO_HDRS)
#endif
int do__hbytes(ClientData cd, Tcl_Interp *ip,
- const ParserCommandTableEntry *subcmd,
+ const HBytes_SubCommand *subcmd,
int objc, Tcl_Obj *const *objv) {
return subcmd->func(0,ip,objc,objv);
}
int Hbytes_Init(Tcl_Interp *ip) {
Tcl_RegisterObjType(&hbytes_type);
Tcl_RegisterObjType(&enum_nearlytype);
+ Tcl_RegisterObjType(&enum1_nearlytype);
Tcl_CreateObjCommand(ip,"hbytes", pa__hbytes,0,0);
return TCL_OK;
}
void hbytes_set(HBytes_Value *upd, const Byte *array, int l);
Tcl_Obj *hbytes_set_obj(Tcl_Obj *overwrite, const Byte *array, int l);
+/* from parse.c */
+
+typedef struct {
+ HBytes_Value *hb;
+ Tcl_Obj *obj, *var;
+} HBytes_Var;
+
+void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);
+
/* from enum.c */
extern Tcl_ObjType enum_nearlytype;
+extern Tcl_ObjType enum1_nearlytype;
const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
- size_t entrysize, const void *firstentry,
+ const void *firstentry, size_t entrysize,
const char *what);
#define enum_lookup_cached(ip,o,table,what) \
(enum_lookup_cached_func((ip),(o), \
* set to the error message.
*/
+int enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+ const char *opts, const char *what);
+ /* -1 => error */
+
/* from crypto.c */
typedef struct {
- sc= enum_lookup_cached(ip,objv[1],subcommands,"hbytes subcommand");
+/*
+ */
+#include "tables.h"
-static Tcl_Obj *hb_getvar(Tcl_Interp *ip, Tcl_Obj *varname) {
- int ec;
- Tcl_Obj *value;
+int pat_charfrom(Tcl_Interp *ip, Tcl_Obj *obj, int *val,
+ const char *opts, const char *what) {
+ *val= enum1_lookup_cached_func(ip,obj,opts,what);
+ if (*val==-1) return TCL_ERROR;
+ return TCL_OK;
+}
+
+int pat_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val,
+ const void *opts, size_t sz, const char *what) {
+ *val= enum_lookup_cached_func(ip,obj,opts,sz,what);
+ if (!*val) return TCL_ERROR;
+ return TCL_OK;
+}
- value= Tcl_ObjGetVar2(ip,varname,0,TCL_LEAVE_ERR_MSG);
- if (!value) return 0;
+int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) {
+ *val= obj;
+ return TCL_OK;
+}
- ec= Tcl_ConvertToType(ip,value,&hbytes_type);
- if (ec) return 0;
+int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
+ int rc;
+ Tcl_Obj *val;
+
+ Tcl_IncrRefCount(var);
+ agg->var= var;
+
+ val= Tcl_ObjGetVar2(ip,var,0,TCL_LEAVE_ERR_MSG);
+ if (!val) return TCL_ERROR;
+ if (Tcl_IsShared(val)) val= Tcl_DuplicateObj(val);
+ Tcl_IncrRefCount(val);
+ agg->obj= val;
+
+ rc= Tcl_ConvertToType(ip,val,&hbytes_type);
+ if (rc) return rc;
- return value;
+ agg->hb= &HBYTES(val);
+ return TCL_OK;
}
+void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg) {
+ Tcl_Obj *ro;
+
+ if (!rc) {
+ assert(agg->obj);
+ ro= Tcl_ObjSetVar2(ip,agg->var,0,agg->obj,TCL_LEAVE_ERR_MSG);
+ if (!ro) rc= TCL_ERROR;
+ }
+ if (agg->obj) Tcl_DecrRefCount(agg->obj);
+ if (agg->var) Tcl_DecrRefCount(agg->var);
+}
+
+int pat_hb(Tcl_Interp *ip, Tcl_Obj *obj, HBytes_Value *val) {
+ int rc;
+ rc= Tcl_ConvertToType(ip,obj,&hbytes_type); if (rc) return rc;
+ *val= HBYTES(obj);
+ return TCL_OK;
+}
+
+Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) {
+ return hbytes_set_obj(0, val.start, HBYTES_LEN(val));
+}