gcc/ada/libgnat/g-sehash.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --              G N A T . 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-2019, 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 GNAT.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       use System;
 103
 104       type Words is array (Natural range <>) of Interfaces.Unsigned_32;
 105
 106       X : Words (0 .. 15);
 107       for X'Address use M.Buffer'Address;
 108       pragma Import (Ada, X);
 109
 110       W : Words (0 .. 79);
 111
 112       A, B, C, D, E, Temp : Interfaces.Unsigned_32;
 113
 114    begin
 115       if Default_Bit_Order /= High_Order_First then
 116          for J in X'Range loop
 117             Swap4 (X (J)'Address);
 118          end loop;
 119       end if;
 120
 121       --  a. Divide data block into sixteen words
 122
 123       W (0 .. 15) := X;
 124
 125       --  b. Prepare working block of 80 words
 126
 127       for T in 16 .. 79 loop
 128
 129          --  W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
 130
 131          W (T) := Rotate_Left
 132            (W (T - 3) xor W (T - 8) xor W (T - 14) xor W (T - 16), 1);
 133
 134       end loop;
 135
 136       --  c. Set up transformation variables
 137
 138       A := H (0);
 139       B := H (1);
 140       C := H (2);
 141       D := H (3);
 142       E := H (4);
 143
 144       --  d. For each of the 80 rounds, compute:
 145
 146       --  TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
 147       --  E = D;  D = C;  C = S^30(B);  B = A; A = TEMP;
 148
 149       for T in 0 .. 19 loop
 150          Temp := Rotate_Left (A, 5) + F0 (B, C, D) + E + W (T) + 16#5A827999#;
 151          E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
 152       end loop;
 153
 154       for T in 20 .. 39 loop
 155          Temp := Rotate_Left (A, 5) + F1 (B, C, D) + E + W (T) + 16#6ED9EBA1#;
 156          E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
 157       end loop;
 158
 159       for T in 40 .. 59 loop
 160          Temp := Rotate_Left (A, 5) + F2 (B, C, D) + E + W (T) + 16#8F1BBCDC#;
 161          E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
 162       end loop;
 163
 164       for T in 60 .. 79 loop
 165          Temp := Rotate_Left (A, 5) + F3 (B, C, D) + E + W (T) + 16#CA62C1D6#;
 166          E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
 167       end loop;
 168
 169       --  e. Update context:
 170       --  H0 = H0 + A, H1 = H1 + B, H2 = H2 + C, H3 = H3 + D, H4 = H4 + E
 171
 172       H (0) := H (0) + A;
 173       H (1) := H (1) + B;
 174       H (2) := H (2) + C;
 175       H (3) := H (3) + D;
 176       H (4) := H (4) + E;
 177    end Transform;
 178
 179 end GNAT.Secure_Hashes.SHA1;