|
111
|
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 -- --
|
|
145
|
9 -- Copyright (C) 2002-2019, Free Software Foundation, Inc. --
|
|
111
|
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;
|
