1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
9 -- Copyright (C) 2002-2006, 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;
192 Result (Cur + 1) := Hex_Digit (Y and Unsigned_32'(16#0F#));
193 Y := Shift_Right (Y, 4);
194 Result (Cur) := Hex_Digit (Y and Unsigned_32'(16#0F#));
195 Y := Shift_Right (Y, 4);
200 -- Start of processing for Digest
203 -- Process characters in the context buffer, if any
205 Last_Block (1 .. C.Last) := C.Buffer (1 .. C.Last);
207 -- Too many magic literals below, should be defined as constants ???
210 Last_Block (C.Last + 1 .. 64) := Padding (1 .. 64 - C.Last);
211 Transform (C1, Last_Block);
212 Last_Block := (others => ASCII.NUL);
215 Last_Block (C.Last + 1 .. 56) := Padding (1 .. 56 - C.Last);
218 -- Add the input length (as stored in the context) as 8 characters
220 Last_Block (57 .. 64) := (others => ASCII.NUL);
223 L : Unsigned_64 := Unsigned_64 (C.Length) * 8;
224 Idx : Positive := 57;
228 Last_Block (Idx) := Character'Val (L and 16#Ff#);
229 L := Shift_Right (L, 8);
234 Transform (C1, Last_Block);
243 function Digest (S : String) return Message_Digest is
251 (A : Ada.Streams.Stream_Element_Array) return Message_Digest
263 function F (X, Y, Z : Unsigned_32) return Unsigned_32 is
265 return (X and Y) or ((not X) and Z);
273 (A : in out Unsigned_32;
274 B, C, D : Unsigned_32;
280 A := A + F (B, C, D) + X + AC;
281 A := Rotate_Left (A, S);
289 function G (X, Y, Z : Unsigned_32) return Unsigned_32 is
291 return (X and Z) or (Y and (not Z));
299 (A : in out Unsigned_32;
300 B, C, D : Unsigned_32;
306 A := A + G (B, C, D) + X + AC;
307 A := Rotate_Left (A, S);
315 function H (X, Y, Z : Unsigned_32) return Unsigned_32 is
317 return X xor Y xor Z;
325 (A : in out Unsigned_32;
326 B, C, D : Unsigned_32;
332 A := A + H (B, C, D) + X + AC;
333 A := Rotate_Left (A, S);
341 function I (X, Y, Z : Unsigned_32) return Unsigned_32 is
343 return Y xor (X or (not Z));
351 (A : in out Unsigned_32;
352 B, C, D : Unsigned_32;
358 A := A + I (B, C, D) + X + AC;
359 A := Rotate_Left (A, S);
373 AA : Unsigned_32 := C.A;
374 BB : Unsigned_32 := C.B;
375 CC : Unsigned_32 := C.C;
376 DD : Unsigned_32 := C.D;
379 pragma Assert (Block'Length = 64);
385 FF (AA, BB, CC, DD, X (00), 16#D76aa478#, S11); -- 1
386 FF (DD, AA, BB, CC, X (01), 16#E8c7b756#, S12); -- 2
387 FF (CC, DD, AA, BB, X (02), 16#242070db#, S13); -- 3
388 FF (BB, CC, DD, AA, X (03), 16#C1bdceee#, S14); -- 4
390 FF (AA, BB, CC, DD, X (04), 16#f57c0faf#, S11); -- 5
391 FF (DD, AA, BB, CC, X (05), 16#4787c62a#, S12); -- 6
392 FF (CC, DD, AA, BB, X (06), 16#a8304613#, S13); -- 7
393 FF (BB, CC, DD, AA, X (07), 16#fd469501#, S14); -- 8
395 FF (AA, BB, CC, DD, X (08), 16#698098d8#, S11); -- 9
396 FF (DD, AA, BB, CC, X (09), 16#8b44f7af#, S12); -- 10
397 FF (CC, DD, AA, BB, X (10), 16#ffff5bb1#, S13); -- 11
398 FF (BB, CC, DD, AA, X (11), 16#895cd7be#, S14); -- 12
400 FF (AA, BB, CC, DD, X (12), 16#6b901122#, S11); -- 13
401 FF (DD, AA, BB, CC, X (13), 16#fd987193#, S12); -- 14
402 FF (CC, DD, AA, BB, X (14), 16#a679438e#, S13); -- 15
403 FF (BB, CC, DD, AA, X (15), 16#49b40821#, S14); -- 16
407 GG (AA, BB, CC, DD, X (01), 16#f61e2562#, S21); -- 17
408 GG (DD, AA, BB, CC, X (06), 16#c040b340#, S22); -- 18
409 GG (CC, DD, AA, BB, X (11), 16#265e5a51#, S23); -- 19
410 GG (BB, CC, DD, AA, X (00), 16#e9b6c7aa#, S24); -- 20
412 GG (AA, BB, CC, DD, X (05), 16#d62f105d#, S21); -- 21
413 GG (DD, AA, BB, CC, X (10), 16#02441453#, S22); -- 22
414 GG (CC, DD, AA, BB, X (15), 16#d8a1e681#, S23); -- 23
415 GG (BB, CC, DD, AA, X (04), 16#e7d3fbc8#, S24); -- 24
417 GG (AA, BB, CC, DD, X (09), 16#21e1cde6#, S21); -- 25
418 GG (DD, AA, BB, CC, X (14), 16#c33707d6#, S22); -- 26
419 GG (CC, DD, AA, BB, X (03), 16#f4d50d87#, S23); -- 27
420 GG (BB, CC, DD, AA, X (08), 16#455a14ed#, S24); -- 28
422 GG (AA, BB, CC, DD, X (13), 16#a9e3e905#, S21); -- 29
423 GG (DD, AA, BB, CC, X (02), 16#fcefa3f8#, S22); -- 30
424 GG (CC, DD, AA, BB, X (07), 16#676f02d9#, S23); -- 31
425 GG (BB, CC, DD, AA, X (12), 16#8d2a4c8a#, S24); -- 32
429 HH (AA, BB, CC, DD, X (05), 16#fffa3942#, S31); -- 33
430 HH (DD, AA, BB, CC, X (08), 16#8771f681#, S32); -- 34
431 HH (CC, DD, AA, BB, X (11), 16#6d9d6122#, S33); -- 35
432 HH (BB, CC, DD, AA, X (14), 16#fde5380c#, S34); -- 36
434 HH (AA, BB, CC, DD, X (01), 16#a4beea44#, S31); -- 37
435 HH (DD, AA, BB, CC, X (04), 16#4bdecfa9#, S32); -- 38
436 HH (CC, DD, AA, BB, X (07), 16#f6bb4b60#, S33); -- 39
437 HH (BB, CC, DD, AA, X (10), 16#bebfbc70#, S34); -- 40
439 HH (AA, BB, CC, DD, X (13), 16#289b7ec6#, S31); -- 41
440 HH (DD, AA, BB, CC, X (00), 16#eaa127fa#, S32); -- 42
441 HH (CC, DD, AA, BB, X (03), 16#d4ef3085#, S33); -- 43
442 HH (BB, CC, DD, AA, X (06), 16#04881d05#, S34); -- 44
444 HH (AA, BB, CC, DD, X (09), 16#d9d4d039#, S31); -- 45
445 HH (DD, AA, BB, CC, X (12), 16#e6db99e5#, S32); -- 46
446 HH (CC, DD, AA, BB, X (15), 16#1fa27cf8#, S33); -- 47
447 HH (BB, CC, DD, AA, X (02), 16#c4ac5665#, S34); -- 48
451 II (AA, BB, CC, DD, X (00), 16#f4292244#, S41); -- 49
452 II (DD, AA, BB, CC, X (07), 16#432aff97#, S42); -- 50
453 II (CC, DD, AA, BB, X (14), 16#ab9423a7#, S43); -- 51
454 II (BB, CC, DD, AA, X (05), 16#fc93a039#, S44); -- 52
456 II (AA, BB, CC, DD, X (12), 16#655b59c3#, S41); -- 53
457 II (DD, AA, BB, CC, X (03), 16#8f0ccc92#, S42); -- 54
458 II (CC, DD, AA, BB, X (10), 16#ffeff47d#, S43); -- 55
459 II (BB, CC, DD, AA, X (01), 16#85845dd1#, S44); -- 56
461 II (AA, BB, CC, DD, X (08), 16#6fa87e4f#, S41); -- 57
462 II (DD, AA, BB, CC, X (15), 16#fe2ce6e0#, S42); -- 58
463 II (CC, DD, AA, BB, X (06), 16#a3014314#, S43); -- 59
464 II (BB, CC, DD, AA, X (13), 16#4e0811a1#, S44); -- 60
466 II (AA, BB, CC, DD, X (04), 16#f7537e82#, S41); -- 61
467 II (DD, AA, BB, CC, X (11), 16#bd3af235#, S42); -- 62
468 II (CC, DD, AA, BB, X (02), 16#2ad7d2bb#, S43); -- 63
469 II (BB, CC, DD, AA, X (09), 16#eb86d391#, S44); -- 64
486 Inp : constant String := C.Buffer (1 .. C.Last) & Input;
487 Cur : Positive := Inp'First;
490 C.Length := C.Length + Input'Length;
492 while Cur + 63 <= Inp'Last loop
493 Transform (C, Inp (Cur .. Cur + 63));
497 C.Last := Inp'Last - Cur + 1;
498 C.Buffer (1 .. C.Last) := Inp (Cur .. Inp'Last);
503 Input : Ada.Streams.Stream_Element_Array)
505 subtype Stream_Array is Ada.Streams.Stream_Element_Array (Input'Range);
506 subtype Stream_String is
507 String (1 + Integer (Input'First) .. 1 + Integer (Input'Last));
509 function To_String is new Ada.Unchecked_Conversion
510 (Stream_Array, Stream_String);
512 String_Input : constant String := To_String (Input);
514 Update (C, String_Input);
521 function Wide_Digest (W : Wide_String) return Message_Digest is
532 procedure Wide_Update
536 String_Input : String (1 .. 2 * Input'Length);
540 for Index in Input'Range loop
541 String_Input (Cur) :=
543 (Unsigned_32 (Wide_Character'Pos (Input (Index))) and 16#FF#);
545 String_Input (Cur) :=
547 (Shift_Right (Unsigned_32 (Wide_Character'Pos (Input (Index))), 8)
552 Update (C, String_Input);