1# sha1c.tcl - Copyright (C) 2005 Pat Thoyts <patthoyts@users.sourceforge.net> 2# 3# Wrapper for the Secure Hashing Algorithm (SHA1) 4# 5# $Id: sha1c.tcl,v 1.6 2009/05/07 00:35:10 patthoyts Exp $ 6 7package require critcl; # needs critcl 8# @sak notprovided sha1c 9package provide sha1c 2.0.3 10 11critcl::cheaders sha1.h; # NetBSD SHA1 implementation 12critcl::csources sha1.c; # NetBSD SHA1 implementation 13 14if {$tcl_platform(byteOrder) eq "littleEndian"} { 15 set byteOrder 1234 16} else { 17 set byteOrder 4321 18} 19critcl::cflags -DTCL_BYTE_ORDER=$byteOrder 20 21namespace eval ::sha1 { 22 23 critcl::ccode { 24 #include "sha1.h" 25 #include <stdlib.h> 26 #include <string.h> 27 #include <assert.h> 28 29 static 30 Tcl_ObjType sha1_type; /* fast internal access representation */ 31 32 static void 33 sha1_free_rep(Tcl_Obj* obj) 34 { 35 Tcl_Free(obj->internalRep.otherValuePtr); 36 } 37 38 static void 39 sha1_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup) 40 { 41 SHA1_CTX* mp = (SHA1_CTX*) obj->internalRep.otherValuePtr; 42 dup->internalRep.otherValuePtr = Tcl_Alloc(sizeof *mp); 43 memcpy(dup->internalRep.otherValuePtr, mp, sizeof *mp); 44 dup->typePtr = &sha1_type; 45 } 46 47 static void 48 sha1_string_rep(Tcl_Obj* obj) 49 { 50 unsigned char buf[20]; 51 Tcl_Obj* temp; 52 char* str; 53 SHA1_CTX dup = *(SHA1_CTX*) obj->internalRep.otherValuePtr; 54 55 SHA1Final(buf, &dup); 56 57 /* convert via a byte array to properly handle null bytes */ 58 temp = Tcl_NewByteArrayObj(buf, sizeof buf); 59 Tcl_IncrRefCount(temp); 60 61 str = Tcl_GetStringFromObj(temp, &obj->length); 62 obj->bytes = Tcl_Alloc(obj->length + 1); 63 memcpy(obj->bytes, str, obj->length + 1); 64 65 Tcl_DecrRefCount(temp); 66 } 67 68 static int 69 sha1_from_any(Tcl_Interp* ip, Tcl_Obj* obj) 70 { 71 assert(0); 72 return TCL_ERROR; 73 } 74 75 static 76 Tcl_ObjType sha1_type = { 77 "sha1c", sha1_free_rep, sha1_dup_rep, sha1_string_rep, 78 sha1_from_any 79 }; 80 } 81 82 critcl::ccommand sha1c {dummy ip objc objv} { 83 SHA1_CTX* mp; 84 unsigned char* data; 85 int size; 86 Tcl_Obj* obj; 87 88 if (objc < 2 || objc > 3) { 89 Tcl_WrongNumArgs(ip, 1, objv, "data ?context?"); 90 return TCL_ERROR; 91 } 92 93 if (objc == 3) { 94 if (objv[2]->typePtr != &sha1_type 95 && sha1_from_any(ip, objv[2]) != TCL_OK) { 96 return TCL_ERROR; 97 } 98 obj = objv[2]; 99 if (Tcl_IsShared(obj)) { 100 obj = Tcl_DuplicateObj(obj); 101 } 102 } else { 103 obj = Tcl_NewObj(); 104 mp = (SHA1_CTX*) Tcl_Alloc(sizeof *mp); 105 SHA1Init(mp); 106 107 if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) { 108 obj->typePtr->freeIntRepProc(obj); 109 } 110 111 obj->internalRep.otherValuePtr = mp; 112 obj->typePtr = &sha1_type; 113 } 114 115 Tcl_InvalidateStringRep(obj); 116 117 mp = (SHA1_CTX*) obj->internalRep.otherValuePtr; 118 data = Tcl_GetByteArrayFromObj(objv[1], &size); 119 SHA1Update(mp, data, size); 120 121 Tcl_SetObjResult(ip, obj); 122 return TCL_OK; 123 } 124} 125