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