Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2001 Daniel Wang. All rights reserved. |
2 | Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm. | |
3 | *) | |
4 | signature MD5 = | |
5 | sig | |
6 | type md5state | |
7 | (* type slice = (Word8Vector.vector * int * int option) *) | |
8 | val init : md5state | |
9 | (* val updateSlice : (md5state * slice) -> md5state | |
10 | *) | |
11 | val update : (md5state * Word8Vector.vector) -> md5state | |
12 | val final : md5state -> Word8Vector.vector | |
13 | val toHexString : Word8Vector.vector -> string | |
14 | end | |
15 | ||
16 | (* Quick and dirty transliteration of C code *) | |
17 | structure MD5 :> MD5 = | |
18 | struct | |
19 | structure W32 = Word32 | |
20 | structure W8V = | |
21 | struct | |
22 | open Word8Vector | |
23 | fun extract (vec, s, l) = | |
24 | let | |
25 | val n = | |
26 | case l of | |
27 | NONE => length vec - s | |
28 | | SOME i => i | |
29 | in | |
30 | tabulate (n, fn i => sub (vec, s + i)) | |
31 | end | |
32 | end | |
33 | type word64 = {hi:W32.word,lo:W32.word} | |
34 | type word128 = {A:W32.word, B:W32.word, C:W32.word, D:W32.word} | |
35 | type md5state = {digest:word128, | |
36 | mlen:word64, | |
37 | buf:Word8Vector.vector} | |
38 | ||
39 | ||
40 | ||
41 | val w64_zero = ({hi=0w0,lo=0w0}:word64) | |
42 | fun mul8add ({hi,lo},n) = let | |
43 | val mul8lo = W32.<< (W32.fromInt (n),0w3) | |
44 | val mul8hi = W32.>> (W32.fromInt (n),0w29) | |
45 | val lo = W32.+ (lo,mul8lo) | |
46 | val cout = if W32.< (lo,mul8lo) then 0w1 else 0w0 | |
47 | val hi = W32.+ (mul8hi,W32.+ (hi,cout)) | |
48 | in {hi=hi,lo=lo} | |
49 | end | |
50 | ||
51 | fun packLittle wrds = let | |
52 | fun loop [] = [] | |
53 | | loop (w::ws) = let | |
54 | val b0 = Word8.fromLarge (W32.toLarge w) | |
55 | val b1 = Word8.fromLarge (W32.toLarge (W32.>> (w,0w8))) | |
56 | val b2 = Word8.fromLarge (W32.toLarge (W32.>> (w,0w16))) | |
57 | val b3 = Word8.fromLarge (W32.toLarge (W32.>> (w,0w24))) | |
58 | in b0::b1::b2::b3:: (loop ws) | |
59 | end | |
60 | in W8V.fromList (loop wrds) | |
61 | end | |
62 | ||
63 | val S11 = 0w7 | |
64 | val S12 = 0w12 | |
65 | val S13 = 0w17 | |
66 | val S14 = 0w22 | |
67 | val S21 = 0w5 | |
68 | val S22 = 0w9 | |
69 | val S23 = 0w14 | |
70 | val S24 = 0w20 | |
71 | val S31 = 0w4 | |
72 | val S32 = 0w11 | |
73 | val S33 = 0w16 | |
74 | val S34 = 0w23 | |
75 | val S41 = 0w6 | |
76 | val S42 = 0w10 | |
77 | val S43 = 0w15 | |
78 | val S44 = 0w21 | |
79 | ||
80 | fun PADDING i = W8V.tabulate (i,(fn 0 => 0wx80 | _ => 0wx0)) | |
81 | ||
82 | fun F (x,y,z) = W32.orb (W32.andb (x,y), | |
83 | W32.andb (W32.notb x,z)) | |
84 | fun G (x,y,z) = W32.orb (W32.andb (x,z), | |
85 | W32.andb (y,W32.notb z)) | |
86 | fun H (x,y,z) = W32.xorb (x,W32.xorb (y,z)) | |
87 | fun I (x,y,z) = W32.xorb (y,W32.orb (x,W32.notb z)) | |
88 | fun ROTATE_LEFT (x,n) = | |
89 | W32.orb (W32.<< (x,n), W32.>> (x,0w32 - n)) | |
90 | ||
91 | fun XX f (a,b,c,d,x,s,ac) = let | |
92 | val a = W32.+ (a,W32.+ (W32.+ (f (b,c,d),x),ac)) | |
93 | val a = ROTATE_LEFT (a,s) | |
94 | in W32.+ (a,b) | |
95 | end | |
96 | ||
97 | val FF = XX F | |
98 | val GG = XX G | |
99 | val HH = XX H | |
100 | val II = XX I | |
101 | ||
102 | val empty_buf = W8V.tabulate (0,(fn x => raise (Fail "buf"))) | |
103 | val init = {digest= {A=0wx67452301, | |
104 | B=0wxefcdab89, | |
105 | C=0wx98badcfe, | |
106 | D=0wx10325476}, | |
107 | mlen=w64_zero, | |
108 | buf=empty_buf} : md5state | |
109 | ||
110 | fun update ({buf,digest,mlen}:md5state,input) = let | |
111 | val inputLen = W8V.length input | |
112 | val needBytes = 64 - W8V.length buf | |
113 | fun loop (i,digest) = | |
114 | if i + 63 < inputLen then | |
115 | loop (i + 64,transform (digest,i,input)) | |
116 | else (i,digest) | |
117 | val (buf,(i,digest)) = | |
118 | if inputLen >= needBytes then let | |
119 | val buf = W8V.concat [buf,W8V.extract (input,0,SOME needBytes)] | |
120 | val digest = transform (digest,0,buf) | |
121 | in (empty_buf,loop (needBytes,digest)) | |
122 | end | |
123 | else (buf,(0,digest)) | |
124 | val buf = W8V.concat [buf, W8V.extract (input,i,SOME (inputLen-i))] | |
125 | val mlen = mul8add (mlen,inputLen) | |
126 | in {buf=buf,digest=digest,mlen=mlen} | |
127 | end | |
128 | and final (state:md5state) = let | |
129 | val {mlen= {lo,hi},buf,...} = state | |
130 | val bits = packLittle [lo,hi] | |
131 | val index = W8V.length buf | |
132 | val padLen = if index < 56 then 56 - index else 120 - index | |
133 | val state = update (state,PADDING padLen) | |
134 | val {digest= {A,B,C,D},...} = update (state,bits) | |
135 | in packLittle [A,B,C,D] | |
136 | end | |
137 | and transform ({A,B,C,D},i,buf) = let | |
138 | val off = i div PackWord32Little.bytesPerElem | |
139 | fun x (n) = Word32.fromLarge (PackWord32Little.subVec (buf,n + off)) | |
140 | val (a,b,c,d) = (A,B,C,D) | |
141 | (* fetch to avoid range checks *) | |
142 | val x_00 = x (0) val x_01 = x (1) val x_02 = x (2) val x_03 = x (3) | |
143 | val x_04 = x (4) val x_05 = x (5) val x_06 = x (6) val x_07 = x (7) | |
144 | val x_08 = x (8) val x_09 = x (9) val x_10 = x (10) val x_11 = x (11) | |
145 | val x_12 = x (12) val x_13 = x (13) val x_14 = x (14) val x_15 = x (15) | |
146 | ||
147 | val a = FF (a, b, c, d, x_00, S11, 0wxd76aa478) (* 1 *) | |
148 | val d = FF (d, a, b, c, x_01, S12, 0wxe8c7b756) (* 2 *) | |
149 | val c = FF (c, d, a, b, x_02, S13, 0wx242070db) (* 3 *) | |
150 | val b = FF (b, c, d, a, x_03, S14, 0wxc1bdceee) (* 4 *) | |
151 | val a = FF (a, b, c, d, x_04, S11, 0wxf57c0faf) (* 5 *) | |
152 | val d = FF (d, a, b, c, x_05, S12, 0wx4787c62a) (* 6 *) | |
153 | val c = FF (c, d, a, b, x_06, S13, 0wxa8304613) (* 7 *) | |
154 | val b = FF (b, c, d, a, x_07, S14, 0wxfd469501) (* 8 *) | |
155 | val a = FF (a, b, c, d, x_08, S11, 0wx698098d8) (* 9 *) | |
156 | val d = FF (d, a, b, c, x_09, S12, 0wx8b44f7af) (* 10 *) | |
157 | val c = FF (c, d, a, b, x_10, S13, 0wxffff5bb1) (* 11 *) | |
158 | val b = FF (b, c, d, a, x_11, S14, 0wx895cd7be) (* 12 *) | |
159 | val a = FF (a, b, c, d, x_12, S11, 0wx6b901122) (* 13 *) | |
160 | val d = FF (d, a, b, c, x_13, S12, 0wxfd987193) (* 14 *) | |
161 | val c = FF (c, d, a, b, x_14, S13, 0wxa679438e) (* 15 *) | |
162 | val b = FF (b, c, d, a, x_15, S14, 0wx49b40821) (* 16 *) | |
163 | ||
164 | (* Round 2 *) | |
165 | val a = GG (a, b, c, d, x_01, S21, 0wxf61e2562) (* 17 *) | |
166 | val d = GG (d, a, b, c, x_06, S22, 0wxc040b340) (* 18 *) | |
167 | val c = GG (c, d, a, b, x_11, S23, 0wx265e5a51) (* 19 *) | |
168 | val b = GG (b, c, d, a, x_00, S24, 0wxe9b6c7aa) (* 20 *) | |
169 | val a = GG (a, b, c, d, x_05, S21, 0wxd62f105d) (* 21 *) | |
170 | val d = GG (d, a, b, c, x_10, S22, 0wx2441453) (* 22 *) | |
171 | val c = GG (c, d, a, b, x_15, S23, 0wxd8a1e681) (* 23 *) | |
172 | val b = GG (b, c, d, a, x_04, S24, 0wxe7d3fbc8) (* 24 *) | |
173 | val a = GG (a, b, c, d, x_09, S21, 0wx21e1cde6) (* 25 *) | |
174 | val d = GG (d, a, b, c, x_14, S22, 0wxc33707d6) (* 26 *) | |
175 | val c = GG (c, d, a, b, x_03, S23, 0wxf4d50d87) (* 27 *) | |
176 | val b = GG (b, c, d, a, x_08, S24, 0wx455a14ed) (* 28 *) | |
177 | val a = GG (a, b, c, d, x_13, S21, 0wxa9e3e905) (* 29 *) | |
178 | val d = GG (d, a, b, c, x_02, S22, 0wxfcefa3f8) (* 30 *) | |
179 | val c = GG (c, d, a, b, x_07, S23, 0wx676f02d9) (* 31 *) | |
180 | val b = GG (b, c, d, a, x_12, S24, 0wx8d2a4c8a) (* 32 *) | |
181 | ||
182 | (* Round 3 *) | |
183 | val a = HH (a, b, c, d, x_05, S31, 0wxfffa3942) (* 33 *) | |
184 | val d = HH (d, a, b, c, x_08, S32, 0wx8771f681) (* 34 *) | |
185 | val c = HH (c, d, a, b, x_11, S33, 0wx6d9d6122) (* 35 *) | |
186 | val b = HH (b, c, d, a, x_14, S34, 0wxfde5380c) (* 36 *) | |
187 | val a = HH (a, b, c, d, x_01, S31, 0wxa4beea44) (* 37 *) | |
188 | val d = HH (d, a, b, c, x_04, S32, 0wx4bdecfa9) (* 38 *) | |
189 | val c = HH (c, d, a, b, x_07, S33, 0wxf6bb4b60) (* 39 *) | |
190 | val b = HH (b, c, d, a, x_10, S34, 0wxbebfbc70) (* 40 *) | |
191 | val a = HH (a, b, c, d, x_13, S31, 0wx289b7ec6) (* 41 *) | |
192 | val d = HH (d, a, b, c, x_00, S32, 0wxeaa127fa) (* 42 *) | |
193 | val c = HH (c, d, a, b, x_03, S33, 0wxd4ef3085) (* 43 *) | |
194 | val b = HH (b, c, d, a, x_06, S34, 0wx4881d05) (* 44 *) | |
195 | val a = HH (a, b, c, d, x_09, S31, 0wxd9d4d039) (* 45 *) | |
196 | val d = HH (d, a, b, c, x_12, S32, 0wxe6db99e5) (* 46 *) | |
197 | val c = HH (c, d, a, b, x_15, S33, 0wx1fa27cf8) (* 47 *) | |
198 | val b = HH (b, c, d, a, x_02, S34, 0wxc4ac5665) (* 48 *) | |
199 | ||
200 | (* Round 4 *) | |
201 | val a = II (a, b, c, d, x_00, S41, 0wxf4292244) (* 49 *) | |
202 | val d = II (d, a, b, c, x_07, S42, 0wx432aff97) (* 50 *) | |
203 | val c = II (c, d, a, b, x_14, S43, 0wxab9423a7) (* 51 *) | |
204 | val b = II (b, c, d, a, x_05, S44, 0wxfc93a039) (* 52 *) | |
205 | val a = II (a, b, c, d, x_12, S41, 0wx655b59c3) (* 53 *) | |
206 | val d = II (d, a, b, c, x_03, S42, 0wx8f0ccc92) (* 54 *) | |
207 | val c = II (c, d, a, b, x_10, S43, 0wxffeff47d) (* 55 *) | |
208 | val b = II (b, c, d, a, x_01, S44, 0wx85845dd1) (* 56 *) | |
209 | val a = II (a, b, c, d, x_08, S41, 0wx6fa87e4f) (* 57 *) | |
210 | val d = II (d, a, b, c, x_15, S42, 0wxfe2ce6e0) (* 58 *) | |
211 | val c = II (c, d, a, b, x_06, S43, 0wxa3014314) (* 59 *) | |
212 | val b = II (b, c, d, a, x_13, S44, 0wx4e0811a1) (* 60 *) | |
213 | val a = II (a, b, c, d, x_04, S41, 0wxf7537e82) (* 61 *) | |
214 | val d = II (d, a, b, c, x_11, S42, 0wxbd3af235) (* 62 *) | |
215 | val c = II (c, d, a, b, x_02, S43, 0wx2ad7d2bb) (* 63 *) | |
216 | val b = II (b, c, d, a, x_09, S44, 0wxeb86d391) (* 64 *) | |
217 | ||
218 | val A = Word32.+ (A,a) | |
219 | val B = Word32.+ (B,b) | |
220 | val C = Word32.+ (C,c) | |
221 | val D = Word32.+ (D,d) | |
222 | in {A=A,B=B,C=C,D=D} | |
223 | end | |
224 | ||
225 | val hxd = "0123456789abcdef" | |
226 | fun toHexString v = let | |
227 | fun byte2hex (b,acc) = | |
228 | (String.sub (hxd,(Word8.toInt b) div 16)):: | |
229 | (String.sub (hxd,(Word8.toInt b) mod 16))::acc | |
230 | val digits = Word8Vector.foldr byte2hex [] v | |
231 | in String.implode (digits) | |
232 | end | |
233 | end | |
234 | ||
235 | structure Test = | |
236 | struct | |
237 | val tests = | |
238 | [("", "d41d8cd98f00b204e9800998ecf8427e"), | |
239 | ("a", "0cc175b9c0f1b6a831c399e269772661"), | |
240 | ("abc", "900150983cd24fb0d6963f7d28e17f72"), | |
241 | ("message digest", "f96b697d7cb7938d525a2f31aaf161d0"), | |
242 | ("abcdefghijklmnopqrstuvwxyz", "c3fcd3d76192e4007dfb496cca67e13b"), | |
243 | ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789", | |
244 | "d174ab98d277d9f5a5611c2c9f419d9f"), | |
245 | ("12345678901234567890123456789012345678901234567890123456789012345678901234567890", | |
246 | "57edf4a22be3c955ac49da2e2107b67a")] | |
247 | ||
248 | fun do_tests () = let | |
249 | fun f (x,s) = let | |
250 | val mstate = MD5.update (MD5.init,Byte.stringToBytes x) | |
251 | val hash = MD5.final (mstate) | |
252 | in print (" input: "^x^"\n"); | |
253 | print ("expected: "^s^"\n"); | |
254 | print ("produced: "^MD5.toHexString (hash)^"\n") | |
255 | end | |
256 | in List.app f tests | |
257 | end | |
258 | val BLOCK_LEN = 10000 | |
259 | val BLOCK_COUNT = 100000 | |
260 | fun time_test () = let | |
261 | val block = Word8Vector.tabulate (BLOCK_LEN,Word8.fromInt) | |
262 | fun loop (n,s) = | |
263 | if n < BLOCK_COUNT then | |
264 | loop (n+1,MD5.update (s,block)) | |
265 | else s | |
266 | in | |
267 | loop (0,MD5.init) | |
268 | end | |
269 | end | |
270 | ||
271 | structure Main = | |
272 | struct | |
273 | fun doit n = | |
274 | if n = 0 | |
275 | then () | |
276 | else (Test.time_test () | |
277 | ; doit (n - 1)) | |
278 | end |