1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
9 -- Copyright (C) 2002-2005, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Ada.Unchecked_Conversion;
36 package body GNAT.MD5 is
40 Padding : constant String :=
41 (1 => Character'Val (16#80#), 2 .. 64 => ASCII.NUL);
43 Hex_Digit : constant array (Unsigned_32 range 0 .. 15) of Character :=
44 ('0', '1', '2', '3', '4', '5', '6', '7',
45 '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
46 -- Look-up table for each hex digit of the Message-Digest.
47 -- Used by function Digest (Context).
49 -- The sixten values used to rotate the context words.
50 -- Four for each rounds. Used in procedure Transform.
80 type Sixteen_Words is array (Natural range 0 .. 15)
81 of Interfaces.Unsigned_32;
82 -- Sixteen 32-bit words, converted from block of 64 characters.
83 -- Used in procedure Decode and Transform.
87 X : out Sixteen_Words);
88 -- Convert a String of 64 characters into 16 32-bit numbers
90 -- The following functions (F, FF, G, GG, H, HH, I and II) are the
91 -- equivalent of the macros of the same name in the example
92 -- C implementation in the annex of RFC 1321.
94 function F (X, Y, Z : Unsigned_32) return Unsigned_32;
98 (A : in out Unsigned_32;
99 B, C, D : Unsigned_32;
105 function G (X, Y, Z : Unsigned_32) return Unsigned_32;
109 (A : in out Unsigned_32;
110 B, C, D : Unsigned_32;
116 function H (X, Y, Z : Unsigned_32) return Unsigned_32;
120 (A : in out Unsigned_32;
121 B, C, D : Unsigned_32;
127 function I (X, Y, Z : Unsigned_32) return Unsigned_32;
131 (A : in out Unsigned_32;
132 B, C, D : Unsigned_32;
141 -- Process one block of 64 characters
149 X : out Sixteen_Words)
151 Cur : Positive := Block'First;
154 pragma Assert (Block'Length = 64);
156 for Index in X'Range loop
158 Unsigned_32 (Character'Pos (Block (Cur))) +
159 Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 1))), 8) +
160 Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 2))), 16) +
161 Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 3))), 24);
170 function Digest (C : Context) return Message_Digest is
171 Result : Message_Digest;
174 -- Index in Result where the next character will be placed
176 Last_Block : String (1 .. 64);
180 procedure Convert (X : Unsigned_32);
181 -- Put the contribution of one of the four words (A, B, C, D) of the
182 -- Context in Result. Increments Cur.
188 procedure Convert (X : Unsigned_32) is
189 Y : Unsigned_32 := X;
193 Result (Cur + 1) := Hex_Digit (Y and Unsigned_32'(16#0F#));
194 Y := Shift_Right (Y, 4);
195 Result (Cur) := Hex_Digit (Y and Unsigned_32'(16#0F#));
196 Y := Shift_Right (Y, 4);
201 -- Start of processing for Digest
204 -- Process characters in the context buffer, if any
206 Last_Block (1 .. C.Last) := C.Buffer (1 .. C.Last);
209 Last_Block (C.Last + 1 .. 64) := Padding (1 .. 64 - C.Last);
210 Transform (C1, Last_Block);
211 Last_Block := (others => ASCII.NUL);
214 Last_Block (C.Last + 1 .. 56) := Padding (1 .. 56 - C.Last);
217 -- Add the input length (as stored in the context) as 8 characters
219 Last_Block (57 .. 64) := (others => ASCII.NUL);
222 L : Unsigned_64 := Unsigned_64 (C.Length) * 8;
223 Idx : Positive := 57;
227 Last_Block (Idx) := Character'Val (L and 16#Ff#);
228 L := Shift_Right (L, 8);
233 Transform (C1, Last_Block);
242 function Digest (S : String) return Message_Digest is
250 (A : Ada.Streams.Stream_Element_Array) return Message_Digest
262 function F (X, Y, Z : Unsigned_32) return Unsigned_32 is
264 return (X and Y) or ((not X) and Z);
272 (A : in out Unsigned_32;
273 B, C, D : Unsigned_32;
279 A := A + F (B, C, D) + X + AC;
280 A := Rotate_Left (A, S);
288 function G (X, Y, Z : Unsigned_32) return Unsigned_32 is
290 return (X and Z) or (Y and (not Z));
298 (A : in out Unsigned_32;
299 B, C, D : Unsigned_32;
305 A := A + G (B, C, D) + X + AC;
306 A := Rotate_Left (A, S);
314 function H (X, Y, Z : Unsigned_32) return Unsigned_32 is
316 return X xor Y xor Z;
324 (A : in out Unsigned_32;
325 B, C, D : Unsigned_32;
331 A := A + H (B, C, D) + X + AC;
332 A := Rotate_Left (A, S);
340 function I (X, Y, Z : Unsigned_32) return Unsigned_32 is
342 return Y xor (X or (not Z));
350 (A : in out Unsigned_32;
351 B, C, D : Unsigned_32;
357 A := A + I (B, C, D) + X + AC;
358 A := Rotate_Left (A, S);
372 AA : Unsigned_32 := C.A;
373 BB : Unsigned_32 := C.B;
374 CC : Unsigned_32 := C.C;
375 DD : Unsigned_32 := C.D;
378 pragma Assert (Block'Length = 64);
384 FF (AA, BB, CC, DD, X (00), 16#D76aa478#, S11); -- 1
385 FF (DD, AA, BB, CC, X (01), 16#E8c7b756#, S12); -- 2
386 FF (CC, DD, AA, BB, X (02), 16#242070db#, S13); -- 3
387 FF (BB, CC, DD, AA, X (03), 16#C1bdceee#, S14); -- 4
389 FF (AA, BB, CC, DD, X (04), 16#f57c0faf#, S11); -- 5
390 FF (DD, AA, BB, CC, X (05), 16#4787c62a#, S12); -- 6
391 FF (CC, DD, AA, BB, X (06), 16#a8304613#, S13); -- 7
392 FF (BB, CC, DD, AA, X (07), 16#fd469501#, S14); -- 8
394 FF (AA, BB, CC, DD, X (08), 16#698098d8#, S11); -- 9
395 FF (DD, AA, BB, CC, X (09), 16#8b44f7af#, S12); -- 10
396 FF (CC, DD, AA, BB, X (10), 16#ffff5bb1#, S13); -- 11
397 FF (BB, CC, DD, AA, X (11), 16#895cd7be#, S14); -- 12
399 FF (AA, BB, CC, DD, X (12), 16#6b901122#, S11); -- 13
400 FF (DD, AA, BB, CC, X (13), 16#fd987193#, S12); -- 14
401 FF (CC, DD, AA, BB, X (14), 16#a679438e#, S13); -- 15
402 FF (BB, CC, DD, AA, X (15), 16#49b40821#, S14); -- 16
406 GG (AA, BB, CC, DD, X (01), 16#f61e2562#, S21); -- 17
407 GG (DD, AA, BB, CC, X (06), 16#c040b340#, S22); -- 18
408 GG (CC, DD, AA, BB, X (11), 16#265e5a51#, S23); -- 19
409 GG (BB, CC, DD, AA, X (00), 16#e9b6c7aa#, S24); -- 20
411 GG (AA, BB, CC, DD, X (05), 16#d62f105d#, S21); -- 21
412 GG (DD, AA, BB, CC, X (10), 16#02441453#, S22); -- 22
413 GG (CC, DD, AA, BB, X (15), 16#d8a1e681#, S23); -- 23
414 GG (BB, CC, DD, AA, X (04), 16#e7d3fbc8#, S24); -- 24
416 GG (AA, BB, CC, DD, X (09), 16#21e1cde6#, S21); -- 25
417 GG (DD, AA, BB, CC, X (14), 16#c33707d6#, S22); -- 26
418 GG (CC, DD, AA, BB, X (03), 16#f4d50d87#, S23); -- 27
419 GG (BB, CC, DD, AA, X (08), 16#455a14ed#, S24); -- 28
421 GG (AA, BB, CC, DD, X (13), 16#a9e3e905#, S21); -- 29
422 GG (DD, AA, BB, CC, X (02), 16#fcefa3f8#, S22); -- 30
423 GG (CC, DD, AA, BB, X (07), 16#676f02d9#, S23); -- 31
424 GG (BB, CC, DD, AA, X (12), 16#8d2a4c8a#, S24); -- 32
428 HH (AA, BB, CC, DD, X (05), 16#fffa3942#, S31); -- 33
429 HH (DD, AA, BB, CC, X (08), 16#8771f681#, S32); -- 34
430 HH (CC, DD, AA, BB, X (11), 16#6d9d6122#, S33); -- 35
431 HH (BB, CC, DD, AA, X (14), 16#fde5380c#, S34); -- 36
433 HH (AA, BB, CC, DD, X (01), 16#a4beea44#, S31); -- 37
434 HH (DD, AA, BB, CC, X (04), 16#4bdecfa9#, S32); -- 38
435 HH (CC, DD, AA, BB, X (07), 16#f6bb4b60#, S33); -- 39
436 HH (BB, CC, DD, AA, X (10), 16#bebfbc70#, S34); -- 40
438 HH (AA, BB, CC, DD, X (13), 16#289b7ec6#, S31); -- 41
439 HH (DD, AA, BB, CC, X (00), 16#eaa127fa#, S32); -- 42
440 HH (CC, DD, AA, BB, X (03), 16#d4ef3085#, S33); -- 43
441 HH (BB, CC, DD, AA, X (06), 16#04881d05#, S34); -- 44
443 HH (AA, BB, CC, DD, X (09), 16#d9d4d039#, S31); -- 45
444 HH (DD, AA, BB, CC, X (12), 16#e6db99e5#, S32); -- 46
445 HH (CC, DD, AA, BB, X (15), 16#1fa27cf8#, S33); -- 47
446 HH (BB, CC, DD, AA, X (02), 16#c4ac5665#, S34); -- 48
450 II (AA, BB, CC, DD, X (00), 16#f4292244#, S41); -- 49
451 II (DD, AA, BB, CC, X (07), 16#432aff97#, S42); -- 50
452 II (CC, DD, AA, BB, X (14), 16#ab9423a7#, S43); -- 51
453 II (BB, CC, DD, AA, X (05), 16#fc93a039#, S44); -- 52
455 II (AA, BB, CC, DD, X (12), 16#655b59c3#, S41); -- 53
456 II (DD, AA, BB, CC, X (03), 16#8f0ccc92#, S42); -- 54
457 II (CC, DD, AA, BB, X (10), 16#ffeff47d#, S43); -- 55
458 II (BB, CC, DD, AA, X (01), 16#85845dd1#, S44); -- 56
460 II (AA, BB, CC, DD, X (08), 16#6fa87e4f#, S41); -- 57
461 II (DD, AA, BB, CC, X (15), 16#fe2ce6e0#, S42); -- 58
462 II (CC, DD, AA, BB, X (06), 16#a3014314#, S43); -- 59
463 II (BB, CC, DD, AA, X (13), 16#4e0811a1#, S44); -- 60
465 II (AA, BB, CC, DD, X (04), 16#f7537e82#, S41); -- 61
466 II (DD, AA, BB, CC, X (11), 16#bd3af235#, S42); -- 62
467 II (CC, DD, AA, BB, X (02), 16#2ad7d2bb#, S43); -- 63
468 II (BB, CC, DD, AA, X (09), 16#eb86d391#, S44); -- 64
485 Inp : constant String := C.Buffer (1 .. C.Last) & Input;
486 Cur : Positive := Inp'First;
489 C.Length := C.Length + Input'Length;
491 while Cur + 63 <= Inp'Last loop
492 Transform (C, Inp (Cur .. Cur + 63));
496 C.Last := Inp'Last - Cur + 1;
497 C.Buffer (1 .. C.Last) := Inp (Cur .. Inp'Last);
502 Input : Ada.Streams.Stream_Element_Array)
504 subtype Stream_Array is Ada.Streams.Stream_Element_Array (Input'Range);
505 subtype Stream_String is
506 String (1 + Integer (Input'First) .. 1 + Integer (Input'Last));
508 function To_String is new Ada.Unchecked_Conversion
509 (Stream_Array, Stream_String);
511 String_Input : constant String := To_String (Input);
513 Update (C, String_Input);
520 function Wide_Digest (W : Wide_String) return Message_Digest is
531 procedure Wide_Update
535 String_Input : String (1 .. 2 * Input'Length);
539 for Index in Input'Range loop
540 String_Input (Cur) :=
542 (Unsigned_32 (Wide_Character'Pos (Input (Index))) and 16#FF#);
544 String_Input (Cur) :=
546 (Shift_Right (Unsigned_32 (Wide_Character'Pos (Input (Index))), 8)
551 Update (C, String_Input);