Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Begin updating the C pieces to require critcl 3.1. For the current batch that is mostly about setting some meta information. Under struct we can go and use more utilites, i.e critcl::class and the like. |
|---|---|
| Timelines: | family | ancestors | descendants | both | update-to-critcl3 |
| Files: | files | file ages | folders |
| SHA1: |
14fa6eacaa9d304c0d8b27f9ad8b7bc4 |
| User & Date: | andreask 2014-01-23 00:14:15 |
Context
|
2014-02-12
| ||
| 05:52 | Updated to release 1.16 check-in: 25c175ce82 user: aku tags: update-to-critcl3 | |
|
2014-01-23
| ||
| 00:14 | Begin updating the C pieces to require critcl 3.1. For the current batch that is mostly about setting some meta information. Under struct we can go and use more utilites, i.e critcl::class and the like. check-in: 14fa6eacaa user: andreask tags: update-to-critcl3 | |
|
2014-01-21
| ||
| 19:34 | Updated embedded documentation check-in: 2b1eb9024a user: aku tags: trunk | |
Changes
Added CRITCL3_CONVERSION.
> |
1 |
base64 requires separation of C and Tcl parts
|
Changes to modules/dns/ipMoreC.tcl.
1
2
3
4
5
6
7
..
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
# Skip this for window and a specific version of Solaris
#
# This could do with an explanation -- why are we avoiding these platforms
# and perhaps using critcl's platform::platform command might be better?
#
if {[string equal $::tcl_platform(platform) windows] ||
([string equal $::tcl_platform(os) SunOS] &&
................................................................................
# avoid warnings about nothing to compile
critcl::ccode {
/* nothing to do */
}
return
}
package require critcl;
namespace eval ::ip {
critcl::ccode {
#include <stdlib.h>
#include <stdio.h>
#include <tcl.h>
#include <inttypes.h>
#include <arpa/inet.h>
#include <string.h>
#include <sys/socket.h>
}
critcl::ccommand prefixToNativec {clientData interp objc objv} {
int elemLen, maskLen, ipLen, mask;
int rval,convertListc,i;
Tcl_Obj **convertListv;
Tcl_Obj *listPtr,*returnPtr, *addrList;
char *stringIP, *slashPos, *stringMask;
char v4HEX[11];
uint32_t inaddr;
listPtr = NULL;
/* printf ("\n in prefixToNativeC"); */
/* printf ("\n objc = %d",objc); */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "<ipaddress>/<mask>");
return TCL_ERROR;
}
if (Tcl_ListObjGetElements (interp, objv[1],
&convertListc, &convertListv) != TCL_OK) {
return TCL_ERROR;
}
returnPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
for (i = 0; i < convertListc; i++) {
/* need to create a duplicate here because when we modify */
/* the stringIP it'll mess up the original in the calling */
/* context */
addrList = Tcl_DuplicateObj(convertListv[i]);
stringIP = Tcl_GetStringFromObj(addrList, &elemLen);
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
/* printf ("\n ### %s ### string \n", stringIP); */
/* split the ip address and mask */
slashPos = strchr(stringIP, (int) '/');
if (slashPos == NULL) {
/* straight ip address without mask */
mask = 0xffffffff;
ipLen = strlen(stringIP);
} else {
/* ipaddress has the mask, handle the mask and seperate out the */
/* ip address */
/* printf ("\n ** %d ",(uintptr_t)slashPos); */
stringMask = slashPos +1;
maskLen =strlen(stringMask);
/* put mask in hex form */
if (maskLen < 3) {
mask = atoi(stringMask);
mask = (0xFFFFFFFF << (32 - mask)) & 0xFFFFFFFF;
} else {
/* mask is in dotted form */
if ((rval = inet_pton(AF_INET,stringMask,&mask)) < 1 ) {
Tcl_AddErrorInfo(interp, "\n bad format encountered in mask conversion");
return TCL_ERROR;
}
mask = htonl(mask);
}
ipLen = (uintptr_t)slashPos - (uintptr_t)stringIP;
/* divide the string into ip and mask portion */
*slashPos = '\0';
/* printf("\n %d %d %d %d", (uintptr_t)stringMask, maskLen, (uintptr_t)stringIP, ipLen); */
}
if ( (rval = inet_pton(AF_INET,stringIP,&inaddr)) < 1) {
Tcl_AddErrorInfo(interp,
"\n bad format encountered in ip conversion");
return TCL_ERROR;
};
inaddr = htonl(inaddr);
/* apply the mask the to the ip portion, just to make sure */
/* what we return is cleaned up */
inaddr = inaddr & mask;
sprintf(v4HEX,"0x%08X",inaddr);
/* printf ("\n\n ### %s",v4HEX); */
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(v4HEX,-1));
sprintf(v4HEX,"0x%08X",mask);
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(v4HEX,-1));
Tcl_ListObjAppendElement(interp, returnPtr, listPtr);
Tcl_DecrRefCount(addrList);
}
if (convertListc==1) {
Tcl_SetObjResult(interp,listPtr);
} else {
Tcl_SetObjResult(interp,returnPtr);
}
return TCL_OK;
}
critcl::ccommand isOverlapNativec {clientData interp objc objv} {
int i;
unsigned int ipaddr,ipMask, mask1mask2;
unsigned int ipaddr2,ipMask2;
int compareListc,comparePrefixMaskc;
int allSet,inlineSet,index;
Tcl_Obj **compareListv,**comparePrefixMaskv, *listPtr;
Tcl_Obj *result;
static CONST char *options[] = {
"-all", "-inline", "-ipv4", NULL
};
enum options {
OVERLAP_ALL, OVERLAP_INLINE, OVERLAP_IPV4
};
allSet = 0;
inlineSet = 0;
listPtr = NULL;
/* printf ("\n objc = %d",objc); */
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?options? <hexIP> <hexMask> <hexList>");
return TCL_ERROR;
}
for (i = 1; i < objc-3; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
!= TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case OVERLAP_ALL:
allSet = 1;
/* printf ("\n all selected"); */
break;
case OVERLAP_INLINE:
inlineSet = 1;
/* printf ("\n inline selected"); */
break;
case OVERLAP_IPV4:
break;
}
}
/* options are parsed */
/* create return obj */
result = Tcl_GetObjResult (interp);
/* set ipaddr and ipmask */
Tcl_GetIntFromObj(interp,objv[objc-3],&ipaddr);
Tcl_GetIntFromObj(interp,objv[objc-2],&ipMask);
/* split the 3rd argument into <ipaddr> <mask> pairs */
if (Tcl_ListObjGetElements (interp, objv[objc-1], &compareListc, &compareListv) != TCL_OK) {
return TCL_ERROR;
}
/* printf("comparing %x/%x \n",ipaddr,ipMask); */
if (allSet || inlineSet) {
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
}
for (i = 0; i < compareListc; i++) {
/* split the ipaddr2 and ipmask2 */
if (Tcl_ListObjGetElements (interp,
compareListv[i],
&comparePrefixMaskc,
&comparePrefixMaskv) != TCL_OK) {
return TCL_ERROR;
}
if (comparePrefixMaskc != 2) {
Tcl_AddErrorInfo(interp,"need format {{<ipaddr> <mask>} {<ipad..}}");
return TCL_ERROR;
}
Tcl_GetIntFromObj(interp,comparePrefixMaskv[0],&ipaddr2);
Tcl_GetIntFromObj(interp,comparePrefixMaskv[1],&ipMask2);
/* printf(" with %x/%x \n",ipaddr2,ipMask2); */
mask1mask2 = ipMask & ipMask2;
/* printf(" mask1mask2 %x \n",mask1mask2); */
/* printf(" ipaddr & mask1mask2 %x\n",ipaddr & mask1mask2); */
/* printf(" ipaddr2 & mask1mask2 %x\n",ipaddr2 & mask1mask2); */
if ((ipaddr & mask1mask2) == (ipaddr2 & mask1mask2)) {
if (allSet) {
if (inlineSet) {
Tcl_ListObjAppendElement(interp, listPtr,
compareListv[i]);
} else {
/* printf("\n appending %d",i+1); */
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewIntObj(i+1));
};
} else {
if (inlineSet) {
Tcl_ListObjAppendElement(interp, listPtr,
compareListv[i]);
Tcl_SetObjResult(interp,listPtr);
} else {
Tcl_SetIntObj (result, i+1);
}
return TCL_OK;
};
};
};
if (allSet || inlineSet) {
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
} else {
Tcl_SetIntObj (result, 0);
return TCL_OK;
}
return TCL_OK;
}
}
# @sak notprovided ipMorec
package provide ipMorec 1.0
|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
>
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
|
|
|
>
|
>
|
|
|
|
>
|
|
|
>
|
|
>
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
<
>
>
|
|
|
|
|
|
|
|
|
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
|
<
|
|
|
<
<
<
<
<
<
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
..
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
|
# -*- tcl -*- package require critcl 3.1 if {![critcl::compiling]} { error "Unable to build ipMorec, no proper compiler found." } # Skip this for window and a specific version of Solaris # # This could do with an explanation -- why are we avoiding these platforms # and perhaps using critcl's platform::platform command might be better? # if {[string equal $::tcl_platform(platform) windows] || ([string equal $::tcl_platform(os) SunOS] && ................................................................................ # avoid warnings about nothing to compile critcl::ccode { /* nothing to do */ } return } # # ## ### ##### ######## ############# ##################### ## Administrivia critcl::license {Aamer Akhter} BSD critcl::summary { Fast, i.e. C implementations of various dns::ip functions. } critcl::description { Fast, i.e. C implementations of various dns::ip functions. } critcl::subject {internet address} ip ipv4 ipv6 {rfc 3513} critcl::meta location http://core.tcl.tk/tcllib # # ## ### ##### ######## ############# ##################### ## Implementation critcl::tcl 8.4 namespace eval ::ip {} critcl::ccode { #include <stdlib.h> #include <stdio.h> #include <tcl.h> #include <inttypes.h> #include <arpa/inet.h> #include <string.h> #include <sys/socket.h> } # todo :: critcl :: Convert to cproc (single argument, fixed) critcl::ccommand ::ip::prefixToNativec {clientData interp objc objv} { int elemLen, maskLen, ipLen, mask; int rval,convertListc,i; Tcl_Obj **convertListv; Tcl_Obj *listPtr,*returnPtr, *addrList; char *stringIP, *slashPos, *stringMask; char v4HEX[11]; uint32_t inaddr; listPtr = NULL; /* printf ("\n in prefixToNativeC"); */ /* printf ("\n objc = %d",objc); */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "<ipaddress>/<mask>"); return TCL_ERROR; } if (Tcl_ListObjGetElements (interp, objv[1], &convertListc, &convertListv) != TCL_OK) { return TCL_ERROR; } returnPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); for (i = 0; i < convertListc; i++) { /* need to create a duplicate here because when we modify */ /* the stringIP it'll mess up the original in the calling */ /* context */ addrList = Tcl_DuplicateObj(convertListv[i]); stringIP = Tcl_GetStringFromObj(addrList, &elemLen); listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); /* printf ("\n ### %s ### string \n", stringIP); */ /* split the ip address and mask */ slashPos = strchr(stringIP, (int) '/'); if (slashPos == NULL) { /* straight ip address without mask */ mask = 0xffffffff; ipLen = strlen(stringIP); } else { /* ipaddress has the mask, handle the mask and seperate out the */ /* ip address */ /* printf ("\n ** %d ",(uintptr_t)slashPos); */ stringMask = slashPos +1; maskLen =strlen(stringMask); /* put mask in hex form */ if (maskLen < 3) { mask = atoi(stringMask); mask = (0xFFFFFFFF << (32 - mask)) & 0xFFFFFFFF; } else { /* mask is in dotted form */ if ((rval = inet_pton(AF_INET,stringMask,&mask)) < 1 ) { Tcl_AddErrorInfo(interp, "\n bad format encountered in mask conversion"); return TCL_ERROR; } mask = htonl(mask); } ipLen = (uintptr_t)slashPos - (uintptr_t)stringIP; /* divide the string into ip and mask portion */ *slashPos = '\0'; /* printf("\n %d %d %d %d", (uintptr_t)stringMask, maskLen, (uintptr_t)stringIP, ipLen); */ } if ( (rval = inet_pton(AF_INET,stringIP,&inaddr)) < 1) { Tcl_AddErrorInfo(interp, "\n bad format encountered in ip conversion"); return TCL_ERROR; }; inaddr = htonl(inaddr); /* apply the mask the to the ip portion, just to make sure */ /* what we return is cleaned up */ inaddr = inaddr & mask; sprintf(v4HEX,"0x%08X",inaddr); /* printf ("\n\n ### %s",v4HEX); */ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(v4HEX,-1)); sprintf(v4HEX,"0x%08X",mask); Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(v4HEX,-1)); Tcl_ListObjAppendElement(interp, returnPtr, listPtr); Tcl_DecrRefCount(addrList); } if (convertListc==1) { Tcl_SetObjResult(interp,listPtr); } else { Tcl_SetObjResult(interp,returnPtr); } return TCL_OK; } critcl::ccommand ::ip::isOverlapNativec {clientData interp objc objv} { int i; unsigned int ipaddr,ipMask, mask1mask2; unsigned int ipaddr2,ipMask2; int compareListc,comparePrefixMaskc; int allSet,inlineSet,index; Tcl_Obj **compareListv,**comparePrefixMaskv, *listPtr; Tcl_Obj *result; static CONST char *options[] = { "-all","-inline","-ipv4", NULL }; enum options { OVERLAP_ALL, OVERLAP_INLINE, OVERLAP_IPV4 }; allSet = 0; inlineSet = 0; listPtr = NULL; /* printf ("\n objc = %d",objc); */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? <hexIP> <hexMask> <hexList>"); return TCL_ERROR; } /* process options */ for (i = 1; i < objc-3; i++) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OVERLAP_ALL: allSet = 1; /* printf ("\n all selected"); */ break; case OVERLAP_INLINE: inlineSet = 1; /* printf ("\n inline selected"); */ break; case OVERLAP_IPV4: break; } } /* options are parsed */ /* create return obj */ result = Tcl_GetObjResult (interp); /* set ipaddr and ipmask */ Tcl_GetIntFromObj(interp,objv[objc-3],&ipaddr); Tcl_GetIntFromObj(interp,objv[objc-2],&ipMask); /* split the 3rd argument into <ipaddr> <mask> pairs */ if (Tcl_ListObjGetElements (interp, objv[objc-1], &compareListc, &compareListv) != TCL_OK) { return TCL_ERROR; } /* printf("comparing %x/%x \n",ipaddr,ipMask); */ if (allSet || inlineSet) { listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); } for (i = 0; i < compareListc; i++) { /* split the ipaddr2 and ipmask2 */ if (Tcl_ListObjGetElements (interp, compareListv[i], &comparePrefixMaskc, &comparePrefixMaskv) != TCL_OK) { return TCL_ERROR; } if (comparePrefixMaskc != 2) { Tcl_AddErrorInfo(interp,"need format {{<ipaddr> <mask>} {<ipad..}}"); return TCL_ERROR; } Tcl_GetIntFromObj(interp,comparePrefixMaskv[0],&ipaddr2); Tcl_GetIntFromObj(interp,comparePrefixMaskv[1],&ipMask2); /* printf(" with %x/%x \n",ipaddr2,ipMask2); */ mask1mask2 = ipMask & ipMask2; /* printf(" mask1mask2 %x \n",mask1mask2); */ /* printf(" ipaddr & mask1mask2 %x\n",ipaddr & mask1mask2); */ /* printf(" ipaddr2 & mask1mask2 %x\n",ipaddr2 & mask1mask2); */ if ((ipaddr & mask1mask2) == (ipaddr2 & mask1mask2)) { if (allSet) { if (inlineSet) { Tcl_ListObjAppendElement(interp, listPtr, compareListv[i]); } else { /* printf("\n appending %d",i+1); */ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(i+1)); }; } else { if (inlineSet) { Tcl_ListObjAppendElement(interp, listPtr, compareListv[i]); Tcl_SetObjResult(interp,listPtr); } else { Tcl_SetIntObj (result, i+1); } return TCL_OK; }; }; }; if (allSet || inlineSet) { Tcl_SetObjResult(interp, listPtr); } else { Tcl_SetIntObj (result, 0); } return TCL_OK; } # # ## ### ##### ######## ############# ##################### # @sak notprovided ipMorec package provide ipMorec 1.0 |
Changes to modules/md4/md4c.tcl.
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 |
# md4c.tcl - Copyright (C) 2003 Pat Thoyts <[email protected]> # # This provides a C implementation of MD4 using the sample code from RFC1320 # and wrapping this up in a Tcl package. # # The tcl interface code is based upon the md5c code from critcl by JCW. # # INSTALLATION # ------------ # This package uses critcl (http://wiki.tcl.tk/critcl). To build do: # critcl -libdir <your-tcl-lib-dir> -pkg md4c md4c # # $Id: md4c.tcl,v 1.6 2009/05/06 22:57:50 patthoyts Exp $ package require critcl # @sak notprovided md4c package provide md4c 1.1.0 critcl::cheaders md4.h critcl::csources md4.c namespace eval ::md4 { critcl::ccode { #include "md4.h" /* * define a Tcl object type for the MD4 state */ static Tcl_ObjType md4_type; static void md4_free_rep(Tcl_Obj *obj) { MD4_CTX *ctx = (MD4_CTX *)obj->internalRep.otherValuePtr; Tcl_Free((char *)ctx); } static void md4_dup_rep(Tcl_Obj *obj, Tcl_Obj *dup) { MD4_CTX *ctx = (MD4_CTX *)obj->internalRep.otherValuePtr; dup->internalRep.otherValuePtr = (MD4_CTX *)Tcl_Alloc(sizeof(MD4_CTX)); memcpy(dup->internalRep.otherValuePtr, ctx, sizeof(MD4_CTX)); dup->typePtr = &md4_type; } static void md4_string_rep(Tcl_Obj* obj) { unsigned char buf[16]; Tcl_Obj* temp; char* str; MD4_CTX *dup = (MD4_CTX *)obj->internalRep.otherValuePtr; MD4Final(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 md4_from_any(Tcl_Interp* interp, Tcl_Obj* obj) { /* assert(0); */ return TCL_ERROR; } static Tcl_ObjType md4_type = { "md4c", md4_free_rep, md4_dup_rep, md4_string_rep, md4_from_any }; } critcl::ccommand md4c {dummy interp objc objv} { MD4_CTX *ctx; unsigned char *data; int size; Tcl_Obj *obj; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "data ?context?"); return TCL_ERROR; } if (objc == 3) { if (objv[2]->typePtr != &md4_type && md4_from_any(interp, objv[2]) != TCL_OK) { return TCL_ERROR; } obj = objv[2]; if (Tcl_IsShared(obj)) { obj = Tcl_DuplicateObj(obj); } } else { ctx = (MD4_CTX *)Tcl_Alloc(sizeof(MD4_CTX)); MD4Init(ctx); obj = Tcl_NewObj(); Tcl_InvalidateStringRep(obj); obj->internalRep.otherValuePtr = ctx; obj->typePtr = &md4_type; } ctx = (MD4_CTX *)obj->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[1], &size); MD4Update(ctx, data, size); Tcl_SetObjResult(interp, obj); return TCL_OK; } } # Local variables: # mode: tcl # indent-tabs-mode: nil # End: |
| | | | | > | | > | | < > > > > > > > > > > > > > | > > > | > > > > > > > > > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > |
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 |
# md4c.tcl - Copyright (C) 2003 Pat Thoyts <[email protected]> # This provides a C implementation of MD4 using the sample code from # RFC1320 and wrapping this up in a Tcl package. # The tcl interface code is based upon the md5c code from critcl by # JCW (Jean-Claude Wippler <[email protected]>). # INSTALLATION # ------------ # This package uses critcl v3 (http://wiki.tcl.tk/critcl). # To build run: # critcl3 -libdir <your-tcl-lib-dir> -pkg md4c md4c # # $Id: md4c.tcl,v 1.6 2009/05/06 22:57:50 patthoyts Exp $ package require critcl 3.1 if {![critcl::compiling]} { error "Unable to build md4c, no proper compiler found." } # # ## ### ##### ######## ############# ##################### ## Administrivia critcl::license {Pat Thoyts, Jean-Claude Wippler} BSD critcl::summary { C implementation of the MD4 message digest } critcl::description { This package provides a C implementation of MD4 using the sample code from RFC1320 and wrapping this up in a Tcl package. The tcl interface code is based upon the md5c code from critcl by JCW (Jean-Claude Wippler <[email protected]>). } critcl::subject \ hashing md4 message-digest security \ {rfc 1320} {rfc 1321} {rfc 2104} critcl::meta location http://core.tcl.tk/tcllib # # ## ### ##### ######## ############# ##################### ## Implementation ## todo :: critcl :: possibly define an argument conversion for the ## context. handling of default is an issue. critcl::tcl 8.4 critcl::cheaders md4.h critcl::csources md4.c namespace eval ::md4 {} critcl::ccode { #include "md4.h" /* * define a Tcl object type for the MD4 state */ static Tcl_ObjType md4_type; static void md4_free_rep(Tcl_Obj *obj) { MD4_CTX *ctx = (MD4_CTX *)obj->internalRep.otherValuePtr; Tcl_Free((char *)ctx); } static void md4_dup_rep(Tcl_Obj *obj, Tcl_Obj *dup) { MD4_CTX *ctx = (MD4_CTX *)obj->internalRep.otherValuePtr; dup->internalRep.otherValuePtr = (MD4_CTX *)Tcl_Alloc(sizeof(MD4_CTX)); memcpy(dup->internalRep.otherValuePtr, ctx, sizeof(MD4_CTX)); dup->typePtr = &md4_type; } static void md4_string_rep(Tcl_Obj* obj) { unsigned char buf[16]; Tcl_Obj* temp; char* str; MD4_CTX *dup = (MD4_CTX *)obj->internalRep.otherValuePtr; MD4Final(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 md4_from_any(Tcl_Interp* interp, Tcl_Obj* obj) { /* assert(0); */ return TCL_ERROR; } static Tcl_ObjType md4_type = { "md4c", md4_free_rep, md4_dup_rep, md4_string_rep, md4_from_any }; } critcl::ccommand ::md4::md4c {dummy interp objc objv} { MD4_CTX *ctx; unsigned char *data; int size; Tcl_Obj *obj; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "data ?context?"); return TCL_ERROR; } if (objc == 3) { if (objv[2]->typePtr != &md4_type && md4_from_any(interp, objv[2]) != TCL_OK) { return TCL_ERROR; } obj = objv[2]; if (Tcl_IsShared(obj)) { obj = Tcl_DuplicateObj(obj); } } else { ctx = (MD4_CTX *)Tcl_Alloc(sizeof(MD4_CTX)); MD4Init(ctx); obj = Tcl_NewObj(); Tcl_InvalidateStringRep(obj); obj->internalRep.otherValuePtr = ctx; obj->typePtr = &md4_type; } ctx = (MD4_CTX *)obj->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[1], &size); MD4Update(ctx, data, size); Tcl_SetObjResult(interp, obj); return TCL_OK; } # # ## ### ##### ######## ############# ##################### # @sak notprovided md4c package provide md4c 1.1.0 return # Local variables: # mode: tcl # indent-tabs-mode: nil # End: |
Changes to modules/md5/md5c.tcl.
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 |
# md5c.tcl - # # Wrapper for RSA's Message Digest in C # # Written by Jean-Claude Wippler <jc[email protected]> # # $Id: md5c.tcl,v 1.5 2009/05/06 22:46:10 patthoyts Exp $ package require critcl; # needs critcl # @sak notprovided md5c package provide md5c 0.12; # critcl::cheaders md5.h; # The RSA header file critcl::csources md5.c; # The RSA MD5 implementation. namespace eval ::md5 { critcl::ccode { #include "md5.h" #include <assert.h> static Tcl_ObjType md5_type; /* fast internal access representation */ static void md5_free_rep(Tcl_Obj *obj) { MD5_CTX *mp = (MD5_CTX *) obj->internalRep.otherValuePtr; Tcl_Free(mp); } static void md5_dup_rep(Tcl_Obj *obj, Tcl_Obj *dup) { MD5_CTX *mp = (MD5_CTX *) obj->internalRep.otherValuePtr; dup->internalRep.otherValuePtr = Tcl_Alloc(sizeof *mp); memcpy(dup->internalRep.otherValuePtr, mp, sizeof *mp); dup->typePtr = &md5_type; } static void md5_string_rep(Tcl_Obj *obj) { unsigned char buf[16]; Tcl_Obj *temp; char *str; MD5_CTX dup = *(MD5_CTX *) obj->internalRep.otherValuePtr; MD5Final(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 md5_from_any(Tcl_Interp* ip, Tcl_Obj* obj) { assert(0); return TCL_ERROR; } static Tcl_ObjType md5_type = { "md5c", md5_free_rep, md5_dup_rep, md5_string_rep, md5_from_any }; } critcl::ccommand md5c {dummy ip objc objv} { MD5_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 != &md5_type && md5_from_any(ip, objv[2]) != TCL_OK) { return TCL_ERROR; } obj = objv[2]; if (Tcl_IsShared(obj)) { obj = Tcl_DuplicateObj(obj); } } else { mp = (MD5_CTX *)Tcl_Alloc(sizeof *mp); MD5Init(mp); obj = Tcl_NewObj(); Tcl_InvalidateStringRep(obj); obj->internalRep.otherValuePtr = mp; obj->typePtr = &md5_type; } mp = (MD5_CTX *) obj->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[1], &size); MD5Update(mp, data, size); Tcl_SetObjResult(ip, obj); return TCL_OK; } } if {[info exists pkgtest] && $pkgtest} { proc md5c_try {} { foreach {msg expected} { "" "d41d8cd98f00b204e9800998ecf8427e" "a" "0cc175b9c0f1b6a831c399e269772661" "abc" "900150983cd24fb0d6963f7d28e17f72" "message digest" "f96b697d7cb7938d525a2f31aaf161d0" "abcdefghijklmnopqrstuvwxyz" "c3fcd3d76192e4007dfb496cca67e13b" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" "d174ab98d277d9f5a5611c2c9f419d9f" "12345678901234567890123456789012345678901234567890123456789012345678901234567890" "57edf4a22be3c955ac49da2e2107b67a" } { puts "testing: ::md5::md5c \"$msg\"" binary scan [::md5::md5c $msg] H* computed puts "computed: $computed" if {0 != [string compare $computed $expected]} { puts "expected: $expected" puts "FAILED" } } foreach len {10 50 100 500 1000 5000 10000} { set blanks [format %$len.0s ""] puts "input length $len: [time {md5c $blanks} 1000]" } } md5c_try } |
| | < > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > > > > > > > |
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 |
# md5c.tcl - # # Wrapper for RSA's Message Digest in C # # Written by Jean-Claude Wippler <jc@wippler.nl> # # $Id: md5c.tcl,v 1.5 2009/05/06 22:46:10 patthoyts Exp $ package require critcl 3.1 if {![critcl::compiling]} { error "Unable to build md5c, no proper compiler found." } # # ## ### ##### ######## ############# ##################### ## Administrivia critcl::license {Jean-Claude Wippler} BSD critcl::summary { C implementation of the MD5 message digest } critcl::description { This package provides a C implementation of MD5 using the RSA sample code and wrapping this up in a Tcl package. } critcl::subject \ hashing md5 message-digest security \ {rfc 1320} {rfc 1321} {rfc 2104} critcl::meta location http://core.tcl.tk/tcllib # # ## ### ##### ######## ############# ##################### ## Implementation ## todo :: critcl :: possibly define an argument conversion for the ## context. handling of default is an issue. critcl::tcl 8.4 critcl::cheaders md5.h ; # The RSA header file critcl::csources md5.c ; # The RSA MD5 implementation. namespace eval ::md5 {} critcl::ccode { #include "md5.h" #include <assert.h> static Tcl_ObjType md5_type; /* fast internal access representation */ static void md5_free_rep(Tcl_Obj *obj) { MD5_CTX *mp = (MD5_CTX *) obj->internalRep.otherValuePtr; Tcl_Free(mp); } static void md5_dup_rep(Tcl_Obj *obj, Tcl_Obj *dup) { MD5_CTX *mp = (MD5_CTX *) obj->internalRep.otherValuePtr; dup->internalRep.otherValuePtr = Tcl_Alloc(sizeof *mp); memcpy(dup->internalRep.otherValuePtr, mp, sizeof *mp); dup->typePtr = &md5_type; } static void md5_string_rep(Tcl_Obj *obj) { unsigned char buf[16]; Tcl_Obj *temp; char *str; MD5_CTX dup = *(MD5_CTX *) obj->internalRep.otherValuePtr; MD5Final(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 md5_from_any(Tcl_Interp* ip, Tcl_Obj* obj) { assert(0); return TCL_ERROR; } static Tcl_ObjType md5_type = { "md5c", md5_free_rep, md5_dup_rep, md5_string_rep, md5_from_any }; } critcl::ccommand ::md5::md5c {dummy ip objc objv} { MD5_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 != &md5_type && md5_from_any(ip, objv[2]) != TCL_OK) { return TCL_ERROR; } obj = objv[2]; if (Tcl_IsShared(obj)) { obj = Tcl_DuplicateObj(obj); } } else { mp = (MD5_CTX *)Tcl_Alloc(sizeof *mp); MD5Init(mp); obj = Tcl_NewObj(); Tcl_InvalidateStringRep(obj); obj->internalRep.otherValuePtr = mp; obj->typePtr = &md5_type; } mp = (MD5_CTX *) obj->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[1], &size); MD5Update(mp, data, size); Tcl_SetObjResult(ip, obj); return TCL_OK; } # # ## ### ##### ######## ############# ##################### ## Integrated test cases. if {[info exists pkgtest] && $pkgtest} { proc md5_try {} { foreach {msg expected} { "" "d41d8cd98f00b204e9800998ecf8427e" "a" "0cc175b9c0f1b6a831c399e269772661" "abc" "900150983cd24fb0d6963f7d28e17f72" "message digest" "f96b697d7cb7938d525a2f31aaf161d0" "abcdefghijklmnopqrstuvwxyz" "c3fcd3d76192e4007dfb496cca67e13b" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" "d174ab98d277d9f5a5611c2c9f419d9f" "12345678901234567890123456789012345678901234567890123456789012345678901234567890" "57edf4a22be3c955ac49da2e2107b67a" } { puts "testing: ::md5::md5c \"$msg\"" binary scan [::md5::md5c $msg] H* computed puts "computed: $computed" if {0 != [string compare $computed $expected]} { puts "expected: $expected" puts "FAILED" } } foreach len {10 50 100 500 1000 5000 10000} { set blanks [format %$len.0s ""] puts "input length $len: [time {md5c $blanks} 1000]" } } md5c_try } # # ## ### ##### ######## ############# ##################### # @sak notprovided md5c package provide md5c 0.12 return # Local variables: # mode: tcl # indent-tabs-mode: nil # End: |
Changes to modules/md5crypt/md5cryptc.tcl.
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 |
# */ # # ------------------------------------------------------------------------- # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------- package require critcl # @sak notprovided md5cryptc package provide md5cryptc 1.0 critcl::cheaders ../md5/md5.h #critcl::csources ../md5/md5.c namespace eval ::md5crypt { critcl::ccode { #include "md5.h" #ifdef _MSC_VER #define snprintf _snprintf #endif static unsigned char itoa64[] = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; static void to64(char *s, unsigned int v, int n) { while (--n >= 0) { *s++ = itoa64[v&0x3f]; v >>= 6; } } static void dump(const char *s, unsigned int len) { unsigned int i; for (i = 0; i < len; i++) printf("%02X", s[i]&0xFF); putchar('\n'); } static char * md5crypt(const char *pw, const char *salt, const char *magic) { static char passwd[120], *p; static const unsigned char *sp,*ep; unsigned char final[16]; int sl,pl,i; MD5_CTX ctx,ctx1; unsigned long l; /* Refine the Salt first */ sp = (const unsigned char *)salt; /* If it starts with the magic string, then skip that */ if(!strncmp((const char *)sp,(const char *)magic,strlen((const char *)magic))) sp += strlen((const char *)magic); /* It stops at the first '$', max 8 chars */ for(ep=sp;*ep && *ep != '$' && ep < (sp+8);ep++) continue; /* get the length of the true salt */ sl = ep - sp; MD5Init(&ctx); /* The password first, since that is what is most unknown */ MD5Update(&ctx,(const unsigned char *)pw,strlen(pw)); /* Then our magic string */ MD5Update(&ctx,magic,strlen((const char *)magic)); /* Then the raw salt */ MD5Update(&ctx,sp,sl); /* Then just as many characters of the MD5(pw,salt,pw) */ MD5Init(&ctx1); MD5Update(&ctx1,(const unsigned char *)pw,strlen(pw)); MD5Update(&ctx1,sp,sl); MD5Update(&ctx1,(const unsigned char *)pw,strlen(pw)); MD5Final(final,&ctx1); for(pl = strlen(pw); pl > 0; pl -= 16) { int tl = pl > 16 ? 16 : pl; MD5Update(&ctx,final,pl>16 ? 16 : pl); } /* Don't leave anything around in vm they could use. */ memset(final,0,sizeof final); /* Then something really weird... */ for (i = strlen(pw); i ; i >>= 1) { if(i&1) MD5Update(&ctx, final, 1); else MD5Update(&ctx, (const unsigned char *)pw, 1); } /* Now make the output string */ snprintf(passwd, sizeof(passwd), "%s%.*s$", (char *)magic, sl, (const char *)sp); MD5Final(final,&ctx); /* * and now, just to make sure things don't run too fast * On a 60 Mhz Pentium this takes 34 msec, so you would * need 30 seconds to build a 1000 entry dictionary... */ for(i=0;i<1000;i++) { MD5Init(&ctx1); if(i & 1) MD5Update(&ctx1,(const unsigned char *)pw,strlen(pw)); else MD5Update(&ctx1,final,16); if(i % 3) MD5Update(&ctx1,sp,sl); if(i % 7) MD5Update(&ctx1,pw,strlen(pw)); if(i & 1) MD5Update(&ctx1,final,16); else MD5Update(&ctx1,pw,strlen(pw)); MD5Final(final,&ctx1); } p = passwd + strlen(passwd); l = (final[ 0]<<16) | (final[ 6]<<8) | final[12]; to64(p,l,4); p += 4; l = (final[ 1]<<16) | (final[ 7]<<8) | final[13]; to64(p,l,4); p += 4; l = (final[ 2]<<16) | (final[ 8]<<8) | final[14]; to64(p,l,4); p += 4; l = (final[ 3]<<16) | (final[ 9]<<8) | final[15]; to64(p,l,4); p += 4; l = (final[ 4]<<16) | (final[10]<<8) | final[ 5]; to64(p,l,4); p += 4; l = final[11] ; to64(p,l,2); p += 2; *p = '\0'; /* Don't leave anything around in vm they could use. */ memset(final,0,sizeof final); return passwd; } } critcl::cproc to64_c {Tcl_Interp* interp int v int n} ok { char s[5]; to64(s, (unsigned int)v, n); Tcl_SetObjResult(interp, Tcl_NewStringObj(s, n)); return TCL_OK; } critcl::cproc md5crypt_c {Tcl_Interp* interp char* magic char* pw char* salt} ok { char* s = md5crypt(pw, salt, magic); Tcl_SetObjResult(interp, Tcl_NewStringObj(s, strlen(s))); return TCL_OK; } } |
> < | | | > > > > > > > > > > > > > > > > > > > > > > > > | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | | | | | | | | | | | | > > > > > |
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 |
# */ # # ------------------------------------------------------------------------- # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # ------------------------------------------------------------------------- package require critcl 3.1 if {![critcl::compiling]} { error "Unable to build md5cryptc, no proper compiler found." } # # ## ### ##### ######## ############# ##################### ## Administrivia critcl::license {Pat Thoyts} BSD critcl::summary { C implementation of the MD5crypt MAC } critcl::description { This package provides a C implementation of MD5crypt based on the OpenBSD sources, which is in turn derived from the original implementation by Poul-Henning Kamp. } critcl::subject \ hashing md5 md5crypt message-digest security \ {rfc 1320} {rfc 1321} {rfc 2104} critcl::meta location http://core.tcl.tk/tcllib # # ## ### ##### ######## ############# ##################### ## Implementation critcl::tcl 8.4 critcl::cheaders ../md5/md5.h #critcl::csources ../md5/md5.c namespace eval ::md5crypt {} critcl::ccode { #include "md5.h" #ifdef _MSC_VER #define snprintf _snprintf #endif static unsigned char itoa64[] = "./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; static void to64(char *s, unsigned int v, int n) { while (--n >= 0) { *s++ = itoa64[v&0x3f]; v >>= 6; } } static void dump(const char *s, unsigned int len) { unsigned int i; for (i = 0; i < len; i++) printf("%02X", s[i]&0xFF); putchar('\n'); } static char * md5crypt(const char *pw, const char *salt, const char *magic) { static char passwd[120], *p; static const unsigned char *sp,*ep; unsigned char final[16]; int sl,pl,i; MD5_CTX ctx,ctx1; unsigned long l; /* Refine the Salt first */ sp = (const unsigned char *)salt; /* If it starts with the magic string, then skip that */ if(!strncmp((const char *)sp,(const char *)magic,strlen((const char *)magic))) sp += strlen((const char *)magic); /* It stops at the first '$', max 8 chars */ for(ep=sp;*ep && *ep != '$' && ep < (sp+8);ep++) continue; /* get the length of the true salt */ sl = ep - sp; MD5Init(&ctx); /* The password first, since that is what is most unknown */ MD5Update(&ctx,(const unsigned char *)pw,strlen(pw)); /* Then our magic string */ MD5Update(&ctx,magic,strlen((const char *)magic)); /* Then the raw salt */ MD5Update(&ctx,sp,sl); /* Then just as many characters of the MD5(pw,salt,pw) */ MD5Init(&ctx1); MD5Update(&ctx1,(const unsigned char *)pw,strlen(pw)); MD5Update(&ctx1,sp,sl); MD5Update(&ctx1,(const unsigned char *)pw,strlen(pw)); MD5Final(final,&ctx1); for(pl = strlen(pw); pl > 0; pl -= 16) { int tl = pl > 16 ? 16 : pl; MD5Update(&ctx,final,pl>16 ? 16 : pl); } /* Don't leave anything around in vm they could use. */ memset(final,0,sizeof final); /* Then something really weird... */ for (i = strlen(pw); i ; i >>= 1) { if(i&1) MD5Update(&ctx, final, 1); else MD5Update(&ctx, (const unsigned char *)pw, 1); } /* Now make the output string */ snprintf(passwd, sizeof(passwd), "%s%.*s$", (char *)magic, sl, (const char *)sp); MD5Final(final,&ctx); /* * and now, just to make sure things don't run too fast * On a 60 Mhz Pentium this takes 34 msec, so you would * need 30 seconds to build a 1000 entry dictionary... */ for(i=0;i<1000;i++) { MD5Init(&ctx1); if(i & 1) MD5Update(&ctx1,(const unsigned char *)pw,strlen(pw)); else MD5Update(&ctx1,final,16); if(i % 3) MD5Update(&ctx1,sp,sl); if(i % 7) MD5Update(&ctx1,pw,strlen(pw)); if(i & 1) MD5Update(&ctx1,final,16); else MD5Update(&ctx1,pw,strlen(pw)); MD5Final(final,&ctx1); } p = passwd + strlen(passwd); l = (final[ 0]<<16) | (final[ 6]<<8) | final[12]; to64(p,l,4); p += 4; l = (final[ 1]<<16) | (final[ 7]<<8) | final[13]; to64(p,l,4); p += 4; l = (final[ 2]<<16) | (final[ 8]<<8) | final[14]; to64(p,l,4); p += 4; l = (final[ 3]<<16) | (final[ 9]<<8) | final[15]; to64(p,l,4); p += 4; l = (final[ 4]<<16) | (final[10]<<8) | final[ 5]; to64(p,l,4); p += 4; l = final[11] ; to64(p,l,2); p += 2; *p = '\0'; /* Don't leave anything around in vm they could use. */ memset(final,0,sizeof final); return passwd; } } critcl::cproc ::md5crypt::to64_c {Tcl_Interp* interp int v int n} ok { char s[5]; to64(s, (unsigned int)v, n); Tcl_SetObjResult(interp, Tcl_NewStringObj(s, n)); return TCL_OK; } critcl::cproc ::md5crypt::md5crypt_c {Tcl_Interp* interp char* magic char* pw char* salt} ok { char* s = md5crypt(pw, salt, magic); Tcl_SetObjResult(interp, Tcl_NewStringObj(s, strlen(s))); return TCL_OK; } # # ## ### ##### ######## ############# ##################### # @sak notprovided md5cryptc package provide md5cryptc 1.0 return |
Changes to modules/rc4/rc4c.tcl.
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 |
# rc4c.tcl - Copyright (C) 2004 Pat Thoyts <[email protected]> # # This provides a critcl C implementation of RC4 # # INSTALLATION # ------------ # This package uses critcl (http://wiki.tcl.tk/critcl). To build do: # critcl -libdir <your-tcl-lib-dir> -pkg rc4c rc4c # # To build this for tcllib use sak.tcl: # tclsh sak.tcl critcl # generates a tcllibc module. # # $Id: rc4c.tcl,v 1.4 2009/05/07 00:14:02 patthoyts Exp $ package require critcl # @sak notprovided rc4c package provide rc4c 1.1.0 namespace eval ::rc4 { critcl::ccode { typedef struct RC4_CTX { unsigned char x; unsigned char y; unsigned char s[256]; } RC4_CTX; /* #define TRACE trace */ #define TRACE 1 ? ((void)0) : trace static void trace(const char *format, ...) { va_list args; va_start(args, format); vfprintf(stderr, format, args); va_end(args); } static Tcl_ObjType rc4_type; static void rc4_free_rep(Tcl_Obj *obj) { RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr; TRACE("rc4_free_rep(%08x)\n", (long)obj); Tcl_Free((char *)ctx); } static void rc4_dup_rep(Tcl_Obj *obj, Tcl_Obj *dup) { RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr; TRACE("rc4_dup_rep(%08x,%08x)\n", (long)obj, (long)dup); dup->internalRep.otherValuePtr = (RC4_CTX *)Tcl_Alloc(sizeof(RC4_CTX)); memcpy(dup->internalRep.otherValuePtr, ctx, sizeof(RC4_CTX)); dup->typePtr = &rc4_type; } static void rc4_string_rep(Tcl_Obj* obj) { RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr; Tcl_Obj* tmpObj; char* str; TRACE("rc4_string_rep(%08x)\n", (long)obj); /* convert via a byte array to properly handle null bytes */ tmpObj = Tcl_NewByteArrayObj((char *)ctx, sizeof(RC4_CTX)); Tcl_IncrRefCount(tmpObj); str = Tcl_GetStringFromObj(tmpObj, &obj->length); obj->bytes = Tcl_Alloc(obj->length + 1); memcpy(obj->bytes, str, obj->length + 1); Tcl_DecrRefCount(tmpObj); } static int rc4_from_any(Tcl_Interp* interp, Tcl_Obj* obj) { TRACE("rc4_from_any %08x\n", (long)obj); return TCL_ERROR; } static Tcl_ObjType rc4_type = { "rc4c", rc4_free_rep, rc4_dup_rep, rc4_string_rep, rc4_from_any }; #ifdef __GNUC__ inline #elif defined(_MSC_VER) __inline #endif void swap (unsigned char *lhs, unsigned char *rhs) { unsigned char t = *lhs; *lhs = *rhs; *rhs = t; } } critcl::ccommand rc4c_init {dummy interp objc objv} { RC4_CTX *ctx; Tcl_Obj *obj; const unsigned char *k; int n = 0, i = 0, j = 0, keylen; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "keystring"); return TCL_ERROR; } k = Tcl_GetByteArrayFromObj(objv[1], &keylen); obj = Tcl_NewObj(); ctx = (RC4_CTX *)Tcl_Alloc(sizeof(RC4_CTX)); ctx->x = 0; ctx->y = 0; for (n = 0; n < 256; n++) ctx->s[n] = n; for (n = 0; n < 256; n++) { j = (k[i] + ctx->s[n] + j) % 256; swap(&ctx->s[n], &ctx->s[j]); i = (i + 1) % keylen; } if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) obj->typePtr->freeIntRepProc(obj); obj->internalRep.otherValuePtr = ctx; obj->typePtr = &rc4_type; Tcl_InvalidateStringRep(obj); Tcl_SetObjResult(interp, obj); return TCL_OK; } critcl::ccommand rc4c {dummy interp objc objv} { Tcl_Obj *resObj = NULL; RC4_CTX *ctx = NULL; unsigned char *data, *res, x, y; int size, n, i; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "key data"); return TCL_ERROR; } if (objv[1]->typePtr != &rc4_type && rc4_from_any(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } ctx = objv[1]->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[2], &size); res = (unsigned char *)Tcl_Alloc(size); x = ctx->x; y = ctx->y; for (n = 0; n < size; n++) { x = (x + 1) % 256; y = (ctx->s[x] + y) % 256; swap(&ctx->s[x], &ctx->s[y]); i = (ctx->s[x] + ctx->s[y]) % 256; res[n] = data[n] ^ ctx->s[i]; } ctx->x = x; ctx->y = y; resObj = Tcl_NewByteArrayObj(res, size); Tcl_SetObjResult(interp, resObj); Tcl_Free(res); return TCL_OK; } } |
| > | | < > > > > > > > > > > > > > | | > > > > > > > > > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > |
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 |
# rc4c.tcl - Copyright (C) 2004 Pat Thoyts <[email protected]> # # This provides a critcl C implementation of RC4 # # INSTALLATION # ------------ # This package uses critcl3 (http://wiki.tcl.tk/critcl). # To build run: # critcl3 -libdir <your-tcl-lib-dir> -pkg rc4c rc4c # # To build this for tcllib use sak.tcl: # tclsh sak.tcl critcl # generates a tcllibc module. # # $Id: rc4c.tcl,v 1.4 2009/05/07 00:14:02 patthoyts Exp $ package require critcl 3.1 if {![critcl::compiling]} { error "Unable to build rc4c, no proper compiler found." } # # ## ### ##### ######## ############# ##################### ## Administrivia critcl::license {Pat Thoyts} BSD critcl::summary { C implementation of the RC4 cipher } critcl::description { This package provides a C implementation of RC4. } critcl::subject \ arcfour rc4 {data integrity} encryption security \ {stream cipher} critcl::meta location http://core.tcl.tk/tcllib # # ## ### ##### ######## ############# ##################### ## Implementation ## todo :: critcl :: possibly define an argument conversion for the ## context. handling of default is an issue. critcl::tcl 8.4 namespace eval ::rc4 {} critcl::ccode { typedef struct RC4_CTX { unsigned char x; unsigned char y; unsigned char s[256]; } RC4_CTX; /* #define TRACE trace */ #define TRACE 1 ? ((void)0) : trace static void trace(const char *format, ...) { va_list args; va_start(args, format); vfprintf(stderr, format, args); va_end(args); } static Tcl_ObjType rc4_type; static void rc4_free_rep(Tcl_Obj *obj) { RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr; TRACE("rc4_free_rep(%08x)\n", (long)obj); Tcl_Free((char *)ctx); } static void rc4_dup_rep(Tcl_Obj *obj, Tcl_Obj *dup) { RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr; TRACE("rc4_dup_rep(%08x,%08x)\n", (long)obj, (long)dup); dup->internalRep.otherValuePtr = (RC4_CTX *)Tcl_Alloc(sizeof(RC4_CTX)); memcpy(dup->internalRep.otherValuePtr, ctx, sizeof(RC4_CTX)); dup->typePtr = &rc4_type; } static void rc4_string_rep(Tcl_Obj* obj) { RC4_CTX *ctx = (RC4_CTX *)obj->internalRep.otherValuePtr; Tcl_Obj* tmpObj; char* str; TRACE("rc4_string_rep(%08x)\n", (long)obj); /* convert via a byte array to properly handle null bytes */ tmpObj = Tcl_NewByteArrayObj((char *)ctx, sizeof(RC4_CTX)); Tcl_IncrRefCount(tmpObj); str = Tcl_GetStringFromObj(tmpObj, &obj->length); obj->bytes = Tcl_Alloc(obj->length + 1); memcpy(obj->bytes, str, obj->length + 1); Tcl_DecrRefCount(tmpObj); } static int rc4_from_any(Tcl_Interp* interp, Tcl_Obj* obj) { TRACE("rc4_from_any %08x\n", (long)obj); return TCL_ERROR; } static Tcl_ObjType rc4_type = { "rc4c", rc4_free_rep, rc4_dup_rep, rc4_string_rep, rc4_from_any }; #ifdef __GNUC__ inline #elif defined(_MSC_VER) __inline #endif void swap (unsigned char *lhs, unsigned char *rhs) { unsigned char t = *lhs; *lhs = *rhs; *rhs = t; } } # todo :: critcl :: convertible to cproc critcl::ccommand ::rc4::rc4c_init {dummy interp objc objv} { RC4_CTX *ctx; Tcl_Obj *obj; const unsigned char *k; int n = 0, i = 0, j = 0, keylen; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "keystring"); return TCL_ERROR; } k = Tcl_GetByteArrayFromObj(objv[1], &keylen); obj = Tcl_NewObj(); ctx = (RC4_CTX *)Tcl_Alloc(sizeof(RC4_CTX)); ctx->x = 0; ctx->y = 0; for (n = 0; n < 256; n++) ctx->s[n] = n; for (n = 0; n < 256; n++) { j = (k[i] + ctx->s[n] + j) % 256; swap(&ctx->s[n], &ctx->s[j]); i = (i + 1) % keylen; } if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) obj->typePtr->freeIntRepProc(obj); obj->internalRep.otherValuePtr = ctx; obj->typePtr = &rc4_type; Tcl_InvalidateStringRep(obj); Tcl_SetObjResult(interp, obj); return TCL_OK; } # todo :: critcl :: convertible to cproc critcl::ccommand ::rc4::rc4c {dummy interp objc objv} { Tcl_Obj *resObj = NULL; RC4_CTX *ctx = NULL; unsigned char *data, *res, x, y; int size, n, i; if (objc != 3) { Tcl_WrongNumArgs(interp, 1, objv, "key data"); return TCL_ERROR; } if (objv[1]->typePtr != &rc4_type && rc4_from_any(interp, objv[1]) != TCL_OK) { return TCL_ERROR; } ctx = objv[1]->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[2], &size); res = (unsigned char *)Tcl_Alloc(size); x = ctx->x; y = ctx->y; for (n = 0; n < size; n++) { x = (x + 1) % 256; y = (ctx->s[x] + y) % 256; swap(&ctx->s[x], &ctx->s[y]); i = (ctx->s[x] + ctx->s[y]) % 256; res[n] = data[n] ^ ctx->s[i]; } ctx->x = x; ctx->y = y; resObj = Tcl_NewByteArrayObj(res, size); Tcl_SetObjResult(interp, resObj); Tcl_Free(res); return TCL_OK; } # # ## ### ##### ######## ############# ##################### # @sak notprovided rc4c package provide rc4c 1.1.0 return |
Changes to modules/sha1/sha1c.tcl.
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 123 124 |
# sha1c.tcl - Copyright (C) 2005 Pat Thoyts <[email protected]> # # Wrapper for the Secure Hashing Algorithm (SHA1) # # $Id: sha1c.tcl,v 1.6 2009/05/07 00:35:10 patthoyts Exp $ package require critcl; # needs critcl # @sak notprovided sha1c 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::cflags -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; Tcl_Free(mp); } static void sha1_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup) { SHA1_CTX* mp = (SHA1_CTX*) obj->internalRep.otherValuePtr; dup->internalRep.otherValuePtr = Tcl_Alloc(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*) Tcl_Alloc(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_InvalidateStringRep(obj); mp = (SHA1_CTX*) obj->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[1], &size); SHA1Update(mp, data, size); Tcl_SetObjResult(ip, obj); return TCL_OK; } } |
| < > > > > > > > > > > > > > | > | > > > > > > > > > > > > > > | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > |
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 |
# sha1c.tcl - Copyright (C) 2005 Pat Thoyts <[email protected]> # # Wrapper for the Secure Hashing Algorithm (SHA1) # # $Id: sha1c.tcl,v 1.6 2009/05/07 00:35:10 patthoyts Exp $ package require critcl 3.1 if {![critcl::compiling]} { error "Unable to build sha1c, no proper compiler found." } # # ## ### ##### ######## ############# ##################### ## Administrivia critcl::license {Pat Thoyts} BSD critcl::summary { C implementation of the SHA1 message digest } critcl::description { This package provides a C implementation of SHA1 based on the NetBSD sources. } critcl::subject \ hashing sha1 message-digest security \ {rfc 2104} {FIPS 180-1} critcl::meta location http://core.tcl.tk/tcllib # # ## ### ##### ######## ############# ##################### ## Implementation ## todo :: critcl :: possibly define an argument conversion for the ## context. handling of default is an issue. critcl::tcl 8.4 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::cflags -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; Tcl_Free(mp); } static void sha1_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup) { SHA1_CTX* mp = (SHA1_CTX*) obj->internalRep.otherValuePtr; dup->internalRep.otherValuePtr = Tcl_Alloc(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 ::sha1::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*) Tcl_Alloc(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_InvalidateStringRep(obj); mp = (SHA1_CTX*) obj->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[1], &size); SHA1Update(mp, data, size); Tcl_SetObjResult(ip, obj); return TCL_OK; } # # ## ### ##### ######## ############# ##################### # @sak notprovided sha1c package provide sha1c 2.0.3 return |
Changes to modules/sha1/sha256c.tcl.
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 |
# - Copyright (C) 2006 Andreas Kupries <[email protected]> # (Rewriting the sha1c wrapper to 256). # # Wrapper for the Secure Hashing Algorithm (SHA256) # # $Id: sha256c.tcl,v 1.5 2009/05/07 00:35:10 patthoyts Exp $ package require critcl; # needs critcl # @sak notprovided sha256c package provide sha256c 1.0.2 critcl::cheaders sha256.h; # FreeBSD SHA256 implementation critcl::csources sha256.c; # FreeBSD SHA256 implementation if {$tcl_platform(byteOrder) eq "littleEndian"} { set byteOrder 1234 } else { set byteOrder 4321 } critcl::cflags -DTCL_BYTE_ORDER=$byteOrder namespace eval ::sha2 { # Supporting code for the main command. catch { #critcl::debug memory symbols } critcl::ccode { #include "sha256.h" #include <stdlib.h> #include <assert.h> static Tcl_ObjType sha256_type; /* fast internal access representation */ static void sha256_free_rep(Tcl_Obj* obj) { SHA256_CTX* mp = (SHA256_CTX*) obj->internalRep.otherValuePtr; free(mp); } static void sha256_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup) { SHA256_CTX* mp = (SHA256_CTX*) obj->internalRep.otherValuePtr; dup->internalRep.otherValuePtr = malloc(sizeof *mp); memcpy(dup->internalRep.otherValuePtr, mp, sizeof *mp); dup->typePtr = &sha256_type; } static void sha256_string_rep(Tcl_Obj* obj) { unsigned char buf[SHA256_HASH_SIZE]; Tcl_Obj* temp; char* str; SHA256_CTX dup = *(SHA256_CTX*) obj->internalRep.otherValuePtr; SHA256Final(&dup, buf); /* 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 sha256_from_any(Tcl_Interp* ip, Tcl_Obj* obj) { assert(0); return TCL_ERROR; } static Tcl_ObjType sha256_type = { "sha256c", sha256_free_rep, sha256_dup_rep, sha256_string_rep, sha256_from_any }; } critcl::ccommand sha256c_init256 {dummy ip objc objv} { SHA256_CTX* mp; unsigned char* data; int size; Tcl_Obj* obj; if (objc > 1) { Tcl_WrongNumArgs(ip, 1, objv, ""); return TCL_ERROR; } obj = Tcl_NewObj(); mp = (SHA256_CTX*) malloc(sizeof *mp); SHA256Init(mp); if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) { obj->typePtr->freeIntRepProc(obj); } obj->internalRep.otherValuePtr = mp; obj->typePtr = &sha256_type; Tcl_InvalidateStringRep(obj); Tcl_SetObjResult(ip, obj); return TCL_OK; } critcl::ccommand sha256c_init224 {dummy ip objc objv} { SHA256_CTX* mp; unsigned char* data; int size; Tcl_Obj* obj; if (objc > 1) { Tcl_WrongNumArgs(ip, 1, objv, ""); return TCL_ERROR; } obj = Tcl_NewObj(); mp = (SHA256_CTX*) malloc(sizeof *mp); SHA224Init(mp); if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) { obj->typePtr->freeIntRepProc(obj); } obj->internalRep.otherValuePtr = mp; obj->typePtr = &sha256_type; Tcl_InvalidateStringRep(obj); Tcl_SetObjResult(ip, obj); return TCL_OK; } critcl::ccommand sha256c_update {dummy ip objc objv} { SHA256_CTX* mp; unsigned char* data; int size; Tcl_Obj* obj; if (objc != 3) { Tcl_WrongNumArgs(ip, 1, objv, "data context"); return TCL_ERROR; } if (objv[2]->typePtr != &sha256_type && sha256_from_any(ip, objv[2]) != TCL_OK) { return TCL_ERROR; } obj = objv[2]; if (Tcl_IsShared(obj)) { obj = Tcl_DuplicateObj(obj); } Tcl_InvalidateStringRep(obj); mp = (SHA256_CTX*) obj->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[1], &size); SHA256Update(mp, data, size); Tcl_SetObjResult(ip, obj); return TCL_OK; } } |
| < > | > | > > > > > > > > > > > > > > > > > > > > > > > > > > | | | < < < | < | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | > > > > |
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 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 |
# - Copyright (C) 2006 Andreas Kupries <[email protected]> # (Rewriting the sha1c wrapper to 256). # # Wrapper for the Secure Hashing Algorithm (SHA256) # # $Id: sha256c.tcl,v 1.5 2009/05/07 00:35:10 patthoyts Exp $ package require critcl 3.1 if {![critcl::compiling]} { error "Unable to build sha256c, no proper compiler found." } # # ## ### ##### ######## ############# ##################### ## Administrivia critcl::license {Pat Thoyts, Andreas Kupries} BSD critcl::summary { C implementation of the SHA256 message digest } critcl::description { This package provides a C implementation of SHA256 based on the FreeBSD sources. } critcl::subject \ hashing sha256 message-digest security \ {rfc 2104} {FIPS 180-1} critcl::meta location http://core.tcl.tk/tcllib # # ## ### ##### ######## ############# ##################### ## Implementation ## todo :: critcl :: possibly define an argument conversion for the ## context. handling of default is an issue. critcl::tcl 8.4 critcl::cheaders sha256.h ; # FreeBSD SHA256 implementation critcl::csources sha256.c ; # FreeBSD SHA256 implementation if {$tcl_platform(byteOrder) eq "littleEndian"} { set byteOrder 1234 } else { set byteOrder 4321 } critcl::cflags -DTCL_BYTE_ORDER=$byteOrder namespace eval ::sha2 {} critcl::ccode { #include "sha256.h" #include <stdlib.h> #include <assert.h> static Tcl_ObjType sha256_type; /* fast internal access representation */ static void sha256_free_rep(Tcl_Obj* obj) { SHA256_CTX* mp = (SHA256_CTX*) obj->internalRep.otherValuePtr; free(mp); } static void sha256_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup) { SHA256_CTX* mp = (SHA256_CTX*) obj->internalRep.otherValuePtr; dup->internalRep.otherValuePtr = malloc(sizeof *mp); memcpy(dup->internalRep.otherValuePtr, mp, sizeof *mp); dup->typePtr = &sha256_type; } static void sha256_string_rep(Tcl_Obj* obj) { unsigned char buf[SHA256_HASH_SIZE]; Tcl_Obj* temp; char* str; SHA256_CTX dup = *(SHA256_CTX*) obj->internalRep.otherValuePtr; SHA256Final(&dup, buf); /* 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 sha256_from_any(Tcl_Interp* ip, Tcl_Obj* obj) { assert(0); return TCL_ERROR; } static Tcl_ObjType sha256_type = { "sha256c", sha256_free_rep, sha256_dup_rep, sha256_string_rep, sha256_from_any }; } critcl::ccommand ::sha2::sha256c_init256 {dummy ip objc objv} { SHA256_CTX* mp; unsigned char* data; int size; Tcl_Obj* obj; if (objc > 1) { Tcl_WrongNumArgs(ip, 1, objv, ""); return TCL_ERROR; } obj = Tcl_NewObj(); mp = (SHA256_CTX*) malloc(sizeof *mp); SHA256Init(mp); if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) { obj->typePtr->freeIntRepProc(obj); } obj->internalRep.otherValuePtr = mp; obj->typePtr = &sha256_type; Tcl_InvalidateStringRep(obj); Tcl_SetObjResult(ip, obj); return TCL_OK; } critcl::ccommand ::sha2::sha256c_init224 {dummy ip objc objv} { SHA256_CTX* mp; unsigned char* data; int size; Tcl_Obj* obj; if (objc > 1) { Tcl_WrongNumArgs(ip, 1, objv, ""); return TCL_ERROR; } obj = Tcl_NewObj(); mp = (SHA256_CTX*) malloc(sizeof *mp); SHA224Init(mp); if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) { obj->typePtr->freeIntRepProc(obj); } obj->internalRep.otherValuePtr = mp; obj->typePtr = &sha256_type; Tcl_InvalidateStringRep(obj); Tcl_SetObjResult(ip, obj); return TCL_OK; } critcl::ccommand ::sha2::sha256c_update {dummy ip objc objv} { SHA256_CTX* mp; unsigned char* data; int size; Tcl_Obj* obj; if (objc != 3) { Tcl_WrongNumArgs(ip, 1, objv, "data context"); return TCL_ERROR; } if (objv[2]->typePtr != &sha256_type && sha256_from_any(ip, objv[2]) != TCL_OK) { return TCL_ERROR; } obj = objv[2]; if (Tcl_IsShared(obj)) { obj = Tcl_DuplicateObj(obj); } Tcl_InvalidateStringRep(obj); mp = (SHA256_CTX*) obj->internalRep.otherValuePtr; data = Tcl_GetByteArrayFromObj(objv[1], &size); SHA256Update(mp, data, size); Tcl_SetObjResult(ip, obj); return TCL_OK; } # # ## ### ##### ######## ############# ##################### # @sak notprovided sha256c package provide sha256c 1.0.2 return |