home *** CD-ROM | disk | FTP | other *** search
/ H4CK3R 5 / hacker05 / 05_HACK_05.ISO / programacao / freewrap / TCLLIBsampleApp.exe / sample / tcllib / tcllib1.0 / md5 / md5.tcl next >
Encoding:
Text File  |  2001-08-17  |  16.3 KB  |  454 lines
  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.  
  25. package require Tcl 8.2
  26. namespace eval ::md5 {
  27. }
  28.  
  29. if {![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.  
  452. package provide md5 1.4
  453.  
  454.