gcc/ada/s-sehash.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --            S Y S T E M . S E C U R E _ H A S H E S . S H A 1             --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --         Copyright (C) 2002-2009, Free Software Foundation, Inc.          --
  10 --                                                                          --
  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 3,  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.                                     --
  17 --                                                                          --
  18 -- As a special exception under Section 7 of GPL version 3, you are granted --
  19 -- additional permissions described in the GCC Runtime Library Exception,   --
  20 -- version 3.1, as published by the Free Software Foundation.               --
  21 --                                                                          --
  22 -- You should have received a copy of the GNU General Public License and    --
  23 -- a copy of the GCC Runtime Library Exception along with this program;     --
  24 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  25 -- <http://www.gnu.org/licenses/>.                                          --
  26 --                                                                          --
  27 -- GNAT was originally developed  by the GNAT team at  New York University. --
  28 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  29 --                                                                          --
  30 ------------------------------------------------------------------------------
  31
  32 package body System.Secure_Hashes.SHA1 is
  33
  34    use Interfaces;
  35    use GNAT.Byte_Swapping;
  36
  37    --  The following functions are the four elementary components of each
  38    --  of the four round groups (0 .. 19, 20 .. 39, 40 .. 59, and 60 .. 79)
  39    --  defined in RFC 3174.
  40
  41    function F0 (B, C, D : Unsigned_32) return Unsigned_32;
  42    pragma Inline (F0);
  43
  44    function F1 (B, C, D : Unsigned_32) return Unsigned_32;
  45    pragma Inline (F1);
  46
  47    function F2 (B, C, D : Unsigned_32) return Unsigned_32;
  48    pragma Inline (F2);
  49
  50    function F3 (B, C, D : Unsigned_32) return Unsigned_32;
  51    pragma Inline (F3);
  52
  53    --------
  54    -- F0 --
  55    --------
  56
  57    function F0
  58      (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
  59    is
  60    begin
  61       return (B and C) or ((not B) and D);
  62    end F0;
  63
  64    --------
  65    -- F1 --
  66    --------
  67
  68    function F1
  69      (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
  70    is
  71    begin
  72       return B xor C xor D;
  73    end F1;
  74
  75    --------
  76    -- F2 --
  77    --------
  78
  79    function F2
  80      (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
  81    is
  82    begin
  83       return (B and C) or (B and D) or (C and D);
  84    end F2;
  85
  86    --------
  87    -- F3 --
  88    --------
  89
  90    function F3
  91      (B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
  92      renames F1;
  93
  94    ---------------
  95    -- Transform --
  96    ---------------
  97
  98    procedure Transform
  99      (H : in out Hash_State.State;
 100       M : in out Message_State)
 101    is
 102       type Words is array (Natural range <>) of Interfaces.Unsigned_32;
 103
 104       X : Words (0 .. 15);
 105       for X'Address use M.Buffer'Address;
 106       pragma Import (Ada, X);
 107
 108       W : Words (0 .. 79);
 109
 110       A, B, C, D, E, Temp : Interfaces.Unsigned_32;
 111
 112    begin
 113       if System.Default_Bit_Order /= High_Order_First then
 114          for J in X'Range loop
 115             Swap4 (X (J)'Address);
 116          end loop;
 117       end if;
 118
 119       --  a. Divide data block into sixteen words
 120
 121       W (0 .. 15) := X;
 122
 123       --  b. Prepare working block of 80 words
 124
 125       for T in 16 .. 79 loop
 126
 127          --  W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
 128
 129          W (T) := Rotate_Left
 130            (W (T - 3) xor W (T - 8) xor W (T - 14) xor W (T - 16), 1);
 131
 132       end loop;
 133
 134       --  c. Set up transformation variables
 135
 136       A := H (0);
 137       B := H (1);
 138       C := H (2);
 139       D := H (3);
 140       E := H (4);
 141
 142       --  d. For each of the 80 rounds, compute:
 143
 144       --  TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
 145       --  E = D;  D = C;  C = S^30(B);  B = A; A = TEMP;
 146
 147       for T in 0 .. 19 loop
 148          Temp := Rotate_Left (A, 5) + F0 (B, C, D) + E + W (T) + 16#5A827999#;
 149          E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
 150       end loop;
 151
 152       for T in 20 .. 39 loop
 153          Temp := Rotate_Left (A, 5) + F1 (B, C, D) + E + W (T) + 16#6ED9EBA1#;
 154          E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
 155       end loop;
 156
 157       for T in 40 .. 59 loop
 158          Temp := Rotate_Left (A, 5) + F2 (B, C, D) + E + W (T) + 16#8F1BBCDC#;
 159          E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
 160       end loop;
 161
 162       for T in 60 .. 79 loop
 163          Temp := Rotate_Left (A, 5) + F3 (B, C, D) + E + W (T) + 16#CA62C1D6#;
 164          E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
 165       end loop;
 166
 167       --  e. Update context:
 168       --  H0 = H0 + A, H1 = H1 + B, H2 = H2 + C, H3 = H3 + D, H4 = H4 + E
 169
 170       H (0) := H (0) + A;
 171       H (1) := H (1) + B;
 172       H (2) := H (2) + C;
 173       H (3) := H (3) + D;
 174       H (4) := H (4) + E;
 175    end Transform;
 176
 177 end System.Secure_Hashes.SHA1;