s-sechas.adb, [...]: Rename System.Secure_Hashes to GNAT.Secure_Hashes.

2009-11-30  Thomas Quinot  <quinot@adacore.com>

	* s-sechas.adb, s-sechas.ads, s-shshco.adb, s-shshco.ads, s-shsh64.adb,
	s-shsh64.ads, s-sehamd.adb, s-sehamd.ads, s-shsh32.adb, s-shsh32.ads,
	s-sehash.adb, s-sehash.ads, g-sechas.adb, g-sechas.ads, g-shshco.adb,
	g-shshco.ads, g-md5.ads, g-sha256.ads, g-shsh64.adb, g-shsh64.ads,
	g-sehamd.adb, g-sehamd.ads, g-sha512.ads, g-sha1.ads, Makefile.rtl,
	g-sha224.ads, g-shsh32.adb, g-shsh32.ads, g-sha384.ads, g-sehash.adb,
	g-sehash.ads: Rename System.Secure_Hashes to GNAT.Secure_Hashes.

From-SVN: r154822

1 files changed, 367 insertions, 0 deletions

diff --git a/gcc/ada/g-sechas.adb b/gcc/ada/g-sechas.adb
new file mode 100644
index 0000000..1c57548
--- /dev/null
+++ b/gcc/ada/g-sechas.adb
@@ -0,0 +1,367 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--                   G N A T . S E C U R E _ H A S H E S                    --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--           Copyright (C) 2009, Free Software Foundation, Inc.             --
+--                                                                          --
+-- 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 3,  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.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System;     use System;
+with Interfaces; use Interfaces;
+
+package body GNAT.Secure_Hashes is
+
+   use Ada.Streams;
+
+   Hex_Digit : constant array (Stream_Element range 0 .. 15) of Character :=
+                 ('0', '1', '2', '3', '4', '5', '6', '7',
+                  '8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
+
+   type Fill_Buffer_Access is
+     access procedure
+       (M     : in out Message_State;
+        S     : String;
+        First : Natural;
+        Last  : out Natural);
+   --  A procedure to transfer data from S, starting at First, into M's block
+   --  buffer until either the block buffer is full or all data from S has been
+   --  consumed.
+
+   procedure Fill_Buffer_Copy
+     (M     : in out Message_State;
+      S     : String;
+      First : Natural;
+      Last  : out Natural);
+   --  Transfer procedure which just copies data from S to M
+
+   procedure Fill_Buffer_Swap
+     (M     : in out Message_State;
+      S     : String;
+      First : Natural;
+      Last  : out Natural);
+   --  Transfer procedure which swaps bytes from S when copying into M. S must
+   --  have even length. Note that the swapping is performed considering pairs
+   --  starting at S'First, even if S'First /= First (that is, if
+   --  First = S'First then the first copied byte is always S (S'First + 1),
+   --  and if First = S'First + 1 then the first copied byte is always
+   --  S (S'First).
+
+   procedure To_String (SEA : Stream_Element_Array; S : out String);
+   --  Return the hexadecimal representation of SEA
+
+   ----------------------
+   -- Fill_Buffer_Copy --
+   ----------------------
+
+   procedure Fill_Buffer_Copy
+     (M     : in out Message_State;
+      S     : String;
+      First : Natural;
+      Last  : out Natural)
+   is
+      Buf_String : String (M.Buffer'Range);
+      for Buf_String'Address use M.Buffer'Address;
+      pragma Import (Ada, Buf_String);
+
+      Length : constant Natural :=
+                 Natural'Min (M.Block_Length - M.Last, S'Last - First + 1);
+
+   begin
+      pragma Assert (Length > 0);
+
+      Buf_String (M.Last + 1 .. M.Last + Length) :=
+        S (First .. First + Length - 1);
+      M.Last := M.Last + Length;
+      Last := First + Length - 1;
+   end Fill_Buffer_Copy;
+
+   ----------------------
+   -- Fill_Buffer_Swap --
+   ----------------------
+
+   procedure Fill_Buffer_Swap
+     (M     : in out Message_State;
+      S     : String;
+      First : Natural;
+      Last  : out Natural)
+   is
+      pragma Assert (S'Length mod 2 = 0);
+      Length : constant Natural :=
+                  Natural'Min (M.Block_Length - M.Last, S'Last - First + 1);
+   begin
+      Last := First;
+      while Last - First < Length loop
+         M.Buffer (M.Last + 1 + Last - First) :=
+           (if (Last - S'First) mod 2 = 0
+            then S (Last + 1)
+            else S (Last - 1));
+         Last := Last + 1;
+      end loop;
+      M.Last := M.Last + Length;
+      Last := First + Length - 1;
+   end Fill_Buffer_Swap;
+
+   ---------------
+   -- To_String --
+   ---------------
+
+   procedure To_String (SEA : Stream_Element_Array; S : out String) is
+      pragma Assert (S'Length = 2 * SEA'Length);
+   begin
+      for J in SEA'Range loop
+         declare
+            S_J : constant Natural := 1 + Natural (J - SEA'First) * 2;
+         begin
+            S (S_J)     := Hex_Digit (SEA (J) / 16);
+            S (S_J + 1) := Hex_Digit (SEA (J) mod 16);
+         end;
+      end loop;
+   end To_String;
+
+   -------
+   -- H --
+   -------
+
+   package body H is
+
+      procedure Update
+        (C           : in out Context;
+         S           : String;
+         Fill_Buffer : Fill_Buffer_Access);
+      --  Internal common routine for all Update procedures
+
+      procedure Final
+        (C         : Context;
+         Hash_Bits : out Ada.Streams.Stream_Element_Array);
+      --  Perform final hashing operations (data padding) and extract the
+      --  (possibly truncated) state of C into Hash_Bits.
+
+      ------------
+      -- Digest --
+      ------------
+
+      function Digest (C : Context) return Message_Digest is
+         Hash_Bits : Stream_Element_Array
+                       (1 .. Stream_Element_Offset (Hash_Length));
+      begin
+         Final (C, Hash_Bits);
+         return MD : Message_Digest do
+            To_String (Hash_Bits, MD);
+         end return;
+      end Digest;
+
+      function Digest (S : String) return Message_Digest is
+         C : Context;
+      begin
+         Update (C, S);
+         return Digest (C);
+      end Digest;
+
+      function Digest (A : Stream_Element_Array) return Message_Digest is
+         C : Context;
+      begin
+         Update (C, A);
+         return Digest (C);
+      end Digest;
+
+      -----------
+      -- Final --
+      -----------
+
+      --  Once a complete message has been processed, it is padded with one
+      --  1 bit followed by enough 0 bits so that the last block is
+      --  2 * Word'Size bits short of being completed. The last 2 * Word'Size
+      --  bits are set to the message size in bits (excluding padding).
+
+      procedure Final
+        (C          : Context;
+         Hash_Bits  : out Stream_Element_Array)
+      is
+         FC : Context := C;
+
+         Zeroes : Natural;
+         --  Number of 0 bytes in padding
+
+         Message_Length : Unsigned_64 := FC.M_State.Length;
+         --  Message length in bytes
+
+         Size_Length : constant Natural :=
+                         2 * Hash_State.Word'Size / 8;
+         --  Length in bytes of the size representation
+
+      begin
+         Zeroes := (Block_Length - 1 - Size_Length - FC.M_State.Last)
+                     mod FC.M_State.Block_Length;
+         declare
+            Pad : String (1 .. 1 + Zeroes + Size_Length) :=
+                    (1 => Character'Val (128), others => ASCII.NUL);
+
+            Index       : Natural;
+            First_Index : Natural;
+
+         begin
+            First_Index := (if Hash_Bit_Order = Low_Order_First
+                            then Pad'Last - Size_Length + 1
+                            else Pad'Last);
+
+            Index := First_Index;
+            while Message_Length > 0 loop
+               if Index = First_Index then
+
+                  --  Message_Length is in bytes, but we need to store it as
+                  --  a bit count).
+
+                  Pad (Index) := Character'Val
+                                   (Shift_Left (Message_Length and 16#1f#, 3));
+                  Message_Length := Shift_Right (Message_Length, 5);
+
+               else
+                  Pad (Index) := Character'Val (Message_Length and 16#ff#);
+                  Message_Length := Shift_Right (Message_Length, 8);
+               end if;
+
+               Index := Index +
+                          (if Hash_Bit_Order = Low_Order_First then 1 else -1);
+            end loop;
+
+            Update (FC, Pad);
+         end;
+
+         pragma Assert (FC.M_State.Last = 0);
+
+         Hash_State.To_Hash (FC.H_State, Hash_Bits);
+      end Final;
+
+      ------------
+      -- Update --
+      ------------
+
+      procedure Update
+        (C           : in out Context;
+         S           : String;
+         Fill_Buffer : Fill_Buffer_Access)
+      is
+         Last : Natural := S'First - 1;
+
+      begin
+         C.M_State.Length := C.M_State.Length + S'Length;
+
+         while Last < S'Last loop
+            Fill_Buffer (C.M_State, S, Last + 1, Last);
+
+            if C.M_State.Last = Block_Length then
+               Transform (C.H_State, C.M_State);
+               C.M_State.Last := 0;
+            end if;
+         end loop;
+
+      end Update;
+
+      ------------
+      -- Update --
+      ------------
+
+      procedure Update (C : in out Context; Input : String) is
+      begin
+         Update (C, Input, Fill_Buffer_Copy'Access);
+      end Update;
+
+      ------------
+      -- Update --
+      ------------
+
+      procedure Update (C : in out Context; Input : Stream_Element_Array) is
+         S : String (1 .. Input'Length);
+         for S'Address use Input'Address;
+         pragma Import (Ada, S);
+      begin
+         Update (C, S, Fill_Buffer_Copy'Access);
+      end Update;
+
+      -----------------
+      -- Wide_Update --
+      -----------------
+
+      procedure Wide_Update (C : in out Context; Input : Wide_String) is
+         S : String (1 .. 2 * Input'Length);
+         for S'Address use Input'Address;
+         pragma Import (Ada, S);
+      begin
+         Update
+           (C, S,
+            (if System.Default_Bit_Order /= Low_Order_First
+             then Fill_Buffer_Swap'Access
+             else Fill_Buffer_Copy'Access));
+      end Wide_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;
+
+   end H;
+
+   -------------------------
+   -- Hash_Function_State --
+   -------------------------
+
+   package body Hash_Function_State is
+
+      -------------
+      -- To_Hash --
+      -------------
+
+      procedure To_Hash (H : State; H_Bits : out Stream_Element_Array) is
+         Hash_Words : constant Natural := H'Size / Word'Size;
+         Result     : State (1 .. Hash_Words) :=
+                        H (H'Last - Hash_Words + 1 .. H'Last);
+
+         R_SEA : Stream_Element_Array (1 .. Result'Size / 8);
+         for R_SEA'Address use Result'Address;
+         pragma Import (Ada, R_SEA);
+
+      begin
+         if System.Default_Bit_Order /= Hash_Bit_Order then
+            for J in Result'Range loop
+               Swap (Result (J)'Address);
+            end loop;
+         end if;
+
+         --  Return truncated hash
+
+         pragma Assert (H_Bits'Length <= R_SEA'Length);
+         H_Bits := R_SEA (R_SEA'First .. R_SEA'First + H_Bits'Length - 1);
+      end To_Hash;
+
+   end Hash_Function_State;
+
+end GNAT.Secure_Hashes;