/
hato-md5.scm
358 lines (324 loc) · 16.3 KB
/
hato-md5.scm
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
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
;;;; hato-md5.scm -- md5 implementation
;;
;; Copyright (c) 2009 Alex Shinn. All rights reserved.
;; BSD-style license: http://synthcode.com/license.txt
(module hato-md5
(md5-digest md5-digest-file)
(import scheme chicken extras)
(define (extract-byte n i)
(bitwise-and #xFF (arithmetic-shift n (* i -8))))
(define (string-u16-ref str i)
(+ (char->integer (string-ref str i))
(arithmetic-shift (char->integer (string-ref str (+ i 1))) 8)))
(define (string-byte-set! str i n)
(string-set! str i (integer->char n)))
(define (hex n)
(if (< n 16)
(string-append "0" (number->string n 16))
(number->string n 16)))
(define (number->u16-string n)
(string-append (hex (extract-byte n 0)) (hex (extract-byte n 1))))
;; 3. MD5 Algorithm Description
;; We begin by supposing that we have a b-bit message as input, and that
;; we wish to find its message digest. Here b is an arbitrary
;; nonnegative integer; b may be zero, it need not be a multiple of
;; eight, and it may be arbitrarily large. We imagine the bits of the
;; message written down as follows:
;; m_0 m_1 ... m_{b-1}
;; The following five steps are performed to compute the message digest
;; of the message.
;; 3.1 Step 1. Append Padding Bits
;; The message is "padded" (extended) so that its length (in bits) is
;; congruent to 448, modulo 512. That is, the message is extended so
;; that it is just 64 bits shy of being a multiple of 512 bits long.
;; Padding is always performed, even if the length of the message is
;; already congruent to 448, modulo 512.
;; Padding is performed as follows: a single "1" bit is appended to the
;; message, and then "0" bits are appended so that the length in bits of
;; the padded message becomes congruent to 448, modulo 512. In all, at
;; least one bit and at most 512 bits are appended.
;; 3.2 Step 2. Append Length
;; A 64-bit representation of b (the length of the message before the
;; padding bits were added) is appended to the result of the previous
;; step. In the unlikely event that b is greater than 2^64, then only
;; the low-order 64 bits of b are used. (These bits are appended as two
;; 32-bit words and appended low-order word first in accordance with the
;; previous conventions.)
;; At this point the resulting message (after padding with bits and with
;; b) has a length that is an exact multiple of 512 bits. Equivalently,
;; this message has a length that is an exact multiple of 16 (32-bit)
;; words. Let M[0 ... N-1] denote the words of the resulting message,
;; where N is a multiple of 16.
;; 3.3 Step 3. Initialize MD Buffer
;; A four-word buffer (A,B,C,D) is used to compute the message digest.
;; Here each of A, B, C, D is a 32-bit register. These registers are
;; initialized to the following values in hexadecimal, low-order bytes
;; first):
;; word A: 01 23 45 67
;; word B: 89 ab cd ef
;; word C: fe dc ba 98
;; word D: 76 54 32 10
;; 3.4 Step 4. Process Message in 16-Word Blocks
;; We first define four auxiliary functions that each take as input
;; three 32-bit words and produce as output one 32-bit word.
;; F(X,Y,Z) = XY v not(X) Z
;; G(X,Y,Z) = XZ v Y not(Z)
;; H(X,Y,Z) = X xor Y xor Z
;; I(X,Y,Z) = Y xor (X v not(Z))
;; (define T
;; (do ((i 64 (- i 1))
;; (ls '()
;; (cons (u32 (inexact->exact (truncate (* 4294967296 (abs (sin i))))))
;; ls)))
;; ((< i 0) (list->vector ls))))
(define T
'#(0 0 #xd76a #xa478 #xe8c7 #xb756 #x2420 #x70db #xc1bd #xceee
#xf57c #x0faf #x4787 #xc62a #xa830 #x4613 #xfd46 #x9501 #x6980 #x98d8
#x8b44 #xf7af #xffff #x5bb1 #x895c #xd7be #x6b90 #x1122 #xfd98 #x7193
#xa679 #x438e #x49b4 #x0821 #xf61e #x2562 #xc040 #xb340 #x265e #x5a51
#xe9b6 #xc7aa #xd62f #x105d #x0244 #x1453 #xd8a1 #xe681 #xe7d3 #xfbc8
#x21e1 #xcde6 #xc337 #x07d6 #xf4d5 #x0d87 #x455a #x14ed #xa9e3 #xe905
#xfcef #xa3f8 #x676f #x02d9 #x8d2a #x4c8a #xfffa #x3942 #x8771 #xf681
#x6d9d #x6122 #xfde5 #x380c #xa4be #xea44 #x4bde #xcfa9 #xf6bb #x4b60
#xbebf #xbc70 #x289b #x7ec6 #xeaa1 #x27fa #xd4ef #x3085 #x0488 #x1d05
#xd9d4 #xd039 #xe6db #x99e5 #x1fa2 #x7cf8 #xc4ac #x5665 #xf429 #x2244
#x432a #xff97 #xab94 #x23a7 #xfc93 #xa039 #x655b #x59c3 #x8f0c #xcc92
#xffef #xf47d #x8584 #x5dd1 #x6fa8 #x7e4f #xfe2c #xe6e0 #xa301 #x4314
#x4e08 #x11a1 #xf753 #x7e82 #xbd3a #xf235 #x2ad7 #xd2bb #xeb86 #xd391))
;; In each bit position F acts as a conditional: if X then Y else Z.
;; The function F could have been defined using + instead of v since XY
;; and not(X)Z will never have 1's in the same bit position.) It is
;; interesting to note that if the bits of X, Y, and Z are independent
;; and unbiased, the each bit of F(X,Y,Z) will be independent and
;; unbiased.
;; The functions G, H, and I are similar to the function F, in that they
;; act in "bitwise parallel" to produce their output from the bits of X,
;; Y, and Z, in such a manner that if the corresponding bits of X, Y,
;; and Z are independent and unbiased, then each bit of G(X,Y,Z),
;; H(X,Y,Z), and I(X,Y,Z) will be independent and unbiased. Note that
;; the function H is the bit-wise "xor" or "parity" function of its
;; inputs.
;; This step uses a 64-element table T[1 ... 64] constructed from the
;; sine function. Let T[i] denote the i-th element of the table, which
;; is equal to the integer part of 4294967296 times abs(sin(i)), where i
;; is in radians. The elements of the table are given in the appendix.
(define (md5-digest src)
(let ((in (if (string? src) (open-input-string src) src))
(buf (make-string 64))
(vec (make-vector 32))
(A1 #x6745) (A0 #x2301)
(B1 #xefcd) (B0 #xab89)
(C1 #x98ba) (C0 #xdcfe)
(D1 #x1032) (D0 #x5476))
;; Process each 16-word block.
(let lp ((i 0) (pad (integer->char #x80)))
(let ((n (read-string! 64 buf in)))
(cond
((< n 64) ;; pad
(let ((len (* 8 (+ i n))))
(string-set! buf n pad)
(do ((j (+ n 1) (+ j 1))) ((>= j 64))
(string-set! buf j (integer->char 0)))
(cond
((< n 56)
(string-byte-set! buf 56 (extract-byte len 0))
(string-byte-set! buf 57 (extract-byte len 1))
(string-byte-set! buf 58 (extract-byte len 2))
(string-byte-set! buf 59 (extract-byte len 3))
;;(string-byte-set! buf 60 (extract-byte len 4))
;;(string-byte-set! buf 61 (extract-byte len 5))
;;(string-byte-set! buf 62 (extract-byte len 6))
;;(string-byte-set! buf 63 (extract-byte len 7))
)))))
;; Copy block i into X.
(do ((j 0 (+ j 1)))
((= j 16))
(vector-set! vec (* j 2) (string-u16-ref buf (* j 4)))
(vector-set! vec (+ (* j 2) 1) (string-u16-ref buf (+ (* j 4) 2))))
;; Save A as AA, B as BB, C as CC, and D as DD.
(let ((AA0 A0) (AA1 A1)
(BB0 B0) (BB1 B1)
(CC0 C0) (CC1 C1)
(DD0 D0) (DD1 D1)
(T1 0) (T0 0))
(letrec-syntax
((add
(syntax-rules ()
((add d1 d0 a1 a0 b1 b0)
(begin
(set! d0 (+ a0 b0))
(set! d1 (bitwise-and
(+ a1 b1 (arithmetic-shift d0 -16))
#xFFFF))
(set! d0 (bitwise-and d0 #xFFFF))))))
(rot
(syntax-rules ()
((rot d1 d0 a1 a0 s)
(let ((tmp a1))
(set! d1 (bitwise-and
(bitwise-ior (arithmetic-shift a1 s)
(arithmetic-shift a1 (- s 32))
(arithmetic-shift a0 (- s 16)))
#xFFFF))
(set! d0 (bitwise-and
(bitwise-ior (arithmetic-shift a0 s)
(arithmetic-shift a0 (- s 32))
(arithmetic-shift tmp (- s 16)))
#xFFFF))))))
(bit-not
(syntax-rules ()
((bit-not a) (- (expt 2 16) a 1))))
(FF
(syntax-rules ()
((FF d1 d0 x1 x0 y1 y0 z1 z0)
(begin
(set! d1 (bitwise-ior (bitwise-and x1 y1)
(bitwise-and (bit-not x1) z1)))
(set! d0 (bitwise-ior (bitwise-and x0 y0)
(bitwise-and (bit-not x0) z0)))
))))
(GG
(syntax-rules ()
((GG d1 d0 x1 x0 y1 y0 z1 z0)
(begin
(set! d1 (bitwise-ior (bitwise-and x1 z1)
(bitwise-and y1 (bit-not z1))))
(set! d0 (bitwise-ior (bitwise-and x0 z0)
(bitwise-and y0 (bit-not z0))))
))))
(HH
(syntax-rules ()
((HH d1 d0 x1 x0 y1 y0 z1 z0)
(begin (set! d1 (bitwise-xor x1 y1 z1))
(set! d0 (bitwise-xor x0 y0 z0))))))
(II
(syntax-rules ()
((II d1 d0 x1 x0 y1 y0 z1 z0)
(begin
(set! d1 (bitwise-xor y1 (bitwise-ior x1 (bit-not z1))))
(set! d0 (bitwise-xor y0 (bitwise-ior x0 (bit-not z0))))
))))
(R
(syntax-rules ()
((R op T1 T0 a1 a0 b1 b0 c1 c0 d1 d0 vec k s i)
(begin
(op T1 T0 b1 b0 c1 c0 d1 d0)
(add T1 T0 T1 T0
(vector-ref vec (+ (* k 2) 1))
(vector-ref vec (* k 2)))
(add T1 T0 T1 T0
(vector-ref T (* i 2))
(vector-ref T (+ (* i 2) 1)))
(add a1 a0 a1 a0 T1 T0)
(rot a1 a0 a1 a0 s)
(add a1 a0 a1 a0 b1 b0)))))
(R1 (syntax-rules ()
((R1 T1 T0 a1 a0 b1 b0 c1 c0 d1 d0 vec k s i)
(R FF T1 T0 a1 a0 b1 b0 c1 c0 d1 d0 vec k s i))))
(R2 (syntax-rules ()
((R2 T1 T0 a1 a0 b1 b0 c1 c0 d1 d0 vec k s i)
(R GG T1 T0 a1 a0 b1 b0 c1 c0 d1 d0 vec k s i))))
(R3 (syntax-rules ()
((R3 T1 T0 a1 a0 b1 b0 c1 c0 d1 d0 vec k s i)
(R HH T1 T0 a1 a0 b1 b0 c1 c0 d1 d0 vec k s i))))
(R4 (syntax-rules ()
((R4 T1 T0 a1 a0 b1 b0 c1 c0 d1 d0 vec k s i)
(R II T1 T0 a1 a0 b1 b0 c1 c0 d1 d0 vec k s i)))))
;; Round 1: Let [abcd k s i] denote the operation
;; a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
(R1 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 0 7 1)
(R1 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 1 12 2)
(R1 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 2 17 3)
(R1 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 3 22 4)
(R1 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 4 7 5)
(R1 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 5 12 6)
(R1 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 6 17 7)
(R1 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 7 22 8)
(R1 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 8 7 9)
(R1 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 9 12 10)
(R1 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 10 17 11)
(R1 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 11 22 12)
(R1 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 12 7 13)
(R1 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 13 12 14)
(R1 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 14 17 15)
(R1 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 15 22 16)
;; Round 2: Let [abcd k s i] denote the operation
;; a = b + ((a + G(b,c,d) + X[k] + T[i]) <<< s)
(R2 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 1 5 17)
(R2 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 6 9 18)
(R2 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 11 14 19)
(R2 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 0 20 20)
(R2 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 5 5 21)
(R2 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 10 9 22)
(R2 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 15 14 23)
(R2 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 4 20 24)
(R2 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 9 5 25)
(R2 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 14 9 26)
(R2 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 3 14 27)
(R2 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 8 20 28)
(R2 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 13 5 29)
(R2 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 2 9 30)
(R2 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 7 14 31)
(R2 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 12 20 32)
;; Round 3: Let [abcd k s i] denote the operation
;; a = b + ((a + H(b,c,d) + X[k] + T[i]) <<< s)
(R3 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 5 4 33)
(R3 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 8 11 34)
(R3 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 11 16 35)
(R3 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 14 23 36)
(R3 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 1 4 37)
(R3 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 4 11 38)
(R3 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 7 16 39)
(R3 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 10 23 40)
(R3 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 13 4 41)
(R3 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 0 11 42)
(R3 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 3 16 43)
(R3 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 6 23 44)
(R3 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 9 4 45)
(R3 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 12 11 46)
(R3 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 15 16 47)
(R3 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 2 23 48)
;; Round 4: Let [abcd k s i] denote the operation
;; a = b + ((a + I(b,c,d) + X[k] + T[i]) <<< s)
(R4 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 0 6 49)
(R4 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 7 10 50)
(R4 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 14 15 51)
(R4 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 5 21 52)
(R4 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 12 6 53)
(R4 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 3 10 54)
(R4 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 10 15 55)
(R4 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 1 21 56)
(R4 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 8 6 57)
(R4 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 15 10 58)
(R4 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 6 15 59)
(R4 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 13 21 60)
(R4 T1 T0 A1 A0 B1 B0 C1 C0 D1 D0 vec 4 6 61)
(R4 T1 T0 D1 D0 A1 A0 B1 B0 C1 C0 vec 11 10 62)
(R4 T1 T0 C1 C0 D1 D0 A1 A0 B1 B0 vec 2 15 63)
(R4 T1 T0 B1 B0 C1 C0 D1 D0 A1 A0 vec 9 21 64)
;; Then in increment each of the four registers by the
;; value it had before this block was started.
(add A1 A0 A1 A0 AA1 AA0)
(add B1 B0 B1 B0 BB1 BB0)
(add C1 C0 C1 C0 CC1 CC0)
(add D1 D0 D1 D0 DD1 DD0)
(cond
((< n 64)
(if (>= n 56)
(lp (+ i n) (integer->char 0))
(string-append
(number->u16-string A0) (number->u16-string A1)
(number->u16-string B0) (number->u16-string B1)
(number->u16-string C0) (number->u16-string C1)
(number->u16-string D0) (number->u16-string D1))))
(else
(lp (+ i 64) pad)))))))))
(define (md5-digest-file file)
(call-with-input-file file md5-digest))
;; 3.5 Step 5. Output
;; The message digest produced as output is A, B, C, D. That is, we
;; begin with the low-order byte of A, and end with the high-order byte
;; of D.
;; This completes the description of MD5. A reference implementation in
;; C is given in the appendix.
)