with Ada.Unchecked_Conversion;
package body MD5 is
--====================================================================
-- Authors Rolf Ebert,
-- Christoph Grein <Christ-Usch.Grein@T-Online.de>
-- Version 1.1
-- Date 16 January 1999
--====================================================================
-- This is a direct translation into Ada of the C language Reference
-- Implementation given in the official MD5 algorithm description.
-- It was originally written by Rolf Ebert (unknown address).
--
-- The official description of the MD5 algorithm can be found at
-- <ftp://ftp.rsa.com/pub/md5.txt>
-- License is granted by RSA Data Security, Inc. <http://www.rsa.com>
-- to make and use derivative works provided that such works are
-- identified as "derived from the RSA Data Security, Inc. MD5
-- Message-Digest Algorithm" in all material mentioning or referencing
-- the derived work. (See the copyright notice in the official
-- description.)
--====================================================================
-- History
-- Author Version Date Reason for change
-- R.E. 1.0 04.06.1997 Original as found in internet
-- C.G. 1.1 16.01.1999 Minor code changes; commented to make
-- publication legal
--====================================================================
function Rotate_Left (Value: Word; Amount: Natural) return Word;
function Shift_Left (Value: Word; Amount: Natural) return Word;
function Shift_Right (Value: Word; Amount: Natural) return Word;
pragma Import (Intrinsic, Rotate_Left);
pragma Import (Intrinsic, Shift_Left);
pragma Import (Intrinsic, Shift_Right);
------------------------------------------------------------------------
-- F, G, H, I are the basic MD5 functions
function F (X, Y, Z: Word) return Word is
begin
return (X and Y) or ((not X) and Z);
end F;
pragma Inline (F);
function G (X, Y, Z: Word) return Word is
begin
return (X and Z) or (Y and (not Z));
end G;
pragma Inline (G);
function H (X, Y, Z: Word) return Word is
begin
return X xor Y xor Z;
end H;
pragma Inline (H);
function I (X, Y, Z: Word) return Word is
begin
return Y xor (X or (not Z));
end I;
pragma Inline (I);
------------------------------------------------------------------------
procedure FF (A : in out Word;
B, C, D, X: in Word;
S : in Natural;
AC : in Word) is
begin
A := A + F (B, C, D) + X + AC;
A := Rotate_Left (A, S) + B;
end FF;
pragma Inline (FF);
procedure GG (A : in out Word;
B, C, D, X: in Word;
S : in Natural;
AC : in Word) is
begin
A := A + G (B, C, D) + X + AC;
A := Rotate_Left (A, S) + B;
end GG;
pragma Inline (GG);
procedure HH (A : in out Word;
B, C, D, X: in Word;
S : in Natural;
AC : in Word) is
begin
A := A + H (B, C, D) + X + AC;
A := Rotate_Left (A, S) + B;
end HH;
pragma Inline (HH);
procedure II (A : in out Word;
B, C, D, X: in Word;
S : in Natural;
AC : in Word) is
begin
A := A + I (B, C, D) + X + AC;
A := Rotate_Left (A, S) + B;
end II;
pragma Inline (II);
------------------------------------------------------------------------
procedure Encode (Output: out Byte_Array;
Input : in Word_Array) is
J: Long_Integer := Output'First;
begin
for I in Input'range loop
Output (J ) := Byte ( Input (I) and 16#FF#);
Output (J + 1) := Byte (Shift_Right (Input (I), 8) and 16#FF#);
Output (J + 2) := Byte (Shift_Right (Input (I), 16) and 16#FF#);
Output (J + 3) := Byte (Shift_Right (Input (I), 24) and 16#FF#);
J := J + 4;
end loop;
end Encode;
procedure Decode (Output: out Word_Array;
Input : in Byte_Array) is
J : Long_Integer := Input'First;
begin
for I in Output'range loop
Output (I) := Word (Input (J )) or
Shift_Left (Word (Input (J + 1)), 8) or
Shift_Left (Word (Input (J + 2)), 16) or
Shift_Left (Word (Input (J + 3)), 24);
J := J + 4;
end loop;
end Decode;
------------------------------------------------------------------------
S11: constant := 7;
S12: constant := 12;
S13: constant := 17;
S14: constant := 22;
S21: constant := 5;
S22: constant := 9;
S23: constant := 14;
S24: constant := 20;
S31: constant := 4;
S32: constant := 11;
S33: constant := 16;
S34: constant := 23;
S41: constant := 6;
S42: constant := 10;
S43: constant := 15;
S44: constant := 21;
procedure Transform (State: in out ABCD_State;
Block: in Buffer_T) is
A: Word := State (1);
B: Word := State (2);
C: Word := State (3);
D: Word := State (4);
X: Word_Array (0 .. 15);
begin
Decode (X, Block);
-- Round 1
FF (A, B, C, D, X ( 0), S11, 16#D76AA478#); -- 1
FF (D, A, B, C, X ( 1), S12, 16#E8C7B756#); -- 2
FF (C, D, A, B, X ( 2), S13, 16#242070DB#); -- 3
FF (B, C, D, A, X ( 3), S14, 16#C1BDCEEE#); -- 4
FF (A, B, C, D, X ( 4), S11, 16#F57C0FAF#); -- 5
FF (D, A, B, C, X ( 5), S12, 16#4787C62A#); -- 6
FF (C, D, A, B, X ( 6), S13, 16#A8304613#); -- 7
FF (B, C, D, A, X ( 7), S14, 16#FD469501#); -- 8
FF (A, B, C, D, X ( 8), S11, 16#698098D8#); -- 9
FF (D, A, B, C, X ( 9), S12, 16#8B44F7AF#); -- 10
FF (C, D, A, B, X (10), S13, 16#FFFF5BB1#); -- 11
FF (B, C, D, A, X (11), S14, 16#895CD7BE#); -- 12
FF (A, B, C, D, X (12), S11, 16#6B901122#); -- 13
FF (D, A, B, C, X (13), S12, 16#FD987193#); -- 14
FF (C, D, A, B, X (14), S13, 16#A679438E#); -- 15
FF (B, C, D, A, X (15), S14, 16#49B40821#); -- 16
-- Round 2
GG (A, B, C, D, X ( 1), S21, 16#F61E2562#); -- 17
GG (D, A, B, C, X ( 6), S22, 16#C040B340#); -- 18
GG (C, D, A, B, X (11), S23, 16#265E5A51#); -- 19
GG (B, C, D, A, X ( 0), S24, 16#E9B6C7AA#); -- 20
GG (A, B, C, D, X ( 5), S21, 16#D62F105D#); -- 21
GG (D, A, B, C, X (10), S22, 16#02441453#); -- 22
GG (C, D, A, B, X (15), S23, 16#D8A1E681#); -- 23
GG (B, C, D, A, X ( 4), S24, 16#E7D3FBC8#); -- 24
GG (A, B, C, D, X ( 9), S21, 16#21E1CDE6#); -- 25
GG (D, A, B, C, X (14), S22, 16#C33707D6#); -- 26
GG (C, D, A, B, X ( 3), S23, 16#F4D50D87#); -- 27
GG (B, C, D, A, X ( 8), S24, 16#455A14ED#); -- 28
GG (A, B, C, D, X (13), S21, 16#A9E3E905#); -- 29
GG (D, A, B, C, X ( 2), S22, 16#FCEFA3F8#); -- 30
GG (C, D, A, B, X ( 7), S23, 16#676F02D9#); -- 31
GG (B, C, D, A, X (12), S24, 16#8D2A4C8A#); -- 32
-- Round 3
HH (A, B, C, D, X ( 5), S31, 16#FFFA3942#); -- 33
HH (D, A, B, C, X ( 8), S32, 16#8771F681#); -- 34
HH (C, D, A, B, X (11), S33, 16#6D9D6122#); -- 35
HH (B, C, D, A, X (14), S34, 16#FDE5380C#); -- 36
HH (A, B, C, D, X ( 1), S31, 16#A4BEEA44#); -- 37
HH (D, A, B, C, X ( 4), S32, 16#4BDECFA9#); -- 38
HH (C, D, A, B, X ( 7), S33, 16#F6BB4B60#); -- 39
HH (B, C, D, A, X (10), S34, 16#BEBFBC70#); -- 40
HH (A, B, C, D, X (13), S31, 16#289B7EC6#); -- 41
HH (D, A, B, C, X ( 0), S32, 16#EAA127FA#); -- 42
HH (C, D, A, B, X ( 3), S33, 16#D4EF3085#); -- 43
HH (B, C, D, A, X ( 6), S34, 16#04881D05#); -- 44
HH (A, B, C, D, X ( 9), S31, 16#D9D4D039#); -- 45
HH (D, A, B, C, X (12), S32, 16#E6DB99E5#); -- 46
HH (C, D, A, B, X (15), S33, 16#1FA27CF8#); -- 47
HH (B, C, D, A, X ( 2), S34, 16#C4AC5665#); -- 48
-- Round 4
II (A, B, C, D, X ( 0), S41, 16#F4292244#); -- 49
II (D, A, B, C, X ( 7), S42, 16#432AFF97#); -- 50
II (C, D, A, B, X (14), S43, 16#AB9423A7#); -- 51
II (B, C, D, A, X ( 5), S44, 16#FC93A039#); -- 52
II (A, B, C, D, X (12), S41, 16#655B59C3#); -- 53
II (D, A, B, C, X ( 3), S42, 16#8F0CCC92#); -- 54
II (C, D, A, B, X (10), S43, 16#FFEFF47D#); -- 55
II (B, C, D, A, X ( 1), S44, 16#85845DD1#); -- 56
II (A, B, C, D, X ( 8), S41, 16#6FA87E4F#); -- 57
II (D, A, B, C, X (15), S42, 16#FE2CE6E0#); -- 58
II (C, D, A, B, X ( 6), S43, 16#A3014314#); -- 59
II (B, C, D, A, X (13), S44, 16#4E0811A1#); -- 60
II (A, B, C, D, X ( 4), S41, 16#F7537E82#); -- 61
II (D, A, B, C, X (11), S42, 16#BD3AF235#); -- 62
II (C, D, A, B, X ( 2), S43, 16#2AD7D2BB#); -- 63
II (B, C, D, A, X ( 9), S44, 16#EB86D391#); -- 64
State (1) := State (1) + A;
State (2) := State (2) + B;
State (3) := State (3) + C;
State (4) := State (4) + D;
-- Zeroize sensitive information.
X := (others => 0);
end Transform;
------------------------------------------------------------------------
procedure Init (Ctx: out Context) is
begin
Ctx := (State => (1 => 16#67452301#,
2 => 16#Efcdab89#,
3 => 16#98badcfe#,
4 => 16#10325476#),
Count => (others => 0),
Buffer => (others => 0));
end Init;
procedure Update (Ctx: in out Context; Data: in Byte_Array) is
Index : Long_Integer;
Part_Len: Long_Integer;
I : Long_Integer;
begin
-- compute number of bytes mod 64
Index := Long_Integer (Shift_Right (Ctx.Count (1), 3) and 16#3F#);
-- update number of bits
Ctx.Count (1) := Ctx.Count (1) + Shift_Left (Word (Data'Length), 3);
if Ctx.Count (1) < Shift_Left (Word (Data'Length), 3) then
Ctx.Count (2) := Ctx.Count (2) + 1;
end if;
Ctx.Count (2) := Ctx.Count (2) + Shift_Right (Word (Data'Length), 29);
Part_Len := 64 - Index;
-- Transform as many times as possible.
if Data'Length >= Part_Len then
Ctx.Buffer (Index + 1 .. Index + Part_Len) :=
Data (Data'First .. Data'First + Part_Len - 1);
Transform (Ctx.State, Ctx.Buffer);
I := Part_Len;
while I + 63 < Data'Length loop
Transform (Ctx.State, Data (I + 1 .. I + 64));
I := I + 64;
end loop;
Index := 0;
else
I := 0;
end if;
-- Buffer remaining input
Ctx.Buffer (Index + 1 .. Index + Data'Length - I) := Data (I + 1 .. Data'Length);
end Update;
procedure Update (Ctx: in out Context; Data: in String) is
subtype Data_Byte_Array is Byte_Array (1 .. Data'Length);
subtype Data_String is String (1 .. Data'Length);
function String_To_Byte_Array is new Ada.Unchecked_Conversion
(Source => Data_String,
Target => Data_Byte_Array);
begin
Update (Ctx, String_To_Byte_Array (Data_String (Data)));
end Update;
procedure Final (Ctx: in out Context; Digest: out Fingerprint) is
Bits : Byte_Array (1 .. 8);
Index : Long_Integer;
Pad_Length: Long_Integer;
Padding : constant Buffer_T := (1 => 16#80#, others => 0);
begin
-- save number of bits
Encode (Bits, Ctx.Count);
-- Pad out to 56 mod 64.
Index := Long_Integer (Shift_Right (Ctx.Count(1), 3) and 16#3F#);
if Index < 56 then
Pad_Length := 56 - Index;
else
Pad_Length := 120 - Index;
end if;
Update (Ctx, Padding (1 .. Pad_Length));
-- Append length (before padding)
Update (Ctx, Bits);
-- Store state in digest
Encode (Digest, Ctx.State);
-- Zeroize sensitive information.
Ctx := (State => (others => 0),
Count => (others => 0),
Buffer => (others => 0));
end Final;
------------------------------------------------------------------------
Hex_Tab: constant array (0 .. 15) of Character := "0123456789abcdef";
function Digest_From_Text (S: in Digest_String) return Fingerprint is
Digest: Fingerprint;
Val : Word;
Ch : Character;
begin
for I in Digest'range loop
Ch := S (2 * Integer (I));
case Ch is
when '0' .. '9' => Val := Character'Pos (Ch) - Character'Pos ('0');
when 'a' .. 'f' => Val := Character'Pos (Ch) - Character'Pos ('a') + 10;
when 'A' .. 'F' => Val := Character'Pos (Ch) - Character'Pos ('A') + 10;
when others => raise Malformed;
end case;
Val := Shift_Left (Val, 4);
Ch := S (2 * Integer (I) + 1);
case Ch is
when '0' .. '9' => Val := Val + (Character'Pos (Ch) - Character'Pos ('0'));
when 'a' .. 'f' => Val := Val + (Character'Pos (Ch) - Character'Pos ('a') + 10);
when 'A' .. 'F' => Val := Val + (Character'Pos (Ch) - Character'Pos ('A') + 10);
when others => raise Malformed;
end case;
Digest (I) := Byte (Val);
end loop;
return Digest;
end Digest_From_Text;
function Digest_To_Text (A: in Fingerprint) return Digest_String is
Str: Digest_String;
J : Positive;
begin
for I in A'range loop
J := 2 * Integer (I) - 1;
Str (J) := Hex_Tab (Natural (Shift_Right (Word (A (I)), 4)));
Str (J + 1) := Hex_Tab (Natural (A (I) and 16#F#));
end loop;
return Str;
end Digest_To_Text;
end MD5;
Back to text.