| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT LIBRARY COMPONENTS -- |
| -- -- |
| -- G N A T . S H A 1 -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2002-2006, AdaCore -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 2, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING. If not, write -- |
| -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- |
| -- Boston, MA 02110-1301, USA. -- |
| -- -- |
| -- As a special exception, if other files instantiate generics from this -- |
| -- unit, or you link this unit with other files to produce an executable, -- |
| -- this unit does not by itself cause the resulting executable to be -- |
| -- covered by the GNU General Public License. This exception does not -- |
| -- however invalidate any other reasons why the executable file might be -- |
| -- covered by the GNU Public License. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| -- Note: the code for this unit is derived from GNAT.MD5 |
| |
| with Ada.Unchecked_Conversion; |
| |
| package body GNAT.SHA1 is |
| |
| use Interfaces; |
| |
| Padding : constant String := |
| (1 => Character'Val (16#80#), 2 .. 64 => ASCII.NUL); |
| |
| Hex_Digit : constant array (Unsigned_32 range 0 .. 15) of Character := |
| ('0', '1', '2', '3', '4', '5', '6', '7', |
| '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'); |
| -- Look-up table for each hex digit of the Message-Digest. |
| -- Used by function Digest (Context). |
| |
| type Sixteen_Words is array (Natural range 0 .. 15) |
| of Interfaces.Unsigned_32; |
| -- Sixteen 32-bit words, converted from block of 64 characters. |
| -- Used in procedure Decode and Transform. |
| |
| procedure Decode (Block : String; X : out Sixteen_Words); |
| -- Convert a String of 64 characters into 16 32-bit numbers |
| |
| -- The following functions are the four elementary components of each |
| -- of the four round groups (0 .. 19, 20 .. 39, 40 .. 59, and 60 .. 79) |
| -- defined in RFC 3174. |
| |
| function F0 (B, C, D : Unsigned_32) return Unsigned_32; |
| pragma Inline (F0); |
| |
| function F1 (B, C, D : Unsigned_32) return Unsigned_32; |
| pragma Inline (F1); |
| |
| function F2 (B, C, D : Unsigned_32) return Unsigned_32; |
| pragma Inline (F2); |
| |
| function F3 (B, C, D : Unsigned_32) return Unsigned_32; |
| pragma Inline (F3); |
| |
| procedure Transform (Ctx : in out Context; Block : String); |
| -- Process one block of 64 characters |
| |
| ------------ |
| -- Decode -- |
| ------------ |
| |
| procedure Decode (Block : String; X : out Sixteen_Words) is |
| Cur : Positive := Block'First; |
| |
| begin |
| pragma Assert (Block'Length = 64); |
| |
| for Index in X'Range loop |
| X (Index) := |
| Unsigned_32 (Character'Pos (Block (Cur + 3))) + |
| Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 2))), 8) + |
| Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 1))), 16) + |
| Shift_Left (Unsigned_32 (Character'Pos (Block (Cur))), 24); |
| Cur := Cur + 4; |
| end loop; |
| end Decode; |
| |
| ------------ |
| -- Digest -- |
| ------------ |
| |
| function Digest (C : Context) return Message_Digest is |
| Result : Message_Digest; |
| |
| Cur : Natural := 1; |
| -- Index in Result where the next character will be placed |
| |
| Last_Block : String (1 .. 64); |
| |
| C1 : Context := C; |
| |
| procedure Convert (X : Unsigned_32); |
| -- Put the contribution of one of the five H words of the Context in |
| -- Result. Increments Cur. |
| |
| ------------- |
| -- Convert -- |
| ------------- |
| |
| procedure Convert (X : Unsigned_32) is |
| Y : Unsigned_32 := X; |
| begin |
| for J in 1 .. 8 loop |
| Y := Rotate_Left (Y, 4); |
| Result (Cur) := Hex_Digit (Y and Unsigned_32'(16#0F#)); |
| Cur := Cur + 1; |
| end loop; |
| end Convert; |
| |
| -- Start of processing for Digest |
| |
| begin |
| -- Process characters in the context buffer, if any |
| |
| pragma Assert (C.Last /= C.Buffer'Last); |
| Last_Block (1 .. C.Last) := C.Buffer (1 .. C.Last); |
| |
| if C.Last > 55 then |
| Last_Block (C.Last + 1 .. 64) := Padding (1 .. 64 - C.Last); |
| Transform (C1, Last_Block); |
| Last_Block := (others => ASCII.NUL); |
| |
| else |
| Last_Block (C.Last + 1 .. 56) := Padding (1 .. 56 - C.Last); |
| end if; |
| |
| -- Add the input length (as stored in the context) as 8 characters |
| |
| Last_Block (57 .. 64) := (others => ASCII.NUL); |
| |
| declare |
| L : Unsigned_64 := Unsigned_64 (C.Length) * 8; |
| Idx : Positive := 64; |
| begin |
| while L > 0 loop |
| Last_Block (Idx) := Character'Val (L and 16#Ff#); |
| L := Shift_Right (L, 8); |
| Idx := Idx - 1; |
| end loop; |
| end; |
| |
| Transform (C1, Last_Block); |
| |
| Convert (C1.H (0)); |
| Convert (C1.H (1)); |
| Convert (C1.H (2)); |
| Convert (C1.H (3)); |
| Convert (C1.H (4)); |
| return Result; |
| end Digest; |
| |
| function Digest (S : String) return Message_Digest is |
| C : Context; |
| begin |
| Update (C, S); |
| return Digest (C); |
| end Digest; |
| |
| function Digest |
| (A : Ada.Streams.Stream_Element_Array) return Message_Digest |
| is |
| C : Context; |
| begin |
| Update (C, A); |
| return Digest (C); |
| end Digest; |
| |
| -------- |
| -- F0 -- |
| -------- |
| |
| function F0 |
| (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32 |
| is |
| begin |
| return (B and C) or ((not B) and D); |
| end F0; |
| |
| -------- |
| -- F1 -- |
| -------- |
| |
| function F1 |
| (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32 |
| is |
| begin |
| return B xor C xor D; |
| end F1; |
| |
| -------- |
| -- F2 -- |
| -------- |
| |
| function F2 |
| (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32 |
| is |
| begin |
| return (B and C) or (B and D) or (C and D); |
| end F2; |
| |
| -------- |
| -- F3 -- |
| -------- |
| |
| function F3 |
| (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32 |
| renames F1; |
| |
| --------------- |
| -- Transform -- |
| --------------- |
| |
| procedure Transform |
| (Ctx : in out Context; |
| Block : String) |
| is |
| W : array (0 .. 79) of Interfaces.Unsigned_32; |
| |
| A, B, C, D, E, Temp : Interfaces.Unsigned_32; |
| |
| begin |
| pragma Assert (Block'Length = 64); |
| |
| -- a. Divide data block into sixteen words |
| |
| Decode (Block, Sixteen_Words (W (0 .. 15))); |
| |
| -- b. Prepare working block of 80 words |
| |
| for T in 16 .. 79 loop |
| |
| -- W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16)) |
| |
| W (T) := Rotate_Left |
| (W (T - 3) xor W (T - 8) xor W (T - 14) xor W (T - 16), 1); |
| |
| end loop; |
| |
| -- c. Set up transformation variables |
| |
| A := Ctx.H (0); |
| B := Ctx.H (1); |
| C := Ctx.H (2); |
| D := Ctx.H (3); |
| E := Ctx.H (4); |
| |
| -- d. For each of the 80 rounds, compute: |
| |
| -- TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t); |
| -- E = D; D = C; C = S^30(B); B = A; A = TEMP; |
| |
| for T in 0 .. 19 loop |
| Temp := Rotate_Left (A, 5) + F0 (B, C, D) + E + W (T) + 16#5A827999#; |
| E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp; |
| end loop; |
| |
| for T in 20 .. 39 loop |
| Temp := Rotate_Left (A, 5) + F1 (B, C, D) + E + W (T) + 16#6ED9EBA1#; |
| E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp; |
| end loop; |
| |
| for T in 40 .. 59 loop |
| Temp := Rotate_Left (A, 5) + F2 (B, C, D) + E + W (T) + 16#8F1BBCDC#; |
| E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp; |
| end loop; |
| |
| for T in 60 .. 79 loop |
| Temp := Rotate_Left (A, 5) + F3 (B, C, D) + E + W (T) + 16#CA62C1D6#; |
| E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp; |
| end loop; |
| |
| -- e. Update context: |
| -- H0 = H0 + A, H1 = H1 + B, H2 = H2 + C, H3 = H3 + D, H4 = H4 + E |
| |
| Ctx.H (0) := Ctx.H (0) + A; |
| Ctx.H (1) := Ctx.H (1) + B; |
| Ctx.H (2) := Ctx.H (2) + C; |
| Ctx.H (3) := Ctx.H (3) + D; |
| Ctx.H (4) := Ctx.H (4) + E; |
| end Transform; |
| |
| ------------ |
| -- Update -- |
| ------------ |
| |
| procedure Update |
| (C : in out Context; |
| Input : String) |
| is |
| Inp : constant String := C.Buffer (1 .. C.Last) & Input; |
| Cur : Positive := Inp'First; |
| |
| begin |
| C.Length := C.Length + Input'Length; |
| |
| while Cur + 63 <= Inp'Last loop |
| Transform (C, Inp (Cur .. Cur + 63)); |
| Cur := Cur + 64; |
| end loop; |
| |
| C.Last := Inp'Last - Cur + 1; |
| C.Buffer (1 .. C.Last) := Inp (Cur .. Inp'Last); |
| end Update; |
| |
| procedure Update |
| (C : in out Context; |
| Input : Ada.Streams.Stream_Element_Array) |
| is |
| subtype Stream_Array is Ada.Streams.Stream_Element_Array (Input'Range); |
| subtype Stream_String is |
| String (1 + Integer (Input'First) .. 1 + Integer (Input'Last)); |
| |
| function To_String is new Ada.Unchecked_Conversion |
| (Stream_Array, Stream_String); |
| |
| String_Input : constant String := To_String (Input); |
| begin |
| Update (C, String_Input); |
| end Update; |
| |
| ----------------- |
| -- Wide_Digest -- |
| ----------------- |
| |
| function Wide_Digest (W : Wide_String) return Message_Digest is |
| C : Context; |
| begin |
| Wide_Update (C, W); |
| return Digest (C); |
| end Wide_Digest; |
| |
| ----------------- |
| -- Wide_Update -- |
| ----------------- |
| |
| procedure Wide_Update |
| (C : in out Context; |
| Input : Wide_String) |
| is |
| String_Input : String (1 .. 2 * Input'Length); |
| Cur : Positive := 1; |
| |
| begin |
| for Index in Input'Range loop |
| String_Input (Cur) := |
| Character'Val |
| (Unsigned_32 (Wide_Character'Pos (Input (Index))) and 16#FF#); |
| Cur := Cur + 1; |
| String_Input (Cur) := |
| Character'Val |
| (Shift_Right (Unsigned_32 (Wide_Character'Pos (Input (Index))), 8) |
| and 16#FF#); |
| Cur := Cur + 1; |
| end loop; |
| |
| Update (C, String_Input); |
| end Wide_Update; |
| |
| end GNAT.SHA1; |
