1# md5.tcl - Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net> 2# 3# MD5 defined by RFC 1321, "The MD5 Message-Digest Algorithm" 4# HMAC defined by RFC 2104, "Keyed-Hashing for Message Authentication" 5# 6# This is an implementation of MD5 based upon the example code given in 7# RFC 1321 and upon the tcllib MD4 implementation and taking some ideas 8# from the earlier tcllib md5 version by Don Libes. 9# 10# This implementation permits incremental updating of the hash and 11# provides support for external compiled implementations either using 12# critcl (md5c) or Trf. 13# 14# ------------------------------------------------------------------------- 15# See the file "license.terms" for information on usage and redistribution 16# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 17# ------------------------------------------------------------------------- 18# 19# $Id: md5x.tcl,v 1.19 2008/07/04 18:27:00 andreas_kupries Exp $ 20 21package require Tcl 8.2; # tcl minimum version 22 23namespace eval ::md5 { 24 variable version 2.0.7 25 variable rcsid {$Id: md5x.tcl,v 1.19 2008/07/04 18:27:00 andreas_kupries Exp $} 26 variable accel 27 array set accel {critcl 0 cryptkit 0 trf 0} 28 29 namespace export md5 hmac MD5Init MD5Update MD5Final 30 31 variable uid 32 if {![info exists uid]} { 33 set uid 0 34 } 35} 36 37# ------------------------------------------------------------------------- 38 39# MD5Init -- 40# 41# Create and initialize an MD5 state variable. This will be 42# cleaned up when we call MD5Final 43# 44proc ::md5::MD5Init {} { 45 variable accel 46 variable uid 47 set token [namespace current]::[incr uid] 48 upvar #0 $token state 49 50 # RFC1321:3.3 - Initialize MD5 state structure 51 array set state \ 52 [list \ 53 A [expr {0x67452301}] \ 54 B [expr {0xefcdab89}] \ 55 C [expr {0x98badcfe}] \ 56 D [expr {0x10325476}] \ 57 n 0 i "" ] 58 if {$accel(cryptkit)} { 59 cryptkit::cryptCreateContext state(ckctx) CRYPT_UNUSED CRYPT_ALGO_MD5 60 } elseif {$accel(trf)} { 61 set s {} 62 switch -exact -- $::tcl_platform(platform) { 63 windows { set s [open NUL w] } 64 unix { set s [open /dev/null w] } 65 } 66 if {$s != {}} { 67 fconfigure $s -translation binary -buffering none 68 ::md5 -attach $s -mode write \ 69 -read-type variable \ 70 -read-destination [subst $token](trfread) \ 71 -write-type variable \ 72 -write-destination [subst $token](trfwrite) 73 array set state [list trfread 0 trfwrite 0 trf $s] 74 } 75 } 76 return $token 77} 78 79# MD5Update -- 80# 81# This is called to add more data into the hash. You may call this 82# as many times as you require. Note that passing in "ABC" is equivalent 83# to passing these letters in as separate calls -- hence this proc 84# permits hashing of chunked data 85# 86# If we have a C-based implementation available, then we will use 87# it here in preference to the pure-Tcl implementation. 88# 89proc ::md5::MD5Update {token data} { 90 variable accel 91 upvar #0 $token state 92 93 if {$accel(critcl)} { 94 if {[info exists state(md5c)]} { 95 set state(md5c) [md5c $data $state(md5c)] 96 } else { 97 set state(md5c) [md5c $data] 98 } 99 return 100 } elseif {[info exists state(ckctx)]} { 101 if {[string length $data] > 0} { 102 cryptkit::cryptEncrypt $state(ckctx) $data 103 } 104 return 105 } elseif {[info exists state(trf)]} { 106 puts -nonewline $state(trf) $data 107 return 108 } 109 110 # Update the state values 111 incr state(n) [string length $data] 112 append state(i) $data 113 114 # Calculate the hash for any complete blocks 115 set len [string length $state(i)] 116 for {set n 0} {($n + 64) <= $len} {} { 117 MD5Hash $token [string range $state(i) $n [incr n 64]] 118 } 119 120 # Adjust the state for the blocks completed. 121 set state(i) [string range $state(i) $n end] 122 return 123} 124 125# MD5Final -- 126# 127# This procedure is used to close the current hash and returns the 128# hash data. Once this procedure has been called the hash context 129# is freed and cannot be used again. 130# 131# Note that the output is 128 bits represented as binary data. 132# 133proc ::md5::MD5Final {token} { 134 upvar #0 $token state 135 136 # Check for either of the C-compiled versions. 137 if {[info exists state(md5c)]} { 138 set r $state(md5c) 139 unset state 140 return $r 141 } elseif {[info exists state(ckctx)]} { 142 cryptkit::cryptEncrypt $state(ckctx) "" 143 cryptkit::cryptGetAttributeString $state(ckctx) \ 144 CRYPT_CTXINFO_HASHVALUE r 16 145 cryptkit::cryptDestroyContext $state(ckctx) 146 # If nothing was hashed, we get no r variable set! 147 if {[info exists r]} { 148 unset state 149 return $r 150 } 151 } elseif {[info exists state(trf)]} { 152 close $state(trf) 153 set r $state(trfwrite) 154 unset state 155 return $r 156 } 157 158 # RFC1321:3.1 - Padding 159 # 160 set len [string length $state(i)] 161 set pad [expr {56 - ($len % 64)}] 162 if {$len % 64 > 56} { 163 incr pad 64 164 } 165 if {$pad == 0} { 166 incr pad 64 167 } 168 append state(i) [binary format a$pad \x80] 169 170 # RFC1321:3.2 - Append length in bits as little-endian wide int. 171 append state(i) [binary format ii [expr {8 * $state(n)}] 0] 172 173 # Calculate the hash for the remaining block. 174 set len [string length $state(i)] 175 for {set n 0} {($n + 64) <= $len} {} { 176 MD5Hash $token [string range $state(i) $n [incr n 64]] 177 } 178 179 # RFC1321:3.5 - Output 180 set r [bytes $state(A)][bytes $state(B)][bytes $state(C)][bytes $state(D)] 181 unset state 182 return $r 183} 184 185# ------------------------------------------------------------------------- 186# HMAC Hashed Message Authentication (RFC 2104) 187# 188# hmac = H(K xor opad, H(K xor ipad, text)) 189# 190 191# HMACInit -- 192# 193# This is equivalent to the MD5Init procedure except that a key is 194# added into the algorithm 195# 196proc ::md5::HMACInit {K} { 197 198 # Key K is adjusted to be 64 bytes long. If K is larger, then use 199 # the MD5 digest of K and pad this instead. 200 set len [string length $K] 201 if {$len > 64} { 202 set tok [MD5Init] 203 MD5Update $tok $K 204 set K [MD5Final $tok] 205 set len [string length $K] 206 } 207 set pad [expr {64 - $len}] 208 append K [string repeat \0 $pad] 209 210 # Cacluate the padding buffers. 211 set Ki {} 212 set Ko {} 213 binary scan $K i16 Ks 214 foreach k $Ks { 215 append Ki [binary format i [expr {$k ^ 0x36363636}]] 216 append Ko [binary format i [expr {$k ^ 0x5c5c5c5c}]] 217 } 218 219 set tok [MD5Init] 220 MD5Update $tok $Ki; # initialize with the inner pad 221 222 # preserve the Ko value for the final stage. 223 # FRINK: nocheck 224 set [subst $tok](Ko) $Ko 225 226 return $tok 227} 228 229# HMACUpdate -- 230# 231# Identical to calling MD5Update 232# 233proc ::md5::HMACUpdate {token data} { 234 MD5Update $token $data 235 return 236} 237 238# HMACFinal -- 239# 240# This is equivalent to the MD5Final procedure. The hash context is 241# closed and the binary representation of the hash result is returned. 242# 243proc ::md5::HMACFinal {token} { 244 upvar #0 $token state 245 246 set tok [MD5Init]; # init the outer hashing function 247 MD5Update $tok $state(Ko); # prepare with the outer pad. 248 MD5Update $tok [MD5Final $token]; # hash the inner result 249 return [MD5Final $tok] 250} 251 252# ------------------------------------------------------------------------- 253# Description: 254# This is the core MD5 algorithm. It is a lot like the MD4 algorithm but 255# includes an extra round and a set of constant modifiers throughout. 256# 257# Note: 258# This function body is substituted later on to inline some of the 259# procedures and to make is a bit more comprehensible. 260# 261set ::md5::MD5Hash_body { 262 variable $token 263 upvar 0 $token state 264 265 # RFC1321:3.4 - Process Message in 16-Word Blocks 266 binary scan $msg i* blocks 267 foreach {X0 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15} $blocks { 268 set A $state(A) 269 set B $state(B) 270 set C $state(C) 271 set D $state(D) 272 273 # Round 1 274 # Let [abcd k s i] denote the operation 275 # a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s). 276 # Do the following 16 operations. 277 # [ABCD 0 7 1] [DABC 1 12 2] [CDAB 2 17 3] [BCDA 3 22 4] 278 set A [expr {$B + (($A + [F $B $C $D] + $X0 + $T01) <<< 7)}] 279 set D [expr {$A + (($D + [F $A $B $C] + $X1 + $T02) <<< 12)}] 280 set C [expr {$D + (($C + [F $D $A $B] + $X2 + $T03) <<< 17)}] 281 set B [expr {$C + (($B + [F $C $D $A] + $X3 + $T04) <<< 22)}] 282 # [ABCD 4 7 5] [DABC 5 12 6] [CDAB 6 17 7] [BCDA 7 22 8] 283 set A [expr {$B + (($A + [F $B $C $D] + $X4 + $T05) <<< 7)}] 284 set D [expr {$A + (($D + [F $A $B $C] + $X5 + $T06) <<< 12)}] 285 set C [expr {$D + (($C + [F $D $A $B] + $X6 + $T07) <<< 17)}] 286 set B [expr {$C + (($B + [F $C $D $A] + $X7 + $T08) <<< 22)}] 287 # [ABCD 8 7 9] [DABC 9 12 10] [CDAB 10 17 11] [BCDA 11 22 12] 288 set A [expr {$B + (($A + [F $B $C $D] + $X8 + $T09) <<< 7)}] 289 set D [expr {$A + (($D + [F $A $B $C] + $X9 + $T10) <<< 12)}] 290 set C [expr {$D + (($C + [F $D $A $B] + $X10 + $T11) <<< 17)}] 291 set B [expr {$C + (($B + [F $C $D $A] + $X11 + $T12) <<< 22)}] 292 # [ABCD 12 7 13] [DABC 13 12 14] [CDAB 14 17 15] [BCDA 15 22 16] 293 set A [expr {$B + (($A + [F $B $C $D] + $X12 + $T13) <<< 7)}] 294 set D [expr {$A + (($D + [F $A $B $C] + $X13 + $T14) <<< 12)}] 295 set C [expr {$D + (($C + [F $D $A $B] + $X14 + $T15) <<< 17)}] 296 set B [expr {$C + (($B + [F $C $D $A] + $X15 + $T16) <<< 22)}] 297 298 # Round 2. 299 # Let [abcd k s i] denote the operation 300 # a = b + ((a + G(b,c,d) + X[k] + Ti) <<< s) 301 # Do the following 16 operations. 302 # [ABCD 1 5 17] [DABC 6 9 18] [CDAB 11 14 19] [BCDA 0 20 20] 303 set A [expr {$B + (($A + [G $B $C $D] + $X1 + $T17) <<< 5)}] 304 set D [expr {$A + (($D + [G $A $B $C] + $X6 + $T18) <<< 9)}] 305 set C [expr {$D + (($C + [G $D $A $B] + $X11 + $T19) <<< 14)}] 306 set B [expr {$C + (($B + [G $C $D $A] + $X0 + $T20) <<< 20)}] 307 # [ABCD 5 5 21] [DABC 10 9 22] [CDAB 15 14 23] [BCDA 4 20 24] 308 set A [expr {$B + (($A + [G $B $C $D] + $X5 + $T21) <<< 5)}] 309 set D [expr {$A + (($D + [G $A $B $C] + $X10 + $T22) <<< 9)}] 310 set C [expr {$D + (($C + [G $D $A $B] + $X15 + $T23) <<< 14)}] 311 set B [expr {$C + (($B + [G $C $D $A] + $X4 + $T24) <<< 20)}] 312 # [ABCD 9 5 25] [DABC 14 9 26] [CDAB 3 14 27] [BCDA 8 20 28] 313 set A [expr {$B + (($A + [G $B $C $D] + $X9 + $T25) <<< 5)}] 314 set D [expr {$A + (($D + [G $A $B $C] + $X14 + $T26) <<< 9)}] 315 set C [expr {$D + (($C + [G $D $A $B] + $X3 + $T27) <<< 14)}] 316 set B [expr {$C + (($B + [G $C $D $A] + $X8 + $T28) <<< 20)}] 317 # [ABCD 13 5 29] [DABC 2 9 30] [CDAB 7 14 31] [BCDA 12 20 32] 318 set A [expr {$B + (($A + [G $B $C $D] + $X13 + $T29) <<< 5)}] 319 set D [expr {$A + (($D + [G $A $B $C] + $X2 + $T30) <<< 9)}] 320 set C [expr {$D + (($C + [G $D $A $B] + $X7 + $T31) <<< 14)}] 321 set B [expr {$C + (($B + [G $C $D $A] + $X12 + $T32) <<< 20)}] 322 323 # Round 3. 324 # Let [abcd k s i] denote the operation 325 # a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s) 326 # Do the following 16 operations. 327 # [ABCD 5 4 33] [DABC 8 11 34] [CDAB 11 16 35] [BCDA 14 23 36] 328 set A [expr {$B + (($A + [H $B $C $D] + $X5 + $T33) <<< 4)}] 329 set D [expr {$A + (($D + [H $A $B $C] + $X8 + $T34) <<< 11)}] 330 set C [expr {$D + (($C + [H $D $A $B] + $X11 + $T35) <<< 16)}] 331 set B [expr {$C + (($B + [H $C $D $A] + $X14 + $T36) <<< 23)}] 332 # [ABCD 1 4 37] [DABC 4 11 38] [CDAB 7 16 39] [BCDA 10 23 40] 333 set A [expr {$B + (($A + [H $B $C $D] + $X1 + $T37) <<< 4)}] 334 set D [expr {$A + (($D + [H $A $B $C] + $X4 + $T38) <<< 11)}] 335 set C [expr {$D + (($C + [H $D $A $B] + $X7 + $T39) <<< 16)}] 336 set B [expr {$C + (($B + [H $C $D $A] + $X10 + $T40) <<< 23)}] 337 # [ABCD 13 4 41] [DABC 0 11 42] [CDAB 3 16 43] [BCDA 6 23 44] 338 set A [expr {$B + (($A + [H $B $C $D] + $X13 + $T41) <<< 4)}] 339 set D [expr {$A + (($D + [H $A $B $C] + $X0 + $T42) <<< 11)}] 340 set C [expr {$D + (($C + [H $D $A $B] + $X3 + $T43) <<< 16)}] 341 set B [expr {$C + (($B + [H $C $D $A] + $X6 + $T44) <<< 23)}] 342 # [ABCD 9 4 45] [DABC 12 11 46] [CDAB 15 16 47] [BCDA 2 23 48] 343 set A [expr {$B + (($A + [H $B $C $D] + $X9 + $T45) <<< 4)}] 344 set D [expr {$A + (($D + [H $A $B $C] + $X12 + $T46) <<< 11)}] 345 set C [expr {$D + (($C + [H $D $A $B] + $X15 + $T47) <<< 16)}] 346 set B [expr {$C + (($B + [H $C $D $A] + $X2 + $T48) <<< 23)}] 347 348 # Round 4. 349 # Let [abcd k s i] denote the operation 350 # a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s) 351 # Do the following 16 operations. 352 # [ABCD 0 6 49] [DABC 7 10 50] [CDAB 14 15 51] [BCDA 5 21 52] 353 set A [expr {$B + (($A + [I $B $C $D] + $X0 + $T49) <<< 6)}] 354 set D [expr {$A + (($D + [I $A $B $C] + $X7 + $T50) <<< 10)}] 355 set C [expr {$D + (($C + [I $D $A $B] + $X14 + $T51) <<< 15)}] 356 set B [expr {$C + (($B + [I $C $D $A] + $X5 + $T52) <<< 21)}] 357 # [ABCD 12 6 53] [DABC 3 10 54] [CDAB 10 15 55] [BCDA 1 21 56] 358 set A [expr {$B + (($A + [I $B $C $D] + $X12 + $T53) <<< 6)}] 359 set D [expr {$A + (($D + [I $A $B $C] + $X3 + $T54) <<< 10)}] 360 set C [expr {$D + (($C + [I $D $A $B] + $X10 + $T55) <<< 15)}] 361 set B [expr {$C + (($B + [I $C $D $A] + $X1 + $T56) <<< 21)}] 362 # [ABCD 8 6 57] [DABC 15 10 58] [CDAB 6 15 59] [BCDA 13 21 60] 363 set A [expr {$B + (($A + [I $B $C $D] + $X8 + $T57) <<< 6)}] 364 set D [expr {$A + (($D + [I $A $B $C] + $X15 + $T58) <<< 10)}] 365 set C [expr {$D + (($C + [I $D $A $B] + $X6 + $T59) <<< 15)}] 366 set B [expr {$C + (($B + [I $C $D $A] + $X13 + $T60) <<< 21)}] 367 # [ABCD 4 6 61] [DABC 11 10 62] [CDAB 2 15 63] [BCDA 9 21 64] 368 set A [expr {$B + (($A + [I $B $C $D] + $X4 + $T61) <<< 6)}] 369 set D [expr {$A + (($D + [I $A $B $C] + $X11 + $T62) <<< 10)}] 370 set C [expr {$D + (($C + [I $D $A $B] + $X2 + $T63) <<< 15)}] 371 set B [expr {$C + (($B + [I $C $D $A] + $X9 + $T64) <<< 21)}] 372 373 # Then perform the following additions. (That is, increment each 374 # of the four registers by the value it had before this block 375 # was started.) 376 incr state(A) $A 377 incr state(B) $B 378 incr state(C) $C 379 incr state(D) $D 380 } 381 382 return 383} 384 385proc ::md5::byte {n v} {expr {((0xFF << (8 * $n)) & $v) >> (8 * $n)}} 386proc ::md5::bytes {v} { 387 #format %c%c%c%c [byte 0 $v] [byte 1 $v] [byte 2 $v] [byte 3 $v] 388 format %c%c%c%c \ 389 [expr {0xFF & $v}] \ 390 [expr {(0xFF00 & $v) >> 8}] \ 391 [expr {(0xFF0000 & $v) >> 16}] \ 392 [expr {((0xFF000000 & $v) >> 24) & 0xFF}] 393} 394 395# 32bit rotate-left 396proc ::md5::<<< {v n} { 397 return [expr {((($v << $n) \ 398 | (($v >> (32 - $n)) \ 399 & (0x7FFFFFFF >> (31 - $n))))) \ 400 & 0xFFFFFFFF}] 401} 402 403# Convert our <<< pseudo-operator into a procedure call. 404regsub -all -line \ 405 {\[expr {(\$[ABCD]) \+ \(\((.*)\)\s+<<<\s+(\d+)\)}\]} \ 406 $::md5::MD5Hash_body \ 407 {[expr {int(\1 + [<<< [expr {\2}] \3])}]} \ 408 ::md5::MD5Hash_body 409 410# RFC1321:3.4 - function F 411proc ::md5::F {X Y Z} { 412 return [expr {($X & $Y) | ((~$X) & $Z)}] 413} 414 415# Inline the F function 416regsub -all -line \ 417 {\[F (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ 418 $::md5::MD5Hash_body \ 419 {( (\1 \& \2) | ((~\1) \& \3) )} \ 420 ::md5::MD5Hash_body 421 422# RFC1321:3.4 - function G 423proc ::md5::G {X Y Z} { 424 return [expr {(($X & $Z) | ($Y & (~$Z)))}] 425} 426 427# Inline the G function 428regsub -all -line \ 429 {\[G (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ 430 $::md5::MD5Hash_body \ 431 {(((\1 \& \3) | (\2 \& (~\3))))} \ 432 ::md5::MD5Hash_body 433 434# RFC1321:3.4 - function H 435proc ::md5::H {X Y Z} { 436 return [expr {$X ^ $Y ^ $Z}] 437} 438 439# Inline the H function 440regsub -all -line \ 441 {\[H (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ 442 $::md5::MD5Hash_body \ 443 {(\1 ^ \2 ^ \3)} \ 444 ::md5::MD5Hash_body 445 446# RFC1321:3.4 - function I 447proc ::md5::I {X Y Z} { 448 return [expr {$Y ^ ($X | (~$Z))}] 449} 450 451# Inline the I function 452regsub -all -line \ 453 {\[I (\$[ABCD]) (\$[ABCD]) (\$[ABCD])\]} \ 454 $::md5::MD5Hash_body \ 455 {(\2 ^ (\1 | (~\3)))} \ 456 ::md5::MD5Hash_body 457 458 459# RFC 1321:3.4 step 4: inline the set of constant modifiers. 460namespace eval md5 { 461 foreach tName { 462 T01 T02 T03 T04 T05 T06 T07 T08 T09 T10 463 T11 T12 T13 T14 T15 T16 T17 T18 T19 T20 464 T21 T22 T23 T24 T25 T26 T27 T28 T29 T30 465 T31 T32 T33 T34 T35 T36 T37 T38 T39 T40 466 T41 T42 T43 T44 T45 T46 T47 T48 T49 T50 467 T51 T52 T53 T54 T55 T56 T57 T58 T59 T60 468 T61 T62 T63 T64 469 } tVal { 470 0xd76aa478 0xe8c7b756 0x242070db 0xc1bdceee 471 0xf57c0faf 0x4787c62a 0xa8304613 0xfd469501 472 0x698098d8 0x8b44f7af 0xffff5bb1 0x895cd7be 473 0x6b901122 0xfd987193 0xa679438e 0x49b40821 474 475 0xf61e2562 0xc040b340 0x265e5a51 0xe9b6c7aa 476 0xd62f105d 0x2441453 0xd8a1e681 0xe7d3fbc8 477 0x21e1cde6 0xc33707d6 0xf4d50d87 0x455a14ed 478 0xa9e3e905 0xfcefa3f8 0x676f02d9 0x8d2a4c8a 479 480 0xfffa3942 0x8771f681 0x6d9d6122 0xfde5380c 481 0xa4beea44 0x4bdecfa9 0xf6bb4b60 0xbebfbc70 482 0x289b7ec6 0xeaa127fa 0xd4ef3085 0x4881d05 483 0xd9d4d039 0xe6db99e5 0x1fa27cf8 0xc4ac5665 484 485 0xf4292244 0x432aff97 0xab9423a7 0xfc93a039 486 0x655b59c3 0x8f0ccc92 0xffeff47d 0x85845dd1 487 0x6fa87e4f 0xfe2ce6e0 0xa3014314 0x4e0811a1 488 0xf7537e82 0xbd3af235 0x2ad7d2bb 0xeb86d391 489 } { 490 lappend map \$$tName $tVal 491 } 492 set ::md5::MD5Hash_body [string map $map $::md5::MD5Hash_body] 493 unset map tName tVal 494} 495 496# Define the MD5 hashing procedure with inline functions. 497proc ::md5::MD5Hash {token msg} $::md5::MD5Hash_body 498unset ::md5::MD5Hash_body 499 500# ------------------------------------------------------------------------- 501 502if {[package provide Trf] != {}} { 503 interp alias {} ::md5::Hex {} ::hex -mode encode -- 504} else { 505 proc ::md5::Hex {data} { 506 binary scan $data H* result 507 return [string toupper $result] 508 } 509} 510 511# ------------------------------------------------------------------------- 512 513# LoadAccelerator -- 514# 515# This package can make use of a number of compiled extensions to 516# accelerate the digest computation. This procedure manages the 517# use of these extensions within the package. During normal usage 518# this should not be called, but the test package manipulates the 519# list of enabled accelerators. 520# 521proc ::md5::LoadAccelerator {name} { 522 variable accel 523 set r 0 524 switch -exact -- $name { 525 critcl { 526 if {![catch {package require tcllibc}] 527 || ![catch {package require md5c}]} { 528 set r [expr {[info command ::md5::md5c] != {}}] 529 } 530 } 531 cryptkit { 532 if {![catch {package require cryptkit}]} { 533 set r [expr {![catch {cryptkit::cryptInit}]}] 534 } 535 } 536 trf { 537 if {![catch {package require Trf}]} { 538 set r [expr {![catch {::md5 aa} msg]}] 539 } 540 } 541 default { 542 return -code error "invalid accelerator package:\ 543 must be one of [join [array names accel] {, }]" 544 } 545 } 546 set accel($name) $r 547} 548 549# ------------------------------------------------------------------------- 550 551# Description: 552# Pop the nth element off a list. Used in options processing. 553# 554proc ::md5::Pop {varname {nth 0}} { 555 upvar $varname args 556 set r [lindex $args $nth] 557 set args [lreplace $args $nth $nth] 558 return $r 559} 560 561# ------------------------------------------------------------------------- 562 563# fileevent handler for chunked file hashing. 564# 565proc ::md5::Chunk {token channel {chunksize 4096}} { 566 upvar #0 $token state 567 568 if {[eof $channel]} { 569 fileevent $channel readable {} 570 set state(reading) 0 571 } 572 573 MD5Update $token [read $channel $chunksize] 574} 575 576# ------------------------------------------------------------------------- 577 578proc ::md5::md5 {args} { 579 array set opts {-hex 0 -filename {} -channel {} -chunksize 4096} 580 while {[string match -* [set option [lindex $args 0]]]} { 581 switch -glob -- $option { 582 -hex { set opts(-hex) 1 } 583 -file* { set opts(-filename) [Pop args 1] } 584 -channel { set opts(-channel) [Pop args 1] } 585 -chunksize { set opts(-chunksize) [Pop args 1] } 586 default { 587 if {[llength $args] == 1} { break } 588 if {[string compare $option "--"] == 0} { Pop args; break } 589 set err [join [lsort [array names opts]] ", "] 590 return -code error "bad option $option:\ 591 must be one of $err\nlen: [llength $args]" 592 } 593 } 594 Pop args 595 } 596 597 if {$opts(-filename) != {}} { 598 set opts(-channel) [open $opts(-filename) r] 599 fconfigure $opts(-channel) -translation binary 600 } 601 602 if {$opts(-channel) == {}} { 603 604 if {[llength $args] != 1} { 605 return -code error "wrong # args:\ 606 should be \"md5 ?-hex? -filename file | string\"" 607 } 608 set tok [MD5Init] 609 MD5Update $tok [lindex $args 0] 610 set r [MD5Final $tok] 611 612 } else { 613 614 set tok [MD5Init] 615 # FRINK: nocheck 616 set [subst $tok](reading) 1 617 fileevent $opts(-channel) readable \ 618 [list [namespace origin Chunk] \ 619 $tok $opts(-channel) $opts(-chunksize)] 620 vwait [subst $tok](reading) 621 set r [MD5Final $tok] 622 623 # If we opened the channel - we should close it too. 624 if {$opts(-filename) != {}} { 625 close $opts(-channel) 626 } 627 } 628 629 if {$opts(-hex)} { 630 set r [Hex $r] 631 } 632 return $r 633} 634 635# ------------------------------------------------------------------------- 636 637proc ::md5::hmac {args} { 638 array set opts {-hex 0 -filename {} -channel {} -chunksize 4096} 639 while {[string match -* [set option [lindex $args 0]]]} { 640 switch -glob -- $option { 641 -key { set opts(-key) [Pop args 1] } 642 -hex { set opts(-hex) 1 } 643 -file* { set opts(-filename) [Pop args 1] } 644 -channel { set opts(-channel) [Pop args 1] } 645 -chunksize { set opts(-chunksize) [Pop args 1] } 646 default { 647 if {[llength $args] == 1} { break } 648 if {[string compare $option "--"] == 0} { Pop args; break } 649 set err [join [lsort [array names opts]] ", "] 650 return -code error "bad option $option:\ 651 must be one of $err" 652 } 653 } 654 Pop args 655 } 656 657 if {![info exists opts(-key)]} { 658 return -code error "wrong # args:\ 659 should be \"hmac ?-hex? -key key -filename file | string\"" 660 } 661 662 if {$opts(-filename) != {}} { 663 set opts(-channel) [open $opts(-filename) r] 664 fconfigure $opts(-channel) -translation binary 665 } 666 667 if {$opts(-channel) == {}} { 668 669 if {[llength $args] != 1} { 670 return -code error "wrong # args:\ 671 should be \"hmac ?-hex? -key key -filename file | string\"" 672 } 673 set tok [HMACInit $opts(-key)] 674 HMACUpdate $tok [lindex $args 0] 675 set r [HMACFinal $tok] 676 677 } else { 678 679 set tok [HMACInit $opts(-key)] 680 # FRINK: nocheck 681 set [subst $tok](reading) 1 682 fileevent $opts(-channel) readable \ 683 [list [namespace origin Chunk] \ 684 $tok $opts(-channel) $opts(-chunksize)] 685 vwait [subst $tok](reading) 686 set r [HMACFinal $tok] 687 688 # If we opened the channel - we should close it too. 689 if {$opts(-filename) != {}} { 690 close $opts(-channel) 691 } 692 } 693 694 if {$opts(-hex)} { 695 set r [Hex $r] 696 } 697 return $r 698} 699 700# ------------------------------------------------------------------------- 701 702# Try and load a compiled extension to help. 703namespace eval ::md5 { 704 variable e 705 foreach e {critcl cryptkit trf} { if {[LoadAccelerator $e]} { break } } 706 unset e 707} 708 709package provide md5 $::md5::version 710 711# ------------------------------------------------------------------------- 712# Local Variables: 713# mode: tcl 714# indent-tabs-mode: nil 715# End: 716 717 718