/pliant/admin/md5.pli
1	# This is Pliant MD5 Message Digest Algorithm implementation
2	# should be conforming to RFC 1321
3	#
4	# Translation to Pliant has been performed by Hubert Tonneau.
5	# Please find below the original C implementation copyright:
6	#
7	# **********************************************************************
8	# ** md5.h -- Header file for implementation of MD5                   **
9	# ** RSA Data Security, Inc. MD5 Message Digest Algorithm             **
10	# ** Created: 2/17/90 RLR                                             **
11	# ** Revised: 12/27/90 SRD,AJ,BSK,JT Reference C version              **
12	# ** Revised (for MD5): RLR 4/27/91                                   **
13	# **   -- G modified to have y&~z instead of y&z                      **
14	# **   -- FF, GG, HH modified to add in last register done            **
15	# **   -- Access pattern: round 2 works mod 5, round 3 works mod 3    **
16	# **   -- distinct additive constant for each step                    **
17	# **   -- round 4 added, working mod 7                                **
18	# **********************************************************************
19	#
20	# **********************************************************************
21	# ** Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. **
22	# **                                                                  **
23	# ** License to copy and use this software is granted provided that   **
24	# ** it is identified as the "RSA Data Security, Inc. MD5 Message     **
25	# ** Digest Algorithm" in all material mentioning or referencing this **
26	# ** software or this function.                                       **
27	# **                                                                  **
28	# ** License is also granted to make and use derivative works         **
29	# ** provided that such works are identified as "derived from the RSA **
30	# ** Data Security, Inc. MD5 Message Digest Algorithm" in all         **
31	# ** material mentioning or referencing the derived work.             **
32	# **                                                                  **
33	# ** RSA Data Security, Inc. makes no representations concerning      **
34	# ** either the merchantability of this software or the suitability   **
35	# ** of this software for any particular purpose.  It is provided "as **
36	# ** is" without express or implied warranty of any kind.             **
37	# **                                                                  **
38	# ** These notices must be retained in any copies of any part of this **
39	# ** documentation and/or software.                                   **
40	# **********************************************************************
41
42
43	module "/pliant/language/unsafe.pli"
44	module "/pliant/language/context.pli"
45	module "/pliant/language/stream.pli"
46
47	type MD5_CTX
48	field (Array uInt32 2) bitscount
49	field (Array uInt32 4) buf
50	field (Array uInt8 64) in
51	field (Array uInt8 16) digest
52
53	constant MD5DigestSize 16
54
55
56
57
58
59	function F x y z -> t
60	arg uInt32 x y z t
61	t := (x .and. y) .or. (.not. x .and. z)
62
63	function G x y z -> t
64	arg uInt32 x y z t
65	t := (x .and. z) .or. (y .and. .not. z)
66
67	function H x y z -> t
68	arg uInt32 x y z t
69	t := x .xor. y .xor. z
70
71	function I x y z -> t
72	arg uInt32 x y z t
73	t := y .xor. (x .or. .not. z)
74
75	function ROTATE_LEFT x n -> r
76	arg uInt32 x ; arg Int n ; arg uInt32 r
77	var Int nn := n%32
78	if nn=0
79	r := x
80	else
81	r := (x .*. 2^nn) .or. (x \ 2^(32-nn))
82	check ((r .*. 2^(32-nn)) .or. (r \ 2^nn))=x
83
84
85	function FF a b c d x s ac
86	arg_rw uInt32 a ; arg uInt32 b c d x ; arg Int s ; arg uInt ac
87	a := a .+. (F b c d) .+. x .+. ac
88	a := ROTATE_LEFT a s
89	a := a .+. b
90
91	function GG a b c d x s ac
92	arg_rw uInt32 a ; arg uInt32 b c d x ; arg Int s ; arg uInt ac
93	a := a .+. (G b c d) .+. x .+. ac
94	a := ROTATE_LEFT a s
95	a := a .+. b
96
97	function HH a b c d x s ac
98	arg_rw uInt32 a ; arg uInt32 b c d x ; arg Int s ; arg uInt ac
99	a := a .+. (H b c d) .+. x .+. ac
100	a := ROTATE_LEFT a s
101	a := a .+. b
102
103	function II a b c d x s ac
104	arg_rw uInt32 a ; arg uInt32 b c d x ; arg Int s ; arg uInt ac
105	a := a .+. (I b c d) .+. x .+. ac
106	a := ROTATE_LEFT a s
107	a := a .+. b
108
109	function Transform buf in
110	arg_rw (Array uInt32 4) buf ; arg (Array uInt32 16) in
111	var uInt32 a := buf 0
112	var uInt32 b := buf 1
113	var uInt32 c := buf 2
114	var uInt32 d := buf 3
115	# round 1
116	constant S11 7
117	constant S12 12
118	constant S13 17
119	constant S14 22
120	FF a b c d in:0 S11 3614090360
121	FF d a b c in:1 S12 3905402710
122	FF c d a b in:2 S13  606105819
123	FF b c d a in:3 S14 3250441966
124	FF a b c d in:4 S11 4118548399
125	FF d a b c in:5 S12 1200080426
126	FF c d a b in:6 S13 2821735955
127	FF b c d a in:7 S14 4249261313
128	FF a b c d in:8 S11 1770035416
129	FF d a b c in:9 S12 2336552879
130	FF c d a b in:10 S13 4294925233
131	FF b c d a in:11 S14 2304563134
132	FF a b c d in:12 S11 1804603682
133	FF d a b c in:13 S12 4254626195
134	FF c d a b in:14 S13 2792965006
135	FF b c d a in:15 S14 1236535329
136	# round 2
137	constant S21 5
138	constant S22 9
139	constant S23 14
140	constant S24 20
141	GG a b c d in:1 S21 4129170786
142	GG d a b c in:6 S22 3225465664
143	GG c d a b in:11 S23  643717713
144	GG b c d a in:0 S24 3921069994
145	GG a b c d in:5 S21 3593408605
146	GG d a b c in:10 S22   38016083
147	GG c d a b in:15 S23 3634488961
148	GG b c d a in:4 S24 3889429448
149	GG a b c d in:9 S21  568446438
150	GG d a b c in:14 S22 3275163606
151	GG c d a b in:3 S23 4107603335
152	GG b c d a in:8 S24 1163531501
153	GG a b c d in:13 S21 2850285829
154	GG d a b c in:2 S22 4243563512
155	GG c d a b in:7 S23 1735328473
156	GG b c d a in:12 S24 2368359562
157	# round 3
158	constant S31 4
159	constant S32 11
160	constant S33 16
161	constant S34 23
162	HH a b c d in:5 S31 4294588738
163	HH d a b c in:8 S32 2272392833
164	HH c d a b in:11 S33 1839030562
165	HH b c d a in:14 S34 4259657740
166	HH a b c d in:1 S31 2763975236
167	HH d a b c in:4 S32 1272893353
168	HH c d a b in:7 S33 4139469664
169	HH b c d a in:10 S34 3200236656
170	HH a b c d in:13 S31  681279174
171	HH d a b c in:0 S32 3936430074
172	HH c d a b in:3 S33 3572445317
173	HH b c d a in:6 S34   76029189
174	HH a b c d in:9 S31 3654602809
175	HH d a b c in:12 S32 3873151461
176	HH c d a b in:15 S33  530742520
177	HH b c d a in:2 S34 3299628645
178	# round 4
179	constant S41 6
180	constant S42 10
181	constant S43 15
182	constant S44 21
183	II a b c d in:0 S41 4096336452
184	II d a b c in:7 S42 1126891415
185	II c d a b in:14 S43 2878612391
186	II b c d a in:5 S44 4237533241
187	II a b c d in:12 S41 1700485571
188	II d a b c in:3 S42 2399980690
189	II c d a b in:10 S43 4293915773
190	II b c d a in:1 S44 2240044497
191	II a b c d in:8 S41 1873313359
192	II d a b c in:15 S42 4264355552
193	II c d a b in:6 S43 2734768916
194	II b c d a in:13 S44 1309151649
195	II a b c d in:4 S41 4149444226
196	II d a b c in:11 S42 3174756917
197	II c d a b in:2 S43  718787259
198	II b c d a in:9 S44 3951481745
199	buf 0 := buf:0 .+. a
200	buf 1 := buf:1 .+. b
201	buf 2 := buf:2 .+. c
202	buf 3 := buf:3 .+. d
203
204	function MD5Init ctx
205	arg_w MD5_CTX ctx
206	implicit ctx
207	bitscount 0 := 0 ; bitscount 1 := 0
208	buf 0 := 067452301h
209	buf 1 := 0EFCDAB89h
210	buf 2 := 098BADCFEh
211	buf 3 := 010325476h
212
213	function MD5Update ctx buffer len
214	arg_rw MD5_CTX ctx ; arg Address buffer ; arg Int len
215	implicit ctx
216	var Int mdi := (bitscount:0\2^3) .and. 3Fh
217	if (bitscount:0 .+. len*2^3)<bitscount:0
218	bitscount:1 += 1
219	bitscount 0 := bitscount:0 .+. len*2^3
220	bitscount 1 := bitscount:1 .+. len\2^29
221	for (var Int u) 0 len-1
222	in mdi := (buffer translate uInt8 u) map uInt8
223	mdi += 1
224	if mdi=64
225	var (Array uInt32 16) temp
226	for (var Int i) 0 15
227	temp i := (in i*4+3)*2^24 .or. (in i*4+2)*2^16 .or. (in i*4+1)*2^8 .or. (in i*4+0)
228	Transform buf temp
229	mdi := 0
230
231
232	function MD5Final ctx
233	arg_rw MD5_CTX ctx
234	implicit ctx
235	var (Array uInt32 16) temp
236	temp 14 := bitscount 0
237	temp 15 := bitscount 1
238	var Int mdi := (bitscount:0\2^3) .and. 3Fh
239	var Str padding := character:80h+(repeat 63 character:0)
240	MD5Update ctx padding:characters (shunt mdi<56 56-mdi 64+56-mdi)
241	var Int mdi := (bitscount:0\2^3) .and. 3Fh
242	for (var Int i) 0 13
243	temp i := (in i*4+3)*2^24 .or. (in i*4+2)*2^16 .or. (in i*4+1)*2^8 .or. (in i*4+0)
244	Transform buf temp
245	for i 0 3
246	for (var Int j) 0 3
247	digest i*4+j := (buf:i\2^(8*j)) .and. 0FFh
248
249
250
251
252
253	function MD5BinarySignature ctx -> sign
254	arg_rw MD5_CTX ctx ; arg Str sign
255	sign := repeat MD5DigestSize " "
256	memory_copy (addressof ctx:digest) sign:characters MD5DigestSize
257
258	function MD5HexaSignature ctx -> hexsign
259	arg_rw MD5_CTX ctx ; arg Str hexsign
260	hexsign := repeat 2*MD5DigestSize " "
261	var Str hexdigits := "0123456789ABCDEF"
262	for (var Int i) 0 MD5DigestSize-1
263	hexsign 2*i := hexdigits ctx:digest:i\16
264	hexsign 2*i+1 := hexdigits ctx:digest:i%16
265
266
267	function string_md5_binary_signature string -> sign
268	arg Str string sign
269	var MD5_CTX ctx
270	MD5Init ctx
271	MD5Update ctx string:characters string:len
272	MD5Final ctx
273	sign := MD5BinarySignature ctx
274
275	function string_md5_hexa_signature string -> hexsign
276	arg Str string hexsign
277	var MD5_CTX ctx
278	MD5Init ctx
279	MD5Update ctx string:characters string:len
280	MD5Final ctx
281	hexsign := MD5HexaSignature ctx
282
283
284	function file_md5_hexa_signature filename -> hexsign
285	arg Str filename hexsign
286	var MD5_CTX ctx
287	MD5Init ctx
288	(var Stream data) open filename in+safe+bigcache
289	while not data:atend
290	data read_available (var Address buffer) (var Int size)
291	MD5Update ctx buffer size
292	data close
293	MD5Final ctx
294	hexsign := MD5HexaSignature ctx
295
296	function file_md5_hexa_signature filename size -> hexsign
297	arg Str filename ; arg Int size ; arg Str hexsign
298	var MD5_CTX ctx
299	MD5Init ctx
300	(var Stream data) open filename in+safe+bigcache
301	var Int size2 := 0
302	while not data:atend
303	data read_available (var Address buffer) (var Int step)
304	MD5Update ctx buffer step
305	size2 += step
306	data close
307	MD5Final ctx
308	hexsign := MD5HexaSignature ctx
309	if size2<>size
310	hexsign := ""
311
312
313	export MD5_CTX MD5Init MD5Update MD5Final MD5BinarySignature MD5HexaSignature
314	export string_md5_binary_signature string_md5_hexa_signature
315	export file_md5_hexa_signature
316
317
318
319
320
321	if pliant_debugging_level>=3
322	if string_md5_hexa_signature:""<>"D41D8CD98F00B204E9800998ECF8427E"
323	error error_id_unexpected "MD5 implementation is buggy"
324	if string_md5_hexa_signature:"This is a sample string"<>"1E55C45D6638B0DBC9B33B8F03CBC4F8"
325	error error_id_unexpected "MD5 implementation is buggy"