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