1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
10 -- Copyright (C) 2002 Ada Core Technologies, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
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 procedure Convert (X : Unsigned_32);
177 -- Put the contribution of one of the four words (A, B, C, D) of the
178 -- Context in Result. Increments Cur.
184 procedure Convert (X : Unsigned_32) is
185 Y : Unsigned_32 := X;
189 Result (Cur + 1) := Hex_Digit (Y and Unsigned_32'(16#0F#));
190 Y := Shift_Right (Y, 4);
191 Result (Cur) := Hex_Digit (Y and Unsigned_32'(16#0F#));
192 Y := Shift_Right (Y, 4);
197 -- Start of processing for Digest
207 function Digest (S : String) return Message_Digest is
216 (A : Ada.Streams.Stream_Element_Array)
217 return Message_Digest
230 function F (X, Y, Z : Unsigned_32) return Unsigned_32 is
232 return (X and Y) or ((not X) and Z);
240 (A : in out Unsigned_32;
241 B, C, D : Unsigned_32;
247 A := A + F (B, C, D) + X + AC;
248 A := Rotate_Left (A, S);
256 function G (X, Y, Z : Unsigned_32) return Unsigned_32 is
258 return (X and Z) or (Y and (not Z));
266 (A : in out Unsigned_32;
267 B, C, D : Unsigned_32;
273 A := A + G (B, C, D) + X + AC;
274 A := Rotate_Left (A, S);
282 function H (X, Y, Z : Unsigned_32) return Unsigned_32 is
284 return X xor Y xor Z;
292 (A : in out Unsigned_32;
293 B, C, D : Unsigned_32;
299 A := A + H (B, C, D) + X + AC;
300 A := Rotate_Left (A, S);
308 function I (X, Y, Z : Unsigned_32) return Unsigned_32 is
310 return Y xor (X or (not Z));
318 (A : in out Unsigned_32;
319 B, C, D : Unsigned_32;
325 A := A + I (B, C, D) + X + AC;
326 A := Rotate_Left (A, S);
340 AA : Unsigned_32 := C.A;
341 BB : Unsigned_32 := C.B;
342 CC : Unsigned_32 := C.C;
343 DD : Unsigned_32 := C.D;
346 pragma Assert (Block'Length = 64);
352 FF (AA, BB, CC, DD, X (00), 16#D76aa478#, S11); -- 1
353 FF (DD, AA, BB, CC, X (01), 16#E8c7b756#, S12); -- 2
354 FF (CC, DD, AA, BB, X (02), 16#242070db#, S13); -- 3
355 FF (BB, CC, DD, AA, X (03), 16#C1bdceee#, S14); -- 4
357 FF (AA, BB, CC, DD, X (04), 16#f57c0faf#, S11); -- 5
358 FF (DD, AA, BB, CC, X (05), 16#4787c62a#, S12); -- 6
359 FF (CC, DD, AA, BB, X (06), 16#a8304613#, S13); -- 7
360 FF (BB, CC, DD, AA, X (07), 16#fd469501#, S14); -- 8
362 FF (AA, BB, CC, DD, X (08), 16#698098d8#, S11); -- 9
363 FF (DD, AA, BB, CC, X (09), 16#8b44f7af#, S12); -- 10
364 FF (CC, DD, AA, BB, X (10), 16#ffff5bb1#, S13); -- 11
365 FF (BB, CC, DD, AA, X (11), 16#895cd7be#, S14); -- 12
367 FF (AA, BB, CC, DD, X (12), 16#6b901122#, S11); -- 13
368 FF (DD, AA, BB, CC, X (13), 16#fd987193#, S12); -- 14
369 FF (CC, DD, AA, BB, X (14), 16#a679438e#, S13); -- 15
370 FF (BB, CC, DD, AA, X (15), 16#49b40821#, S14); -- 16
374 GG (AA, BB, CC, DD, X (01), 16#f61e2562#, S21); -- 17
375 GG (DD, AA, BB, CC, X (06), 16#c040b340#, S22); -- 18
376 GG (CC, DD, AA, BB, X (11), 16#265e5a51#, S23); -- 19
377 GG (BB, CC, DD, AA, X (00), 16#e9b6c7aa#, S24); -- 20
379 GG (AA, BB, CC, DD, X (05), 16#d62f105d#, S21); -- 21
380 GG (DD, AA, BB, CC, X (10), 16#02441453#, S22); -- 22
381 GG (CC, DD, AA, BB, X (15), 16#d8a1e681#, S23); -- 23
382 GG (BB, CC, DD, AA, X (04), 16#e7d3fbc8#, S24); -- 24
384 GG (AA, BB, CC, DD, X (09), 16#21e1cde6#, S21); -- 25
385 GG (DD, AA, BB, CC, X (14), 16#c33707d6#, S22); -- 26
386 GG (CC, DD, AA, BB, X (03), 16#f4d50d87#, S23); -- 27
387 GG (BB, CC, DD, AA, X (08), 16#455a14ed#, S24); -- 28
389 GG (AA, BB, CC, DD, X (13), 16#a9e3e905#, S21); -- 29
390 GG (DD, AA, BB, CC, X (02), 16#fcefa3f8#, S22); -- 30
391 GG (CC, DD, AA, BB, X (07), 16#676f02d9#, S23); -- 31
392 GG (BB, CC, DD, AA, X (12), 16#8d2a4c8a#, S24); -- 32
396 HH (AA, BB, CC, DD, X (05), 16#fffa3942#, S31); -- 33
397 HH (DD, AA, BB, CC, X (08), 16#8771f681#, S32); -- 34
398 HH (CC, DD, AA, BB, X (11), 16#6d9d6122#, S33); -- 35
399 HH (BB, CC, DD, AA, X (14), 16#fde5380c#, S34); -- 36
401 HH (AA, BB, CC, DD, X (01), 16#a4beea44#, S31); -- 37
402 HH (DD, AA, BB, CC, X (04), 16#4bdecfa9#, S32); -- 38
403 HH (CC, DD, AA, BB, X (07), 16#f6bb4b60#, S33); -- 39
404 HH (BB, CC, DD, AA, X (10), 16#bebfbc70#, S34); -- 40
406 HH (AA, BB, CC, DD, X (13), 16#289b7ec6#, S31); -- 41
407 HH (DD, AA, BB, CC, X (00), 16#eaa127fa#, S32); -- 42
408 HH (CC, DD, AA, BB, X (03), 16#d4ef3085#, S33); -- 43
409 HH (BB, CC, DD, AA, X (06), 16#04881d05#, S34); -- 44
411 HH (AA, BB, CC, DD, X (09), 16#d9d4d039#, S31); -- 45
412 HH (DD, AA, BB, CC, X (12), 16#e6db99e5#, S32); -- 46
413 HH (CC, DD, AA, BB, X (15), 16#1fa27cf8#, S33); -- 47
414 HH (BB, CC, DD, AA, X (02), 16#c4ac5665#, S34); -- 48
418 II (AA, BB, CC, DD, X (00), 16#f4292244#, S41); -- 49
419 II (DD, AA, BB, CC, X (07), 16#432aff97#, S42); -- 50
420 II (CC, DD, AA, BB, X (14), 16#ab9423a7#, S43); -- 51
421 II (BB, CC, DD, AA, X (05), 16#fc93a039#, S44); -- 52
423 II (AA, BB, CC, DD, X (12), 16#655b59c3#, S41); -- 53
424 II (DD, AA, BB, CC, X (03), 16#8f0ccc92#, S42); -- 54
425 II (CC, DD, AA, BB, X (10), 16#ffeff47d#, S43); -- 55
426 II (BB, CC, DD, AA, X (01), 16#85845dd1#, S44); -- 56
428 II (AA, BB, CC, DD, X (08), 16#6fa87e4f#, S41); -- 57
429 II (DD, AA, BB, CC, X (15), 16#fe2ce6e0#, S42); -- 58
430 II (CC, DD, AA, BB, X (06), 16#a3014314#, S43); -- 59
431 II (BB, CC, DD, AA, X (13), 16#4e0811a1#, S44); -- 60
433 II (AA, BB, CC, DD, X (04), 16#f7537e82#, S41); -- 61
434 II (DD, AA, BB, CC, X (11), 16#bd3af235#, S42); -- 62
435 II (CC, DD, AA, BB, X (02), 16#2ad7d2bb#, S43); -- 63
436 II (BB, CC, DD, AA, X (09), 16#eb86d391#, S44); -- 64
453 Cur : Positive := Input'First;
454 Last_Block : String (1 .. 64);
457 while Cur + 63 <= Input'Last loop
458 Transform (C, Input (Cur .. Cur + 63));
462 Last_Block (1 .. Input'Last - Cur + 1) := Input (Cur .. Input'Last);
464 if Input'Last - Cur + 1 > 56 then
465 Cur := Input'Last - Cur + 2;
466 Last_Block (Cur .. 64) := Padding (1 .. 64 - Cur + 1);
467 Transform (C, Last_Block);
468 Last_Block := (others => ASCII.NUL);
471 Cur := Input'Last - Cur + 2;
472 Last_Block (Cur .. 56) := Padding (1 .. 56 - Cur + 1);
475 -- Add the input length as 8 characters
477 Last_Block (57 .. 64) := (others => ASCII.NUL);
480 L : Unsigned_64 := Unsigned_64 (Input'Length) * 8;
485 Last_Block (Cur) := Character'Val (L and 16#Ff#);
486 L := Shift_Right (L, 8);
491 Transform (C, Last_Block);
496 Input : Ada.Streams.Stream_Element_Array)
498 subtype Stream_Array is Ada.Streams.Stream_Element_Array (Input'Range);
499 subtype Stream_String is
500 String (1 + Integer (Input'First) .. 1 + Integer (Input'Last));
502 function To_String is new Ada.Unchecked_Conversion
503 (Stream_Array, Stream_String);
505 String_Input : constant String := To_String (Input);
507 Update (C, String_Input);
514 function Wide_Digest (W : Wide_String) return Message_Digest is
526 procedure Wide_Update
531 String_Input : String (1 .. 2 * Input'Length);
535 for Index in Input'Range loop
536 String_Input (Cur) :=
538 (Unsigned_32 (Wide_Character'Pos (Input (Index))) and 16#FF#);
540 String_Input (Cur) :=
542 (Shift_Right (Unsigned_32 (Wide_Character'Pos (Input (Index))), 8)
547 Update (C, String_Input);