/*
- */
-/*
- * 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 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
+ * base code for various Tcl extensions
+ * Copyright 2006 Ian Jackson
*
- * 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
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License as
+ * published by the Free Software Foundation; either version 2 of the
+ * License, or (at your option) any later version.
*
- * 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)
+ * This program is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * General Public License for more details.
*
- * 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
- * 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
+ * You should have received a copy of the GNU General Public License
+ * along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
+ * 02110-1301, USA.
*/
-#ifndef HBYTES_H
-#define HBYTES_H
+#ifndef CHIARK_TCL_H
+#define CHIARK_TCL_H
#include <assert.h>
#include <stdlib.h>
#include <sys/un.h>
#include <arpa/inet.h>
+#ifndef _TCL /* if someone already included some tcl.h, use that */
#include <tcl.h>
+#endif /*_TCL*/
-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 */
+#include <adns.h>
-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 */
-
-/* Public interfaces: */
-
-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. */
+typedef unsigned char Byte;
-/* from sockaddr.c */
+/* for assisting tcmdifgen and tcmdiflib.c */
-typedef struct {
- Byte *begin, *end;
-} SockAddr_Value;
+typedef struct TopLevel_Command TopLevel_Command;
-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 */
-typedef struct { /* semi-opaque - read only, and then only where commented */
- Tcl_Interp *ip; /* valid, non-0 and useable if set */
- Tcl_Obj *obj; /* non-0 iff set (but only test for 0/non-0) */
- int llength;
+typedef struct { /* opaque; comments are for scriptinv.c impl'n only */
+ /* states: Cancelled Set */
+ Tcl_Interp *ipq; /* 0 valid, non-0, useable */
+ Tcl_Obj *script; /* 0 valid, non-0 */
+ Tcl_Obj *xargs; /* 0 valid, may be 0 */
+ int llen; /* undefined llength of script + xargs */
} ScriptToInvoke;
-void scriptinv_init(ScriptToInvoke *si);
-int scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip, Tcl_Obj *newscript);
-void scriptinv_cancel(ScriptToInvoke *si); /* then don't invoke */
- /* no separate free function - just cancel */
+void cht_scriptinv_init(ScriptToInvoke *si); /* undefined -> Cancelled */
+int cht_scriptinv_set(ScriptToInvoke *si, Tcl_Interp *ip,
+ Tcl_Obj *newscript, Tcl_Obj *xargs);
+ /* Cancelled/Set -> Set (newscript!=0, ok) / Cancelled (otherwise) */
+void cht_scriptinv_cancel(ScriptToInvoke *si);
+ /* Cancelled/Set -> Cancelled. No separate free function - just cancel. */
+#define cht_scriptinv_interp(si) ((si)->ipq)
+ /* int cht_scriptinv_interp(ScriptToInvoke *si); returns 0 if Cancelled */
-void scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj **argv);
+int cht_scriptinv_invoke_fg(ScriptToInvoke *si, int argc,
+ Tcl_Obj *const *argv);
+ /* is a no-op if Cancelled rather than Set */
+ /* if script fails, returns that error */
+
+void cht_scriptinv_invoke(ScriptToInvoke *si, int argc, Tcl_Obj *const *argv);
+ /* if script fails, reports it with Tcl_BackgroundError */
/* from idtable.c */
typedef struct {
- const char *const prefix;
- int n;
- void **a;
-} IdDataTable;
-
-extern Tcl_ObjType tabledataid_nearlytype;
-int tabledataid_parse(Tcl_Interp *ip, Tcl_Obj *o, IdDataTable *tab);
-
-/* from dgram.c */
-
-extern IdDataTable dgram_socks;
-int newfdposixerr(Tcl_Interp *ip, int fd, const char *m);
+ const char *valprefix, *assockey;
+ void (*destroyitem)(Tcl_Interp *ip, void *val);
+} IdDataSpec;
-/* from tuntap.c */
+/* The stored struct must start with a single int, conventionally
+ * named `ix'. When the struct is returned for the first time ix must
+ * be -1; on subsequent occasions it must be >=0. ix will be -1 iff
+ * the struct is registered by the iddatatable machinery. */
-extern IdDataTable tuntap_socks;
+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 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_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,
- 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);
+
+void cht_prepare__basic(Tcl_Interp *ip);
+void cht_setup__commands(Tcl_Interp *ip, const TopLevel_Command *cmds);
+ /* ... for use by CHT_INIT and CHTI_... macros only */
/* from parse.c */
typedef struct {
- HBytes_Value *hb;
Tcl_Obj *obj, *var;
int copied;
-} HBytes_Var;
-
-void fini_hbv(Tcl_Interp *ip, int rc, HBytes_Var *agg);
-
-/* from chop.c */
- /* only do_... functions declared in tables.h */
+} Something_Var;
-/* from ulong.c */
-
-Tcl_ObjType ulong_type;
+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);
/* 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)))
+
+/* macros for Chiark_tcl_FOOBAR_Init et al */
+
+ /*
+ * use these macros like this:
+ * CHT_INIT(<extbase>,
+ * <preparations>,
+ * <results>)
+ * where
+ *
+ * <extbase> is the short name eg `hbytes'
+ * and should correspond to EXTBASE from the Makefile.
+ *
+ * <results> are the initialisations which cause new commands
+ * etc. to appear in the Tcl namespace. Eg, CHTI_COMMANDS,
+ * These initialisations are called only when a Tcl `load'
+ * command loads this extension.
+ *
+ * <preparations> are the initialisations that we need but which
+ * do not interfere with the Tcl namespaces. For example,
+ * OBJECT types we used (CHTI_TYPE), and other chiark_tcl
+ * extensions (CHTI_OTHER). These initialisations are called
+ * both as a result of Tcl `load' (before the <results>
+ * initialisations) and also when another extension declares a
+ * dependency on this one with CHTI_OTHER.
+ *
+ * Both <results> and <preparations> are whitespace-separated
+ * lists of calls to CHTI_... macros. If the list is to be empty,
+ * write `{ }' instead to prevent an empty macro argument. The
+ * preparations and results currently supported are:
+ *
+ * CHTI_COMMANDS(cht_<somethingtoplevel>_entries)
+ * where the .tct file contains
+ * Table *<somethingtoplevel> TopLevel_Command
+ *
+ * CHTI_OTHER(<extbase-of-underlying-extension>)
+ * which does the <preparations> of that extension
+ * (if they have not already been done).
+ *
+ * CHTI_TYPE(cht_<something>_type)
+ * where extern Tcl_ObjType cht_<something>_type;
+ * Note that CHTI_TYPE should only be called by the
+ * extension which actually implements the type. Other
+ * extensions which need it should use CHTI_OTHER to bring
+ * in the implementing extension.
+ */
-#endif /*HBYTES_H*/
+#define CHT_INIT(e, preparations, results) \
+ extern void cht_prepare_##e(Tcl_Interp *ip); \
+ void cht_prepare_##e(Tcl_Interp *ip) { \
+ static int prepared; \
+ if (prepared) return; \
+ cht_prepare__basic(ip); \
+ { preparations } \
+ prepared= 1; \
+ } \
+ extern int Chiark_tcl_##e##_Init(Tcl_Interp *ip); /*called by load(3tcl)*/ \
+ int Chiark_tcl_##e##_Init(Tcl_Interp *ip) { \
+ static int initd; \
+ if (initd) return TCL_OK; \
+ cht_prepare_##e(ip); \
+ { results } \
+ initd= 1; \
+ return TCL_OK; \
+ }
+
+#define CHTI_OTHER(e) \
+ { extern void cht_prepare_##e(Tcl_Interp *ip); cht_prepare_##e(ip); }
+
+#define CHTI_TYPE(ot) { Tcl_RegisterObjType(&(ot)); }
+
+#define CHTI_COMMANDS(cl) { cht_setup__commands(ip,cl); }
+
+#endif /*CHIARK_TCL_H*/