Serpent seems to work. Byte order is very strange.

[chiark-tcl.git] / base / hook.c

diff --git a/base/hook.c b/base/hook.c
index d6d96d9ce1a406ff4b34b4199415abc0b3fa1040..68df783561431b14b411c22fa274111b5e16fa99 100644 (file)
--- a/base/hook.c
+++ b/base/hook.c
@@ -1,6 +1,8 @@
 /*
  */
 
+#include <errno.h>
+
 #include "hbytes.h"
 #include "tables.h"
 
@@ -9,6 +11,16 @@ int staticerr(Tcl_Interp *ip, const char *m) {
   return TCL_ERROR;
 }
 
+int posixerr(Tcl_Interp *ip, int errnoval, const char *m) {
+  const char *em;
+  
+  Tcl_ResetResult(ip);
+  errno= errnoval;
+  em= Tcl_PosixError(ip);
+  Tcl_AppendResult(ip, m, ": ", em, (char*)0);
+  return TCL_ERROR;
+}
+
 void objfreeir(Tcl_Obj *o) {
   if (o->typePtr && o->typePtr->freeIntRepProc)
     o->typePtr->freeIntRepProc(o);
@@ -16,27 +28,35 @@ void objfreeir(Tcl_Obj *o) {
 }  
 
 int do_hbytes_rep_info(ClientData cd, Tcl_Interp *ip,
-                      HBytes_Value v, Tcl_Obj **result) {
+                      Tcl_Obj *obj, Tcl_Obj **result) {
   const char *tn;
-  int nums[3], i;
+  int nums[3], i, lnl;
   Tcl_Obj *objl[4];
 
-  memset(nums,0,sizeof(nums));
-  nums[1]= hbytes_len(&v);
+  if (obj->typePtr == &hbytes_type) {
+    HBytes_Value *v= OBJ_HBYTES(obj);
+    memset(nums,0,sizeof(nums));
+    nums[1]= hbytes_len(v);
   
-  if (HBYTES_ISEMPTY(&v)) tn= "empty";
-  else if (HBYTES_ISSENTINEL(&v)) tn= "sentinel!";
-  else if (HBYTES_ISSIMPLE(&v)) tn= "simple";
-  else {
-    HBytes_ComplexValue *cx= v.begin_complex;
-    tn= "complex";
-    nums[0]= cx->prespace;
-    nums[2]= cx->avail - cx->len;
+    if (HBYTES_ISEMPTY(v)) tn= "empty";
+    else if (HBYTES_ISSENTINEL(v)) tn= "sentinel!";
+    else if (HBYTES_ISSIMPLE(v)) tn= "simple";
+    else {
+      HBytes_ComplexValue *cx= v->begin_complex;
+      tn= "complex";
+      nums[0]= cx->prespace;
+      nums[2]= cx->avail - cx->len;
+    }
+    lnl= 3;
+  } else {
+    tn= "other";
+    lnl= 0;
   }
     
   objl[0]= Tcl_NewStringObj((char*)tn,-1);
-  for (i=0; i<3; i++) objl[i+1]= Tcl_NewIntObj(nums[i]);
-  *result= Tcl_NewListObj(4,objl);
+  for (i=0; i<lnl; i++) objl[i+1]= Tcl_NewIntObj(nums[i]);
+  *result= Tcl_NewListObj(lnl+1,objl);
+    
   return TCL_OK;
 }
 
@@ -51,13 +71,9 @@ static void hbytes_t_free(Tcl_Obj *o) {
   hbytes_free(OBJ_HBYTES(o));
 }
 
-static void hbytes_t_ustr(Tcl_Obj *o) {
-  int l;
+void obj_updatestr_array(Tcl_Obj *o, const Byte *byte, int l) {
   char *str;
-  const Byte *byte;
 
-  byte= hbytes_data(OBJ_HBYTES(o));
-  l= hbytes_len(OBJ_HBYTES(o));
   str= o->bytes= TALLOC(l*2+1);
   o->length= l*2;
   while (l>0) {
@@ -67,6 +83,12 @@ static void hbytes_t_ustr(Tcl_Obj *o) {
   *str= 0;
 }
 
+static void hbytes_t_ustr(Tcl_Obj *o) {
+  obj_updatestr_array(o,
+                     hbytes_data(OBJ_HBYTES(o)),
+                     hbytes_len(OBJ_HBYTES(o)));
+}
+
 static int hbytes_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
   char *str, *ep, *os;
   Byte *startbytes, *bytes;
@@ -131,8 +153,34 @@ int do__hbytes(ClientData cd, Tcl_Interp *ip,
   return subcmd->func(0,ip,objc,objv);
 }
 
+#define URANDOM "/dev/urandom"
+
+int get_urandom(Tcl_Interp *ip, Byte *buffer, int l) {
+  static FILE *urandom;
+
+  int r, esave;
+
+  if (!urandom) {
+    urandom= fopen(URANDOM,"rb");
+    if (!urandom) return posixerr(ip,errno,"open " URANDOM);
+  }
+  r= fread(buffer,1,l,urandom);
+  if (r==l) return 0;
+
+  esave= errno;
+  fclose(urandom); urandom=0;
+
+  if (ferror(urandom)) {
+    return posixerr(ip,errno,"read " URANDOM);
+  } else {
+    assert(feof(urandom));
+    return staticerr(ip, URANDOM " gave eof!");
+  }
+}
+
 int Hbytes_Init(Tcl_Interp *ip) {
   Tcl_RegisterObjType(&hbytes_type);
+  Tcl_RegisterObjType(&blockcipherkey_type);
   Tcl_RegisterObjType(&enum_nearlytype);
   Tcl_RegisterObjType(&enum1_nearlytype);
   Tcl_CreateObjCommand(ip,"hbytes", pa__hbytes,0,0);