\ MD5.fth       HPO  7 Feb 2003

\ 32 bit little endian version of the MD5 algorithm ( i.e. PC ).

\ The endian-ness of the MD5 algorithm is factored out to allow easy

\ conversion to a big-endian system.

\ Tested on VFX PFW and Win32Forth.

\ Local variables are not used.

 

\ **********************************************************************

\ *S Endian specific code

\ ** LE@ and LE! provide the required LittleEndian 4 octet string

\ ** to number conversion for the MD5 algorithm.

\ ** For a string containing hex 44 C, 33 C, 22 C, 11 C,

\ ** LE@ must return 11223344 ( LittleEndian )

\ ** LE! must store the string as shown, in LittleEndian format,

\ ** BE@ must return 44332211 ( BigEndian )

\ ** Define these for your system and the following code should work...

\ **********************************************************************

 

variable big-little

\ *G a temporary 32 bit variable

 

: L<>B          \ u -- u

\ *G convert littleEndian to bigEndian or vice versa

  big-little !  big-little

  dup 3 + c@

  over 2 chars + c@  0x08 Lshift or

  over char+ c@ 0x10 Lshift or

  swap c@ 0x18 Lshift or

;

 

: BE@ ( a - n)

\ *G big Endian 32 bit @

   @ L<>B

;

((

: BE! ( n a )

\ *G big Endian 32 bit !

   >r  L<>B  r> !

;

))

: LE@ ( a - n)

\ *G little Endian 32 bit @

   @

;

 

: LE! ( n a )

\ *G little Endian 32 bit !

   !

;

 

((

\ An alternative implementation :

: BE! ( x addr -- )     \ BigEndian !  for LittleEndian processors

   over 0x0000000FF and              over            c!

   over 0x00000FF00 and 0x08 Rshift  over char+      c!

   over 0x000FF0000 and 0x10 Rshift  over 2 chars +  c!

   swap 0x0FF000000 and 0x18 Rshift  swap 3 chars +  c! ;

 

: BE@ ( addr -- x )     \ BigEndian @  for LittleEndian processors

   dup c@

   over   char+   c@ 0x08 Lshift or

   over 2 chars + c@ 0x10 Lshift or

   swap 3 chars + c@ 0x18 Lshift or

;

))

 

\ *** Endian tests ***

 

: .X9 ( u)   BASE @ >R  HEX  9 U.R  R> BASE ! ;

\ *G display u right justified in a field of 9 characters.

 

Create aNUM  0x44 C, 0x33 C, 0x22 C, 0x11 C,

\ *G a BigEndian number for testing the endian operators

 

: LL1   aNUM LE@ .X9 ;

\ *G must display = 0x11223344

: LL2   aNUM @ .X9 ;

\ *G may display any order e.g. 0x11223344 or 0x44332211, but must match !

: LL3   aNUM BE@ .X9 ;

\ *G must display 0x44332211

 

 

\ *********************************

\ *S The md5 secure hash algorithm

\ *********************************

 

Create Tmagic

\ *G The table of magic numbers = ( 2** 32 ) * sin[ x ]

\ ** where x goes from 1 to 64 radians.

(  1 ) 0xD76AA478 , 0xE8C7B756 , 0x242070DB , 0xC1BDCEEE ,

(  5 ) 0xF57C0FAF , 0x4787C62A , 0xA8304613 , 0xFD469501 ,

(  9 ) 0x698098D8 , 0x8B44F7AF , 0xFFFF5BB1 , 0x895CD7BE ,

( 13 ) 0x6B901122 , 0xFD987193 , 0xA679438E , 0x49B40821 ,

( 17 ) 0xF61E2562 , 0xC040B340 , 0x265E5A51 , 0xE9B6C7AA ,

( 21 ) 0xD62F105D , 0x02441453 , 0xD8A1E681 , 0xE7D3FBC8 ,

( 25 ) 0x21E1CDE6 , 0xC33707D6 , 0xF4D50D87 , 0x455A14ED ,

( 29 ) 0xA9E3E905 , 0xFCEFA3F8 , 0x676F02D9 , 0x8D2A4C8A ,

( 33 ) 0xFFFA3942 , 0x8771F681 , 0x6D9D6122 , 0xFDE5380C ,

( 37 ) 0xA4BEEA44 , 0x4BDECFA9 , 0xF6BB4B60 , 0xBEBFBC70 ,

( 41 ) 0x289B7EC6 , 0xEAA127FA , 0xD4EF3085 , 0x04881D05 ,

( 45 ) 0xD9D4D039 , 0xE6DB99E5 , 0x1FA27CF8 , 0xC4AC5665 ,

( 49 ) 0xF4292244 , 0x432AFF97 , 0xAB9423A7 , 0xFC93A039 ,

( 53 ) 0x655B59C3 , 0x8F0CCC92 , 0xFFEFF47D , 0x85845DD1 ,

( 57 ) 0x6FA87E4F , 0xFE2CE6E0 , 0xA3014314 , 0x4E0811A1 ,

( 61 ) 0xF7537E82 , 0xBD3AF235 , 0x2AD7D2BB , 0xEB86D391 ,

 

variable >InputBlock

\ *G points to current 64 octet string to process

 

variable T#

\ *G a counter to select table entries - could be a Cvariable

 

variable md5[] 0x10 allot

\ *G the md5 result array

\ ** An initial value is put in here which is mangled by the message to

\ ** give a one-way function md5 secure hash key.

md5[] 0x00 + constant md5[a]      \ accessed by name

md5[] 0x04 + constant md5[b]

md5[] 0x08 + constant md5[c]

md5[] 0x0C + constant md5[d]

 

variable md5[]saved 0x10 allot

\ *G a saved copy of md5[] result array for adding in at the

\ ** end of the computation.

md5[]saved 0x00 + constant md5[a]saved  \ accessed by name

md5[]saved 0x04 + constant md5[b]saved

md5[]saved 0x08 + constant md5[c]saved

md5[]saved 0x0C + constant md5[d]saved

 

: .md5[]                \ --

\ *G display the md5 result array

   cr ." >>> "  base @ >r  hex

   md5[] 0x10 over + swap do  I c@ 3 U.R  loop  r> base ! ;

 

: Lrotate                \ x1 u -- x2

\ *G cyclicly rotate the 32 Bit word x1 left u bits

\ ** i.e put the MSB into the LSB when it drops of the left hand end.

   2dup Lshift >r 32 swap - Rshift  r> or

;

 

: md5-XX                \ k u a --

\ *G the common part of the FF, GG, HH and II functions

   >r  swap

   ( add one of the 64 input string octets to process )

   ( k ) 4 * >InputBlock @ + LE@  ( u ) +   \ Note Little Endian @

   ( add number from table) Tmagic T# c@ 4 * + @  +

   ( rotate the bits using the XXrotate table)

      r> ( a ) T# c@ 3 and + c@ Lrotate

   ( add this 32 bit word)  md5[b] @ +

   ( roll the key around) md5[d] @ ( * ) md5[c] @ md5[d] !

   md5[b] @ md5[c] !

   \  md5[a] @ md5[b] !  \ overwritten 2 lines below :

   ( * ) md5[a] !

   ( replace this 32 bit word)  md5[b] !

   ( next time use next magic number and rotate table entries)

   1 T# C+!

;

 

Create FFrotate 0x07 C, 0x0C C, 0x11 C, 0x16 C,

\ *G lists the four possible rotate values for this function

 

: md5-FF        \  k --

\ *G takes 4 octet value k of the message and mangles it

\ ** into the hash value using function FF.

   md5[c] @   md5[b] @ and

   md5[d] @   md5[b] @ -1 xor   and

   or  md5[a] @  +

   FFrotate md5-XX

;

 

Create GGrotate 0x05 C, 0x09 C, 0x0E C, 0x14 C,

\ *G lists the four possible rotate values for this function

 

: md5-GG        \ k --

\ *G md5-GG  takes 4 octet value k of the message an mangles it

\ ** into the hash value using function GG.

   md5[b] @  md5[d] @ and

   md5[c] @  md5[d] @ -1 xor and

   or  md5[a] @  +

   GGrotate md5-XX

;

 

Create HHrotate 0x04 C, 0x0B C, 0x10 C, 0x17 C,

\ *G lists the four possible rotate values for this function

 

: md5-HH (  k -- )

\ *G md5-HH  takes 4 octet value k of the message an mangles it

\ ** into the hash value using function HH.

   md5[b] @  md5[c] @  md5[d] @  xor  xor

   md5[a] @  +

   HHrotate md5-XX

;

 

Create IIrotate 6 C, 10 C, 15 C, 21 C,

\ *G lists the four possible rotate values for this function

 

: md5-II (  k -- )

\ *G takes 4 octet value k of the message an mangles it

\ ** into the hash value using function II.

   md5[b] @  md5[d] @ -1 xor  or

   md5[c] @  xor

   md5[a] @  +

   IIrotate md5-XX ;

 

: md5-block             \ c-addr --

\ *G processes a 64 octet block of the message

\ ** Note :

\ ** round 1 - start at 0, add 1 each time

\ ** round 2 - start at 1, add 5 each time

\ ** round 3 - start at 5, add 3 each time

\ ** round 4 - start at 0, add 7 each time

   >InputBlock !  0 T# c!

   md5[] md5[]saved 0x10 cmove  \ save the key for later

   0x00  0x10 0x00 do  dup  0x01 + 0x0F and >r  md5-FF  r>  loop  drop

   0x01  0x10 0x00 do  dup  0x05 + 0x0F and >r  md5-GG  r>  loop  drop

   0x05  0x10 0x00 do  dup  0x03 + 0x0F and >r  md5-HH  r>  loop  drop

   0x00  0x10 0x00 do  dup  0x07 + 0x0F and >r  md5-II  r>  loop  drop

   \ add in the saved original key

   md5[d]saved @ md5[d] +!  \ d

   md5[c]saved @ md5[c] +!  \ c

   md5[b]saved @ md5[b] +!  \ b

   md5[a]saved @ md5[a] +!  \ a

;

 

8 constant bits/char

\ *G the number of bits in a character

 

variable $pad 0x40 allot

\ *G a scratch buffer for up to 64 octets

 

: md5-final     \ c-addr u len -- ; Note that u < 64

\ *G processes the final part of the message

\ ** Note that MD5 specifies a message length in bits, but this

\ ** implementation must have a whole number of octets.

   ( len ) >r

   $pad 0x40 erase

   ( c-addr u ) >r  $pad r@ cmove

   128 r@ ( u ) $pad + c!

   r> ( u ) 1+ 0x38 < 0= if    \ padding will exceed block

      $pad md5-block

      $pad 0x40 erase

   then

   r> ( len ) bits/char *  $pad 0x38 + LE!

   0x00 $pad 0x3C + LE!

   $pad md5-block

;

 

: InitMD5[]

\ *G puts the initial values into the md5[] array as specified by the RFC

   0x67452301 md5[a] !

   0xEFCDAB89 md5[b] !

   0x98BADCFE md5[c] !

   0x10325476 md5[d] !

;

 

((

: /STRING ( a n n2 - a n )

\ *G removes n2 bytes from the start of string a n

   >r r@ - 0 max  swap r> + swap

;

))

 

: md5           \  c-addr len --

\ *G convert the string of length len at c-addr to its MD5 hash

\ ** the result is in the md5[x] array

   dup >r               \ save len for later

   InitMD5[]

   begin                \ c-addr len -- ; process 64 octets at a time

      dup 64 < 0=

   while                \ c-addr u --

      over              \ c-addr --

      md5-block         \ process 64 octets of the input string

      0x40 /STRING        \ remove the first 64 octets from the string

   repeat               \ c-addr u ; process the remainder of the input

   r>                   \ c-addr u len --

   md5-final            \ process the remainder of the input string

;

 

\ ******************

\ *S Test functions

\ ******************

 

: md5[]>stack   \ -- a b c d

\ *G get the md5 data in the local endian format in BigEndian

   md5[a] BE@

   md5[b] BE@

   md5[c] BE@

   md5[d] BE@

;

 

: md5[]>$       \ -- a n

\ *G fetches the MD5 hash result from the array and formats it as a string.

\ ** Note that the string is NOT in LittleEndian format.

\ ** It is in the same format as the test strings...

   base @ >r hex

   md5[]>stack 0 0

   <#   4 0 do  2drop 0  # # # # # # # #  loop  #>

    r> base !

;

 

: .md5          \ --

\ *G displays the MD5 hash result array

   md5[]>$ type ;

 

: mmm           \ c-addr len --

\ *G display the MD5 hash of the string on length len at address c-addr

   md5  .md5

;

 

: md5test               \ c-addr1 u1 c-addr2 u2 --

\ *G takes a string and its pre-calculated MD5 hash,

\ ** and compares this to its own calculation.

  cr   >r >r   ." MD5 ("  [char] " emit  2dup type  [char] " EMIT ." ) = "

     md5 md5[]>$  2dup ( cr  ." Fingerprint : " ) type

     r> r>

     cr  compare if  ."  FAILED "  else  ."  passed "  then

;

 

variable NULL$  0 NULL$ !

\ *G a null string

 

: md5tests                 \ --

\ *G runs a standard set of tests to verify the MD5 program

   PAGE ." MD5 test suite:" cr

   NULL$ 0  S" D41D8CD98F00B204E9800998ECF8427E" md5test

   S" a"  S" 0CC175B9C0F1B6A831C399E269772661" md5test

   S" abc"  S" 900150983CD24FB0D6963F7D28E17F72" md5test

   S" message digest"

   S" F96B697D7CB7938D525A2F31AAF161D0" md5test

   S" abcdefghijklmnopqrstuvwxyz"

   S" C3FCD3D76192E4007DFB496CCA67E13B" md5test

   S" ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"

   S" D174AB98D277D9F5A5611C2C9F419D9F" md5test

   S" 12345678901234567890123456789012345678901234567890123456789012345678901234567890"

   S" 57EDF4A22BE3C955AC49DA2E2107B67A" md5test

;

 

md5tests