\ MD5.f 2006 Jan 07 \ 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