1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- S Y S T E M . S E C U R E _ H A S H E S --
9 -- Copyright (C) 2009, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with System; use System;
33 with Interfaces; use Interfaces;
35 package body System.Secure_Hashes is
39 Hex_Digit : constant array (Stream_Element range 0 .. 15) of Character :=
40 ('0', '1', '2', '3', '4', '5', '6', '7',
41 '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
43 type Fill_Buffer_Access is
45 (M : in out Message_State;
49 -- A procedure to transfer data from S into M's block buffer until either
50 -- the block buffer is full or all data from S has been consumed.
52 procedure Fill_Buffer_Copy
53 (M : in out Message_State;
57 -- Transfer procedure which just copies data from S to M
59 procedure Fill_Buffer_Swap
60 (M : in out Message_State;
64 -- Transfer procedure which swaps bytes from S when copying into M
66 procedure To_String (SEA : Stream_Element_Array; S : out String);
67 -- Return the hexadecimal representation of SEA
69 ----------------------
70 -- Fill_Buffer_Copy --
71 ----------------------
73 procedure Fill_Buffer_Copy
74 (M : in out Message_State;
79 Buf_String : String (M.Buffer'Range);
80 for Buf_String'Address use M.Buffer'Address;
81 pragma Import (Ada, Buf_String);
83 Length : constant Natural :=
84 Natural'Min (M.Block_Length - M.Last, S'Last - First + 1);
87 pragma Assert (Length > 0);
89 Buf_String (M.Last + 1 .. M.Last + Length) :=
90 S (First .. First + Length - 1);
91 M.Last := M.Last + Length;
92 Last := First + Length - 1;
95 ----------------------
96 -- Fill_Buffer_Swap --
97 ----------------------
99 procedure Fill_Buffer_Swap
100 (M : in out Message_State;
105 Length : constant Natural :=
106 Natural'Min (M.Block_Length - M.Last, S'Last - First + 1);
109 while Last - First < Length loop
110 M.Buffer (M.Last + 1 + Last - First) :=
111 (if (Last - First) mod 2 = 0 then S (Last + 1) else S (Last - 1));
114 M.Last := M.Last + Length;
115 Last := First + Length - 1;
116 end Fill_Buffer_Swap;
122 procedure To_String (SEA : Stream_Element_Array; S : out String) is
123 pragma Assert (S'Length = 2 * SEA'Length);
125 for J in SEA'Range loop
127 S_J : constant Natural := 1 + Natural (J - SEA'First) * 2;
129 S (S_J) := Hex_Digit (SEA (J) / 16);
130 S (S_J + 1) := Hex_Digit (SEA (J) mod 16);
144 Fill_Buffer : Fill_Buffer_Access);
145 -- Internal common routine for all Update procedures
149 Hash_Bits : out Ada.Streams.Stream_Element_Array);
150 -- Perform final hashing operations (data padding) and extract the
151 -- (possibly truncated) state of C into Hash_Bits.
157 function Digest (C : Context) return Message_Digest is
158 Hash_Bits : Stream_Element_Array
159 (1 .. Stream_Element_Offset (Hash_Length));
161 Final (C, Hash_Bits);
162 return MD : Message_Digest do
163 To_String (Hash_Bits, MD);
167 function Digest (S : String) return Message_Digest is
174 function Digest (A : Stream_Element_Array) return Message_Digest is
185 -- Once a complete message has been processed, it is padded with one
186 -- 1 bit followed by enough 0 bits so that the last block is
187 -- 2 * Word'Size bits short of being completed. The last 2 * Word'Size
188 -- bits are set to the message size in bits (excluding padding).
192 Hash_Bits : out Stream_Element_Array)
197 -- Number of 0 bytes in padding
199 Message_Length : Unsigned_64 := FC.M_State.Length;
200 -- Message length in bytes
202 Size_Length : constant Natural :=
203 2 * Hash_State.Word'Size / 8;
204 -- Length in bytes of the size representation
207 Zeroes := (Block_Length - 1 - Size_Length - FC.M_State.Last)
208 mod FC.M_State.Block_Length;
210 Pad : String (1 .. 1 + Zeroes + Size_Length) :=
211 (1 => Character'Val (128), others => ASCII.NUL);
214 First_Index : Natural;
217 First_Index := (if Hash_Bit_Order = Low_Order_First
218 then Pad'Last - Size_Length + 1
221 Index := First_Index;
222 while Message_Length > 0 loop
223 if Index = First_Index then
225 -- Message_Length is in bytes, but we need to store it as
228 Pad (Index) := Character'Val
229 (Shift_Left (Message_Length and 16#1f#, 3));
230 Message_Length := Shift_Right (Message_Length, 5);
233 Pad (Index) := Character'Val (Message_Length and 16#ff#);
234 Message_Length := Shift_Right (Message_Length, 8);
238 (if Hash_Bit_Order = Low_Order_First then 1 else -1);
244 pragma Assert (FC.M_State.Last = 0);
246 Hash_State.To_Hash (FC.H_State, Hash_Bits);
256 Fill_Buffer : Fill_Buffer_Access)
258 Last : Natural := S'First - 1;
261 C.M_State.Length := C.M_State.Length + S'Length;
263 while Last < S'Last loop
264 Fill_Buffer (C.M_State, S, Last + 1, Last);
266 if C.M_State.Last = Block_Length then
267 Transform (C.H_State, C.M_State);
278 procedure Update (C : in out Context; Input : String) is
280 Update (C, Input, Fill_Buffer_Copy'Access);
287 procedure Update (C : in out Context; Input : Stream_Element_Array) is
288 S : String (1 .. Input'Length);
289 for S'Address use Input'Address;
290 pragma Import (Ada, S);
292 Update (C, S, Fill_Buffer_Copy'Access);
299 procedure Wide_Update (C : in out Context; Input : Wide_String) is
300 S : String (1 .. 2 * Input'Length);
301 for S'Address use Input'Address;
302 pragma Import (Ada, S);
306 (if System.Default_Bit_Order /= Low_Order_First
307 then Fill_Buffer_Swap'Access
308 else Fill_Buffer_Copy'Access));
315 function Wide_Digest (W : Wide_String) return Message_Digest is
324 -------------------------
325 -- Hash_Function_State --
326 -------------------------
328 package body Hash_Function_State is
334 procedure To_Hash (H : State; H_Bits : out Stream_Element_Array) is
335 Hash_Words : constant Natural := H'Size / Word'Size;
336 Result : State (1 .. Hash_Words) :=
337 H (H'Last - Hash_Words + 1 .. H'Last);
339 R_SEA : Stream_Element_Array (1 .. Result'Size / 8);
340 for R_SEA'Address use Result'Address;
341 pragma Import (Ada, R_SEA);
344 if System.Default_Bit_Order /= Hash_Bit_Order then
345 for J in Result'Range loop
346 Swap (Result (J)'Address);
350 -- Return truncated hash
352 pragma Assert (H_Bits'Length <= R_SEA'Length);
353 H_Bits := R_SEA (R_SEA'First .. R_SEA'First + H_Bits'Length - 1);
356 end Hash_Function_State;
358 end System.Secure_Hashes;