Tcl Library Source Code

Check-in [14fa6eacaa]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki

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.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | update-to-critcl3
Files: files | file ages | folders
SHA1: 14fa6eacaa9d304c0d8b27f9ad8b7bc44b2793c4
User & Date: andreask 2014-01-23 00:14:15.213
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
Unified Diff Ignore Whitespace Patch
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
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
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] &&
     [string equal $::tcl_platform(osVersion) 5.6])
} {
    # 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
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
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] &&
     [string equal $::tcl_platform(osVersion) 5.6])
} {
    # 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 <jcw@equi4.com>
#
# $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. 
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





# sha256c.tcl
# - Copyright (C) 2005 Pat Thoyts <[email protected]>
# - 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;
    }
}














|
|
>
>
>
>
>
>
>
>
>
>
>
>
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|








|
<
<
<
<

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>

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
200

# sha256c.tcl
# - Copyright (C) 2005 Pat Thoyts <[email protected]>
# - 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
This page was generated in about 0.018s by Fossil 2.27 [a6d506ecc4] 2025-07-09 13:52:53