1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
9 -- Copyright (C) 2002 Ada Core Technologies, Inc. --
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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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 is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
31 ------------------------------------------------------------------------------
33 with Ada.Unchecked_Conversion;
35 package body GNAT.MD5 is
39 Padding : constant String :=
40 (1 => Character'Val (16#80#), 2 .. 64 => ASCII.NUL);
42 Hex_Digit : constant array (Unsigned_32 range 0 .. 15) of Character :=
43 ('0', '1', '2', '3', '4', '5', '6', '7',
44 '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
45 -- Look-up table for each hex digit of the Message-Digest.
46 -- Used by function Digest (Context).
48 -- The sixten values used to rotate the context words.
49 -- Four for each rounds. Used in procedure Transform.
79 type Sixteen_Words is array (Natural range 0 .. 15)
80 of Interfaces.Unsigned_32;
81 -- Sixteen 32-bit words, converted from block of 64 characters.
82 -- Used in procedure Decode and Transform.
86 X : out Sixteen_Words);
87 -- Convert a String of 64 characters into 16 32-bit numbers
89 -- The following functions (F, FF, G, GG, H, HH, I and II) are the
90 -- equivalent of the macros of the same name in the example
91 -- C implementation in the annex of RFC 1321.
93 function F (X, Y, Z : Unsigned_32) return Unsigned_32;
97 (A : in out Unsigned_32;
98 B, C, D : Unsigned_32;
104 function G (X, Y, Z : Unsigned_32) return Unsigned_32;
108 (A : in out Unsigned_32;
109 B, C, D : Unsigned_32;
115 function H (X, Y, Z : Unsigned_32) return Unsigned_32;
119 (A : in out Unsigned_32;
120 B, C, D : Unsigned_32;
126 function I (X, Y, Z : Unsigned_32) return Unsigned_32;
130 (A : in out Unsigned_32;
131 B, C, D : Unsigned_32;
140 -- Process one block of 64 characters.
148 X : out Sixteen_Words)
150 Cur : Positive := Block'First;
153 pragma Assert (Block'Length = 64);
155 for Index in X'Range loop
157 Unsigned_32 (Character'Pos (Block (Cur))) +
158 Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 1))), 8) +
159 Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 2))), 16) +
160 Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 3))), 24);
169 function Digest (C : Context) return Message_Digest is
170 Result : Message_Digest;
173 -- Index in Result where the next character will be placed.
175 procedure Convert (X : Unsigned_32);
176 -- Put the contribution of one of the four words (A, B, C, D) of the
177 -- Context in Result. Increments Cur.
183 procedure Convert (X : Unsigned_32) is
184 Y : Unsigned_32 := X;
188 Result (Cur + 1) := Hex_Digit (Y and Unsigned_32'(16#0F#));
189 Y := Shift_Right (Y, 4);
190 Result (Cur) := Hex_Digit (Y and Unsigned_32'(16#0F#));
191 Y := Shift_Right (Y, 4);
196 -- Start of processing for Digest
206 function Digest (S : String) return Message_Digest is
215 (A : Ada.Streams.Stream_Element_Array)
216 return Message_Digest
229 function F (X, Y, Z : Unsigned_32) return Unsigned_32 is
231 return (X and Y) or ((not X) and Z);
239 (A : in out Unsigned_32;
240 B, C, D : Unsigned_32;
246 A := A + F (B, C, D) + X + AC;
247 A := Rotate_Left (A, S);
255 function G (X, Y, Z : Unsigned_32) return Unsigned_32 is
257 return (X and Z) or (Y and (not Z));
265 (A : in out Unsigned_32;
266 B, C, D : Unsigned_32;
272 A := A + G (B, C, D) + X + AC;
273 A := Rotate_Left (A, S);
281 function H (X, Y, Z : Unsigned_32) return Unsigned_32 is
283 return X xor Y xor Z;
291 (A : in out Unsigned_32;
292 B, C, D : Unsigned_32;
298 A := A + H (B, C, D) + X + AC;
299 A := Rotate_Left (A, S);
307 function I (X, Y, Z : Unsigned_32) return Unsigned_32 is
309 return Y xor (X or (not Z));
317 (A : in out Unsigned_32;
318 B, C, D : Unsigned_32;
324 A := A + I (B, C, D) + X + AC;
325 A := Rotate_Left (A, S);
339 AA : Unsigned_32 := C.A;
340 BB : Unsigned_32 := C.B;
341 CC : Unsigned_32 := C.C;
342 DD : Unsigned_32 := C.D;
345 pragma Assert (Block'Length = 64);
351 FF (AA, BB, CC, DD, X (00), 16#D76aa478#, S11); -- 1
352 FF (DD, AA, BB, CC, X (01), 16#E8c7b756#, S12); -- 2
353 FF (CC, DD, AA, BB, X (02), 16#242070db#, S13); -- 3
354 FF (BB, CC, DD, AA, X (03), 16#C1bdceee#, S14); -- 4
356 FF (AA, BB, CC, DD, X (04), 16#f57c0faf#, S11); -- 5
357 FF (DD, AA, BB, CC, X (05), 16#4787c62a#, S12); -- 6
358 FF (CC, DD, AA, BB, X (06), 16#a8304613#, S13); -- 7
359 FF (BB, CC, DD, AA, X (07), 16#fd469501#, S14); -- 8
361 FF (AA, BB, CC, DD, X (08), 16#698098d8#, S11); -- 9
362 FF (DD, AA, BB, CC, X (09), 16#8b44f7af#, S12); -- 10
363 FF (CC, DD, AA, BB, X (10), 16#ffff5bb1#, S13); -- 11
364 FF (BB, CC, DD, AA, X (11), 16#895cd7be#, S14); -- 12
366 FF (AA, BB, CC, DD, X (12), 16#6b901122#, S11); -- 13
367 FF (DD, AA, BB, CC, X (13), 16#fd987193#, S12); -- 14
368 FF (CC, DD, AA, BB, X (14), 16#a679438e#, S13); -- 15
369 FF (BB, CC, DD, AA, X (15), 16#49b40821#, S14); -- 16
373 GG (AA, BB, CC, DD, X (01), 16#f61e2562#, S21); -- 17
374 GG (DD, AA, BB, CC, X (06), 16#c040b340#, S22); -- 18
375 GG (CC, DD, AA, BB, X (11), 16#265e5a51#, S23); -- 19
376 GG (BB, CC, DD, AA, X (00), 16#e9b6c7aa#, S24); -- 20
378 GG (AA, BB, CC, DD, X (05), 16#d62f105d#, S21); -- 21
379 GG (DD, AA, BB, CC, X (10), 16#02441453#, S22); -- 22
380 GG (CC, DD, AA, BB, X (15), 16#d8a1e681#, S23); -- 23
381 GG (BB, CC, DD, AA, X (04), 16#e7d3fbc8#, S24); -- 24
383 GG (AA, BB, CC, DD, X (09), 16#21e1cde6#, S21); -- 25
384 GG (DD, AA, BB, CC, X (14), 16#c33707d6#, S22); -- 26
385 GG (CC, DD, AA, BB, X (03), 16#f4d50d87#, S23); -- 27
386 GG (BB, CC, DD, AA, X (08), 16#455a14ed#, S24); -- 28
388 GG (AA, BB, CC, DD, X (13), 16#a9e3e905#, S21); -- 29
389 GG (DD, AA, BB, CC, X (02), 16#fcefa3f8#, S22); -- 30
390 GG (CC, DD, AA, BB, X (07), 16#676f02d9#, S23); -- 31
391 GG (BB, CC, DD, AA, X (12), 16#8d2a4c8a#, S24); -- 32
395 HH (AA, BB, CC, DD, X (05), 16#fffa3942#, S31); -- 33
396 HH (DD, AA, BB, CC, X (08), 16#8771f681#, S32); -- 34
397 HH (CC, DD, AA, BB, X (11), 16#6d9d6122#, S33); -- 35
398 HH (BB, CC, DD, AA, X (14), 16#fde5380c#, S34); -- 36
400 HH (AA, BB, CC, DD, X (01), 16#a4beea44#, S31); -- 37
401 HH (DD, AA, BB, CC, X (04), 16#4bdecfa9#, S32); -- 38
402 HH (CC, DD, AA, BB, X (07), 16#f6bb4b60#, S33); -- 39
403 HH (BB, CC, DD, AA, X (10), 16#bebfbc70#, S34); -- 40
405 HH (AA, BB, CC, DD, X (13), 16#289b7ec6#, S31); -- 41
406 HH (DD, AA, BB, CC, X (00), 16#eaa127fa#, S32); -- 42
407 HH (CC, DD, AA, BB, X (03), 16#d4ef3085#, S33); -- 43
408 HH (BB, CC, DD, AA, X (06), 16#04881d05#, S34); -- 44
410 HH (AA, BB, CC, DD, X (09), 16#d9d4d039#, S31); -- 45
411 HH (DD, AA, BB, CC, X (12), 16#e6db99e5#, S32); -- 46
412 HH (CC, DD, AA, BB, X (15), 16#1fa27cf8#, S33); -- 47
413 HH (BB, CC, DD, AA, X (02), 16#c4ac5665#, S34); -- 48
417 II (AA, BB, CC, DD, X (00), 16#f4292244#, S41); -- 49
418 II (DD, AA, BB, CC, X (07), 16#432aff97#, S42); -- 50
419 II (CC, DD, AA, BB, X (14), 16#ab9423a7#, S43); -- 51
420 II (BB, CC, DD, AA, X (05), 16#fc93a039#, S44); -- 52
422 II (AA, BB, CC, DD, X (12), 16#655b59c3#, S41); -- 53
423 II (DD, AA, BB, CC, X (03), 16#8f0ccc92#, S42); -- 54
424 II (CC, DD, AA, BB, X (10), 16#ffeff47d#, S43); -- 55
425 II (BB, CC, DD, AA, X (01), 16#85845dd1#, S44); -- 56
427 II (AA, BB, CC, DD, X (08), 16#6fa87e4f#, S41); -- 57
428 II (DD, AA, BB, CC, X (15), 16#fe2ce6e0#, S42); -- 58
429 II (CC, DD, AA, BB, X (06), 16#a3014314#, S43); -- 59
430 II (BB, CC, DD, AA, X (13), 16#4e0811a1#, S44); -- 60
432 II (AA, BB, CC, DD, X (04), 16#f7537e82#, S41); -- 61
433 II (DD, AA, BB, CC, X (11), 16#bd3af235#, S42); -- 62
434 II (CC, DD, AA, BB, X (02), 16#2ad7d2bb#, S43); -- 63
435 II (BB, CC, DD, AA, X (09), 16#eb86d391#, S44); -- 64
452 Cur : Positive := Input'First;
453 Last_Block : String (1 .. 64);
456 while Cur + 63 <= Input'Last loop
457 Transform (C, Input (Cur .. Cur + 63));
461 Last_Block (1 .. Input'Last - Cur + 1) := Input (Cur .. Input'Last);
463 if Input'Last - Cur + 1 > 56 then
464 Cur := Input'Last - Cur + 2;
465 Last_Block (Cur .. 64) := Padding (1 .. 64 - Cur + 1);
466 Transform (C, Last_Block);
467 Last_Block := (others => ASCII.NUL);
470 Cur := Input'Last - Cur + 2;
471 Last_Block (Cur .. 56) := Padding (1 .. 56 - Cur + 1);
474 -- Add the input length as 8 characters
476 Last_Block (57 .. 64) := (others => ASCII.NUL);
479 L : Unsigned_64 := Unsigned_64 (Input'Length) * 8;
484 Last_Block (Cur) := Character'Val (L and 16#Ff#);
485 L := Shift_Right (L, 8);
490 Transform (C, Last_Block);
495 Input : Ada.Streams.Stream_Element_Array)
497 subtype Stream_Array is Ada.Streams.Stream_Element_Array (Input'Range);
498 subtype Stream_String is
499 String (1 + Integer (Input'First) .. 1 + Integer (Input'Last));
501 function To_String is new Ada.Unchecked_Conversion
502 (Stream_Array, Stream_String);
504 String_Input : constant String := To_String (Input);
506 Update (C, String_Input);
513 function Wide_Digest (W : Wide_String) return Message_Digest is
525 procedure Wide_Update
530 String_Input : String (1 .. 2 * Input'Length);
534 for Index in Input'Range loop
535 String_Input (Cur) :=
537 (Unsigned_32 (Wide_Character'Pos (Input (Index))) and 16#FF#);
539 String_Input (Cur) :=
541 (Shift_Right (Unsigned_32 (Wide_Character'Pos (Input (Index))), 8)
546 Update (C, String_Input);