1##################################################
2#
3# md5.tcl - MD5 in Tcl
4# Author: Don Libes <libes@nist.gov>, July 1999
5# Version 1.2.0
6#
7# MD5  defined by RFC 1321, "The MD5 Message-Digest Algorithm"
8# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication"
9#
10# Most of the comments below come right out of RFC 1321; That's why
11# they have such peculiar numbers.  In addition, I have retained
12# original syntax, bugs in documentation (yes, really), etc. from the
13# RFC.  All remaining bugs are mine.
14#
15# HMAC implementation by D. J. Hagberg <dhagberg@millibits.com> and
16# is based on C code in RFC 2104.
17#
18# For more info, see: http://expect.nist.gov/md5pure
19#
20# - Don
21#
22# Modified by Miguel Sofer to use inlines and simple variables
23##################################################
24
25package require Tcl 8.2
26namespace eval ::md5 {
27}
28
29if {![catch {package require Trf 2.0}]} {
30    # Trf is available, so implement the functionality provided here
31    # in terms of calls to Trf for speed.
32
33    proc ::md5::md5 {msg} {
34	string tolower [::hex -mode encode -- [::md5 -- $msg]]
35    }
36
37    # hmac: hash for message authentication
38
39    # MD5 of Trf and MD5 as defined by this package have slightly
40    # different results. Trf returns the digest in binary, here we get
41    # it as hex-string. In the computation of the HMAC the latter
42    # requires back conversion into binary in some places. With Trf we
43    # can use omit these.
44
45    proc ::md5::hmac {key text} {
46	# if key is longer than 64 bytes, reset it to MD5(key).  If shorter,
47	# pad it out with null (\x00) chars.
48	set keyLen [string length $key]
49	if {$keyLen > 64} {
50	    #old: set key [binary format H32 [md5 $key]]
51	    set key [::md5 -- $key]
52	    set keyLen [string length $key]
53	}
54
55	# ensure the key is padded out to 64 chars with nulls.
56	set padLen [expr {64 - $keyLen}]
57	append key [binary format "a$padLen" {}]
58
59	# Split apart the key into a list of 16 little-endian words
60	binary scan $key i16 blocks
61
62	# XOR key with ipad and opad values
63	set k_ipad {}
64	set k_opad {}
65	foreach i $blocks {
66	    append k_ipad [binary format i [expr {$i ^ 0x36363636}]]
67	    append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]]
68	}
69
70	# Perform inner md5, appending its results to the outer key
71	append k_ipad $text
72	#old: append k_opad [binary format H* [md5 $k_ipad]]
73	append k_opad [::md5 -- $k_ipad]
74
75	# Perform outer md5
76	#old: md5 $k_opad
77	string tolower [::hex -mode encode -- [::md5 -- $k_opad]]
78    }
79
80} else {
81    # Without Trf use the all-tcl implementation by Don Libes.
82
83    # T will be inlined after the definition of md5body
84
85    # test md5
86    #
87    # This proc is not necessary during runtime and may be omitted if you
88    # are simply inserting this file into a production program.
89    #
90    proc ::md5::test {} {
91	foreach {msg expected} {
92	    ""
93	    "d41d8cd98f00b204e9800998ecf8427e"
94	    "a"
95	    "0cc175b9c0f1b6a831c399e269772661"
96	    "abc"
97	    "900150983cd24fb0d6963f7d28e17f72"
98	    "message digest"
99	    "f96b697d7cb7938d525a2f31aaf161d0"
100	    "abcdefghijklmnopqrstuvwxyz"
101	    "c3fcd3d76192e4007dfb496cca67e13b"
102	    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
103	    "d174ab98d277d9f5a5611c2c9f419d9f"
104	    "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
105	    "57edf4a22be3c955ac49da2e2107b67a"
106	} {
107	    puts "testing: md5 \"$msg\""
108	    set computed [md5 $msg]
109	    puts "expected: $expected"
110	    puts "computed: $computed"
111	    if {0 != [string compare $computed $expected]} {
112		puts "FAILED"
113	    } else {
114		puts "SUCCEEDED"
115	    }
116	}
117    }
118
119    # time md5
120    #
121    # This proc is not necessary during runtime and may be omitted if you
122    # are simply inserting this file into a production program.
123    #
124    proc ::md5::time {} {
125	foreach len {10 50 100 500 1000 5000 10000} {
126	    set time [::time {md5 [format %$len.0s ""]} 100]
127	    regexp -- "\[0-9]*" $time msec
128	    puts "input length $len: [expr {$msec/1000}] milliseconds per interation"
129	}
130    }
131
132    #
133    # We just define the body of md5pure::md5 here; later we
134    # regsub to inline a few function calls for speed
135    #
136
137    set ::md5::md5body {
138
139	#
140	# 3.1 Step 1. Append Padding Bits
141	#
142
143	set msgLen [string length $msg]
144
145	set padLen [expr {56 - $msgLen%64}]
146	if {$msgLen % 64 > 56} {
147	    incr padLen 64
148	}
149
150	# pad even if no padding required
151	if {$padLen == 0} {
152	    incr padLen 64
153	}
154
155	# append single 1b followed by 0b's
156	append msg [binary format "a$padLen" \200]
157
158	#
159	# 3.2 Step 2. Append Length
160	#
161
162	# RFC doesn't say whether to use little- or big-endian
163	# code demonstrates little-endian
164	# This step limits our input to size 2^32b or 2^24B
165	append msg [binary format "i1i1" [expr {8*$msgLen}] 0]
166
167	#
168	# 3.3 Step 3. Initialize MD Buffer
169	#
170
171	set A [expr 0x67452301]
172	set B [expr 0xefcdab89]
173	set C [expr 0x98badcfe]
174	set D [expr 0x10325476]
175
176	#
177	# 3.4 Step 4. Process Message in 16-Word Blocks
178	#
179
180	# process each 16-word block
181	# RFC doesn't say whether to use little- or big-endian
182	# code says little-endian
183	binary scan $msg i* blocks
184
185	# loop over the message taking 16 blocks at a time
186
187	foreach {X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15} $blocks {
188
189	    # Save A as AA, B as BB, C as CC, and D as DD.
190	    set AA $A
191	    set BB $B
192	    set CC $C
193	    set DD $D
194
195	    # Round 1.
196	    # Let [abcd k s i] denote the operation
197	    #      a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s).
198	    # [ABCD  0  7  1]  [DABC  1 12  2]  [CDAB  2 17  3]  [BCDA  3 22  4]
199	    set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X0  + $T01}]  7]}]
200	    set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X1  + $T02}] 12]}]
201	    set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X2  + $T03}] 17]}]
202	    set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X3  + $T04}] 22]}]
203	    # [ABCD  4  7  5]  [DABC  5 12  6]  [CDAB  6 17  7]  [BCDA  7 22  8]
204	    set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X4  + $T05}]  7]}]
205	    set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X5  + $T06}] 12]}]
206	    set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X6  + $T07}] 17]}]
207	    set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X7  + $T08}] 22]}]
208	    # [ABCD  8  7  9]  [DABC  9 12 10]  [CDAB 10 17 11]  [BCDA 11 22 12]
209	    set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X8  + $T09}]  7]}]
210	    set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X9  + $T10}] 12]}]
211	    set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X10 + $T11}] 17]}]
212	    set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X11 + $T12}] 22]}]
213	    # [ABCD 12  7 13]  [DABC 13 12 14]  [CDAB 14 17 15]  [BCDA 15 22 16]
214	    set A [expr {$B + [<<< [expr {$A + [F $B $C $D] + $X12 + $T13}]  7]}]
215	    set D [expr {$A + [<<< [expr {$D + [F $A $B $C] + $X13 + $T14}] 12]}]
216	    set C [expr {$D + [<<< [expr {$C + [F $D $A $B] + $X14 + $T15}] 17]}]
217	    set B [expr {$C + [<<< [expr {$B + [F $C $D $A] + $X15 + $T16}] 22]}]
218
219	    # Round 2.
220	    # Let [abcd k s i] denote the operation
221	    #      a = b + ((a + G(b,c,d) + X[k] + T[i]) <<< s).
222	    # Do the following 16 operations.
223	    # [ABCD  1  5 17]  [DABC  6  9 18]  [CDAB 11 14 19]  [BCDA  0 20 20]
224	    set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X1  + $T17}]  5]}]
225	    set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X6  + $T18}]  9]}]
226	    set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X11 + $T19}] 14]}]
227	    set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X0  + $T20}] 20]}]
228	    # [ABCD  5  5 21]  [DABC 10  9 22]  [CDAB 15 14 23]  [BCDA  4 20 24]
229	    set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X5  + $T21}]  5]}]
230	    set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X10 + $T22}]  9]}]
231	    set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X15 + $T23}] 14]}]
232	    set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X4  + $T24}] 20]}]
233	    # [ABCD  9  5 25]  [DABC 14  9 26]  [CDAB  3 14 27]  [BCDA  8 20 28]
234	    set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X9  + $T25}]  5]}]
235	    set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X14 + $T26}]  9]}]
236	    set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X3  + $T27}] 14]}]
237	    set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X8  + $T28}] 20]}]
238	    # [ABCD 13  5 29]  [DABC  2  9 30]  [CDAB  7 14 31]  [BCDA 12 20 32]
239	    set A [expr {$B + [<<< [expr {$A + [G $B $C $D] + $X13 + $T29}]  5]}]
240	    set D [expr {$A + [<<< [expr {$D + [G $A $B $C] + $X2  + $T30}]  9]}]
241	    set C [expr {$D + [<<< [expr {$C + [G $D $A $B] + $X7  + $T31}] 14]}]
242	    set B [expr {$C + [<<< [expr {$B + [G $C $D $A] + $X12 + $T32}] 20]}]
243
244	    # Round 3.
245	    # Let [abcd k s t] [sic] denote the operation
246	    #     a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s).
247	    # Do the following 16 operations.
248	    # [ABCD  5  4 33]  [DABC  8 11 34]  [CDAB 11 16 35]  [BCDA 14 23 36]
249	    set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X5  + $T33}]  4]}]
250	    set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X8  + $T34}] 11]}]
251	    set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X11 + $T35}] 16]}]
252	    set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X14 + $T36}] 23]}]
253	    # [ABCD  1  4 37]  [DABC  4 11 38]  [CDAB  7 16 39]  [BCDA 10 23 40]
254	    set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X1  + $T37}]  4]}]
255	    set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X4  + $T38}] 11]}]
256	    set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X7  + $T39}] 16]}]
257	    set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X10 + $T40}] 23]}]
258	    # [ABCD 13  4 41]  [DABC  0 11 42]  [CDAB  3 16 43]  [BCDA  6 23 44]
259	    set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X13 + $T41}]  4]}]
260	    set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X0  + $T42}] 11]}]
261	    set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X3  + $T43}] 16]}]
262	    set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X6  + $T44}] 23]}]
263	    # [ABCD  9  4 45]  [DABC 12 11 46]  [CDAB 15 16 47]  [BCDA  2 23 48]
264	    set A [expr {$B + [<<< [expr {$A + [H $B $C $D] + $X9  + $T45}]  4]}]
265	    set D [expr {$A + [<<< [expr {$D + [H $A $B $C] + $X12 + $T46}] 11]}]
266	    set C [expr {$D + [<<< [expr {$C + [H $D $A $B] + $X15 + $T47}] 16]}]
267	    set B [expr {$C + [<<< [expr {$B + [H $C $D $A] + $X2  + $T48}] 23]}]
268
269	    # Round 4.
270	    # Let [abcd k s t] [sic] denote the operation
271	    #     a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s).
272	    # Do the following 16 operations.
273	    # [ABCD  0  6 49]  [DABC  7 10 50]  [CDAB 14 15 51]  [BCDA  5 21 52]
274	    set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X0  + $T49}]  6]}]
275	    set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X7  + $T50}] 10]}]
276	    set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X14 + $T51}] 15]}]
277	    set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X5  + $T52}] 21]}]
278	    # [ABCD 12  6 53]  [DABC  3 10 54]  [CDAB 10 15 55]  [BCDA  1 21 56]
279	    set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X12 + $T53}]  6]}]
280	    set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X3  + $T54}] 10]}]
281	    set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X10 + $T55}] 15]}]
282	    set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X1  + $T56}] 21]}]
283	    # [ABCD  8  6 57]  [DABC 15 10 58]  [CDAB  6 15 59]  [BCDA 13 21 60]
284	    set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X8  + $T57}]  6]}]
285	    set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X15 + $T58}] 10]}]
286	    set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X6  + $T59}] 15]}]
287	    set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X13 + $T60}] 21]}]
288	    # [ABCD  4  6 61]  [DABC 11 10 62]  [CDAB  2 15 63]  [BCDA  9 21 64]
289	    set A [expr {$B + [<<< [expr {$A + [I $B $C $D] + $X4  + $T61}]  6]}]
290	    set D [expr {$A + [<<< [expr {$D + [I $A $B $C] + $X11 + $T62}] 10]}]
291	    set C [expr {$D + [<<< [expr {$C + [I $D $A $B] + $X2  + $T63}] 15]}]
292	    set B [expr {$C + [<<< [expr {$B + [I $C $D $A] + $X9  + $T64}] 21]}]
293
294	    # Then perform the following additions. (That is increment each
295	    #   of the four registers by the value it had before this block
296	    #   was started.)
297	    incr A $AA
298	    incr B $BB
299	    incr C $CC
300	    incr D $DD
301	}
302	# 3.5 Step 5. Output
303
304	# ... begin with the low-order byte of A, and end with the high-order byte
305	# of D.
306
307	return [bytes $A][bytes $B][bytes $C][bytes $D]
308    }
309
310    #
311    # Here we inline/regsub the functions F, G, H, I and <<<
312    #
313
314    namespace eval ::md5 {
315	#proc md5pure::F {x y z} {expr {(($x & $y) | ((~$x) & $z))}}
316	regsub -all -- {\[ *F +(\$.) +(\$.) +(\$.) *\]} $md5body {((\1 \& \2) | ((~\1) \& \3))} md5body
317
318	#proc md5pure::G {x y z} {expr {(($x & $z) | ($y & (~$z)))}}
319	regsub -all -- {\[ *G +(\$.) +(\$.) +(\$.) *\]} $md5body {((\1 \& \3) | (\2 \& (~\3)))} md5body
320
321	#proc md5pure::H {x y z} {expr {$x ^ $y ^ $z}}
322	regsub -all -- {\[ *H +(\$.) +(\$.) +(\$.) *\]} $md5body {(\1 ^ \2 ^ \3)} md5body
323
324	#proc md5pure::I {x y z} {expr {$y ^ ($x | (~$z))}}
325	regsub -all -- {\[ *I +(\$.) +(\$.) +(\$.) *\]} $md5body {(\2 ^ (\1 | (~\3)))} md5body
326
327	# bitwise left-rotate
328	if {0} {
329	    proc md5pure::<<< {x i} {
330		# This works by bitwise-ORing together right piece and left
331		# piece so that the (original) right piece becomes the left
332		# piece and vice versa.
333		#
334		# The (original) right piece is a simple left shift.
335		# The (original) left piece should be a simple right shift
336		# but Tcl does sign extension on right shifts so we
337		# shift it 1 bit, mask off the sign, and finally shift
338		# it the rest of the way.
339
340		# expr {($x << $i) | ((($x >> 1) & 0x7fffffff) >> (31-$i))}
341
342		#
343		# New version, faster when inlining
344		# We replace inline (computing at compile time):
345		#   R$i -> (32 - $i)
346		#   S$i -> (0x7fffffff >> (31-$i))
347		#
348
349		expr { ($x << $i) | (($x >> R$i) & S$i)}
350	    }
351	}
352	# inline <<<
353	regsub -all -- {\[ *<<< +\[ *expr +({[^\}]*})\] +([0-9]+) *\]} $md5body {(([set x [expr \1]] << \2) |  (($x >> R\2) \& S\2))} md5body
354
355	# now replace the R and S
356	set map {}
357	foreach i {
358	    7 12 17 22
359	    5  9 14 20
360	    4 11 16 23
361	    6 10 15 21
362	} {
363	    lappend map R$i [expr {32 - $i}] S$i [expr {0x7fffffff >> (31-$i)}]
364	}
365
366	# inline the values of T
367	foreach \
368		tName {
369	    T01 T02 T03 T04 T05 T06 T07 T08 T09 T10
370	    T11 T12 T13 T14 T15 T16 T17 T18 T19 T20
371	    T21 T22 T23 T24 T25 T26 T27 T28 T29 T30
372	    T31 T32 T33 T34 T35 T36 T37 T38 T39 T40
373	    T41 T42 T43 T44 T45 T46 T47 T48 T49 T50
374	    T51 T52 T53 T54 T55 T56 T57 T58 T59 T60
375	    T61 T62 T63 T64 } \
376		tVal {
377	    0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee
378	    0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501
379	    0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be
380	    0x6b901122 0xfd987193 0xa679438e 0x49b40821
381
382	    0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa
383	    0xd62f105d 0x2441453  0xd8a1e681 0xe7d3fbc8
384	    0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed
385	    0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a
386
387	    0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c
388	    0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70
389	    0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05
390	    0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665
391
392	    0xf4292244 0x432aff97 0xab9423a7 0xfc93a039
393	    0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1
394	    0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1
395	    0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391
396	} {
397	    lappend map \$$tName $tVal
398	}
399	set md5body [string map $map $md5body]
400
401
402	# Finally, define the proc
403	proc md5 {msg} $md5body
404
405	# unset auxiliary variables
406	unset md5body tName tVal map
407    }
408
409    proc ::md5::byte0 {i} {expr {0xff & $i}}
410    proc ::md5::byte1 {i} {expr {(0xff00 & $i) >> 8}}
411    proc ::md5::byte2 {i} {expr {(0xff0000 & $i) >> 16}}
412    proc ::md5::byte3 {i} {expr {((0xff000000 & $i) >> 24) & 0xff}}
413
414    proc ::md5::bytes {i} {
415	format %0.2x%0.2x%0.2x%0.2x [byte0 $i] [byte1 $i] [byte2 $i] [byte3 $i]
416    }
417
418    # hmac: hash for message authentication
419    proc ::md5::hmac {key text} {
420	# if key is longer than 64 bytes, reset it to MD5(key).  If shorter,
421	# pad it out with null (\x00) chars.
422	set keyLen [string length $key]
423	if {$keyLen > 64} {
424	    set key [binary format H32 [md5 $key]]
425	    set keyLen [string length $key]
426	}
427
428	# ensure the key is padded out to 64 chars with nulls.
429	set padLen [expr {64 - $keyLen}]
430	append key [binary format "a$padLen" {}]
431
432	# Split apart the key into a list of 16 little-endian words
433	binary scan $key i16 blocks
434
435	# XOR key with ipad and opad values
436	set k_ipad {}
437	set k_opad {}
438	foreach i $blocks {
439	    append k_ipad [binary format i [expr {$i ^ 0x36363636}]]
440	    append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]]
441	}
442
443	# Perform inner md5, appending its results to the outer key
444	append k_ipad $text
445	append k_opad [binary format H* [md5 $k_ipad]]
446
447	# Perform outer md5
448	md5 $k_opad
449    }
450}
451
452package provide md5 1.4.2
453
454