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