libs/md5sum.f

   1 \ MD5.f  2006 Jan 07
   2 \ 32 bit little endian version of the MD5 algorithm ( i.e. PC ).
   3 \ The endian-ness of the MD5 algorithm is factored out to allow easy
   4 \ conversion to a big-endian system.
   5 \ Local variables are not used.
   6
   7 \ **********************************************************************
   8 \ *S Endian specific code
   9 \ ** LE@ and LE! provide the required LittleEndian 4 octet string
  10 \ ** to number conversion for the MD5 algorithm.
  11 \ ** For a string containing hex 44 C, 33 C, 22 C, 11 C,
  12 \ ** LE@ must return 11223344 ( LittleEndian )
  13 \ ** LE! must store the string as shown, in LittleEndian format,
  14 \ ** BE@ must return 44332211 ( BigEndian )
  15 \ ** Define these for your system and the following code should work...
  16 \ **********************************************************************
  17 only forth definitions
  18 vocabulary md5sum
  19 also md5sum definitions
  20
  21 \ *G little Endian 32 bit @
  22 \ : LE@ " @" evaluate ; immediate
  23 : LE@  compiler:?comp compile @ ; immediate
  24 \ *G little Endian 32 bit !
  25 \ : LE! " !" evaluate ; immediate
  26 : LE!  compiler:?comp compile ! ; immediate
  27
  28
  29 \ *********************************
  30 \ *S The md5 secure hash algorithm
  31 \ *********************************
  32
  33 Create Tmagic
  34 \ *G The table of magic numbers = ( 2** 32 ) * sin[ x ]
  35 \ ** where x goes from 1 to 64 radians.
  36 (  1 ) 0xD76AA478 , 0xE8C7B756 , 0x242070DB , 0xC1BDCEEE ,
  37 (  5 ) 0xF57C0FAF , 0x4787C62A , 0xA8304613 , 0xFD469501 ,
  38 (  9 ) 0x698098D8 , 0x8B44F7AF , 0xFFFF5BB1 , 0x895CD7BE ,
  39 ( 13 ) 0x6B901122 , 0xFD987193 , 0xA679438E , 0x49B40821 ,
  40 ( 17 ) 0xF61E2562 , 0xC040B340 , 0x265E5A51 , 0xE9B6C7AA ,
  41 ( 21 ) 0xD62F105D , 0x02441453 , 0xD8A1E681 , 0xE7D3FBC8 ,
  42 ( 25 ) 0x21E1CDE6 , 0xC33707D6 , 0xF4D50D87 , 0x455A14ED ,
  43 ( 29 ) 0xA9E3E905 , 0xFCEFA3F8 , 0x676F02D9 , 0x8D2A4C8A ,
  44 ( 33 ) 0xFFFA3942 , 0x8771F681 , 0x6D9D6122 , 0xFDE5380C ,
  45 ( 37 ) 0xA4BEEA44 , 0x4BDECFA9 , 0xF6BB4B60 , 0xBEBFBC70 ,
  46 ( 41 ) 0x289B7EC6 , 0xEAA127FA , 0xD4EF3085 , 0x04881D05 ,
  47 ( 45 ) 0xD9D4D039 , 0xE6DB99E5 , 0x1FA27CF8 , 0xC4AC5665 ,
  48 ( 49 ) 0xF4292244 , 0x432AFF97 , 0xAB9423A7 , 0xFC93A039 ,
  49 ( 53 ) 0x655B59C3 , 0x8F0CCC92 , 0xFFEFF47D , 0x85845DD1 ,
  50 ( 57 ) 0x6FA87E4F , 0xFE2CE6E0 , 0xA3014314 , 0x4E0811A1 ,
  51 ( 61 ) 0xF7537E82 , 0xBD3AF235 , 0x2AD7D2BB , 0xEB86D391 ,
  52
  53 ;; so it will work with ans too
  54 : var  create 0 , create; ;
  55
  56 var >InputBlock
  57 \ *G points to current 64 octet string to process
  58
  59 var T#
  60 \ *G a counter to select table entries - could be a Cvariable
  61
  62 0x10 buffer: md5[]
  63 \ *G the md5 result array
  64 \ ** An initial value is put in here which is mangled by the message to
  65 \ ** give a one-way function md5 secure hash key.
  66 md5[] 0x00 + constant md5[a]      \ accessed by name
  67 md5[] 0x04 + constant md5[b]
  68 md5[] 0x08 + constant md5[c]
  69 md5[] 0x0C + constant md5[d]
  70
  71 0x10 buffer: md5[]saved
  72 \ *G a saved copy of md5[] result array for adding in at the
  73 \ ** end of the computation.
  74 md5[]saved 0x00 + constant md5[a]saved  \ accessed by name
  75 md5[]saved 0x04 + constant md5[b]saved
  76 md5[]saved 0x08 + constant md5[c]saved
  77 md5[]saved 0x0C + constant md5[d]saved
  78
  79 : .md5[]                \ --
  80 \ *G display the md5 result array
  81    cr ." >>> "  base @ >r  hex
  82    md5[] 0x10 over + swap do  I c@ 3 U.R  loop  r> base ! ;
  83
  84 \ : Lrotate                \ x1 u -- x2
  85 \ \ *G cyclicly rotate the 32 Bit word x1 left u bits
  86 \ \ ** i.e put the MSB into the LSB when it drops of the left hand end.
  87 \    2dup Lshift >r 32 swap - Rshift  r> or
  88 \ ;
  89
  90 : md5-XX                \ k u a --
  91 \ *G the common part of the FF, GG, HH and II functions
  92    >r  swap
  93    ( add one of the 64 input string octets to process )
  94    ( k ) 4 * >InputBlock @ + LE@  ( u ) +   \ Note Little Endian @
  95    ( add number from table) Tmagic T# c@ 4 * + @  +
  96    ( rotate the bits using the XXrotate table)
  97       r> ( a ) T# c@ 3 and + c@ Lrotate
  98    ( add this 32 bit word)  md5[b] @ +
  99    ( roll the key around) md5[d] @ ( * ) md5[c] @ md5[d] !
 100    md5[b] @ md5[c] !
 101    \  md5[a] @ md5[b] !  \ overwritten 2 lines below :
 102    ( * ) md5[a] !
 103    ( replace this 32 bit word)  md5[b] !
 104    ( next time use next magic number and rotate table entries)
 105    1 T# C+!
 106 ;
 107
 108 Create FFrotate 0x07 C, 0x0C C, 0x11 C, 0x16 C,
 109 \ *G lists the four possible rotate values for this function
 110
 111 : md5-FF        \  k --
 112 \ *G takes 4 octet value k of the message and mangles it
 113 \ ** into the hash value using function FF.
 114    md5[c] @   md5[b] @ and
 115    md5[d] @   md5[b] @ -1 xor   and
 116    or  md5[a] @  +
 117    FFrotate md5-XX
 118 ;
 119
 120 Create GGrotate 0x05 C, 0x09 C, 0x0E C, 0x14 C,
 121 \ *G lists the four possible rotate values for this function
 122
 123 : md5-GG        \ k --
 124 \ *G md5-GG  takes 4 octet value k of the message an mangles it
 125 \ ** into the hash value using function GG.
 126    md5[b] @  md5[d] @ and
 127    md5[c] @  md5[d] @ -1 xor and
 128    or  md5[a] @  +
 129    GGrotate md5-XX
 130 ;
 131
 132 Create HHrotate 0x04 C, 0x0B C, 0x10 C, 0x17 C,
 133 \ *G lists the four possible rotate values for this function
 134
 135 : md5-HH (  k -- )
 136 \ *G md5-HH  takes 4 octet value k of the message an mangles it
 137 \ ** into the hash value using function HH.
 138    md5[b] @  md5[c] @  md5[d] @  xor  xor
 139    md5[a] @  +
 140    HHrotate md5-XX
 141 ;
 142
 143 Create IIrotate 6 C, 10 C, 15 C, 21 C,
 144 \ *G lists the four possible rotate values for this function
 145
 146 : md5-II (  k -- )
 147 \ *G takes 4 octet value k of the message an mangles it
 148 \ ** into the hash value using function II.
 149    md5[b] @  md5[d] @ -1 xor  or
 150    md5[c] @  xor
 151    md5[a] @  +
 152    IIrotate md5-XX ;
 153
 154 : md5-block             \ c-addr --
 155 \ *G processes a 64 octet block of the message
 156 \ ** Note :
 157 \ ** round 1 - start at 0, add 1 each time
 158 \ ** round 2 - start at 1, add 5 each time
 159 \ ** round 3 - start at 5, add 3 each time
 160 \ ** round 4 - start at 0, add 7 each time
 161    >InputBlock !  0 T# c!
 162    md5[] md5[]saved 0x10 cmove  \ save the key for later
 163    0x00  0x10 for  dup  0x01 + 0x0F and >r  md5-FF  r>  endfor  drop
 164    0x01  0x10 for  dup  0x05 + 0x0F and >r  md5-GG  r>  endfor  drop
 165    0x05  0x10 for  dup  0x03 + 0x0F and >r  md5-HH  r>  endfor  drop
 166    0x00  0x10 for  dup  0x07 + 0x0F and >r  md5-II  r>  endfor  drop
 167    \ add in the saved original key
 168    md5[d]saved @ md5[d] +!  \ d
 169    md5[c]saved @ md5[c] +!  \ c
 170    md5[b]saved @ md5[b] +!  \ b
 171    md5[a]saved @ md5[a] +!  \ a
 172 ;
 173
 174 8 constant bits/char
 175 \ *G the number of bits in a character
 176
 177 0x40 buffer: $pad
 178 \ *G a scratch buffer for up to 64 octets
 179
 180 : md5-final     \ c-addr u len -- ; Note that u < 64
 181 \ *G processes the final part of the message
 182 \ ** Note that MD5 specifies a message length in bits, but this
 183 \ ** implementation must have a whole number of octets.
 184    ( len ) >r
 185    $pad 0x40 erase
 186    ( c-addr u ) >r  $pad r@ 0 max cmove
 187    128 r@ ( u ) $pad + c!
 188    r> ( u ) 1+ 0x38 < 0= if    \ padding will exceed block
 189       $pad md5-block
 190       $pad 0x40 erase
 191    then
 192    r> ( len ) bits/char *  $pad 0x38 + LE!
 193    0x00 $pad 0x3C + LE!
 194    $pad md5-block
 195 ;
 196
 197 : InitMD5[]
 198 \ *G puts the initial values into the md5[] array as specified by the RFC
 199    0x67452301 md5[a] !
 200    0xEFCDAB89 md5[b] !
 201    0x98BADCFE md5[c] !
 202    0x10325476 md5[d] !
 203 ;
 204
 205 ((
 206 : /STRING ( a n n2 - a n )
 207 \ *G removes n2 bytes from the start of string a n
 208    >r r@ - 0 max  swap r> + swap
 209 ;
 210 ))
 211
 212 : md5           \  c-addr len --
 213 \ *G convert the string of length len at c-addr to its MD5 hash
 214 \ ** the result is in the md5[x] array
 215    dup >r               \ save len for later
 216    InitMD5[]
 217    begin                \ c-addr len -- ; process 64 octets at a time
 218       dup 64 < 0=
 219    while                \ c-addr u --
 220       over              \ c-addr --
 221       md5-block         \ process 64 octets of the input string
 222       0x40 /STRING        \ remove the first 64 octets from the string
 223    repeat               \ c-addr u ; process the remainder of the input
 224    r>                   \ c-addr u len --
 225    md5-final            \ process the remainder of the input string
 226 ;
 227
 228 previous definitions
 229
 230
 231 ( MD5-SELF-TESTS) false [IF]
 232 \ ******************
 233 \ *S Test functions
 234 \ ******************
 235
 236 \ *G big Endian 32 bit @
 237 : BE@ @ bswap-dword ;
 238
 239 : md5[]>stack   \ -- a b c d
 240 \ *G get the md5 data in the local endian format in BigEndian
 241    md5sum:md5[a] BE@
 242    md5sum:md5[b] BE@
 243    md5sum:md5[c] BE@
 244    md5sum:md5[d] BE@
 245 ;
 246
 247 : md5[]>$       \ -- a n
 248 \ *G fetches the MD5 hash result from the array and formats it as a string.
 249 \ ** Note that the string is NOT in LittleEndian format.
 250 \ ** It is in the same format as the test strings...
 251    base @ >r hex
 252    md5[]>stack 0 0
 253    <#   4 for  2drop 0  # # # # # # # #  endfor  #>
 254     r> base !
 255 ;
 256
 257 : .md5          \ --
 258 \ *G displays the MD5 hash result array
 259    md5[]>$ type ;
 260
 261 : mmm           \ c-addr len --
 262 \ *G display the MD5 hash of the string on length len at address c-addr
 263    md5sum:md5  .md5
 264 ;
 265
 266 : md5test               \ c-addr1 u1 c-addr2 u2 --
 267 \ *G takes a string and its pre-calculated MD5 hash,
 268 \ ** and compares this to its own calculation.
 269   cr   >r >r   ." MD5 ("  [char] " emit  2dup type  [char] " EMIT ." ) = "
 270      md5sum:md5 md5[]>$  2dup ( cr  ." Fingerprint : " ) type
 271      r> r>
 272      compare if  ."  !FAILED! "  else  ."  passed "  then
 273 ;
 274
 275 create NULL$  0 , create;
 276 \ *G a null string
 277
 278 : md5tests                 \ --
 279 \ *G runs a standard set of tests to verify the MD5 program
 280    \ PAGE
 281    ." MD5 test suite:" cr
 282    NULL$ 0  S" D41D8CD98F00B204E9800998ECF8427E" md5test
 283    S" a"  S" 0CC175B9C0F1B6A831C399E269772661" md5test
 284    S" abc"  S" 900150983CD24FB0D6963F7D28E17F72" md5test
 285    S" message digest"
 286    S" F96B697D7CB7938D525A2F31AAF161D0" md5test
 287    S" abcdefghijklmnopqrstuvwxyz"
 288    S" C3FCD3D76192E4007DFB496CCA67E13B" md5test
 289    S" ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
 290    S" D174AB98D277D9F5A5611C2C9F419D9F" md5test
 291    S" 12345678901234567890123456789012345678901234567890123456789012345678901234567890"
 292    S" 57EDF4A22BE3C955AC49DA2E2107B67A" md5test
 293 ;
 294
 295 md5tests
 296 .stack
 297 bye
 298 [ENDIF]