1 ! Copyright (C) 2006, 2008 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.data byte-arrays checksums
4 checksums.common combinators grouping hints kernel
5 kernel.private literals math math.bitwise
6 math.functions sequences sequences.private specialized-arrays ;
7 SPECIALIZED-ARRAY: uint
12 INSTANCE: md5 block-checksum
14 TUPLE: md5-state < block-checksum-state
16 { old-state uint-array } ;
18 : <md5-state> ( -- md5 )
19 md5-state new-checksum-state
21 uint-array{ 0x67452301 0xefcdab89 0x98badcfe 0x10325476 }
22 [ clone >>state ] [ >>old-state ] bi ;
24 M: md5 initialize-checksum-state drop <md5-state> ;
28 : update-md5 ( md5 -- )
29 [ state>> ] [ old-state>> [ w+ ] 2map dup clone ] [ ] tri
30 [ old-state<< ] [ state<< ] bi ; inline
33 80 <iota> [ sin abs 32 2^ * >integer ] uint-array{ } map-as
36 :: F ( X Y Z -- FXYZ )
37 ! F(X,Y,Z) = XY v not(X) Z
38 X Y bitand X bitnot Z bitand bitor ; inline
40 :: G ( X Y Z -- GXYZ )
41 ! G(X,Y,Z) = XZ v Y not(Z)
42 X Z bitand Y Z bitnot bitand bitor ; inline
45 ! H(X,Y,Z) = X xor Y xor Z
46 bitxor bitxor ; inline
48 :: I ( X Y Z -- IXYZ )
49 ! I(X,Y,Z) = Y xor (X v not(Z))
50 Z bitnot X bitor Y bitxor ; inline
74 :: (ABCD) ( x state a b c d k s i quot -- )
75 ! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
79 d state nth-unsafe quot call w+
84 ] change-nth-unsafe ; inline
86 MACRO: with-md5-round ( ops quot -- quot )
87 '[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ;
89 : (process-md5-block-F) ( block state -- )
90 { uint-array uint-array } declare {
101 [ c d a b 10 S13 11 ]
102 [ b c d a 11 S14 12 ]
103 [ a b c d 12 S11 13 ]
104 [ d a b c 13 S12 14 ]
105 [ c d a b 14 S13 15 ]
106 [ b c d a 15 S14 16 ]
107 } [ F ] with-md5-round ;
109 : (process-md5-block-G) ( block state -- )
110 { uint-array uint-array } declare {
113 [ c d a b 11 S23 19 ]
116 [ d a b c 10 S22 22 ]
117 [ c d a b 15 S23 23 ]
120 [ d a b c 14 S22 26 ]
123 [ a b c d 13 S21 29 ]
126 [ b c d a 12 S24 32 ]
127 } [ G ] with-md5-round ;
129 : (process-md5-block-H) ( block state -- )
130 { uint-array uint-array } declare {
133 [ c d a b 11 S33 35 ]
134 [ b c d a 14 S34 36 ]
138 [ b c d a 10 S34 40 ]
139 [ a b c d 13 S31 41 ]
144 [ d a b c 12 S32 46 ]
145 [ c d a b 15 S33 47 ]
147 } [ H ] with-md5-round ;
149 : (process-md5-block-I) ( block state -- )
150 { uint-array uint-array } declare {
153 [ c d a b 14 S43 51 ]
155 [ a b c d 12 S41 53 ]
157 [ c d a b 10 S43 55 ]
160 [ d a b c 15 S42 58 ]
162 [ b c d a 13 S44 60 ]
164 [ d a b c 11 S42 62 ]
167 } [ I ] with-md5-round ;
169 : byte-array>le ( byte-array -- byte-array )
172 [ [ 1 2 ] dip exchange-unsafe ]
173 [ [ 0 3 ] dip exchange-unsafe ] bi
177 HINTS: byte-array>le byte-array ;
179 M: md5-state checksum-block
181 [ byte-array>le uint cast-array ] [ state>> ] bi* {
182 [ (process-md5-block-F) ]
183 [ (process-md5-block-G) ]
184 [ (process-md5-block-H) ]
185 [ (process-md5-block-I) ]
191 : md5>checksum ( md5 -- bytes )
192 state>> underlying>> byte-array>le ;
196 [ clone ] change-state
197 [ clone ] change-old-state ;
199 M: md5-state get-checksum
201 [ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri
202 [ [ checksum-block ] curry each ] [ md5>checksum ] bi ;