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
);