--- /dev/null
+tables.[ch]
+*.d
--- /dev/null
+BASE_DIR = ../base
+EXTENSION = chiark-tcl-adns
+CFILES = adns
+
+include ../base/extension.make
+
#include <stdio.h>
-#include "tables.h"
-#include "hbytes.h"
+#include <adns.h>
+
+#include "adnstcl.h"
/*---------- important types and forward declarations ----------*/
static int oifn_reverse_any(Tcl_Interp *ip, const OptionInfo *oi,
Tcl_Obj *arg, OptionParse *op) {
- return pat_string(ip,arg,&op->reverseany);
+ return cht_pat_string(ip,arg,&op->reverseany);
}
#define OIFA1(t,f,r) { "-" #f, oifn_fa, 0, adns_##t##_##f, r }
objc--; objv++;
for (;;) {
if (!objc--) break;
- rc= pat_enum(ip, *objv++, &oi_v, opttable, sizeof(OptionInfo),
+ rc= cht_pat_enum(ip, *objv++, &oi_v, opttable, sizeof(OptionInfo),
"query or resolver option");
if (rc) return rc;
oi= oi_v;
if (oi->takesarg) {
if (!objc--) {
- setstringresult(ip,"missing value for option");
+ cht_setstringresult(ip,"missing value for option");
return TCL_ERROR;
}
arg= *objv++;
int rc;
const char *str;
- rc= pat_string(ip,arg,&str); if (rc) return rc;
+ rc= cht_pat_string(ip,arg,&str); if (rc) return rc;
if (!strcmp(str,"stderr")) op->errfile= stderr;
else if (!strcmp(str,"stdout")) op->errfile= stdout;
- else return staticerr(ip,"-errfile argument must be stderr or stdout",0);
+ else return cht_staticerr(ip,"-errfile argument must be stderr or stdout",0);
op->aflags &= ~adns_if_noerrprint;
op->errcallback= 0;
static int oifn_config(Tcl_Interp *ip, const OptionInfo *oi,
Tcl_Obj *arg, OptionParse *op) {
- return pat_string(ip,arg,&op->config_string);
+ return cht_pat_string(ip,arg,&op->config_string);
}
static const OptionInfo resolver_optioninfos[]= {
};
static void adnslogfn_flushmessage(Resolver *res) {
- scriptinv_invoke(&res->errcallback, 1, &res->errstring_accum);
+ cht_scriptinv_invoke(&res->errcallback, 1, &res->errstring_accum);
Tcl_SetObjLength(res->errstring_accum, 0);
}
l= vasprintf(&str,fmt,al);
if (l<0) {
- posixerr(res->interp,errno,"construct adns log callback string");
+ cht_posixerr(res->interp,errno,"construct adns log callback string");
Tcl_BackgroundError(res->interp);
}
res->ads= 0;
}
asynch_cancelhandlers(res);
- scriptinv_cancel(&res->errcallback);
+ cht_scriptinv_cancel(&res->errcallback);
Tcl_EventuallyFree(res, Tcl_Free);
}
destroy_resolver(ip,resolver_v);
}
-int do_adns_destroy_resolver(ClientData cd, Tcl_Interp *ip, void *res_v) {
- tabledataid_disposing(ip,res_v,&adnstcl_resolvers);
+int cht_do_adns_destroy_resolver(ClientData cd, Tcl_Interp *ip, void *res_v) {
+ cht_tabledataid_disposing(ip,res_v,&adnstcl_resolvers);
destroy_resolver(ip,res_v);
return TCL_OK;
}
res->timertoken= 0;
res->maxfd= 0;
for (i=0; i<3; i++) FD_ZERO(&res->handling[i]);
- scriptinv_init(&res->errcallback);
+ cht_scriptinv_init(&res->errcallback);
res->errstring_accum= 0;
if (op->errcallback)
- scriptinv_set(&res->errcallback, ip, op->errcallback, 0);
+ cht_scriptinv_set(&res->errcallback, ip, op->errcallback, 0);
ec= adns_init_logfn(&res->ads,
op->aflags | adns_if_noautosys,
return TCL_OK;
}
-const IdDataSpec adnstcl_resolvers= {
+static const IdDataSpec adnstcl_resolvers= {
"adns-res", "adns-resolvers-table", destroy_resolver_idtabcb
};
const IdDataSpec adnstcl_queries= {
"adns", "adns-query-table", destroy_query_idtabcb
};
+
+/*---------- main hooks for tcl ----------*/
+
+int do_toplevel_adns(ClientData cd, Tcl_Interp *ip,
+ const Adns_SubCommand *subcmd,
+ int objc, Tcl_Obj *const *objv) {
+ return subcmd->func(0,ip,objc,objv);
+}
+
+extern int Adns_Init(Tcl_Interp *ip); /* called by Tcl's "load" */
+int Adns_Init(
+ Tcl_RegisterObjType(&blockcipherkey_type);
+ Tcl_RegisterObjType(&sockaddr_type);
+ Tcl_RegisterObjType(&tabledataid_nearlytype);
+ Tcl_RegisterObjType(&ulong_type);
+ Tcl_RegisterObjType(&addrmap_type);
--- /dev/null
+H-Include "adnstcl.h"
+
+Type adnsresults: adns_answer *@
+Init adnsresults @=0;
+Fini adnsresults free(@);
+
+Table toplevel TopLevel_Command
+ adns
+ subcmd enum(Adns_SubCommand,"adns subcommand")
+ ... obj
+
+Table adns Adns_SubCommand
+ lookup
+ rrtype enum(AdnsTclRRTypeInfo, "rrtype")
+ domain string
+ ... obj
+ => obj
+ synch
+ rrtype enum(AdnsTclRRTypeInfo, "rrtype")
+ domain string
+ ... obj
+ => obj
+ asynch
+ on_yes obj
+ on_no obj
+ on_fail obj
+ xargs obj
+ rrtype enum(AdnsTclRRTypeInfo, "rrtype")
+ domain string
+ ... obj
+ => iddata(&adnstcl_queries)
+ asynch-cancel
+ query iddata(&adnstcl_queries)
+ new-resolver
+ ... obj
+ => iddata(&adnstcl_resolvers)
+ set-default-resolver
+ res iddata(&adnstcl_resolvers)
+ destroy-resolver
+ res iddata(&adnstcl_resolvers)
+
--- /dev/null
+/*
+ */
+
+#ifndef ADNSTCL_H
+#define ADNSTCL_H
+
+#include "chiark-tcl.h"
+
+typedef struct {
+ const char *name;
+ adns_rrtype number;
+} AdnsTclRRTypeInfo;
+
+const IdDataSpec adnstcl_queries, adnstcl_resolvers;
+
+#include "tables.h"
+
+#endif /*ADNSTCL_H*/
--- /dev/null
+tables.[ch]
+*.d
--- /dev/null
+default: all
+
+SHLIB = chiark-tcl
+CFILES = hook parse tcmdiflib
+BASE_DIR = .
+
+AUTO_HDRS += tables.h
+AUTO_SRCS += tables.c
+
+include common.make
+
+tables.c: $(BASE_TCT) $(TCMDIFGEN)
+ $(TCMDIFGEN) -wc -o$@ $<
+
+tables.h: $(BASE_TCT) $(TCMDIFGEN)
+ $(TCMDIFGEN) -wh -o$@ $<
+
+include shlib.make
+include final.make
--- /dev/null
+Type iddata(const IdDataSpec *idds): void *@
+Type ulong: uint32_t @
+Type long: long @
+Type string: const char *@
+Type constv(Tcl_ObjType*): Tcl_Obj *@
+
+Type charfrom(const char *opts, const char *what): int
+
+NoEntryDefine TopLevel_Command
+
+H-Include "chiark-tcl.h"
/*
*/
-/*
- * hbytes raw2h BINARY => hex
- * hbytes h2raw HEX => binary
- *
- * hbytes length VALUE => count
- * hbytes prepend VAR [VALUE ...] = set VAR [concat VALUE ... $VAR]
- * hbytes append VAR [VALUE ...] = set VAR [concat $VAR VALUE ...]
- * hbytes concat VAR [VALUE ...] = set VAR [concat VALUE ...]
- * hbytes unprepend VAR PREFIXLENGTH => prefix (removed from VAR)
- * hbytes unappend VAR SUFFIXLENGTH => suffix (removed from VAR)
- * hbytes chopto VAR NEWVARLENGTH => suffix (removed from VAR)
- * (too short? error)
- *
- * hbytes range VALUE START SIZE => substring (or error)
- * hbytes overwrite VAR START VALUE
- * hbytes trimleft VAR removes any leading 0 octets
- * hbytes repeat VALUE COUNT => COUNT copies of VALUE
- * hbytes zeroes COUNT => COUNT zero bytes
- * hbytes random COUNT => COUNT random bytes
- * hbytes xor VAR VALUE $VAR (+)= VALUE
- *
- * hbytes ushort2h LONG => LONG must be <2^16, returns as hex
- * hbytes h2ushort HEX => |HEX| must be 2 bytes, returns as ulong
- *
- * hbytes compare A B
- * => -2 A is lexically earlier than B and not a prefix of B (A<B)
- * -1 A is prefix of B but not equal (A<B)
- * 0 A == B
- * +1 A is B plus a nonempty suffix (ie, A has B as a prefix)
- * +2 A is lexically later than B and does not have B as a prefix
- *
- * hbytes pad pa|ua VAR ALG METH [METHARGS] => worked? (always 1 for p)
- * hbytes pad pn|un VAR BS METH [METHARGS] => worked? (always 1 for p)
- * hbytes pad pa|pn VAR ALG|BS pkcs5 => 1
- * hbytes pad ua|un VAR ALG|BS pkcs5 => worked?
- * hbytes pad pa|pn VAR ALG|BS rfc2406 NXTHDR => 1
- * hbytes pad ua|un VAR ALG|BS rfc2406 NXTHDRVAR => worked?
- *
- * hbytes blockcipher d|e VAR ALG KEY MODE [IV] => IV
- * hbytes blockcipher mac MSG ALG KEY MODE IV => final block
- * hbytes blockcipher prop PROPERTY ALG => property value
- *
- * hbytes hash ALG MESSAGE => hash
- * hbytes hmac ALG MESSAGE KEY [MACLENGTH] => mac
- * hbytes hash-prop PROPERTY ALG => property value
- *
- * ulong ul2int ULONG => INT can fail if >INT_MAX
- * ulong int2ul INT => ULONG can fail if <0
- * ulong mask A B => A & B
- * ulong add A B => A + B (mod 2^32)
- * ulong subtract A B => A - B (mod 2^32)
- * ulong compare A B => 0 -1 (A<B) +1 (A>B)
- * ulong shift l|r ULONG BITS fails if BITS >32
- *
- * ulong ul2bitfields VALUE [SIZE TYPE [TYPE-ARG...] ...] => 0/1
- * ulong bitfields2ul BASE [SIZE TYPE [TYPE-ARG...] ...] => ULONG
- * goes from left (MSbit) to right (LSbit) where
- * SIZE is size in bits
- * TYPE [TYPE-ARGS...] is as below
- * zero
- * ignore
- * fixed ULONG-VALUE
- * uint VARNAME/VALUE (VARNAME if ul2bitfields;
- * ulong VARNAME/VALUE VALUE if bitfields2ul)
- *
- * Address ranges (addrmap.c):
- *
- * An address range is a slightly efficient partial mapping from
- * addresses to arbitrary data values. An address is a number of
- * octets expressed as an hbytes. All the addresses covered by the
- * same addrmap should have the same length.
- *
- * hbytes addr-map lookup MAP-VAR ADDRESS [DEFAULT] => DATA
- * Error on missing default or if any prefix longer than ADDRESS.
- *
- * hbytes addr-map amend-range MAP-VAR START END DATA
- * hbytes addr-map amend-mask MAP-VAR PREFIX PREFIX-LENGTH DATA
- * Sets all of the addresses in PREFIX/PREFIX-LENGTH to the
- * relevant value.
- *
- * Representation:
- * An address map MAP is
- * [list BIT-LENGTH \
- * [list START END DATA-VALUE] \
- * [list START' END' DATA-VALUE'] \
- * ...
- * ]
- * The list is sorted by ascending START and entries do not overlap.
- * START and END are both inclusive. BIT-LENGTH is in usual Tcl
- * integer notation and must be a multiple of 8.
- *
- * Error codes
- *
- * HBYTES BLOCKCIPHER CRYPTFAIL CRYPT block cipher mode failed somehow (!)
- * HBYTES BLOCKCIPHER CRYPTFAIL MAC HMAC failed somehow (!)
- * HBYTES BLOCKCIPHER LENGTH block cipher input has unsuitable length
- * HBYTES BLOCKCIPHER PARAMS key or iv not suitable
- * HBYTES HMAC PARAMS key, input or output size not suitable
- * HBYTES LENGTH OVERRUN block too long
- * HBYTES LENGTH RANGE input length or offset is -ve or silly
- * HBYTES LENGTH UNDERRUN block too short (or offset too big)
- * HBYTES LENGTH MISMATCH when blocks must be exactly same length
- * HBYTES SYNTAX supposed hex block had wrong syntax
- * HBYTES VALUE OVERFLOW value to be conv'd to hex too big/long
- * HBYTES ADDRMAP NOMATCH no addr/mask matches address for lookup
- * HBYTES ADDRMAP UNDERRUN addr for lookup or amend is too short
- * HBYTES ADDRMAP OVERRUN addr for lookup or amend is too long
- * HBYTES ADDRMAP EXCLBITS amend-mask 1-bits outside prefix len
- * HBYTES ADDRMAP BADRANGE amend-range start > end
- * HBYTES ADDRMAP VALUE addr-map string value is erroneous
- * SOCKADDR AFUNIX LENGTH path for AF_UNIX socket too long
- * SOCKADDR SYNTAX IPV4 bad IPv4 socket address &/or port
- * SOCKADDR SYNTAX OTHER bad socket addr, couldn't tell what kind
- * ULONG BITCOUNT NEGATIVE -ve bitcount specified where not allowed
- * ULONG BITCOUNT OVERRUN attempt to use more than 32 bits
- * ULONG BITCOUNT UNDERRUN bitfields add up to less than 32
- * ULONG VALUE NEGATIVE attempt convert -ve integers to ulong
- * ULONG VALUE OVERFLOW converted value does not fit in result
- * TUNTAP IFNAME LENGTH tun/tap interface name too long
- * TUNTAP MTU OVERRUN tun/tap mtu limited to 2^16 bytes
- *
- * Refs: HMAC: RFC2104 */
-
-#ifndef HBYTES_H
-#define HBYTES_H
+
+#ifndef CHIARK_TCL_H
+#define CHIARK_TCL_H
#include <assert.h>
#include <stdlib.h>
typedef unsigned char Byte;
-/* from hbytes.c */
-
-int Hbytes_Init(Tcl_Interp *ip); /* called by Tcl's "load" */
-
-/* Internal representation details: */
-#define HBYTES_ISEMPTY(hb) (!(hb)->begin_complex && !(hb)->end_0)
-#define HBYTES_ISSENTINEL(hb) (!(hb)->begin_complex && (hb)->end_0)
-#define HBYTES_ISSIMPLE(hb) ((hb)->begin_complex && (hb)->end_0)
-#define HBYTES_ISCOMPLEX(hb) ((hb)->begin_complex && !(hb)->end_0)
-
-typedef struct {
- void *begin_complex, *end_0;
-} HBytes_Value; /* overlays internalRep */
-
-typedef struct {
- Byte *dstart; /* always allocated dynamically */
- int prespace, len, avail;
- /*
- * | SPARE | USED | SPARE |
- * |<-prespace->|<-len->| |
- * | |<----avail---->|
- * ^start
- */
-} HBytes_ComplexValue; /* pointed to from internalRep.otherValuePtr */
+/* for assisting tcmdifgen and tcmdiflib.c */
-/* Public interfaces: */
+typedef struct TopLevel_Command TopLevel_Command;
-extern Tcl_ObjType hbytes_type;
-
-int hbytes_len(const HBytes_Value *v);
-Byte *hbytes_data(const HBytes_Value *v); /* caller may then modify data! */
-int hbytes_issentinel(const HBytes_Value *v);
-
-Byte *hbytes_prepend(HBytes_Value *upd, int el);
-Byte *hbytes_append(HBytes_Value *upd, int el);
- /* return value is where to put the data */
-
-const Byte *hbytes_unprepend(HBytes_Value *upd, int rl);
-const Byte *hbytes_unappend(HBytes_Value *upd, int rl);
- /* return value points to the removed data, which remains valid
- * until next op on the HBytes_Value. If original value is
- * shorter than rl or negative, returns 0 and does nothing. */
-
-void hbytes_empty(HBytes_Value *returns);
-void hbytes_sentinel(HBytes_Value *returns);
-void hbytes_array(HBytes_Value *returns, const Byte *array, int l);
-Byte *hbytes_arrayspace(HBytes_Value *returns, int l);
-void hbytes_free(const HBytes_Value *frees);
- /* _empty, _sentinel and _array do not free or read the old value;
- * _free it first if needed. _free leaves it garbage, so you
- * have to call _empty to reuse it. _arrayspace doesn't fill
- * the array; you get a pointer and must fill it with data
- * yourself. */
-
-/* The value made by hbytes_sentinel should not be passed to
- * anything except HBYTES_IS..., and hbytes_free. */
-
-/* from sockaddr.c */
-
-typedef struct {
- Byte *begin, *end;
-} SockAddr_Value;
-
-extern Tcl_ObjType sockaddr_type;
+struct TopLevel_Command {
+ const char *name;
+ Tcl_ObjCmdProc *func;
+};
-void sockaddr_clear(SockAddr_Value*);
-void sockaddr_create(SockAddr_Value*, const struct sockaddr *addr, int len);
-int sockaddr_len(const SockAddr_Value*);
-const struct sockaddr *sockaddr_addr(const SockAddr_Value*);
-void sockaddr_free(const SockAddr_Value*);
+void cht_setstringresult(Tcl_Interp*, const char*);
+int cht_pat_enum(Tcl_Interp*, Tcl_Obj*, const void**,
+ const void*, size_t, const char *what);
/* from scriptinv.c */
int llength;
} ScriptToInvoke;
-void scriptinv_init(ScriptToInvoke *si);
-int scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
+void cht_scriptinv_init(ScriptToInvoke *si);
+int cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
Tcl_Obj *newscript, Tcl_Obj *xargs);
-void scriptinv_cancel(ScriptToInvoke *si); /* then don't invoke */
+void cht_scriptinv_cancel(ScriptToInvoke *si); /* then don't invoke */
/* no separate free function - just cancel */
-void scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv);
+void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv);
/* from idtable.c */
* be -1; on subsequent occasions it must be >=0. ix will be -1 iff
* the struct is registered by the iddatatable machinery. */
-extern Tcl_ObjType tabledataid_nearlytype;
-int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds);
-void tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds);
+extern Tcl_ObjType cht_tabledataid_nearlytype;
+int cht_tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, const IdDataSpec *idds);
+void cht_tabledataid_disposing(Tcl_Interp *ip, void *val, const IdDataSpec *idds);
/* call this when you destroy the struct, to remove its name;
* _disposing is idempotent */
-/* from adns.c */
-
-typedef struct {
- const char *name;
- adns_rrtype number;
-} AdnsTclRRTypeInfo;
-
-extern const IdDataSpec adnstcl_queries, adnstcl_resolvers;
-
-/* from dgram.c */
-
-extern const IdDataSpec dgram_socks;
-int newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
-
-/* from tuntap.c */
-
-extern const IdDataSpec tuntap_socks;
-
/* from hook.c */
-int staticerr(Tcl_Interp *ip, const char *m, const char *ec);
-int posixerr(Tcl_Interp *ip, int errnoval, const char *m);
-void objfreeir(Tcl_Obj *o);
-int get_urandom(Tcl_Interp *ip, Byte *buffer, int l);
+int cht_initextension(Tcl_Interp *ip, const TopLevel_Command *cmds,
+ int *donep /* or 0, meaning no types follow */,
+ ... /* types, terminated by 0 */);
+
+int cht_staticerr(Tcl_Interp *ip, const char *m, const char *ec);
+int cht_posixerr(Tcl_Interp *ip, int errnoval, const char *m);
+int cht_newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
+void cht_objfreeir(Tcl_Obj *o);
+int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l);
-void obj_updatestr_array(Tcl_Obj *o, const Byte *array, int l);
-void obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
+void cht_obj_updatestr_array(Tcl_Obj *o, const Byte *array, int l);
+void cht_obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
int l, const char *prefix);
-void obj_updatestr_vstringls(Tcl_Obj *o, ...);
+void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...);
/* const char*, int, const char*, int, ..., (const char*)0 */
-void obj_updatestr_string_len(Tcl_Obj *o, const char *str, int l);
-void obj_updatestr_string(Tcl_Obj *o, const char *str);
+void cht_obj_updatestr_string_len(Tcl_Obj *o, const char *str, int l);
+void cht_obj_updatestr_string(Tcl_Obj *o, const char *str);
/* from parse.c */
int copied;
} Something_Var;
-void init_somethingv(Something_Var *sth);
-void fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth);
-int pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
+void cht_init_somethingv(Something_Var *sth);
+void cht_fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth);
+int cht_pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
Something_Var *sth, Tcl_ObjType *type);
-typedef struct {
- HBytes_Value *hb;
- Something_Var sth;
-} HBytes_Var;
-
-/* from addrmap.c */
-
-typedef struct AddrMap_Value AddrMap_Value;
-
-typedef struct {
- AddrMap_Value *am;
- Something_Var sth;
-} AddrMap_Var;
-
-extern Tcl_ObjType addrmap_type;
-
-/* from chop.c */
- /* only do_... functions declared in tables.h */
-
-/* from ulong.c */
-
-Tcl_ObjType ulong_type;
-
/* from enum.c */
-extern Tcl_ObjType enum_nearlytype;
-extern Tcl_ObjType enum1_nearlytype;
+extern Tcl_ObjType cht_enum_nearlytype;
+extern Tcl_ObjType cht_enum1_nearlytype;
-const void *enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+const void *cht_enum_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
const void *firstentry, size_t entrysize,
const char *what);
#define enum_lookup_cached(ip,o,table,what) \
- (enum_lookup_cached_func((ip),(o), \
+ (cht_enum_lookup_cached_func((ip),(o), \
&(table)[0],sizeof((table)[0]), \
(what)))
/* table should be a pointer to an array of structs of size
* set to the error message.
*/
-int enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
+int cht_enum1_lookup_cached_func(Tcl_Interp *ip, Tcl_Obj *o,
const char *opts, const char *what);
/* -1 => error */
-/* from crypto.c */
-
-void memxor(Byte *dest, const Byte *src, int l);
-
-typedef struct {
- const char *name;
- int pad, use_algname;
-} PadOp;
-
-extern Tcl_ObjType blockcipherkey_type;
-
-/* from algtables.c */
-
-typedef struct {
- const char *name;
- int int_offset;
-} BlockCipherPropInfo, HashAlgPropInfo;
-
-typedef struct {
- const char *name;
- int hashsize, blocksize, statesize;
- void (*init)(void *state);
- void (*update)(void *state, const void *data, int len);
- void (*final)(void *state, void *digest);
- void (*oneshot)(void *digest, const void *data, int len);
-} HashAlgInfo;
-
-extern const HashAlgInfo hashalginfos[];
-
-typedef struct {
- void (*make_schedule)(void *schedule, const void *key, int keylen);
- void (*crypt)(const void *schedule, const void *in, void *out);
- /* in and out may be the same, but if they aren't they may not overlap */
- /* in and out for crypt will have been through block_byteswap */
-} BlockCipherPerDirectionInfo;
-
-typedef struct {
- const char *name;
- int blocksize, schedule_size, key_min, key_max;
- BlockCipherPerDirectionInfo encrypt, decrypt;
-} BlockCipherAlgInfo;
-
-extern const BlockCipherAlgInfo blockcipheralginfos[];
-
-/* from bcmode.c */
-
-typedef struct {
- const char *name;
- int iv_blocks, buf_blocks, mac_blocks;
-
- /* Each function is allowed to use up to buf_blocks * blocksize
- * bytes of space in buf. data is blocks * blocksize bytes
- * long. data should be modified in place by encrypt and decrypt;
- * modes may not change the size of data. iv is always provided and
- * is always of length iv_blocks * blocksize; encrypt and
- * decrypt may modify the iv value (in which case the Tcl caller
- * will get the modified IV) but this is not recommended. mac
- * should leave the mac, which must be mac_blocks * blocksize
- * bytes, in buf. (Therefore mac_blocks must be at least
- * buf_blocks.)
- */
- const char *(*encrypt)(Byte *data, int nblocks,
- const Byte *iv, Byte *buf,
- const BlockCipherAlgInfo *alg, int encr,
- const void *sch);
- const char *(*decrypt)(Byte *data, int nblocks,
- const Byte *iv, Byte *buf,
- const BlockCipherAlgInfo *alg, int encr,
- const void *sch);
- const char *(*mac)(const Byte *data, int nblocks,
- const Byte *iv, Byte *buf,
- const BlockCipherAlgInfo *alg,
- const void *sch);
-} BlockCipherModeInfo;
-
-extern const BlockCipherModeInfo blockciphermodeinfos[];
-
-/* from misc.c */
-
-int setnonblock(int fd, int isnonblock);
-
/* useful macros */
-#define OBJ_HBYTES(o) ((HBytes_Value*)&(o)->internalRep.twoPtrValue)
-#define OBJ_SOCKADDR(o) ((SockAddr_Value*)&(o)->internalRep.twoPtrValue)
-
#define TALLOC(s) ((void*)Tcl_Alloc((s)))
#define TFREE(f) (Tcl_Free((void*)(f)))
#define TREALLOC(p,l) ((void*)Tcl_Realloc((void*)(p),(l)))
-#endif /*HBYTES_H*/
+#endif /*CHIARK_TCL_H*/
--- /dev/null
+OPTIMISE ?= -O2
+TCL_MEM_DEBUG ?= -DTCL_MEM_DEBUG
+
+TCMDIFGEN ?= $(BASE_DIR)/tcmdifgen
+BASE_TCT ?= $(BASE_DIR)/base.tct
+
+CFLAGS += -g -Wall -Wmissing-prototypes -Wstrict-prototypes -Werror \
+ $(OPTIMISE)
+CPPFLAGS += -I$(BASE_DIR)
+CPPFLAGS += $(TCL_MEM_DEBUG)
+
+AUTOS += $(AUTO_SRCS) $(AUTO_HDRS)
+
+default: all
+
--- /dev/null
+
+SHLIB ?= $(EXTENSION)
+
+AUTO_HDRS += tables.h
+AUTO_SRCS += tables.c
+
+LDLIBS += -L ../base $(addprefix -l,$(EXTDEPENDS)) -lchiark-tcl
+
+include $(BASE_DIR)/common.make
+
+include $(BASE_DIR)/shlib.make
+
+%.c: %.tct $(BASE_TCT) $(TCMDIFGEN)
+ $(TCMDIFGEN) -wc -p$(EXTENSION) -o$@ $(BASE_TCT) $<
+
+%.h: %.tct $(BASE_TCT) $(TCMDIFGEN)
+ $(TCMDIFGEN) -wh -p$(EXTENSION) -o$@ $(BASE_TCT) $<
+
+include $(BASE_DIR)/final.make
#include <errno.h>
-#include "hbytes.h"
-#include "tables.h"
+#include "chiark-tcl.h"
-int staticerr(Tcl_Interp *ip, const char *m, const char *ec) {
+int cht_staticerr(Tcl_Interp *ip, const char *m, const char *ec) {
Tcl_SetResult(ip, (char*)m, TCL_STATIC);
if (ec) Tcl_SetObjErrorCode(ip, Tcl_NewStringObj(ec,-1));
return TCL_ERROR;
}
-int posixerr(Tcl_Interp *ip, int errnoval, const char *m) {
+int cht_posixerr(Tcl_Interp *ip, int errnoval, const char *m) {
const char *em;
Tcl_ResetResult(ip);
return TCL_ERROR;
}
-int newfdposixerr(Tcl_Interp *ip, int fd, const char *m) {
+int cht_newfdposixerr(Tcl_Interp *ip, int fd, const char *m) {
int e;
e= errno;
close(fd);
- return posixerr(ip,e,m);
+ return cht_posixerr(ip,e,m);
}
-void objfreeir(Tcl_Obj *o) {
+void cht_objfreeir(Tcl_Obj *o) {
if (o->typePtr && o->typePtr->freeIntRepProc)
o->typePtr->freeIntRepProc(o);
o->typePtr= 0;
}
-int 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 == &hbytes_type) {
- HBytes_Value *v= OBJ_HBYTES(obj);
- memset(nums,0,sizeof(nums));
- nums[1]= hbytes_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) {
- hbytes_array(OBJ_HBYTES(dup),
- hbytes_data(OBJ_HBYTES(src)),
- hbytes_len(OBJ_HBYTES(src)));
- dup->typePtr= &hbytes_type;
-}
-
-static void hbytes_t_free(Tcl_Obj *o) {
- hbytes_free(OBJ_HBYTES(o));
-}
-
-void obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
- int l, const char *prefix) {
- char *str;
- int pl;
-
- pl= strlen(prefix);
- 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 obj_updatestr_array(Tcl_Obj *o, const Byte *byte, int l) {
- obj_updatestr_array_prefix(o,byte,l,"");
-}
-
-void obj_updatestr_vstringls(Tcl_Obj *o, ...) {
+void cht_obj_updatestr_vstringls(Tcl_Obj *o, ...) {
va_list al;
char *p;
const char *part;
*p= 0;
}
-void obj_updatestr_string(Tcl_Obj *o, const char *str) {
- obj_updatestr_vstringls(o, str, strlen(str), (char*)0);
-}
-
-static void hbytes_t_ustr(Tcl_Obj *o) {
- obj_updatestr_array(o,
- hbytes_data(OBJ_HBYTES(o)),
- hbytes_len(OBJ_HBYTES(o)));
-}
-
-static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
- char *str, *ep, *os;
- Byte *startbytes, *bytes;
- int l;
- char cbuf[3];
-
- if (o->typePtr == &ulong_type) {
- uint32_t ul;
-
- ul= htonl(*(const uint32_t*)&o->internalRep.longValue);
- hbytes_array(OBJ_HBYTES(o), (const Byte*)&ul, 4);
-
- } else {
-
- os= str= Tcl_GetStringFromObj(o,&l); assert(str);
- objfreeir(o);
-
- if (l & 1) return staticerr(ip, "hbytes: conversion from hex:"
- " odd length in hex", "HBYTES SYNTAX");
-
- startbytes= bytes= hbytes_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) {
- hbytes_free(OBJ_HBYTES(o));
- return staticerr(ip, "hbytes: conversion from hex:"
- " bad hex digit", "HBYTES SYNTAX");
- }
- l -= 2;
- }
-
- }
-
- o->typePtr = &hbytes_type;
- return TCL_OK;
-}
-
-Tcl_ObjType hbytes_type = {
- "hbytes",
- hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
-};
-
-int 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);
- hbytes_array(result, str, l);
- return TCL_OK;
-}
-
-int do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
- HBytes_Value hex, Tcl_Obj **result) {
- *result= Tcl_NewByteArrayObj(hbytes_data(&hex), hbytes_len(&hex));
- return TCL_OK;
-}
-
-int do_hbytes_length(ClientData cd, Tcl_Interp *ip,
- HBytes_Value v, int *result) {
- *result= hbytes_len(&v);
- return TCL_OK;
-}
-
-int do_hbytes_random(ClientData cd, Tcl_Interp *ip,
- int length, HBytes_Value *result) {
- Byte *space;
- int rc;
-
- space= hbytes_arrayspace(result, length);
- rc= get_urandom(ip, space, length);
- if (rc) { hbytes_free(result); return rc; }
- return TCL_OK;
-}
-
-int do_hbytes_overwrite(ClientData cd, Tcl_Interp *ip,
- HBytes_Var v, int start, HBytes_Value sub) {
- int sub_l;
-
- sub_l= hbytes_len(&sub);
- if (start < 0)
- return staticerr(ip, "hbytes overwrite start -ve",
- "HBYTES LENGTH RANGE");
- if (start + sub_l > hbytes_len(v.hb))
- return staticerr(ip, "hbytes overwrite out of range",
- "HBYTES LENGTH UNDERRUN");
- memcpy(hbytes_data(v.hb) + start, hbytes_data(&sub), sub_l);
- return TCL_OK;
-}
-
-int do_hbytes_trimleft(ClientData cd, Tcl_Interp *ip, HBytes_Var v) {
- const Byte *o, *p, *e;
- o= p= hbytes_data(v.hb);
- e= p + hbytes_len(v.hb);
-
- while (p<e && !*p) p++;
- if (p != o)
- hbytes_unprepend(v.hb, p-o);
-
- return TCL_OK;
-}
-
-int 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= hbytes_len(&sub);
- if (count < 0) return staticerr(ip, "hbytes repeat count -ve",
- "HBYTES LENGTH RANGE");
- if (count > INT_MAX/sub_l) return staticerr(ip, "hbytes repeat too long", 0);
-
- data= hbytes_arrayspace(result, sub_l*count);
- sub_d= hbytes_data(&sub);
- while (count) {
- memcpy(data, sub_d, sub_l);
- count--; data += sub_l;
- }
- return TCL_OK;
-}
-
-int do_hbytes_xor(ClientData cd, Tcl_Interp *ip,
- HBytes_Var v, HBytes_Value d) {
- int l;
- Byte *dest;
- const Byte *source;
-
- l= hbytes_len(v.hb);
- if (hbytes_len(&d) != l) return
- staticerr(ip, "hbytes xor lengths do not match", "HBYTES LENGTH MISMATCH");
-
- dest= hbytes_data(v.hb);
- source= hbytes_data(&d);
- memxor(dest,source,l);
- return TCL_OK;
-}
-
-int do_hbytes_zeroes(ClientData cd, Tcl_Interp *ip,
- int length, HBytes_Value *result) {
- Byte *space;
- space= hbytes_arrayspace(result, length);
- memset(space,0,length);
- return TCL_OK;
-}
-
-int do_hbytes_compare(ClientData cd, Tcl_Interp *ip,
- HBytes_Value a, HBytes_Value b, int *result) {
- int al, bl, minl, r;
-
- al= hbytes_len(&a);
- bl= hbytes_len(&b);
- minl= al<bl ? al : bl;
-
- r= memcmp(hbytes_data(&a), hbytes_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 do_hbytes_range(ClientData cd, Tcl_Interp *ip,
- HBytes_Value v, int start, int size,
- HBytes_Value *result) {
- const Byte *data;
- int l;
-
- l= hbytes_len(&v);
- if (start<0 || size<0)
- return staticerr(ip,"hbytes range subscript(s) -ve","HBYTES LENGTH RANGE");
- if (l<start+size)
- return staticerr(ip, "hbytes range subscripts too big",
- "HBYTES LENGTH UNDERRUN");
-
- data= hbytes_data(&v);
- hbytes_array(result, data+start, size);
- return TCL_OK;
-}
-
-int do_hbytes_addr_map(ClientData cd, Tcl_Interp *ip,
- const AddrMap_SubCommand *subcmd,
- int objc, Tcl_Obj *const *objv) {
- return subcmd->func(0,ip,objc,objv);
-}
-
-/* hbytes representing uint16_t's */
-
-int do_hbytes_h2ushort(ClientData cd, Tcl_Interp *ip,
- HBytes_Value hex, long *result) {
- const Byte *data;
- int l;
-
- l= hbytes_len(&hex);
- if (l>2)
- return staticerr(ip, "hbytes h2ushort input more than 4 hex digits",
- "HBYTES VALUE OVERFLOW");
-
- data= hbytes_data(&hex);
- *result= data[l-1] | (l>1 ? data[0]<<8 : 0);
- return TCL_OK;
-}
-
-int do_hbytes_ushort2h(ClientData cd, Tcl_Interp *ip,
- long input, HBytes_Value *result) {
- uint16_t us;
-
- if (input > 0x0ffff)
- return staticerr(ip, "hbytes ushort2h input >2^16",
- "HBYTES VALUE OVERFLOW");
-
- us= htons(input);
- hbytes_array(result,(const Byte*)&us,2);
- return TCL_OK;
-}
-
-/* toplevel functions */
-
-int do_toplevel_hbytes(ClientData cd, Tcl_Interp *ip,
- const HBytes_SubCommand *subcmd,
- int objc, Tcl_Obj *const *objv) {
- return subcmd->func(0,ip,objc,objv);
-}
-
-int do_toplevel_dgram_socket(ClientData cd, Tcl_Interp *ip,
- const DgramSocket_SubCommand *subcmd,
- int objc, Tcl_Obj *const *objv) {
- return subcmd->func(0,ip,objc,objv);
-}
-
-int do_toplevel_tuntap_socket_raw(ClientData cd, Tcl_Interp *ip,
- const TunSocket_SubCommand *subcmd,
- int objc, Tcl_Obj *const *objv) {
- return subcmd->func(0,ip,objc,objv);
-}
-
-int do_toplevel_ulong(ClientData cd, Tcl_Interp *ip,
- const ULong_SubCommand *subcmd,
- int objc, Tcl_Obj *const *objv) {
- return subcmd->func(0,ip,objc,objv);
-}
-
-int do_toplevel_adns(ClientData cd, Tcl_Interp *ip,
- const Adns_SubCommand *subcmd,
- int objc, Tcl_Obj *const *objv) {
- return subcmd->func(0,ip,objc,objv);
+void cht_obj_updatestr_string(Tcl_Obj *o, const char *str) {
+ cht_obj_updatestr_vstringls(o, str, strlen(str), (char*)0);
}
#define URANDOM "/dev/urandom"
-int get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
+int cht_get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
static FILE *urandom;
int r, esave;
if (!urandom) {
urandom= fopen(URANDOM,"rb");
- if (!urandom) return posixerr(ip,errno,"open " URANDOM);
+ if (!urandom) return cht_posixerr(ip,errno,"open " URANDOM);
}
r= fread(buffer,1,l,urandom);
if (r==l) return 0;
fclose(urandom); urandom=0;
if (ferror(urandom)) {
- return posixerr(ip,errno,"read " URANDOM);
+ return cht_posixerr(ip,errno,"read " URANDOM);
} else {
assert(feof(urandom));
- return staticerr(ip, URANDOM " gave eof!", 0);
+ return cht_staticerr(ip, URANDOM " gave eof!", 0);
}
}
-int Hbytes_Init(Tcl_Interp *ip) {
+int cht_initextension(Tcl_Interp *ip, const TopLevel_Command *cmds,
+ int *donep /* or 0, meaning no types follow */,
+ ... /* types, terminated by 0 */) {
+ static int cht_initd;
+
const TopLevel_Command *cmd;
+ Tcl_ObjType *ot;
+
+ va_list al;
- Tcl_RegisterObjType(&hbytes_type);
- Tcl_RegisterObjType(&blockcipherkey_type);
- Tcl_RegisterObjType(&enum_nearlytype);
- Tcl_RegisterObjType(&enum1_nearlytype);
- Tcl_RegisterObjType(&sockaddr_type);
- Tcl_RegisterObjType(&tabledataid_nearlytype);
- Tcl_RegisterObjType(&ulong_type);
- Tcl_RegisterObjType(&addrmap_type);
+ if (!cht_initd) {
+ cht_initd= 1;
+ Tcl_RegisterObjType(&cht_enum_nearlytype);
+ Tcl_RegisterObjType(&cht_enum1_nearlytype);
+ }
+
+ if (donep && !*donep) {
+ *donep= 1;
+ va_start(al, donep);
+ while ((ot= va_arg(al, Tcl_ObjType*)))
+ Tcl_RegisterObjType(ot);
+ }
- for (cmd=toplevel_commands;
+ for (cmd= cmds;
cmd->name;
cmd++)
Tcl_CreateObjCommand(ip, (char*)cmd->name, cmd->func, 0,0);
/*
*/
+#include "chiark-tcl.h"
#include "tables.h"
-int pat_charfrom(Tcl_Interp *ip, Tcl_Obj *obj, int *val,
+int cht_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);
+ *val= cht_enum1_lookup_cached_func(ip,obj,opts,what);
if (*val==-1) return TCL_ERROR;
return TCL_OK;
}
-int pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) {
+int cht_pat_int(Tcl_Interp *ip, Tcl_Obj *obj, int *val) {
return Tcl_GetIntFromObj(ip, obj, val);
}
-int pat_long(Tcl_Interp *ip, Tcl_Obj *obj, long *val) {
+int cht_pat_long(Tcl_Interp *ip, Tcl_Obj *obj, long *val) {
return Tcl_GetLongFromObj(ip, obj, val);
}
-int pat_string(Tcl_Interp *ip, Tcl_Obj *obj, const char **val) {
+int cht_pat_string(Tcl_Interp *ip, Tcl_Obj *obj, const char **val) {
*val= Tcl_GetString(obj);
return TCL_OK;
}
-int pat_constv(Tcl_Interp *ip, Tcl_Obj *var,
+int cht_pat_constv(Tcl_Interp *ip, Tcl_Obj *var,
Tcl_Obj **val_r, Tcl_ObjType *type) {
int rc;
Tcl_Obj *val;
return TCL_OK;
}
-void init_somethingv(Something_Var *sth) {
+void cht_init_somethingv(Something_Var *sth) {
sth->obj=0; sth->var=0; sth->copied=0;
}
-int pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
+int cht_pat_somethingv(Tcl_Interp *ip, Tcl_Obj *var,
Something_Var *sth, Tcl_ObjType *type) {
int rc;
Tcl_Obj *val;
return TCL_OK;
}
-int pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
- int rc;
- rc= pat_somethingv(ip,var,&agg->sth,&hbytes_type); if (rc) return rc;
- agg->hb= OBJ_HBYTES(agg->sth.obj);
- return TCL_OK;
-}
-
-void fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth) {
+void cht_fini_somethingv(Tcl_Interp *ip, int rc, Something_Var *sth) {
Tcl_Obj *ro;
if (!rc) {
Tcl_DecrRefCount(sth->obj);
}
-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= *OBJ_HBYTES(obj);
- return TCL_OK;
-}
-
-Tcl_Obj *ret_hb(Tcl_Interp *ip, HBytes_Value val) {
- Tcl_Obj *obj;
- obj= Tcl_NewObj();
- Tcl_InvalidateStringRep(obj);
- *OBJ_HBYTES(obj)= val;
- obj->typePtr= &hbytes_type;
- return obj;
-}
-
-Tcl_Obj *ret_long(Tcl_Interp *ip, long val) {
+Tcl_Obj *cht_ret_long(Tcl_Interp *ip, long val) {
return Tcl_NewLongObj(val);
}
-Tcl_Obj *ret_string(Tcl_Interp *ip, const char *val) {
+Tcl_Obj *cht_ret_string(Tcl_Interp *ip, const char *val) {
return Tcl_NewStringObj(val,-1);
}
--- /dev/null
+
+OBJS_CFILES += $(addsuffix .o, $(CFILES))
+OBJS += $(OBJS_CFILES)
+
+TARGETS += $(SHLIB).so
+
+$(SHLIB).so: $(OBJS)
+ $(CC) $(CFLAGS) $(LDFLAGS) -o $@ -shared $(OBJS) $(LDLIBS)
Type sockaddr: SockAddr_Value @
Init sockaddr sockaddr_clear(&@);
-Type iddata(const IdDataSpec *idds): void *@
-Type ulong: uint32_t @
-Type long: long @
-Type string: const char *@
-
-Type adnsresults: adns_answer *@
-Init adnsresults @=0;
-Fini adnsresults free(@);
-
-Type charfrom(const char *opts, const char *what): int
-
-H-Include "hbytes.h"
-
Table toplevel TopLevel_Command
hbytes
subcmd enum(HBytes_SubCommand, "hbytes subcommand")
subcmd enum(Adns_SubCommand,"adns subcommand")
... obj
-Table adns Adns_SubCommand
- lookup
- rrtype enum(AdnsTclRRTypeInfo, "rrtype")
- domain string
- ... obj
- => obj
- synch
- rrtype enum(AdnsTclRRTypeInfo, "rrtype")
- domain string
- ... obj
- => obj
- asynch
- on_yes obj
- on_no obj
- on_fail obj
- xargs obj
- rrtype enum(AdnsTclRRTypeInfo, "rrtype")
- domain string
- ... obj
- => iddata(&adnstcl_queries)
- asynch-cancel
- query iddata(&adnstcl_queries)
- new-resolver
- ... obj
- => iddata(&adnstcl_resolvers)
- set-default-resolver
- res iddata(&adnstcl_resolvers)
- destroy-resolver
- res iddata(&adnstcl_resolvers)
-
Table addrmap AddrMap_SubCommand
lookup
map constv(&addrmap_type)
# functions.
#
# `Type' causes declarations in the .h file of these functions:
-# int pat_TYPENAME(Tcl_Interp*, Tcl_Obj *obj, C-TYPE *val, ARGS);
-# Tcl_Obj *ret_TYPENAME(Tcl_Interp*, C-TYPE val, ARGS);
+# int cht_pat_TYPENAME(Tcl_Interp*, Tcl_Obj *obj, C-TYPE *val, ARGS);
+# Tcl_Obj *cht_ret_TYPENAME(Tcl_Interp*, C-TYPE val, ARGS);
#
-# pat_... must attempt to parse obj into the appropriate type.
+# cht_pat_... must attempt to parse obj into the appropriate type.
# val will already have been initialised with `Init' statements if
-# relevant. Whether pat_... fails or succeeds it may allocate
+# relevant. Whether cht_pat_... fails or succeeds it may allocate
# memory into the object and must leave the object valid (for
# `Fini').
#
-# ret_... must convert the value back to a new Tcl_Obj. It may
+# cht_ret_... must convert the value back to a new Tcl_Obj. It may
# not fail.
#
# Init TYPENAME C-STATEMENTS
# ...
# [ => RESULT-TYPE ]
# This will cause the declaration of
-# int do_TABLENAME_ENTRYNAME(ClientData cd, Tcl_Interp *ip,
+# int cht_do_TABLENAME_ENTRYNAME(ClientData cd, Tcl_Interp *ip,
# FORMAL-ARGUMENTS, RESULT-C-TYPE*);
# which is the procedure which the application must supply to
# implement the function. If the `=> RESULT-TYPE' is omitted, so
# is the result argument to the function. Each argument to the
# function is of the C type corresponding to the specified type.
-# The do_... function should not eat any memory associated with
+# The cht_do_... function should not eat any memory associated with
# the arguments. The result buffer (if any) will be initialised
# using the `Init' and should on success contain the relevant
# result. On failure it should leave the result unmodified (or at
# EXTRA-VALUES; the EXTRA-VALUES are used as initialisers for the
# additional structure elements.
#
-# Also declared are these functions:
-# void setstringresult(Tcl_Interp*, const char*);
+# NoEntryDefine C-ENTRY-TYPE
+# Prevents the definition of C-ENTRY-TYPE by Table.
+# The C type must be defined elsewhere.
+#
+# Also expected are these functions:
+# void cht_setstringresult(Tcl_Interp*, const char*);
# sets the Tcl result from the supplied string
-# int pat_enum(Tcl_Interp*, Tcl_Obj*, const void **c_e_t_array,
+# int cht_pat_enum(Tcl_Interp*, Tcl_Obj*, const void **c_e_t_array,
# const void *c_e_t_return, size_t c_e_t_sz, const char *what);
# scans a table of C-ENTRY-TYPEs looking for the
# string matching the string supplied by the script
# are in the same places no matter what the rest of
# the struct contains.
# and the two predefined types `int' (C `int') and `obj' (Tcl_Obj*,
-# unmodified.) The corresponding definitions are in tcmdiflib.c
-# which #includes "tcmdiflib.h" (not supplied).
+# unmodified.) The corresponding definitions are in tcmdiflib.c.
use IO;
use Data::Dumper;
while (@ARGV) {
$_= shift @ARGV;
- if (m/^\-p(\w+)/) {
+ if (m/^\-p([-_0-9a-z]+)$/) {
$prefix= $1;
+ $prefix =~ y/-/_/;
} elsif (m/^\-w(c|h)$/) {
$write= $1;
} elsif (m/^\-o(.+)$/) {
unshift @i, $this_indent;
}
- if (@i==0 && m/^Table\s+(\w+)\s+(\w+)$/) {
+ if (@i==0 && m/^Table\s+(\*toplevel\*|\w+)\s+(\w+)$/) {
zilch();
$c_table= $1;
$table_x{$c_table}{C}= $2;
- $entrytype_x{$2}= '';
+ $entrytype_x{$2}= '' unless exists $entrytype_x{$2};
} elsif (@i==0 && m/^Untabled$/) {
zilch();
$c_table= '';
} elsif (@i==0 && m/^EntryExtra\s+(\w+)$/) {
zilch();
$c_entryextra= $1;
+ } elsif (@i==0 && m/^NoEntryDefine\s+(\w+)$/) {
+ zilch();
+ $entrytype_x{$1}= " ";
} elsif (@i>=1 && defined $c_entryextra) {
$entrytype_x{$c_entryextra} .= " $_\n";
} elsif (@i==1 && m/^[a-z].*$/ && defined $c_table) {
$type= $types{$t};
$c= $type->{C};
$xta= $type->{X};
- $decl= "int pat_$t(Tcl_Interp *ip, Tcl_Obj *obj, ";
+ $decl= "int cht_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 *ip, ".subst_in_decl('val',$c);
+ $decl= "Tcl_Obj *cht_ret_$t(Tcl_Interp *ip, ".subst_in_decl('val',$c);
$decl .= ", $xta" if length $xta;
$decl .= ");\n";
o('h',170, $decl);
}
foreach $c_entrytype (sort keys %entrytype_x) {
+ next if $entrytype_x{$c_entrytype} =~ m/^\s$/;
o('h', 20, "typedef struct $c_entrytype $c_entrytype;\n");
o('h', 100,
"struct $c_entrytype {\n".
$r_entry= $r_table->{$c_entry};
$pa_decl= "int pa_${c_table}_${c_entry_c}(ClientData cd,".
" Tcl_Interp *ip, int objc, Tcl_Obj *const *objv)";
- $do_decl= "int do_${c_table}_${c_entry_c}(";
+ $do_decl= "int cht_do_${c_table}_${c_entry_c}(";
@do_al= ('ClientData cd', 'Tcl_Interp *ip');
@do_aa= qw(cd ip);
$pa_init= '';
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 .= " rc= cht_pat_$t(ip, *objv++, $paarg";
$pa_body .= ", ".$a if length $a;
$pa_body .= ");$pafin if (rc) goto rc_err;\n";
push @do_aa, "a_$n";
if (exists $r_entry->{R}) {
$t= $r_entry->{R};
$xta= $r_entry->{X};
- push @do_al, make_decl("*result", $t, "do_al result");
+ push @do_al, make_decl("*result", $t, "cht_do_al result");
$pa_vars .= make_decl_init("result", $t, $xta, \$pa_init,
"pa_vars result");
push @do_aa, "&result";
- $pa_rslt .= " Tcl_SetObjResult(ip, ret_$t(ip, result";
+ $pa_rslt .= " Tcl_SetObjResult(ip, cht_ret_$t(ip, result";
$pa_rslt .= ", $xta" if length $xta;
$pa_rslt .= "));\n";
}
$pa_body .= "\n";
- $pa_body .= " rc= do_${c_table}_${c_entry_c}(";
+ $pa_body .= " rc= cht_do_${c_table}_${c_entry_c}(";
$pa_body .= join ', ', @do_aa;
$pa_body .= ");\n";
$pa_body .= " if (rc) goto rc_err;\n";
"#define INCLUDED_\U${prefix}_H\n\n".
"#include <tcl8.3/tcl.h>\n");
-o(h, 400,
- "void setstringresult(Tcl_Interp*, const char*);\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");
/*
*/
-#include "tcmdiflib.h"
+#include "chiark-tcl.h"
+#include "tables.h"
-int pat_enum(Tcl_Interp *ip, Tcl_Obj *obj, const void **val,
+int cht_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);
+ *val= cht_enum_lookup_cached_func(ip,obj,opts,sz,what);
if (!*val) return TCL_ERROR;
return TCL_OK;
}
-int pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) {
+int cht_pat_obj(Tcl_Interp *ip, Tcl_Obj *obj, Tcl_Obj **val) {
*val= obj;
return TCL_OK;
}
-Tcl_Obj *ret_int(Tcl_Interp *ip, int val) {
+Tcl_Obj *cht_ret_int(Tcl_Interp *ip, int val) {
return Tcl_NewIntObj(val);
}
-Tcl_Obj *ret_obj(Tcl_Interp *ip, Tcl_Obj *val) {
+Tcl_Obj *cht_ret_obj(Tcl_Interp *ip, Tcl_Obj *val) {
return val;
}
-void setstringresult(Tcl_Interp *ip, const char *m) {
+void cht_setstringresult(Tcl_Interp *ip, const char *m) {
Tcl_ResetResult(ip);
Tcl_AppendResult(ip, m, (char*)0);
}
+++ /dev/null
-#include "tables.h"
-#include "hbytes.h"
-OBJS= tables.o \
- tcmdiflib.o \
- hbytes.o \
- adns.o \
- enum.o \
- idtable.o \
- scriptinv.o \
- ulongs.o \
- sockaddr.o \
- dgram.o \
- tuntap.o \
- chop.o \
- hook.o \
- bcmode.o \
- misc.o \
- algtables.o \
- crypto.o \
- parse.o \
- addrmap.o
-
-HDRS= hbytes.h \
- $(AUTO_HDRS)
-
-AUTO_HDRS= tables.h
-AUTO_SRCS= tables.c
-AUTOS= $(AUTO_HDRS) $(AUTO_SRCS)
-
-TARGETS= hbytes.so autocode.tcl autococo.tcl
-
-CC_CRYPTO= $(CC) $(CFLAGS) $(CPPFLAGS) -O3
-CPPFLAGS= -I../plocal/include $(TCL_MEM_DEBUG) $(CMDLINE_CPPFLAGS)
-LDFLAGS= -L../plocal/lib
-LDLIBS= -lnettle -ladns
-CFLAGS= -g -Wall -Wmissing-prototypes -Wstrict-prototypes -Werror \
- $(OPTIMISE)
-OPTIMISE= -O2
-TCL_MEM_DEBUG= -DTCL_MEM_DEBUG
-
-all: $(TARGETS) $(AUTOS)
-
-hbytes.so: $(OBJS)
- $(CC) $(CFLAGS) $(LDFLAGS) -o $@ -shared $(OBJS) $(LDLIBS)
-
-autoco%.tcl: deco%gen.tcl decobogen.tcl general.tcl ./hbytes.so \
- protocol.deco
- ./$< protocol.deco >$@.new && mv -f $@.new $@
-
-%.c: %.tct tcmdifgen
- ./tcmdifgen -wc -o$@ $<
-
-%.h: %.tct tcmdifgen
- ./tcmdifgen -wh -o$@ $<
-
-%.o: %.c $(HDRS)
- $(CC) $(CFLAGS) $(CPPFLAGS) -o $@ -c $<
#alg.o: alg.c alg.h alg2.h
# $(CC_CRYPTO) -o $@ -c $<
--- /dev/null
+int cht_pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
+ int rc;
+ rc= pat_somethingv(ip,var,&agg->sth,&hbytes_type); if (rc) return rc;
+ agg->hb= OBJ_HBYTES(agg->sth.obj);
+ return TCL_OK;
+}
+
+int cht_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= *OBJ_HBYTES(obj);
+ return TCL_OK;
+}
+
+Tcl_Obj *cht_ret_hb(Tcl_Interp *ip, HBytes_Value val) {
+ Tcl_Obj *obj;
+ obj= Tcl_NewObj();
+ Tcl_InvalidateStringRep(obj);
+ *OBJ_HBYTES(obj)= val;
+ obj->typePtr= &hbytes_type;
+ return obj;
+}
+
/* from dgram.c */
extern const IdDataSpec dgram_socks;
-int newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
/* from tuntap.c */