1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
9 -- Copyright (C) 2002-2004 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 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
532 procedure Wide_Update
537 String_Input
: String (1 .. 2 * Input
'Length);
541 for Index
in Input
'Range loop
542 String_Input
(Cur
) :=
544 (Unsigned_32
(Wide_Character'Pos (Input
(Index
))) and 16#FF#
);
546 String_Input
(Cur
) :=
548 (Shift_Right
(Unsigned_32
(Wide_Character'Pos (Input
(Index
))), 8)
553 Update
(C
, String_Input
);