1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- G N A T . S H A 1 --
9 -- Copyright (C) 2002-2006, AdaCore --
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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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 -- Note: the code for this unit is derived from GNAT.MD5
36 with Ada
.Unchecked_Conversion
;
38 package body GNAT
.SHA1
is
42 Padding
: constant String :=
43 (1 => Character'Val (16#
80#
), 2 .. 64 => ASCII
.NUL
);
45 Hex_Digit
: constant array (Unsigned_32
range 0 .. 15) of Character :=
46 ('0', '1', '2', '3', '4', '5', '6', '7',
47 '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
48 -- Look-up table for each hex digit of the Message-Digest.
49 -- Used by function Digest (Context).
51 type Sixteen_Words
is array (Natural range 0 .. 15)
52 of Interfaces
.Unsigned_32
;
53 -- Sixteen 32-bit words, converted from block of 64 characters.
54 -- Used in procedure Decode and Transform.
56 procedure Decode
(Block
: String; X
: out Sixteen_Words
);
57 -- Convert a String of 64 characters into 16 32-bit numbers
59 -- The following functions are the four elementary components of each
60 -- of the four round groups (0 .. 19, 20 .. 39, 40 .. 59, and 60 .. 79)
61 -- defined in RFC 3174.
63 function F0
(B
, C
, D
: Unsigned_32
) return Unsigned_32
;
66 function F1
(B
, C
, D
: Unsigned_32
) return Unsigned_32
;
69 function F2
(B
, C
, D
: Unsigned_32
) return Unsigned_32
;
72 function F3
(B
, C
, D
: Unsigned_32
) return Unsigned_32
;
75 procedure Transform
(Ctx
: in out Context
; Block
: String);
76 -- Process one block of 64 characters
82 procedure Decode
(Block
: String; X
: out Sixteen_Words
) is
83 Cur
: Positive := Block
'First;
86 pragma Assert
(Block
'Length = 64);
88 for Index
in X
'Range loop
90 Unsigned_32
(Character'Pos (Block
(Cur
+ 3))) +
91 Shift_Left
(Unsigned_32
(Character'Pos (Block
(Cur
+ 2))), 8) +
92 Shift_Left
(Unsigned_32
(Character'Pos (Block
(Cur
+ 1))), 16) +
93 Shift_Left
(Unsigned_32
(Character'Pos (Block
(Cur
))), 24);
102 function Digest
(C
: Context
) return Message_Digest
is
103 Result
: Message_Digest
;
106 -- Index in Result where the next character will be placed
108 Last_Block
: String (1 .. 64);
112 procedure Convert
(X
: Unsigned_32
);
113 -- Put the contribution of one of the five H words of the Context in
114 -- Result. Increments Cur.
120 procedure Convert
(X
: Unsigned_32
) is
121 Y
: Unsigned_32
:= X
;
124 Y
:= Rotate_Left
(Y
, 4);
125 Result
(Cur
) := Hex_Digit
(Y
and Unsigned_32
'(16#0F#));
130 -- Start of processing for Digest
133 -- Process characters in the context buffer, if any
135 pragma Assert (C.Last /= C.Buffer'Last);
136 Last_Block (1 .. C.Last) := C.Buffer (1 .. C.Last);
139 Last_Block (C.Last + 1 .. 64) := Padding (1 .. 64 - C.Last);
140 Transform (C1, Last_Block);
141 Last_Block := (others => ASCII.NUL);
144 Last_Block (C.Last + 1 .. 56) := Padding (1 .. 56 - C.Last);
147 -- Add the input length (as stored in the context) as 8 characters
149 Last_Block (57 .. 64) := (others => ASCII.NUL);
152 L : Unsigned_64 := Unsigned_64 (C.Length) * 8;
153 Idx : Positive := 64;
156 Last_Block (Idx) := Character'Val (L and 16#Ff#);
157 L := Shift_Right (L, 8);
162 Transform (C1, Last_Block);
172 function Digest (S : String) return Message_Digest is
180 (A : Ada.Streams.Stream_Element_Array) return Message_Digest
193 (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
196 return (B and C) or ((not B) and D);
204 (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
207 return B xor C xor D;
215 (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
218 return (B and C) or (B and D) or (C and D);
226 (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
234 (Ctx : in out Context;
237 W : array (0 .. 79) of Interfaces.Unsigned_32;
239 A, B, C, D, E, Temp : Interfaces.Unsigned_32;
242 pragma Assert (Block'Length = 64);
244 -- a. Divide data block into sixteen words
246 Decode (Block, Sixteen_Words (W (0 .. 15)));
248 -- b. Prepare working block of 80 words
250 for T in 16 .. 79 loop
252 -- W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
255 (W (T - 3) xor W (T - 8) xor W (T - 14) xor W (T - 16), 1);
259 -- c. Set up transformation variables
267 -- d. For each of the 80 rounds, compute:
269 -- TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
270 -- E = D; D = C; C = S^30(B); B = A; A = TEMP;
272 for T in 0 .. 19 loop
273 Temp := Rotate_Left (A, 5) + F0 (B, C, D) + E + W (T) + 16#5A827999#;
274 E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
277 for T in 20 .. 39 loop
278 Temp := Rotate_Left (A, 5) + F1 (B, C, D) + E + W (T) + 16#6ED9EBA1#;
279 E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
282 for T in 40 .. 59 loop
283 Temp := Rotate_Left (A, 5) + F2 (B, C, D) + E + W (T) + 16#8F1BBCDC#;
284 E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
287 for T in 60 .. 79 loop
288 Temp := Rotate_Left (A, 5) + F3 (B, C, D) + E + W (T) + 16#CA62C1D6#;
289 E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
292 -- e. Update context:
293 -- H0 = H0 + A, H1 = H1 + B, H2 = H2 + C, H3 = H3 + D, H4 = H4 + E
295 Ctx.H (0) := Ctx.H (0) + A;
296 Ctx.H (1) := Ctx.H (1) + B;
297 Ctx.H (2) := Ctx.H (2) + C;
298 Ctx.H (3) := Ctx.H (3) + D;
299 Ctx.H (4) := Ctx.H (4) + E;
310 Inp : constant String := C.Buffer (1 .. C.Last) & Input;
311 Cur : Positive := Inp'First;
314 C.Length := C.Length + Input'Length;
316 while Cur + 63 <= Inp'Last loop
317 Transform (C, Inp (Cur .. Cur + 63));
321 C.Last := Inp'Last - Cur + 1;
322 C.Buffer (1 .. C.Last) := Inp (Cur .. Inp'Last);
327 Input : Ada.Streams.Stream_Element_Array)
329 subtype Stream_Array is Ada.Streams.Stream_Element_Array (Input'Range);
330 subtype Stream_String is
331 String (1 + Integer (Input'First) .. 1 + Integer (Input'Last));
333 function To_String is new Ada.Unchecked_Conversion
334 (Stream_Array, Stream_String);
336 String_Input : constant String := To_String (Input);
338 Update (C, String_Input);
345 function Wide_Digest (W : Wide_String) return Message_Digest is
356 procedure Wide_Update
360 String_Input : String (1 .. 2 * Input'Length);
364 for Index in Input'Range loop
365 String_Input (Cur) :=
367 (Unsigned_32 (Wide_Character'Pos (Input (Index))) and 16#FF#);
369 String_Input (Cur) :=
371 (Shift_Right (Unsigned_32 (Wide_Character'Pos (Input (Index))), 8)
376 Update (C, String_Input);