chiark-tcl-1.1.1+nmu1/ 0000755 0000000 0000000 00000000000 12223237473 011302 5 ustar chiark-tcl-1.1.1+nmu1/hbytes/ 0000755 0000000 0000000 00000000000 12223237522 012573 5 ustar chiark-tcl-1.1.1+nmu1/hbytes/hbytes.c 0000644 0000000 0000000 00000010663 11762372314 014251 0 ustar /*
* hbytes - hex-stringrep efficient byteblocks for Tcl
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "hbytes.h"
#define COMPLEX(hb) ((HBytes_ComplexValue*)hb->begin_complex)
#define SIMPLE_LEN(hb) ((Byte*)(hb)->end_0 - (Byte*)(hb)->begin_complex)
/* enquirers */
int cht_hb_len(const HBytes_Value *hb) {
if (HBYTES_ISEMPTY(hb)) return 0;
else if (HBYTES_ISCOMPLEX(hb)) return COMPLEX(hb)->len;
else return SIMPLE_LEN(hb);
}
Byte *cht_hb_data(const HBytes_Value *hb) {
if (HBYTES_ISEMPTY(hb)) return 0;
else if (HBYTES_ISCOMPLEX(hb)) return COMPLEX(hb)->dstart;
else return hb->begin_complex;
}
int cht_hb_issentinel(const HBytes_Value *hb) {
return HBYTES_ISSENTINEL(hb);
}
/* constructors */
void cht_hb_empty(HBytes_Value *returns) {
returns->begin_complex= returns->end_0= 0;
}
void cht_hb_sentinel(HBytes_Value *returns) {
returns->begin_complex= 0;
returns->end_0= (void*)&cht_hbytes_type;
}
Byte *cht_hb_arrayspace(HBytes_Value *returns, int l) {
if (!l) { cht_hb_empty(returns); return 0; }
returns->begin_complex= TALLOC(l);
returns->end_0= returns->begin_complex + l;
return returns->begin_complex;
}
void cht_hb_array(HBytes_Value *returns, const Byte *array, int l) {
memcpy(cht_hb_arrayspace(returns,l), array, l);
}
/* destructor */
void cht_hb_free(const HBytes_Value *frees) {
if (HBYTES_ISCOMPLEX(frees)) {
HBytes_ComplexValue *cx= COMPLEX(frees);
TFREE(cx->dstart - cx->prespace);
}
TFREE(frees->begin_complex);
}
/* mutators */
static HBytes_ComplexValue *complex(HBytes_Value *hb) {
HBytes_ComplexValue *cx;
if (HBYTES_ISCOMPLEX(hb)) return hb->begin_complex;
cx= TALLOC(sizeof(*cx));
cx->dstart= hb->begin_complex;
cx->len= cx->avail= SIMPLE_LEN(hb);
cx->prespace= 0;
hb->begin_complex= cx;
hb->end_0= 0;
return cx;
}
Byte *cht_hb_prepend(HBytes_Value *hb, int el) {
HBytes_ComplexValue *cx;
int new_prespace;
Byte *old_block, *new_block, *new_dstart;
cx= complex(hb);
assert(el < INT_MAX/4 && cx->len < INT_MAX/2);
if (cx->prespace < el) {
new_prespace= el*2 + cx->len;
old_block= cx->dstart - cx->prespace;
new_block= Tcl_Realloc(old_block, new_prespace + cx->avail);
new_dstart= new_block + new_prespace;
memmove(new_dstart, new_block + cx->prespace, cx->len);
cx->prespace= new_prespace;
cx->dstart= new_dstart;
}
cx->dstart -= el;
cx->prespace -= el;
cx->len += el;
cx->avail += el;
return cx->dstart;
}
Byte *cht_hb_append(HBytes_Value *hb, int el) {
HBytes_ComplexValue *cx;
int new_len, new_avail;
Byte *newpart, *new_block, *old_block;
cx= complex(hb);
assert(el < INT_MAX/4 && cx->len < INT_MAX/4);
new_len= cx->len + el;
if (new_len > cx->avail) {
new_avail= new_len*2;
old_block= cx->dstart - cx->prespace;
new_block= Tcl_Realloc(old_block, cx->prespace + new_avail);
cx->dstart= new_block + cx->prespace;
cx->avail= new_avail;
}
newpart= cx->dstart + cx->len;
cx->len= new_len;
return newpart;
}
static HBytes_ComplexValue*
prechop(HBytes_Value *hb, int cl, const Byte **rv) {
HBytes_ComplexValue *cx;
if (cl<0) { *rv=0; return 0; }
if (cl==0) { *rv= (const void*)&cht_hbytes_type; return 0; }
cx= complex(hb);
if (cl > cx->len) { *rv=0; return 0; }
return cx;
}
const Byte *cht_hb_unprepend(HBytes_Value *hb, int pl) {
const Byte *chopped;
HBytes_ComplexValue *cx= prechop(hb,pl,&chopped);
if (!cx) return chopped;
chopped= cx->dstart;
cx->dstart += pl;
cx->prespace += pl;
cx->len -= pl;
cx->avail -= pl;
return chopped;
}
const Byte *cht_hb_unappend(HBytes_Value *hb, int sl) {
const Byte *chopped;
HBytes_ComplexValue *cx= prechop(hb,sl,&chopped);
if (!cx) return chopped;
cx->len -= sl;
return cx->dstart + cx->len;
}
void memxor(Byte *dest, const Byte *src, int l) {
while (l--) *dest++ ^= *src++;
}
chiark-tcl-1.1.1+nmu1/hbytes/hook.c 0000644 0000000 0000000 00000017543 11762403261 013713 0 ustar /*
* hbytes - hex-stringrep efficient byteblocks for Tcl
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include
#include "chiark_tcl_hbytes.h"
int cht_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 == &cht_hbytes_type) {
HBytes_Value *v= OBJ_HBYTES(obj);
memset(nums,0,sizeof(nums));
nums[1]= cht_hb_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; itypePtr= &cht_hbytes_type;
}
static void hbytes_t_free(Tcl_Obj *o) {
cht_hb_free(OBJ_HBYTES(o));
}
void cht_obj_updatestr_array_prefix(Tcl_Obj *o, const Byte *byte,
int l, const char *prefix) {
char *str;
int pl;
pl= strlen(prefix);
assert(l < INT_MAX/2 - 1 - pl);
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 cht_obj_updatestr_array(Tcl_Obj *o, const Byte *byte, int l) {
cht_obj_updatestr_array_prefix(o,byte,l,"");
}
static void hbytes_t_ustr(Tcl_Obj *o) {
cht_obj_updatestr_array(o,
cht_hb_data(OBJ_HBYTES(o)),
cht_hb_len(OBJ_HBYTES(o)));
}
static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
char *str, *ep;
Byte *bytes;
int l;
char cbuf[3];
if (o->typePtr == &cht_ulong_type) {
uint32_t ul;
ul= htonl(*(const uint32_t*)&o->internalRep.longValue);
cht_hb_array(OBJ_HBYTES(o), (const Byte*)&ul, 4);
} else {
str= Tcl_GetStringFromObj(o,&l); assert(str);
cht_objfreeir(o);
if (l & 1) return cht_staticerr(ip, "hbytes: conversion from hex:"
" odd length in hex", "HBYTES SYNTAX");
bytes= cht_hb_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) {
cht_hb_free(OBJ_HBYTES(o));
return cht_staticerr(ip, "hbytes: conversion from hex:"
" bad hex digit", "HBYTES SYNTAX");
}
l -= 2;
}
}
o->typePtr = &cht_hbytes_type;
return TCL_OK;
}
Tcl_ObjType cht_hbytes_type = {
"hbytes",
hbytes_t_free, hbytes_t_dup, hbytes_t_ustr, hbytes_t_sfa
};
int cht_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);
cht_hb_array(result, str, l);
return TCL_OK;
}
int cht_do_hbytes_h2raw(ClientData cd, Tcl_Interp *ip,
HBytes_Value hex, Tcl_Obj **result) {
*result= Tcl_NewByteArrayObj(cht_hb_data(&hex), cht_hb_len(&hex));
return TCL_OK;
}
int cht_do_hbytes_length(ClientData cd, Tcl_Interp *ip,
HBytes_Value v, int *result) {
*result= cht_hb_len(&v);
return TCL_OK;
}
int cht_do_hbytes_random(ClientData cd, Tcl_Interp *ip,
int length, HBytes_Value *result) {
Byte *space;
int rc;
space= cht_hb_arrayspace(result, length);
rc= cht_get_urandom(ip, space, length);
if (rc) { cht_hb_free(result); return rc; }
return TCL_OK;
}
int cht_do_hbytes_overwrite(ClientData cd, Tcl_Interp *ip,
HBytes_Var v, int start, HBytes_Value sub) {
int sub_l;
sub_l= cht_hb_len(&sub);
if (start < 0)
return cht_staticerr(ip, "hbytes overwrite start -ve",
"HBYTES LENGTH RANGE");
if (start + sub_l > cht_hb_len(v.hb))
return cht_staticerr(ip, "hbytes overwrite out of range",
"HBYTES LENGTH UNDERRUN");
memcpy(cht_hb_data(v.hb) + start, cht_hb_data(&sub), sub_l);
return TCL_OK;
}
int cht_do_hbytes_trimleft(ClientData cd, Tcl_Interp *ip, HBytes_Var v) {
const Byte *o, *p, *e;
o= p= cht_hb_data(v.hb);
e= p + cht_hb_len(v.hb);
while (p INT_MAX/sub_l) return cht_staticerr(ip, "hbytes repeat too long", 0);
data= cht_hb_arrayspace(result, sub_l*count);
sub_d= cht_hb_data(&sub);
while (count) {
memcpy(data, sub_d, sub_l);
count--; data += sub_l;
}
return TCL_OK;
}
int cht_do_hbytes_xor(ClientData cd, Tcl_Interp *ip,
HBytes_Var v, HBytes_Value d) {
int l;
Byte *dest;
const Byte *source;
l= cht_hb_len(v.hb);
if (cht_hb_len(&d) != l) return
cht_staticerr(ip, "hbytes xor lengths do not match", "HBYTES LENGTH MISMATCH");
dest= cht_hb_data(v.hb);
source= cht_hb_data(&d);
memxor(dest,source,l);
return TCL_OK;
}
int cht_do_hbytes_zeroes(ClientData cd, Tcl_Interp *ip,
int length, HBytes_Value *result) {
Byte *space;
space= cht_hb_arrayspace(result, length);
memset(space,0,length);
return TCL_OK;
}
int cht_do_hbytes_compare(ClientData cd, Tcl_Interp *ip,
HBytes_Value a, HBytes_Value b, int *result) {
int al, bl, minl, r;
al= cht_hb_len(&a);
bl= cht_hb_len(&b);
minl= al0) *result= +2;
else {
if (albl) *result= +1;
else *result= 0;
}
return TCL_OK;
}
int cht_do_hbytes_range(ClientData cd, Tcl_Interp *ip,
HBytes_Value v, int start, int size,
HBytes_Value *result) {
const Byte *data;
int l;
l= cht_hb_len(&v);
if (start<0 || size<0)
return cht_staticerr(ip,"hbytes range subscript(s) -ve","HBYTES LENGTH RANGE");
if (l2)
return cht_staticerr(ip, "hbytes h2ushort input more than 4 hex digits",
"HBYTES VALUE OVERFLOW");
data= cht_hb_data(&hex);
*result= data[l-1] | (l>1 ? data[0]<<8 : 0);
return TCL_OK;
}
int cht_do_hbytes_ushort2h(ClientData cd, Tcl_Interp *ip,
long input, HBytes_Value *result) {
uint16_t us;
if (input > 0x0ffff)
return cht_staticerr(ip, "hbytes ushort2h input >2^16",
"HBYTES VALUE OVERFLOW");
us= htons(input);
cht_hb_array(result,(const Byte*)&us,2);
return TCL_OK;
}
/* toplevel functions */
CHT_INIT(hbytes,
CHTI_TYPE(cht_hbytes_type) CHTI_TYPE(cht_ulong_type),
CHTI_COMMANDS(cht_hbytestoplevel_entries))
chiark-tcl-1.1.1+nmu1/hbytes/chop.c 0000644 0000000 0000000 00000005764 11762372314 013712 0 ustar /*
* hbytes - hex-stringrep efficient byteblocks for Tcl
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "chiark_tcl_hbytes.h"
static int strs1(Tcl_Interp *ip, int strc, Tcl_Obj *const *strv, int *l_r) {
int rc, l, i, pl;
l= 0;
for (i=1; i.
Type hb: HBytes_Value @
Init hb cht_hb_sentinel(&@);
Type hbv: HBytes_Var @
Init hbv @.hb=0; cht_init_somethingv(&@.sth);
Fini hbv cht_fini_somethingv(ip, rc, &@.sth);
Type addrmapv: AddrMap_Var @
Init addrmapv @.am=0; cht_init_somethingv(&@.sth);
Fini addrmapv cht_fini_somethingv(ip, rc, &@.sth);
chiark-tcl-1.1.1+nmu1/hbytes/chiark_tcl_hbytes.h 0000644 0000000 0000000 00000002515 11762372314 016436 0 ustar /*
* hbytes - hex-stringrep efficient byteblocks for Tcl
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#ifndef CHIARK_TCL_HBYTES_H
#define CHIARK_TCL_HBYTES_H
#include "hbytes.h"
typedef struct {
Byte *start; /* byl bytes */
Tcl_Obj *data; /* may be 0 to mean empty */
} AddrMap_Entry;
struct AddrMap_Value {
int byl, used, space;
AddrMap_Entry *entries;
/* Entries are sorted by start. Each entry gives value (or lack of
* it) for all A st START <= A < NEXT-START. Last entry has value
* (or lack of it) for all A >= START. First entry is always
* present and always has start all-bits-0. */
}; /* internalRep.otherValuePtr */
#include "hbytes+tcmdif.h"
#endif /*CHIARK_TCL_HBYTES_H*/
chiark-tcl-1.1.1+nmu1/hbytes/parse.c 0000644 0000000 0000000 00000002547 11762372314 014067 0 ustar /*
* hbytes - hex-stringrep efficient byteblocks for Tcl
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "chiark_tcl_hbytes.h"
int cht_pat_hbv(Tcl_Interp *ip, Tcl_Obj *var, HBytes_Var *agg) {
int rc;
rc= cht_pat_somethingv(ip,var,&agg->sth,&cht_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,&cht_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= &cht_hbytes_type;
return obj;
}
chiark-tcl-1.1.1+nmu1/hbytes/Makefile 0000644 0000000 0000000 00000001536 11762372314 014246 0 ustar # hbytes - hex-stringrep efficient byteblocks for Tcl
# Copyright 2006-2012 Ian Jackson
#
# 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.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this library; if not, see .
BASE_DIR = ../base
EXTBASE = hbytes
CFILES = chop hbytes hook parse ulongs
OTHER_TCTS = hbytes-base.tct
include ../base/extension.make
chiark-tcl-1.1.1+nmu1/hbytes/hbytes.tct 0000644 0000000 0000000 00000003711 11762372314 014615 0 ustar # hbytes - hex-stringrep efficient byteblocks for Tcl
# Copyright 2006-2012 Ian Jackson
#
# 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.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this library; if not, see .
Table *hbytestoplevel TopLevel_Command
hbytes
dispatch(HBytes/_SubCommand, "hbytes subcommand")
ulong
dispatch(ULong/_SubCommand, "ulong subcommand")
Table ulong ULong_SubCommand
ul2int
v ulong
=> int
int2ul
v int
=> ulong
mask
a ulong
b ulong
=> ulong
add
a ulong
b ulong
=> ulong
multiply
a ulong
b ulong
=> ulong
subtract
a ulong
b ulong
=> ulong
compare
a ulong
b ulong
=> int
shift
right charfrom("lr", "shift direction")
v ulong
bits int
=> ulong
ul2bitfields
value ulong
... obj
=> int
bitfields2ul
base ulong
... obj
=> ulong
Table hbytes HBytes_SubCommand
raw2h
binary obj
=> hb
h2raw
hex hb
=> obj
ushort2h
value long
=> hb
h2ushort
hex hb
=> long
length
v hb
=> int
compare
a hb
b hb
=> int
range
v hb
start int
size int
=> hb
prepend
v hbv
... str
append
v hbv
... str
rep-info
v obj
=> obj
concat
... str
=> hb
unprepend
v hbv
length int
=> hb
unappend
v hbv
length int
=> hb
chopto
v hbv
length int
=> hb
overwrite
v hbv
start int
sub hb
trimleft
v hbv
zeroes
length int
=> hb
repeat
v hb
count int
=> hb
xor
v hbv
d hb
random
length int
=> hb
chiark-tcl-1.1.1+nmu1/hbytes/hbytes.h 0000644 0000000 0000000 00000024634 11762372314 014261 0 ustar /*
* 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 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 (AB)
* 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
*/
/* ---8<--- end of documentation comment --8<-- */
/*
* hbytes - hex-stringrep efficient byteblocks for Tcl
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#ifndef HBYTES_H
#define HBYTES_H
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include
#include "chiark-tcl.h"
/* 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 */
void memxor(Byte *dest, const Byte *src, int l);
extern int Chiark_tcl_hbytes_Init(Tcl_Interp *ip);
/* called by load(3tcl) and also by extensions which depend on this one */
/* Public interfaces: */
extern Tcl_ObjType cht_hbytes_type;
int cht_hb_len(const HBytes_Value *v);
Byte *cht_hb_data(const HBytes_Value *v); /* caller may then modify data! */
int cht_hb_issentinel(const HBytes_Value *v);
Byte *cht_hb_prepend(HBytes_Value *upd, int el);
Byte *cht_hb_append(HBytes_Value *upd, int el);
/* return value is where to put the data */
const Byte *cht_hb_unprepend(HBytes_Value *upd, int rl);
const Byte *cht_hb_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 cht_hb_empty(HBytes_Value *returns);
void cht_hb_sentinel(HBytes_Value *returns);
void cht_hb_array(HBytes_Value *returns, const Byte *array, int l);
Byte *cht_hb_arrayspace(HBytes_Value *returns, int l);
void cht_hb_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 cht_hb_sentinel should not be passed to
* anything except HBYTES_IS..., and cht_hb_free. */
/* from hook.c */
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);
/* from parse.c */
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 cht_addrmap_type;
/* from chop.c */
/* only do_... functions declared in tables.h */
/* from ulong.c */
Tcl_ObjType cht_ulong_type;
/* useful macros */
#define OBJ_HBYTES(o) ((HBytes_Value*)&(o)->internalRep.twoPtrValue)
#define OBJ_SOCKADDR(o) ((SockAddr_Value*)&(o)->internalRep.twoPtrValue)
#endif /*HBYTES_H*/
chiark-tcl-1.1.1+nmu1/hbytes/ulongs.c 0000644 0000000 0000000 00000020506 11762372314 014257 0 ustar /*
* hbytes - hex-stringrep efficient byteblocks for Tcl
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "chiark_tcl_hbytes.h"
/* nice simple functions */
int cht_do_ulong_int2ul(ClientData cd, Tcl_Interp *ip, int v,
uint32_t *result) {
if (v<0) return cht_staticerr(ip,"cannot convert"
" -ve integer to ulong","ULONG VALUE NEGATIVE");
*result= v;
return TCL_OK;
}
int cht_do_ulong_add(ClientData cd, Tcl_Interp *ip,
uint32_t a, uint32_t b, uint32_t *result) {
*result= a + b;
return TCL_OK;
}
int cht_do_ulong_multiply(ClientData cd, Tcl_Interp *ip,
uint32_t a, uint32_t b, uint32_t *result) {
*result= a * b;
return TCL_OK;
}
int cht_do_ulong_subtract(ClientData cd, Tcl_Interp *ip,
uint32_t a, uint32_t b, uint32_t *result) {
*result= a - b;
return TCL_OK;
}
int cht_do_ulong_compare(ClientData cd, Tcl_Interp *ip,
uint32_t a, uint32_t b, int *result) {
*result=
a == b ? 0 :
a < b ? -1 : 1;
return TCL_OK;
}
int cht_do_ulong_ul2int(ClientData cd, Tcl_Interp *ip,
uint32_t v, int *result) {
if (v>INT_MAX) return
cht_staticerr(ip,"ulong too large"
" to fit in an int", "ULONG VALUE OVERFLOW");
*result= v;
return TCL_OK;
}
int cht_do_ulong_mask(ClientData cd, Tcl_Interp *ip,
uint32_t a, uint32_t b, uint32_t *result) {
*result= a & b;
return TCL_OK;
}
int cht_do_ulong_shift(ClientData cd, Tcl_Interp *ip, int right,
uint32_t v, int bits, uint32_t *result) {
if (bits < 0) { bits= -bits; right= !right; }
if (bits > 32) return cht_staticerr(ip,"shift out of range (32) bits",
"ULONG BITCOUNT OVERRUN");
*result= (bits==32 ? 0 :
right ? v >> bits : v << bits);
return TCL_OK;
}
/* bitfields */
typedef struct {
const char *name;
int want_arg;
int (*reader_writer[2])(Tcl_Interp *ip, uint32_t *value_io,
int *ok_io, Tcl_Obj *arg);
} BitFieldType;
static int bf_zero_read(Tcl_Interp *ip, uint32_t *value_io,
int *ok_io, Tcl_Obj *arg) {
if (*value_io) *ok_io= 0;
return TCL_OK;
}
static int bf_zero_write(Tcl_Interp *ip, uint32_t *value_io,
int *ok_io, Tcl_Obj *arg) {
*value_io= 0;
return TCL_OK;
}
static int bf_ignore(Tcl_Interp *ip, uint32_t *value_io,
int *ok_io, Tcl_Obj *arg) {
return TCL_OK;
}
static int bf_fixed_read(Tcl_Interp *ip, uint32_t *value_io,
int *ok_io, Tcl_Obj *arg) {
uint32_t ul;
int rc;
rc= cht_pat_ulong(ip, arg, &ul); if (rc) return rc;
if (*value_io != ul) *ok_io= 0;
return TCL_OK;
}
static int bf_ulong_write(Tcl_Interp *ip, uint32_t *value_io,
int *ok_io, Tcl_Obj *arg) {
uint32_t ul;
int rc;
rc= cht_pat_ulong(ip, arg, &ul); if (rc) return rc;
*value_io= ul;
return TCL_OK;
}
static int bf_var_read(Tcl_Interp *ip, Tcl_Obj *varname, Tcl_Obj *val) {
Tcl_Obj *rp;
rp= Tcl_ObjSetVar2(ip,varname,0,val,TCL_LEAVE_ERR_MSG);
if (!rp) return TCL_ERROR;
return TCL_OK;
}
static int bf_ulong_read(Tcl_Interp *ip, uint32_t *value_io,
int *ok_io, Tcl_Obj *arg) {
return bf_var_read(ip,arg, cht_ret_ulong(ip,*value_io));
}
static int bf_uint_write(Tcl_Interp *ip, uint32_t *value_io,
int *ok_io, Tcl_Obj *arg) {
int rc, v;
rc= cht_pat_int(ip, arg, &v); if (rc) return rc;
if (v<0) return cht_staticerr(ip,"value for bitfield is -ve",
"ULONG VALUE NEGATIVE");
*value_io= v;
return TCL_OK;
}
static int bf_uint_read(Tcl_Interp *ip, uint32_t *value_io,
int *ok_io, Tcl_Obj *arg) {
if (*value_io > INT_MAX)
return cht_staticerr(ip,"value from bitfield"
" exceeds INT_MAX","ULONG VALUE OVERFLOW");
return bf_var_read(ip,arg, cht_ret_int(ip,*value_io));
}
#define BFT(t,a) { #t, a, { bf_read_##t, bf_write_##t } }
static const BitFieldType bitfieldtypes[]= {
{ "zero", 0, { bf_zero_read, bf_zero_write } },
{ "ignore", 0, { bf_ignore, bf_ignore } },
{ "fixed", 1, { bf_fixed_read, bf_ulong_write } },
{ "ulong", 1, { bf_ulong_read, bf_ulong_write } },
{ "uint", 1, { bf_uint_read, bf_uint_write } },
{ 0 }
};
static int do_bitfields(Tcl_Interp *ip, int writing, int *ok_r,
uint32_t *value_io,
int objc, Tcl_Obj *const *objv) {
const BitFieldType *ftype;
Tcl_Obj *arg;
int sz, pos, rc;
uint32_t value, sz_mask, this_mask, this_field;
pos= 32;
value= *value_io;
*ok_r= 1;
while (--objc) {
rc= Tcl_GetIntFromObj(ip,*++objv,&sz); if (rc) return rc;
if (!--objc)
return cht_staticerr(ip,"wrong # args: missing bitfield type",0);
if (sz<0)
return cht_staticerr(ip,"bitfield size is -ve",
"ULONG BITCOUNT NEGATIVE");
if (sz>pos)
return cht_staticerr(ip,"total size of bitfields >32",
"ULONG BITCOUNT OVERRUN");
pos -= sz;
sz_mask= ~(~0UL << sz);
this_mask= (sz_mask << pos);
this_field= (value & this_mask) >> pos;
ftype= enum_lookup_cached(ip,*++objv,bitfieldtypes,"bitfield type");
if (!ftype) return TCL_ERROR;
if (ftype->want_arg) {
if (!--objc)
return cht_staticerr(ip,"wrong # args: missing arg for bitfield",0);
arg= *++objv;
} else {
arg= 0;
}
rc= ftype->reader_writer[writing](ip, &this_field, ok_r, arg);
if (rc) return rc;
if (!*ok_r) return TCL_OK;
if (this_field & ~sz_mask)
return cht_staticerr(ip,"bitfield value has more bits than bitfield",
"ULONG VALUE OVERFLOW");
value &= ~this_mask;
value |= (this_field << pos);
}
if (pos != 0) return
cht_staticerr(ip,"bitfield sizes add up to <32","ULONG BITCOUNT UNDERRUN");
*value_io= value;
return TCL_OK;
}
int cht_do_ulong_bitfields2ul(ClientData cd, Tcl_Interp *ip,
uint32_t base,
int objc, Tcl_Obj *const *objv,
uint32_t *result) {
int ok, rc;
*result= base;
rc= do_bitfields(ip,1,&ok,result,objc,objv);
assert(ok);
return rc;
}
int cht_do_ulong_ul2bitfields(ClientData cd, Tcl_Interp *ip,
uint32_t value,
int objc, Tcl_Obj *const *objv,
int *result) {
return do_bitfields(ip,0,result,&value,objc,objv);
}
/* Arg parsing */
int cht_pat_ulong(Tcl_Interp *ip, Tcl_Obj *o, uint32_t *val) {
int rc;
rc= Tcl_ConvertToType(ip,o,&cht_ulong_type);
if (rc) return rc;
*val= *(const uint32_t*)&o->internalRep.longValue;
return TCL_OK;
}
Tcl_Obj *cht_ret_ulong(Tcl_Interp *ip, uint32_t val) {
Tcl_Obj *o;
o= Tcl_NewObj();
Tcl_InvalidateStringRep(o);
*(uint32_t*)&o->internalRep.longValue= val;
o->typePtr= &cht_ulong_type;
return o;
}
/* Tcl ulong type */
static void ulong_t_free(Tcl_Obj *o) { }
static void ulong_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
dup->internalRep= src->internalRep;
dup->typePtr= &cht_ulong_type;
}
static void ulong_t_ustr(Tcl_Obj *o) {
uint32_t val;
char buf[9];
val= *(const uint32_t*)&o->internalRep.longValue;
snprintf(buf,sizeof(buf), "%08lx", (unsigned long)val);
cht_obj_updatestr_vstringls(o, buf, sizeof(buf)-1, (char*)0);
}
static int ulong_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
char *str, *ep;
uint32_t ul;
if (o->typePtr == &cht_hbytes_type) {
int l;
l= cht_hb_len(OBJ_HBYTES(o));
if (l > 4) return cht_staticerr(ip,"hbytes as ulong with length >4",
"HBYTES LENGTH OVERRUN");
ul= 0;
memcpy((Byte*)&ul + 4 - l, cht_hb_data(OBJ_HBYTES(o)), l);
ul= htonl(ul);
} else {
str= Tcl_GetString(o);
errno=0;
if (str[0]=='0' && str[1]=='b' && str[2]) {
ul= strtoul(str+2,&ep,2);
} else if (str[0]=='0' && str[1]=='d' && str[2]) {
ul= strtoul(str+2,&ep,10);
} else {
ul= strtoul(str,&ep,16);
}
if (*ep || errno) return cht_staticerr(ip, "bad unsigned long value", 0);
}
cht_objfreeir(o);
*(uint32_t*)&o->internalRep.longValue= ul;
o->typePtr= &cht_ulong_type;
return TCL_OK;
}
Tcl_ObjType cht_ulong_type = {
"ulong-nearly",
ulong_t_free, ulong_t_dup, ulong_t_ustr, ulong_t_sfa
};
chiark-tcl-1.1.1+nmu1/maskmap/ 0000755 0000000 0000000 00000000000 11762372507 012740 5 ustar chiark-tcl-1.1.1+nmu1/maskmap/maskmap.tct 0000644 0000000 0000000 00000002070 11762372314 015100 0 ustar # maskmap - Tcl extension for address mask map data structures
# Copyright 2006-2012 Ian Jackson
#
# 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.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this library; if not, see .
Table *maskmaptoplevel TopLevel_Command
addr-map
subcmd enum(AddrMap/_SubCommand, "addr-map subcommand")
... obj
Table addrmap AddrMap_SubCommand
lookup
map constv(&cht_addrmap_type)
addr hb
?def obj
=> obj
amend-range
map addrmapv
start hb
end hb
data obj
amend-mask
map addrmapv
prefix hb
preflen obj
data obj
chiark-tcl-1.1.1+nmu1/maskmap/addrmap.c 0000644 0000000 0000000 00000020767 11762372314 014524 0 ustar /*
* maskmap - Tcl extension for address mask map data structures
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "chiark_tcl_hbytes.h"
/*---------- operations on AddrMap_Entry ----------*/
static void ame_free(AddrMap_Entry *ame) {
TFREE(ame->start); ame->start=0;
if (ame->data) { Tcl_DecrRefCount(ame->data); ame->data=0; }
}
static const Byte *ame_parsecheck_addr(Tcl_Interp *ip, const AddrMap_Value *am,
const HBytes_Value *hb) {
int hbl= cht_hb_len(hb);
if (hbl < am->byl) {
cht_staticerr(ip,"addr-map address too short","HBYTES ADDRMAP UNDERRUN");
return 0;
}
if (hbl > am->byl) {
cht_staticerr(ip,"addr-map address too long","HBYTES ADDRMAP OVERRUN");
return 0;
}
return cht_hb_data(hb);
}
static int ame_parsecheck_range(Tcl_Interp *ip, const AddrMap_Value *am,
const HBytes_Value *starthb,
const HBytes_Value *endhb,
const Byte *p_r[2]) {
p_r[0]= ame_parsecheck_addr(ip,am,starthb); if (!p_r[0]) return TCL_ERROR;
p_r[1]= ame_parsecheck_addr(ip,am,endhb); if (!p_r[0]) return TCL_ERROR;
if (memcmp(p_r[0],p_r[1],am->byl) > 0)
return cht_staticerr(ip, "addr-map range start is after end",
"HBYTES ADDRMAP BADRANGE");
return TCL_OK;
}
static int ame_ba_addsubtractone(Byte *out, const Byte *in, int byl,
unsigned signum, unsigned onoverflow) {
/* On entry:
* *in is an array of byl bytes
* signum is 0xff or 0x01
* onoverflow is what counts as overflowed value,
* ie (for unsigned arith) 0x00 for add and 0xff for subtract
* On exit:
* *out is the resulting value (subject to overflow truncation)
* return value is TCL_OK, or TCL_ERROR if overflow happened
* (but interpreter result is not set on overflow)
*/
int j;
for (j= byl, in += byl, out += byl;
in--, out--, j>0;
j--) {
*out = (*out) + signum;
if (*out != onoverflow)
return TCL_OK;
}
return TCL_ERROR;
}
/*---------- useful operations on AddrMap_Value etc. ----------*/
static void am_init0(AddrMap_Value *am, int byl) {
am->byl= byl;
am->used= 0;
am->space= 0;
am->entries= 0;
}
static void am_reallocentries(AddrMap_Value *am, int len) {
AddrMap_Entry *newentries;
assert(len >= am->space);
if (!len) return;
assert(len < INT_MAX/sizeof(*newentries));
newentries= TREALLOC(am->entries, sizeof(*newentries)*len);
assert(newentries);
am->space= len;
am->entries= newentries;
}
static void am_free(AddrMap_Value *am) {
AddrMap_Entry *ame;
int i;
if (!am) return;
for (i=0, ame=am->entries; iused; i++, ame++)
ame_free(ame);
TFREE(am->entries);
TFREE(am);
}
/*---------- Tcl type and arg parsing functions ----------*/
int cht_pat_addrmapv(Tcl_Interp *ip, Tcl_Obj *var, AddrMap_Var *agg) {
int rc;
rc= cht_pat_somethingv(ip,var,&agg->sth,&cht_addrmap_type);
if (rc) return rc;
agg->am= agg->sth.obj->internalRep.otherValuePtr;
return TCL_OK;
}
static void addrmap_t_free(Tcl_Obj *o) {
AddrMap_Value *am= o->internalRep.otherValuePtr;
am_free(am);
}
static void addrmap_t_dup(Tcl_Obj *sob, Tcl_Obj *dob) {
AddrMap_Value *sm= sob->internalRep.otherValuePtr;
AddrMap_Value *dm;
AddrMap_Entry *sme, *dme;
int i;
assert(sob->typePtr == &cht_addrmap_type);
cht_objfreeir(dob);
dm= TALLOC(sizeof(*dm));
am_init0(dm,sm->byl);
am_reallocentries(dm,sm->used);
dm->used= sm->used;
for (i=0, sme=sm->entries, dme=dm->entries;
i < dm->used;
i++, sme++, dme++) {
*dme= *sme;
dme->start= TALLOC(sm->byl); assert(dme->start);
memcpy(dme->start, sme->start, sm->byl);
Tcl_IncrRefCount(dme->data);
}
dob->internalRep.otherValuePtr= dm;
dob->typePtr= &cht_addrmap_type;
}
static void addrmap_t_ustr(Tcl_Obj *so) {
AddrMap_Value *sm= so->internalRep.otherValuePtr;
Tcl_Obj **mainlobjsl, *surrogate;
AddrMap_Entry *sme;
int entnum, listlength;
assert(so->typePtr == &cht_addrmap_type);
mainlobjsl= TALLOC(sizeof(*mainlobjsl) * (sm->used+1)); assert(mainlobjsl);
mainlobjsl[0]= Tcl_NewIntObj(sm->byl * 8);
listlength= 1;
for (entnum=0, sme=sm->entries; entnumused; entnum++, sme++) {
HBytes_Value hb;
Tcl_Obj *subl[3], *sublo;
if (!sme->data) continue;
cht_hb_array(&hb, sme->start, sm->byl);
subl[0]= cht_ret_hb(0, hb); assert(subl[0]);
if (entnum+1 < sm->used) {
ame_ba_addsubtractone(cht_hb_arrayspace(&hb, sm->byl),
(sme+1)->start, sm->byl,
/*subtract:*/ 0x0ffu, 0x0ffu);
} else {
memset(cht_hb_arrayspace(&hb, sm->byl),
0x0ffu, sm->byl);
}
subl[1]= cht_ret_hb(0, hb); assert(subl[1]);
subl[2]= sme->data;
sublo= Tcl_NewListObj(3,subl); assert(sublo);
mainlobjsl[listlength++]= sublo;
}
assert(listlength <= sm->used+1);
surrogate= Tcl_NewListObj(listlength,mainlobjsl); assert(surrogate);
assert(surrogate);
so->bytes= Tcl_GetStringFromObj(surrogate, &so->length); assert(so->bytes);
surrogate->bytes= 0; surrogate->length= 0; /* we stole it */
}
static AddrMap_Entry *ame_sfa_alloc(AddrMap_Value *am) {
AddrMap_Entry *ame;
ame= am->entries + am->used;
am->used++;
assert(am->used <= am->space);
ame->start= TALLOC(am->byl); assert(ame->start);
ame->data= 0;
return ame;
}
static int addrmap_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
int rc, inlen, eol, innum, bitlen, cmp;
Tcl_Obj *eo, *starto, *endo;
HBytes_Value starthb, endhb;
const Byte *rangeptrs[2];
AddrMap_Value *am;
AddrMap_Entry *ame;
am= TALLOC(sizeof(*am)); assert(am);
am_init0(am,0);
rc= Tcl_ListObjLength(ip,o,&inlen); if (rc) goto x_badvalue_rc;
if (inlen<0) {
rc= cht_staticerr(ip, "addr-map overall length < 1", 0);
goto x_badvalue_rc;
}
rc= Tcl_ListObjIndex(ip,o,0,&eo); if (rc) goto x_badvalue_rc;
rc= Tcl_GetIntFromObj(ip,eo,&bitlen); if (rc) goto x_badvalue_rc;
if (bitlen<0 || bitlen % 8) {
rc= cht_staticerr(ip, "addr-map overall length < 1", 0);
goto x_badvalue_rc;
}
am->byl= bitlen/8;
assert(inlen < INT_MAX/2);
am_reallocentries(am, (inlen-1)*2+1);
ame= ame_sfa_alloc(am);
memset(ame->start,0,am->byl);
for (innum=1; innum < inlen; innum++) {
rc= Tcl_ListObjIndex(ip,o,innum,&eo); if (rc) goto x_badvalue_rc;
rc= Tcl_ListObjLength(ip,eo,&eol); if (rc) goto x_badvalue_rc;
if (eol != 3) {
rc= cht_staticerr(ip, "addr-map entry length != 3", 0);
goto x_badvalue_rc;
}
rc= Tcl_ListObjIndex(ip,eo,0,&starto); if (rc) goto x_badvalue_rc;
rc= Tcl_ListObjIndex(ip,eo,1,&endo); if (rc) goto x_badvalue_rc;
rc= cht_pat_hb(ip,starto,&starthb); if (rc) goto x_badvalue_rc;
rc= cht_pat_hb(ip,endo,&endhb); if (rc) goto x_badvalue_rc;
rc= ame_parsecheck_range(ip,am,&starthb,&endhb,rangeptrs);
if (rc) goto x_badvalue_rc;
cmp= memcmp(ame->start, rangeptrs[0], am->byl);
if (cmp < 0) {
rc= cht_staticerr(ip, "addr-map entries out of order", 0);
goto x_badvalue_rc;
}
if (cmp > 0) {
ame= ame_sfa_alloc(am);
memcpy(ame->start, rangeptrs[0], am->byl);
}
assert(!ame->data);
rc= Tcl_ListObjIndex(ip,eo,2,&ame->data); if (rc) goto x_badvalue_rc;
Tcl_IncrRefCount(ame->data);
ame= ame_sfa_alloc(am);
rc= ame_ba_addsubtractone(ame->start, rangeptrs[1], am->byl,
/*add:*/ 0x01u, 0x00u);
if (rc) {
/* we've overflowed. it must have been ffffffff.... */
if (innum != inlen-1) {
rc= cht_staticerr(ip, "addr-map non-last entry end is all-bits-1", 0);
goto x_badvalue_rc;
}
TFREE(ame->start);
am->used--;
break;
}
}
/* we commit now */
cht_objfreeir(o);
o->internalRep.otherValuePtr= am;
o->typePtr= &cht_addrmap_type;
return TCL_OK;
x_badvalue_rc:
if (rc == TCL_ERROR)
Tcl_SetObjErrorCode(ip, Tcl_NewStringObj("HBYTES ADDRMAP VALUE", -1));
am_free(am);
return rc;
}
Tcl_ObjType cht_addrmap_type = {
"addr-map",
addrmap_t_free, addrmap_t_dup, addrmap_t_ustr, addrmap_t_sfa
};
chiark-tcl-1.1.1+nmu1/maskmap/maskmap.c 0000644 0000000 0000000 00000024233 11762372314 014535 0 ustar /*
* maskmap - Tcl extension for address mask map data structures
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "chiark_tcl_hbytes.h"
/*---------- operations on AddrMap_Entry ----------*/
static void ame_init(AddrMap_Entry *ame) {
ame->prefixlen= -1;
ame->prefix= 0;
ame->data= 0;
}
static unsigned ame_clear_unwanted(AddrMap_Entry *ame, int bytes) {
/* returns non-0 iff some bits were cleared */
int sparebits;
unsigned result, sparemask;
Byte *datap;
sparebits= bytes * 8 - ame->prefixlen;
if (!sparebits) return 0;
sparemask= (1u << sparebits) - 1;
datap= &ame->prefix[bytes-1];
result= *datap & sparemask;
*datap &= ~sparemask;
return result;
}
static int ame_parsekey(Tcl_Interp *ip, AddrMap_Entry *ame,
Tcl_Obj *prefixo, Tcl_Obj *prefixbitso,
int inmap) {
/* *ame should be blank entry; after exit (even error exit) it will be valid
* - on errors, it will be blank. inmap is 1 if we're parsing an existing
* map or 0 if it's an entry to be added or modified. */
HBytes_Value prefix;
int suppliedprefixbytes, prefixbits, wantprefixbytes;
const Byte *data;
int rc;
hbytes_empty(&prefix);
rc= pat_hb(ip,prefixo,&prefix); if (rc) goto x_rc;
rc= pat_int(ip,prefixbitso,&prefixbits); if (rc) goto x_rc;
wantprefixbytes= prefix_bytes(prefixbits);
suppliedprefixbytes= hbytes_len(&prefix);
if (suppliedprefixbytes < wantprefixbytes) {
rc= staticerr(ip, "addr-map entry PREFIX too short for PREFIX-LEN",
"HBYTES ADDRMAP SYNTAX UNDERRUN");
goto x_rc;
}
if (inmap && suppliedprefixbytes > wantprefixbytes) {
rc= staticerr(ip, "addr-map existing entry PREFIX too long for PREFIX-LEN",
"HBYTES ADDRMAP SYNTAX OVERRUN");
goto x_rc;
}
ame->prefixlen= prefixbits;
ame->prefix= TALLOC(wantprefixbytes); assert(ame->prefix);
memcpy(ame->prefix, data, wantprefixbytes);
if (ame_clear_unwanted(ame, wantprefixbytes)) {
rc= staticerr(ip, "addr-map entry PREFIX contains bits excluded"
" by PREFIX-LEN", "HBYTES ADDRMAP SYNTAX EXCLBITS");
goto x_rc;
}
return TCL_OK;
x_rc:
ame_free(ame);
return rc;
}
static int ame_contains(const AddrMap_Entry *ref, const Byte *addr, int len) {
int directbytes, leftoverbits;
assert(len >= ref->prefixlen);
directbytes= ref->prefixlen / 8;
if (memcmp(ref->prefix, addr, directbytes)) return 0;
leftoverbits= ref->prefixlen % 8;
if (leftoverbits)
if ((addr[directbytes] & (0xffu << leftoverbits))
!= search->prefix[directbytes])
return 0;
return 1;
}
static int ame_compare(const AddrMap_Entry *a, const AddrMap_Entry *b) {
/* +2 = a covers later range of address space than b
* +1 = a wholly contains but is not equal to b
* 0 = a is identical to b
* -1 = b wholly contains but is not equal to a
* -2 = b covers later range of address space than a
*/
int al= a->prefixlen;
int bl= b->prefixlen;
int ml, d;
if (al==bl) { ml=al; }
else if (alprefix,bl)) return +1; }
else if (blprefix,al)) return -1; }
d= memcmp(b->prefix, a->prefix, prefix_bytes(ml));
return (d > 0 ? +2 :
d < 0 ? -2 :
0);
}
/*---------- searching maps ----------*/
typedef enum {
sr_notfound,
sr_exact,
sr_inbig,
sr_aroundsmall
} Search_Result;
static int
am_binarychop(AddrMap_Value *am, int low_oreq, int high_strict, void *u,
int (*test)(AddrMap_Entry *am, void *u) /* -ve => look left */,
int *found_r) {
int mid, cmp;
for (;;) {
if (high_strict <= low_oreq) {
assert(high_strict == low_oreq);
*found_r= 0;
return high_strict;
}
mid= (high_strict + low_oreq) / 2;
cmp= test(&am->entries[mid], u);
if (!cmp) {
*found_r= 1;
return mid;
}
if (cmp < 0)
high_strict= mid;
else
low_oreq= mid+1;
}
}
struct am_search_u {
int forbid_aroundsmall;
AddrMap_Entry proposed;
Search_Result sr;
};
static int
am_search_binchoptest(AddrMap_Entry *ame, void *u_v) {
struct am_search_u *u= u_v;
int cmp;
cmp= ame_compare(&u.proposed, ame);
switch (cmp) {
case -1: u->sr= sr_inbig; return 0;
case 0: u->sr= sr_exact; return 0;
case +1: u->sr= sr_aroundsmall; return 0;
default: return cmp;
}
}
static Search_Result
am_search(AddrMap_Value *am, const AddrMap_Entry *proposed, int *place_r) {
int place, found;
struct am_search_u u;
u.forbid_aroundsmall= forbid_aroundsmall;
u.proposed= proposed;
u.sr= sr_notfound;
*place_r= am_binarychop(am, 0, am.used, &u, am_search_binchoptest, &found);
assert(!!found == (u.sr != sr_notfound));
return u.sr;
}
/*---------- useful operations on AddrMap_Value etc. ----------*/
/*---------- amendment (complex algorithm) ----------*/
struct am_amend_aroundsmall_u {
AddrMap_Entry *new;
int sign;
};
static int
am_amend_aroundsmall_binchoptest(AddrMap_Entry *search, void *u_v) {
struct am_amend_aroundsmall_u *u= u_v;
cmp= u->sign * ame_compare(search, u->new);
switch (cmp) {
case +2: return -u->sign;
case +1: return +u->sign;
default: abort();
}
}
int do_addrmap_amend(ClientData cd, Tcl_Interp *ip,
AddrMap_Var map, Tcl_Obj *prefix,
Tcl_Obj *preflen, Tcl_Obj *data) {
AddrMap_Value *am= map.am;
AddrMap_Entry new, *fragment;
AddrMap_Entry *breaking, *replacements;
int rc, insertat, findend, cmp, nreplacements, new_used;
struct am_amend_aroundsmall_u u;
ame_init(&new);
rc= ame_parsekey(ip,&new,prefix,preflen,0); if (rc) return rc;
sr= am_search(am, &new, &searched);
replacements= &new;
nreplacements= 1;
replace_start= searched;
replace_end= searched;
switch (sr) {
case sr_notfound:
break;
case sr_exact:
replace_end= searched+1;
break;
case sr_aroundsmall:
u.ame= new;
u.sign= -1;
replace_start= am_binarychop(am, 0, searched, &u,
am_amend_aroundsmall_binchoptest, &dummy);
u.sign= +1;
replace_end= am_binarychop(am, searched+1, am.used, &u,
am_amend_aroundsmall_binchoptest, &dummy);
break;
case sr_inbig:
/* Urgh, we need to break it up. This produces
* - innermost prefix (the new one) as specified
* - one for each bitlength
* <= innermost
* > outermost (the existing one)
* each one specifying the outermost prefix plus zero, one,
* two, etc. bits of the innermost followed by one bit
* opposite to the innermost, with the outermost's data
* Eg, if we have ff/8=>A and want to amend so that ffff/16=>B
* then we replace ff/8 with ff0/9=>A ff8/10=>A ffc/11=>A ...
* ... fff8/14=>A fffc/15=>A fffe/16=>A ffff/16=>B.
*/
breaking= &am.entries[searched];
nreplacements= new.prefix - breaking->prefixlen + 1;
fixme check integer overflow ^
replacements= TALLOC(sizeof(*replacements) * nreplacements);
for (fragmentlen= breaking->prefixlen + 1,
left_insert= 0, right_insert= nreplacements;
fragmentlen <= new.prefix;
fragmentlen++) {
int fragmentbytes;
fragmentbytes= prefix_bytes(fragmentlen)
fragment->prefixlen= fragmentlen;
fragment->prefix= TALLOC(fragmentbytes);
memcpy(fragment->prefix, new.prefix, fragmentbytes);
ame_clear_unwanted(fragment, fragmentbytes);
fragment->prefix[fragmentbytes] ^=
0x80u >> ((fragmentlen+7) & 7);
switch (ame_compare(&fragment, &new)) {
case -2: replacements[left_insert++]= fragment; break;
case +2: replacements[--right_insert]= fragment; break;
default: abort();
}
}
assert(left_insert == right_insert-1);
replacements[left_insert]= new;
ame_init(&new);
replace_end= searched+1;
break;
}
new_used= am.used - (replace_end - replace_start) + nreplacements;
if (new_used > am.space)
am_reallocentries(am, new_used * 2);
for (scan=replacements, i=0;
i < nreplacements;
scan++, i++) {
scan->data= data;
Tcl_IncrRefCount(scan->data);
}
for (i= replace_start, scan= am.entries+i;
i < replace_end;
i++, scan++) {
ame_free(scan);
}
memmove(am.entries + replace_start + nreplacements,
am.entries + replace_end,
sizeof(*am.entries) * (am.used - replace_end));
memcpy(am.entries + replace_start,
replacements,
sizeof(*am.entries) * nreplacements);
am.used= new_used;
if (replacements != &new)
/* we don't bother freeing the actual array elements because
* if replacements!=&new the array is only full if we're
* committed and have already copied the values into the actual
* AddrMap_Value. */
TFREE(replacements);
return TCL_OK;
}
/*---------- other substantial operations on mask maps ----------*/
int do_addrmap_lookup(ClientData cd, Tcl_Interp *ip,
Tcl_Obj *mapo, HBytes_Value addrhb, Tcl_Obj *def,
Tcl_Obj **result) {
AddrMap_Value *am= (void*)&mapo->internalRep;
const Byte *addr= hbytes_data(&addrhb);
int addrbytes= hbytes_len(&addrhb);
int i, addrbits, place;
Search_Result sr;
addrbits= addrbytes * 8;
sr= am_search(am, addr, addrbits, &place);
switch (sr) {
case sr_notfound:
if (!def) return staticerr(ip, "address not found in addr-map",
"HBYTES ADDRMAP NOMATCH");
*result= def;
break;
case sr_aroundsmall:
return staticerr(ip, "address shorter than mask in map",
"HBYTES ADDRMAP UNDERRUN");
case sr_exact:
case sr_inbig:
*result= am.entres[place].data;
break;
}
return TCL_OK;
}
/*---------- Tcl type and arg parsing functions ----------*/
chiark-tcl-1.1.1+nmu1/maskmap/maskmap-bits.c 0000644 0000000 0000000 00000002271 11762372314 015472 0 ustar /*
* maskmap - Tcl extension for address mask map data structures
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
int cht_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);
}
xxxx
extern int Chiark_tcl_hbytes_Init(Tcl_Interp *ip); /*called by load(3tcl)*/
int Chiark_tcl_hbytes_Init(Tcl_Interp *ip) {
static int initd;
return cht_initextension(ip, cht_hbytestoplevel_entries, &initd,
&cht_addrmap_type,
(Tcl_ObjType*)0);
}
chiark-tcl-1.1.1+nmu1/crypto/ 0000755 0000000 0000000 00000000000 12223237521 012614 5 ustar chiark-tcl-1.1.1+nmu1/crypto/crypto.h 0000644 0000000 0000000 00000006432 11762372314 014321 0 ustar /*
* crypto - Tcl bindings for parts of the `nettle' crypto library
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#ifndef CRYPTO_H
#define CRYPTO_H
#include "chiark-tcl.h"
/* 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 cht_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 cht_hashalginfo_entries[];
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 cht_blockcipheralginfo_entries[];
/* 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 IdDataSpec cht_hash_states;
extern const BlockCipherModeInfo cht_blockciphermodeinfo_entries[];
#include "crypto+tcmdif.h"
#endif /*CRYPTO_H*/
chiark-tcl-1.1.1+nmu1/crypto/hook.c 0000644 0000000 0000000 00000001617 11762372314 013734 0 ustar /*
* crypto - Tcl bindings for parts of the `nettle' crypto library
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "chiark_tcl_crypto.h"
CHT_INIT(crypto,
CHTI_OTHER(hbytes) CHTI_TYPE(cht_blockcipherkey_type),
CHTI_COMMANDS(cht_hbcryptotoplevel_entries))
chiark-tcl-1.1.1+nmu1/crypto/crypto.tct 0000644 0000000 0000000 00000004352 11762372314 014663 0 ustar # crypto - Tcl bindings for parts of the `nettle' crypto library
# Copyright 2006-2012 Ian Jackson
#
# 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.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this library; if not, see .
Table *hbcryptotoplevel TopLevel_Command
hbcrypto
dispatch(HBCrypto/_SubCommand, "hbcrypto subcommand")
Table hbcrypto HBCrypto_SubCommand
pad
op enum(PadOp/, "hbcrypto pad subcommand")
v hbv
blocksz obj
meth enum(PadMethodInfo/, "pad method")
... methargs
blockcipher
op enum(BlockCipherOp/, "op")
... obj
hash
alg enum(HashAlgInfo/, "hash alg")
message hb
=> hb
hash-init
alg enum(HashAlgInfo/, "hash alg")
=> iddata(&cht_hash_states)
hash-update
stateh iddata(&cht_hash_states)
message hb
hash-final
stateh iddata(&cht_hash_states)
=> hb
hash-discard
stateh iddata(&cht_hash_states)
hash-clonestate
stateh iddata(&cht_hash_states)
=> iddata(&cht_hash_states)
hmac
alg enum(HashAlgInfo/, "hash alg for hmac")
message hb
key obj
?maclen obj
=> hb
hash-prop
prop enum(HashAlgPropInfo/, "prop")
alg enum(HashAlgInfo/, "alg")
=> int
Table padmethodinfo PadMethodInfo
pkcs5
=> int
rfc2406
nxthdr obj
=> int
Table blockcipherop BlockCipherOp
e 1
v hbv
alg enum(BlockCipherAlgInfo/, "alg")
key obj
mode enum(BlockCipherModeInfo/, "mode")
?iv hb
=> hb
d 0
v hbv
alg enum(BlockCipherAlgInfo/, "alg")
key obj
mode enum(BlockCipherModeInfo/, "mode")
?iv hb
=> hb
mac -1
msg hb
alg enum(BlockCipherAlgInfo/, "alg")
key obj
mode enum(BlockCipherModeInfo/, "mode")
iv hb
=> hb
prop -1
prop enum(BlockCipherPropInfo/, "prop")
alg enum(BlockCipherAlgInfo/, "alg")
=> int
EntryExtra BlockCipherOp
int encrypt;
chiark-tcl-1.1.1+nmu1/crypto/bcmode.c 0000644 0000000 0000000 00000007506 11762372314 014230 0 ustar /*
* crypto - Tcl bindings for parts of the `nettle' crypto library
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "chiark_tcl_crypto.h"
static const char *mode_cbc_encrypt(Byte *data, int blocks,
const Byte *iv, Byte *chain,
const BlockCipherAlgInfo *alg, int encr,
const void *sch) {
int blocksize= alg->blocksize;
memcpy(chain,iv,blocksize);
while (blocks > 0) {
memxor(data, chain, blocksize);
alg->encrypt.crypt(sch, data, data);
memcpy(chain, data, blocksize);
blocks--; data += blocksize;
}
return 0;
}
static const char *mode_cbc_decrypt(Byte *data, int blocks,
const Byte *iv, Byte *chain,
const BlockCipherAlgInfo *alg, int encr,
const void *sch) {
int blocksize= alg->blocksize;
int cchain= 0;
memcpy(chain,iv,blocksize);
while (blocks > 0) {
memcpy(chain + (cchain^blocksize), data, blocksize);
alg->decrypt.crypt(sch, data, data);
memxor(data, chain + cchain, blocksize);
cchain ^= blocksize;
blocks--; data += blocksize;
}
return 0;
}
static void cbcmac_core(const Byte *data, int blocks,
const Byte *iv, Byte *buf,
const BlockCipherAlgInfo *alg,
const void *sch) {
int blocksize= alg->blocksize;
memcpy(buf,iv,blocksize);
while (blocks > 0) {
memcpy(buf + blocksize, data, blocksize);
memxor(buf, buf + blocksize, blocksize);
alg->encrypt.crypt(sch, buf, buf);
blocks--; data += blocksize;
}
}
static const char *mode_cbc_mac(const Byte *data, int blocks,
const Byte *iv, Byte *buf,
const BlockCipherAlgInfo *alg,
const void *sch) {
cbcmac_core(data,blocks,iv,buf,alg,sch);
return 0;
}
static const char *mode_cbc_mac2(const Byte *data, int blocks,
const Byte *iv, Byte *buf,
const BlockCipherAlgInfo *alg,
const void *sch) {
cbcmac_core(data,blocks,iv,buf,alg,sch);
alg->encrypt.crypt(sch, buf, buf);
return 0;
}
static const char *mode_ecb(Byte *data, int blocks,
const Byte *iv, Byte *chain,
const BlockCipherAlgInfo *alg, int encr,
const void *sch) {
int blocksize= alg->blocksize;
while (blocks > 0) {
(encr ? &alg->encrypt : &alg->decrypt)->crypt(sch, data, data);
blocks--; data += blocksize;
}
return 0;
}
static const char *mode_ctr(Byte *data, int blocks,
const Byte *iv, Byte *counter,
const BlockCipherAlgInfo *alg, int encr,
const void *sch) {
int blocksize= alg->blocksize;
Byte *cipher= counter + blocksize;
int byte;
memcpy(counter, iv, blocksize);
while (blocks > 0) {
alg->encrypt.crypt(sch, counter, cipher);
memxor(data, cipher, blocksize);
for (byte=blocksize-1; byte>=0; byte--) {
if (++counter[byte]) break;
/* new value of zero implies carry, so increment next byte */
}
blocks--;
data += blocksize;
}
return 0;
}
const BlockCipherModeInfo cht_blockciphermodeinfo_entries[]= {
{ "cbc", 1, 2, 1, mode_cbc_encrypt, mode_cbc_decrypt, mode_cbc_mac },
{ "cbc-mac2", 1, 2, 1, 0, 0, mode_cbc_mac2 },
{ "ecb", 0, 0, 0, mode_ecb, mode_ecb, 0 },
{ "ctr-sif", 1, 2, 0, mode_ctr, mode_ctr, 0 },
{ 0 }
};
chiark-tcl-1.1.1+nmu1/crypto/crypto.c 0000644 0000000 0000000 00000031742 11762372314 014316 0 ustar /*
* crypto - Tcl bindings for parts of the `nettle' crypto library
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "chiark_tcl_crypto.h"
const PadOp cht_padop_entries[]= {
{ "un", 0, 0 },
{ "ua", 0, 1 },
{ "pn", 1, 0 },
{ "pa", 1, 1 },
{ 0 }
};
typedef struct {
HBytes_Value *hb;
int pad, blocksize; /* 0 or 1 */
} PadMethodClientData;
int cht_do_hbcrypto_pad(ClientData cd, Tcl_Interp *ip, const PadOp *op,
HBytes_Var v, Tcl_Obj *blocksz, const PadMethodInfo *meth,
int methargsc, Tcl_Obj *const *methargsv) {
PadMethodClientData pmcd;
int rc;
if (op->use_algname) {
const BlockCipherAlgInfo *alg;
alg= enum_lookup_cached(ip,blocksz, cht_blockcipheralginfo_entries,
"blockcipher alg for pad");
if (!alg) return TCL_ERROR;
pmcd.blocksize= alg->blocksize;
} else {
rc= Tcl_GetIntFromObj(ip, blocksz, &pmcd.blocksize); if (rc) return rc;
if (pmcd.blocksize < 1) cht_staticerr(ip, "block size must be at least 1", 0);
}
pmcd.hb= v.hb;
pmcd.pad= op->pad;
return meth->func(&pmcd,ip,methargsc,methargsv);
}
int cht_do_padmethodinfo_rfc2406(ClientData cd, Tcl_Interp *ip,
Tcl_Obj *nxthdr_arg, int *ok) {
const PadMethodClientData *pmcd= (const void*)cd;
int i, rc, padlen, old_len;
if (pmcd->blocksize > 256)
return cht_staticerr(ip, "block size too large for RFC2406 padding", 0);
if (pmcd->pad) {
Byte *padding;
HBytes_Value nxthdr;
rc= cht_pat_hb(ip,nxthdr_arg,&nxthdr);
if (rc) return rc;
if (cht_hb_len(&nxthdr) != 1) return
cht_staticerr(ip, "RFC2406 next header field must be exactly 1 byte", 0);
padlen= pmcd->blocksize-1 - ((cht_hb_len(pmcd->hb)+1) % pmcd->blocksize);
padding= cht_hb_append(pmcd->hb, padlen+2);
for (i=1; i<=padlen; i++)
*padding++ = i;
*padding++ = padlen;
*padding++ = cht_hb_data(&nxthdr)[0];
*ok= 1;
} else {
const Byte *padding, *trailer;
HBytes_Value nxthdr;
Tcl_Obj *nxthdr_valobj, *ro;
*ok= 0;
old_len= cht_hb_len(pmcd->hb); if (old_len % pmcd->blocksize) goto quit;
trailer= cht_hb_unappend(pmcd->hb, 2); if (!trailer) goto quit;
padlen= trailer[0];
cht_hb_array(&nxthdr,trailer+1,1);
nxthdr_valobj= cht_ret_hb(ip,nxthdr);
ro= Tcl_ObjSetVar2(ip,nxthdr_arg,0,nxthdr_valobj,TCL_LEAVE_ERR_MSG);
if (!ro) { Tcl_DecrRefCount(nxthdr_valobj); return TCL_ERROR; }
padding= cht_hb_unappend(pmcd->hb, padlen);
for (i=1; i<=padlen; i++)
if (*padding++ != i) goto quit;
*ok= 1;
quit:;
}
return TCL_OK;
}
int cht_do_padmethodinfo_pkcs5(ClientData cd, Tcl_Interp *ip, int *ok) {
const PadMethodClientData *pmcd= (const void*)cd;
int padlen, old_len, i;
if (pmcd->blocksize > 255)
return cht_staticerr(ip, "block size too large for pkcs#5", 0);
if (pmcd->pad) {
Byte *padding;
padlen= pmcd->blocksize - (cht_hb_len(pmcd->hb) % pmcd->blocksize);
padding= cht_hb_append(pmcd->hb, padlen);
memset(padding, padlen, padlen);
} else {
const Byte *padding;
old_len= cht_hb_len(pmcd->hb); if (old_len % pmcd->blocksize) goto bad;
padding= cht_hb_unappend(pmcd->hb, 1); if (!padding) goto bad;
padlen= *padding;
if (padlen < 1 || padlen > pmcd->blocksize) goto bad;
padding= cht_hb_unappend(pmcd->hb, padlen-1); if (!padding) goto bad;
for (i=0; iinternalRep.otherValuePtr)
typedef struct {
int valuelen, bufferslen;
Byte *value, *buffers;
const void *alg;
void *alpha, *beta; /* key schedules etc.; each may be 0 */
} CiphKeyValue;
static void freealg(CiphKeyValue *key) {
TFREE(key->alpha);
TFREE(key->beta);
}
static void key_t_free(Tcl_Obj *obj) {
CiphKeyValue *key= OBJ_CIPHKEY(obj);
freealg(key);
TFREE(key->value);
TFREE(key->buffers);
}
static void noalg(CiphKeyValue *key) {
key->alg= 0;
key->alpha= key->beta= 0;
}
static void key_t_dup(Tcl_Obj *src_obj, Tcl_Obj *dup_obj) {
CiphKeyValue *src= OBJ_CIPHKEY(src_obj);
CiphKeyValue *dup= TALLOC(sizeof(*dup));
dup->valuelen= src->valuelen;
dup->value= src->valuelen ? TALLOC(src->valuelen) : 0;
dup->buffers= 0; dup->bufferslen= 0;
memcpy(dup->value, src->value, src->valuelen);
noalg(dup);
dup_obj->internalRep.otherValuePtr= dup;
dup_obj->typePtr= &cht_blockcipherkey_type;
}
static void key_t_ustr(Tcl_Obj *o) {
cht_obj_updatestr_array(o, OBJ_CIPHKEY(o)->value, OBJ_CIPHKEY(o)->valuelen);
}
static int key_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
int rc, l;
CiphKeyValue *val;
rc= Tcl_ConvertToType(ip,o,&cht_hbytes_type); if (rc) return rc;
val= TALLOC(sizeof(*val));
val->valuelen= l= cht_hb_len(OBJ_HBYTES(o));
val->value= TALLOC(l);
val->buffers= 0;
val->bufferslen= 0;
memcpy(val->value, cht_hb_data(OBJ_HBYTES(o)), l);
noalg(val);
cht_objfreeir(o);
o->internalRep.otherValuePtr= val;
o->typePtr= &cht_blockcipherkey_type;
return TCL_OK;
}
Tcl_ObjType cht_blockcipherkey_type = {
"blockcipher-key",
key_t_free, key_t_dup, key_t_ustr, key_t_sfa
};
static CiphKeyValue *get_key(Tcl_Interp *ip, Tcl_Obj *key_obj,
const void *alg, int want_bufferslen) {
CiphKeyValue *key;
int rc;
rc= Tcl_ConvertToType(ip,key_obj,&cht_blockcipherkey_type); if (rc) return 0;
key= OBJ_CIPHKEY(key_obj);
if (key->alg != alg) {
freealg(key);
noalg(key);
key->alg= alg;
}
if (key->bufferslen < want_bufferslen) {
TFREE(key->buffers);
key->buffers= TALLOC(want_bufferslen);
key->bufferslen= want_bufferslen;
}
return key;
}
int cht_do_hbcrypto_blockcipher(ClientData cd, Tcl_Interp *ip,
const BlockCipherOp *op,
int objc, Tcl_Obj *const *objv) {
return op->func((void*)op,ip,objc,objv);
}
static int blockcipher_prep(Tcl_Interp *ip, Tcl_Obj *key_obj,
const HBytes_Value *iv, int decrypt,
const BlockCipherAlgInfo *alg,
const BlockCipherModeInfo *mode, int data_len,
const CiphKeyValue **key_r, const void **sched_r,
const Byte **iv_r, int *iv_lenbytes_r,
Byte **buffers_r, int *nblocks_r) {
void *sched, **schedp;
int want_bufferslen, want_iv;
int rc;
CiphKeyValue *key;
if (data_len % alg->blocksize)
return cht_staticerr(ip, "block cipher input not whole number of blocks",
"HBYTES BLOCKCIPHER LENGTH");
want_bufferslen= alg->blocksize * (mode->buf_blocks + mode->iv_blocks);
key= get_key(ip, key_obj, alg, want_bufferslen); if (!key) return TCL_ERROR;
schedp= (alg->decrypt.make_schedule==alg->encrypt.make_schedule
|| !decrypt) ? &key->alpha : &key->beta;
sched= *schedp;
if (!sched) {
if (key->valuelen < alg->key_min)
return cht_staticerr(ip, "key too short", "HBYTES BLOCKCIPHER PARAMS");
if (key->valuelen > alg->key_max)
return cht_staticerr(ip, "key too long", "HBYTES BLOCKCIPHER PARAMS");
sched= TALLOC(alg->schedule_size);
(decrypt ? &alg->decrypt : &alg->encrypt)->make_schedule
(sched, key->value, key->valuelen);
*schedp= sched;
}
want_iv= alg->blocksize * mode->iv_blocks;
if (!want_iv) {
if (!cht_hb_issentinel(iv))
return cht_staticerr(ip,"iv supplied but mode does not take one", 0);
} else if (cht_hb_issentinel(iv)) {
if (decrypt) return cht_staticerr(ip,"must supply iv when decrypting", 0);
rc= cht_get_urandom(ip, key->buffers, want_iv);
if (rc) return rc;
} else {
int iv_supplied= cht_hb_len(iv);
if (iv_supplied > want_iv)
return cht_staticerr(ip, "iv too large for algorithm and mode",
"HBYTES BLOCKCIPHER PARAMS");
memcpy(key->buffers, cht_hb_data(iv), iv_supplied);
memset(key->buffers + iv_supplied, 0, want_iv - iv_supplied);
}
*key_r= key;
*sched_r= sched;
*iv_r= key->buffers;
*iv_lenbytes_r= want_iv;
*buffers_r= key->buffers + want_iv;
*nblocks_r= data_len / alg->blocksize;
return TCL_OK;
}
int cht_do_blockcipherop_d(ClientData cd, Tcl_Interp *ip,
HBytes_Var v, const BlockCipherAlgInfo *alg,
Tcl_Obj *key_obj, const BlockCipherModeInfo *mode,
HBytes_Value iv, HBytes_Value *result) {
return cht_do_blockcipherop_e(cd,ip,v,alg,key_obj,mode,iv,result);
}
int cht_do_blockcipherop_e(ClientData cd, Tcl_Interp *ip,
HBytes_Var v, const BlockCipherAlgInfo *alg,
Tcl_Obj *key_obj, const BlockCipherModeInfo *mode,
HBytes_Value iv, HBytes_Value *result) {
const BlockCipherOp *op= (const void*)cd;
int encrypt= op->encrypt;
int rc, iv_lenbytes;
const CiphKeyValue *key;
const char *failure;
const Byte *ivbuf;
Byte *buffers;
const void *sched;
int nblocks;
if (!mode->encrypt)
return cht_staticerr(ip, "mode does not support encrypt/decrypt", 0);
rc= blockcipher_prep(ip,key_obj,&iv,!encrypt,
alg,mode, cht_hb_len(v.hb),
&key,&sched,
&ivbuf,&iv_lenbytes,
&buffers,&nblocks);
if (rc) return rc;
failure=
(encrypt ? mode->encrypt : mode->decrypt)
(cht_hb_data(v.hb), nblocks, ivbuf, buffers, alg, encrypt, sched);
if (failure)
return cht_staticerr(ip, failure, "HBYTES BLOCKCIPHER CRYPTFAIL CRYPT");
cht_hb_array(result, ivbuf, iv_lenbytes);
return TCL_OK;
}
int cht_do_blockcipherop_mac(ClientData cd, Tcl_Interp *ip,
HBytes_Value msg, const BlockCipherAlgInfo *alg,
Tcl_Obj *key_obj, const BlockCipherModeInfo *mode,
HBytes_Value iv, HBytes_Value *result) {
const CiphKeyValue *key;
const char *failure;
const Byte *ivbuf;
Byte *buffers;
const void *sched;
int nblocks, iv_lenbytes;
int rc;
if (!mode->mac)
return cht_staticerr(ip, "mode does not support mac generation", 0);
rc= blockcipher_prep(ip,key_obj,&iv,0,
alg,mode, cht_hb_len(&msg),
&key,&sched,
&ivbuf,&iv_lenbytes,
&buffers,&nblocks);
if (rc) return rc;
failure= mode->mac(cht_hb_data(&msg), nblocks, ivbuf, buffers, alg, sched);
if (failure)
return cht_staticerr(ip,failure, "HBYTES BLOCKCIPHER CRYPTFAIL MAC");
cht_hb_array(result, buffers, alg->blocksize * mode->mac_blocks);
return TCL_OK;
}
int cht_do_hbcrypto_hmac(ClientData cd, Tcl_Interp *ip, const HashAlgInfo *alg,
HBytes_Value message, Tcl_Obj *key_obj,
Tcl_Obj *maclen_obj, HBytes_Value *result) {
/* key->alpha = state after H(K XOR ipad
* key->beta = state after H(K XOR opad
* key->buffers = room for one block, or one state
*/
CiphKeyValue *key;
Byte *dest;
int i, ml, rc;
if (maclen_obj) {
rc= Tcl_GetIntFromObj(ip, maclen_obj, &ml); if (rc) return rc;
if (ml<0 || ml>alg->hashsize)
return cht_staticerr(ip, "requested hmac output size out of range",
"HBYTES HMAC PARAMS");
} else {
ml= alg->hashsize;
}
key= get_key(ip, key_obj, alg,
alg->blocksize > alg->statesize
? alg->blocksize : alg->statesize);
if (!key->alpha) {
assert(!key->beta);
if (key->valuelen > alg->blocksize)
return cht_staticerr(ip, "key to hmac longer than hash block size",
"HBYTES HMAC PARAMS");
memcpy(key->buffers, key->value, key->valuelen);
memset(key->buffers + key->valuelen, 0, alg->blocksize - key->valuelen);
for (i=0; iblocksize; i++) key->buffers[i] ^= 0x36;
key->alpha= TALLOC(alg->statesize);
alg->init(key->alpha);
alg->update(key->alpha, key->buffers, alg->blocksize);
key->beta= TALLOC(alg->statesize);
alg->init(key->beta);
for (i=0; iblocksize; i++) key->buffers[i] ^= (0x5c ^ 0x36);
alg->update(key->beta, key->buffers, alg->blocksize);
}
assert(key->beta);
dest= cht_hb_arrayspace(result, alg->hashsize);
memcpy(key->buffers, key->alpha, alg->statesize);
alg->update(key->buffers, cht_hb_data(&message), cht_hb_len(&message));
alg->final(key->buffers, dest);
memcpy(key->buffers, key->beta, alg->statesize);
alg->update(key->buffers, dest, alg->hashsize);
alg->final(key->buffers, dest);
cht_hb_unappend(result, alg->hashsize - ml);
return TCL_OK;
}
int cht_do_blockcipherop_prop(ClientData cd, Tcl_Interp *ip,
const BlockCipherPropInfo *prop,
const BlockCipherAlgInfo *alg, int *result) {
*result= *(const int*)((const char*)alg + prop->int_offset);
return TCL_OK;
}
int cht_do_hbcrypto_hash_prop(ClientData cd, Tcl_Interp *ip,
const HashAlgPropInfo *prop,
const HashAlgInfo *alg, int *result) {
*result= *(const int*)((const char*)alg + prop->int_offset);
return TCL_OK;
}
chiark-tcl-1.1.1+nmu1/crypto/chiark_tcl_crypto.h 0000644 0000000 0000000 00000001617 11762372314 016504 0 ustar /*
* crypto - Tcl bindings for parts of the `nettle' crypto library
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include
#include
#include
#include
#include "hbytes.h"
#include "crypto.h"
#include "crypto+tcmdif.h"
chiark-tcl-1.1.1+nmu1/crypto/algtables.c 0000644 0000000 0000000 00000007173 11762372314 014735 0 ustar /*
* crypto - Tcl bindings for parts of the `nettle' crypto library
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "chiark_tcl_crypto.h"
#include
#include
#include
#include
#include
#include
#define NETTLE_BLOCKCIPHERS \
DO(serpent, SERPENT) \
DO(twofish, TWOFISH) \
/* DO(aes, AES) */ \
DO(blowfish, BLOWFISH) \
/* ALIAS(rijndael, aes, AES)*/
#define ALIAS(alias,name,NAME)
#define DO(name,NAME) \
static void alg_##name##_makekey(void *sch, const void *key, int keylen) { \
name##_set_key(sch, keylen, key); \
} \
static void alg_##name##_encr(const void *sch, const void *in, void *out) { \
name##_encrypt((void*)sch, NAME##_BLOCK_SIZE, out, in); \
} \
static void alg_##name##_decr(const void *sch, const void *in, void *out) { \
name##_decrypt((void*)sch, NAME##_BLOCK_SIZE, out, in); \
}
NETTLE_BLOCKCIPHERS
#undef DO
#undef ALIAS
const BlockCipherAlgInfo cht_blockcipheralginfo_entries[]= {
#define ALIAS(alias,name,NAME) \
{ #alias, NAME##_BLOCK_SIZE, sizeof(struct name##_ctx), \
NAME##_MIN_KEY_SIZE, NAME##_MAX_KEY_SIZE, \
{ alg_##name##_makekey, alg_##name##_encr }, \
{ alg_##name##_makekey, alg_##name##_decr } \
},
#define DO(name,NAME) ALIAS(name,name,NAME)
NETTLE_BLOCKCIPHERS
#undef DO
#undef ALIAS
{ 0 }
};
const BlockCipherPropInfo cht_blockcipherpropinfo_entries[]= {
{ "blocklen", offsetof(BlockCipherAlgInfo, blocksize) },
{ "minkeylen", offsetof(BlockCipherAlgInfo, key_min) },
{ "maxkeylen", offsetof(BlockCipherAlgInfo, key_max) },
{ 0 }
};
#define NETTLE_DIGESTS \
DO(sha1, SHA1) \
DO(sha256, SHA256) \
DO(md5, MD5)
#define DO(name,NAME) \
static void alg_##name##_init(void *state) { \
name##_init(state); \
} \
static void alg_##name##_update(void *state, const void *data, int len) { \
name##_update(state, len, data); \
} \
static void alg_##name##_final(void *state, void *digest) { \
name##_digest(state,NAME##_DIGEST_SIZE,digest); \
} \
static void alg_##name##_oneshot(void *digest, const void *data, int len) { \
struct name##_ctx ctx; \
name##_init(&ctx); \
name##_update(&ctx, len, data); \
name##_digest(&ctx,NAME##_DIGEST_SIZE,digest); \
}
NETTLE_DIGESTS
#undef DO
const HashAlgPropInfo cht_hashalgpropinfo_entries[]= {
{ "hashlen", offsetof(HashAlgInfo, hashsize) },
{ "blocklen", offsetof(HashAlgInfo, blocksize) },
{ 0 }
};
const HashAlgInfo cht_hashalginfo_entries[]= {
#define DO(name,NAME) \
{ #name, NAME##_DIGEST_SIZE, NAME##_DATA_SIZE, sizeof(struct name##_ctx), \
alg_##name##_init, alg_##name##_update, alg_##name##_final, \
alg_##name##_oneshot },
NETTLE_DIGESTS
#undef DO
{ 0 }
};
chiark-tcl-1.1.1+nmu1/crypto/Makefile 0000644 0000000 0000000 00000001645 11762372314 014271 0 ustar # crypto - Tcl bindings for parts of the `nettle' crypto library
# Copyright 2006-2012 Ian Jackson
#
# 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.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this library; if not, see .
BASE_DIR = ../base
EXTBASE = crypto
CFILES = algtables bcmode crypto hook hash
OTHER_TCTS = ../hbytes/hbytes-base.tct
OTHER_EXTS = hbytes/hbytes
LDLIBS += -lnettle
include ../base/extension.make
chiark-tcl-1.1.1+nmu1/crypto/hash.c 0000644 0000000 0000000 00000005072 11762372314 013716 0 ustar /*
* crypto - Tcl bindings for parts of the `nettle' crypto library
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#include "chiark_tcl_crypto.h"
typedef struct {
int ix;
const HashAlgInfo *alg;
Byte d[1];
} HashState;
int cht_do_hbcrypto_hash(ClientData cd, Tcl_Interp *ip, const HashAlgInfo *alg,
HBytes_Value message, HBytes_Value *result) {
Byte *dest;
dest= cht_hb_arrayspace(result,alg->hashsize);
alg->oneshot(dest, cht_hb_data(&message), cht_hb_len(&message));
return TCL_OK;
}
int cht_do_hbcrypto_hash_init(ClientData cd, Tcl_Interp *ip,
const HashAlgInfo *alg, void **state_r) {
HashState *state= TALLOC(sizeof(*state) + alg->statesize - 1);
state->ix= -1;
state->alg= alg;
alg->init(state->d);
*state_r= state;
return TCL_OK;
}
int cht_do_hbcrypto_hash_update(ClientData cd, Tcl_Interp *ip,
void *state_v, HBytes_Value data) {
HashState *state= state_v;
state->alg->update(&state->d, cht_hb_data(&data), cht_hb_len(&data));
return TCL_OK;
}
int cht_do_hbcrypto_hash_final(ClientData cd, Tcl_Interp *ip,
void *state_v, HBytes_Value *result) {
HashState *state= state_v;
Byte *digest;
digest= cht_hb_arrayspace(result,state->alg->hashsize);
state->alg->final(&state->d, digest);
return cht_do_hbcrypto_hash_discard(cd,ip,state_v);
}
int cht_do_hbcrypto_hash_discard(ClientData cd, Tcl_Interp *ip,
void *state_v) {
cht_tabledataid_disposing(ip,state_v,&cht_hash_states);
free(state_v);
return TCL_OK;
}
int cht_do_hbcrypto_hash_clonestate(ClientData cd, Tcl_Interp *ip,
void *old_v, void **new_r) {
HashState *old= old_v;
int len= sizeof(*old) + old->alg->statesize - 1;
void *new_v= TALLOC(len);
memcpy(new_v, old, len);
((HashState*)new_v)->ix= -1;
*new_r= new_v;
return TCL_OK;
}
static void destroy_idtabcb(Tcl_Interp *ip, void *state_v) {
free(state_v);
}
const IdDataSpec cht_hash_states= {
"hashstate", "hashstate-table", destroy_idtabcb
};
chiark-tcl-1.1.1+nmu1/tuntap/ 0000755 0000000 0000000 00000000000 12223237524 012612 5 ustar chiark-tcl-1.1.1+nmu1/tuntap/tuntap.tct 0000644 0000000 0000000 00000002221 11762372314 014642 0 ustar # tuntap - Tcl extension for tun/tap network device
# Copyright 2006-2012 Ian Jackson
#
# 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.
#
# 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.
#
# You should have received a copy of the GNU General Public License
# along with this library; if not, see .
Table *tuntaptoplevel TopLevel_Command
tuntap-socket
dispatch(TunTapSocket/_SubCommand,"tuntap-socket-raw subcommand")
Table tuntapsocket TunTapSocket_SubCommand
create-tun
?ifname string
=> iddata(&cht_tuntap_socks)
close
sock iddata(&cht_tuntap_socks)
ifname
sock iddata(&cht_tuntap_socks)
=> string
receive
sock iddata(&cht_tuntap_socks)
data hb
on-transmit
sock iddata(&cht_tuntap_socks)
mtu long
?script obj
chiark-tcl-1.1.1+nmu1/tuntap/chiark_tcl_tuntap.h 0000644 0000000 0000000 00000002057 11762372314 016471 0 ustar /*
* tuntap - Tcl bindings for tun/tap userspace network interfaces
* Copyright 2006-2012 Ian Jackson
*
* 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.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this library; if not, see .
*/
#ifndef TUNTAPTCL_H
#define TUNTAPTCL_H
#include
#include
#include
#include
#include
#include "hbytes.h"
#include "dgram.h"
#include "tuntap+tcmdif.h"
/* from tuntap.c */
extern const IdDataSpec cht_tuntap_socks;
#endif /*TUNTAPTCL_H*/
chiark-tcl-1.1.1+nmu1/tuntap/tuntap.c 0000644 0000000 0000000 00000010020 11762372314 014266 0 ustar /*
*/
/*
* tuntap-socket-raw create [] =>
* tuntap-socket-raw ifname =>
* tuntap-socket-raw close
* tuntap-socket-raw receive
* tuntap-socket-raw on-transmit [