Skip to content

R
riscv-gcc-1
Commit 47257438 by Arnaud Charlet
Options

[multiple changes] 

2009-11-30  Pascal Obry  <obry@adacore.com>

	* expect.c: Fix cast to avoid warnings in x86-64 Windows.

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

	* gnat_rm.texi, s-sechas.adb, s-sechas.ads, s-shshco.adb,
	s-shshco.ads, g-md5.adb, g-md5.ads, g-sha256.ads, s-shsh64.adb,
	s-shsh64.ads, s-sehamd.adb, s-sehamd.ads, g-sha512.ads, g-sha1.adb,
	g-sha1.ads, Makefile.rtl, g-sha224.ads, g-sha384.ads, s-shsh32.adb,
	s-shsh32.ads, s-sehash.adb, s-sehash.ads: Reimplementation of GNAT.MD5
	and GNAT.SHA1 to factor shared code and avoid unnecessary stack copies.
	Also introduce new functions SHA-{224,256,384,512}

From-SVN: r154812
parent 0f79311b
Showing with 2082 additions and 1073 deletions
gcc/ada/ChangeLog
2009-11-30 Pascal Obry <obry@adacore.com>
* expect.c: Fix cast to avoid warnings in x86-64 Windows.
2009-11-30 Thomas Quinot <quinot@adacore.com>
* gnat_rm.texi, s-sechas.adb, s-sechas.ads, s-shshco.adb,
s-shshco.ads, g-md5.adb, g-md5.ads, g-sha256.ads, s-shsh64.adb,
s-shsh64.ads, s-sehamd.adb, s-sehamd.ads, g-sha512.ads, g-sha1.adb,
g-sha1.ads, Makefile.rtl, g-sha224.ads, g-sha384.ads, s-shsh32.adb,
s-shsh32.ads, s-sehash.adb, s-sehash.ads: Reimplementation of GNAT.MD5
and GNAT.SHA1 to factor shared code and avoid unnecessary stack copies.
Also introduce new functions SHA-{224,256,384,512}
2009-11-30 Jerome Lambourg <lambourg@adacore.com>
* exp_ch3.adb (Make_Predefined_Primitive_Specs): Improve comment for
......
gcc/ada/Makefile.rtl
......@@ -80,9 +80,9 @@ GNATRTL_TASKING_OBJS= \
GNATRTL_NONTASKING_OBJS= \
a-assert$(objext) \
a-calari$(objext) \
a-calcon$(objext) \
a-caldel$(objext) \
a-calend$(objext) \
a-calcon$(objext) \
a-calfor$(objext) \
a-catizo$(objext) \
a-cdlili$(objext) \
......@@ -146,12 +146,12 @@ GNATRTL_NONTASKING_OBJS= \
a-izteio$(objext) \
a-lcteio$(objext) \
a-lfteio$(objext) \
a-llctio$(objext) \
a-lfwtio$(objext) \
a-lfztio$(objext) \
a-liteio$(objext) \
a-liwtio$(objext) \
a-liztio$(objext) \
a-llctio$(objext) \
a-llftio$(objext) \
a-llfwti$(objext) \
a-llfzti$(objext) \
......@@ -239,9 +239,9 @@ GNATRTL_NONTASKING_OBJS= \
a-szuzha$(objext) \
a-szuzti$(objext) \
a-tags$(objext) \
a-tgdico$(objext) \
a-teioed$(objext) \
a-textio$(objext) \
a-tgdico$(objext) \
a-tiboio$(objext) \
a-ticoau$(objext) \
a-ticoio$(objext) \
......@@ -337,18 +337,18 @@ GNATRTL_NONTASKING_OBJS= \
g-crc32$(objext) \
g-ctrl_c$(objext) \
g-curexc$(objext) \
g-debuti$(objext) \
g-debpoo$(objext) \
g-debuti$(objext) \
g-decstr$(objext) \
g-deutst$(objext) \
g-diopit$(objext) \
g-dirope$(objext) \
g-dyntab$(objext) \
g-dynhta$(objext) \
g-dyntab$(objext) \
g-encstr$(objext) \
g-enutst$(objext) \
g-except$(objext) \
g-excact$(objext) \
g-except$(objext) \
g-exctra$(objext) \
g-expect$(objext) \
g-flocon$(objext) \
......@@ -370,9 +370,13 @@ GNATRTL_NONTASKING_OBJS= \
g-sercom$(objext) \
g-sestin$(objext) \
g-sha1$(objext) \
g-sha224$(objext) \
g-sha256$(objext) \
g-sha384$(objext) \
g-sha512$(objext) \
g-souinf$(objext) \
g-speche$(objext) \
g-spchge$(objext) \
g-speche$(objext) \
g-spipat$(objext) \
g-spitbo$(objext) \
g-sptabo$(objext) \
......@@ -384,8 +388,8 @@ GNATRTL_NONTASKING_OBJS= \
g-tasloc$(objext) \
g-timsta$(objext) \
g-traceb$(objext) \
g-utf_32$(objext) \
g-u3spch$(objext) \
g-utf_32$(objext) \
g-wispch$(objext) \
g-wistsp$(objext) \
g-zspche$(objext) \
......@@ -430,13 +434,13 @@ GNATRTL_NONTASKING_OBJS= \
s-conca7$(objext) \
s-conca8$(objext) \
s-conca9$(objext) \
s-crc32$(objext) \
s-crtl$(objext) \
s-crtrun$(objext) \
s-crc32$(objext) \
s-direio$(objext) \
s-dsaser$(objext) \
s-exctab$(objext) \
s-except$(objext) \
s-exctab$(objext) \
s-exnint$(objext) \
s-exnllf$(objext) \
s-exnlli$(objext) \
......@@ -453,14 +457,15 @@ GNATRTL_NONTASKING_OBJS= \
s-ficobl$(objext) \
s-fileio$(objext) \
s-filofl$(objext) \
s-fishfl$(objext) \
s-finimp$(objext) \
s-finroo$(objext) \
s-fishfl$(objext) \
s-fore$(objext) \
s-fvadfl$(objext) \
s-fvaffl$(objext) \
s-fvagfl$(objext) \
s-geveop$(objext) \
s-gloloc$(objext) \
s-htable$(objext) \
s-imenne$(objext) \
s-imgbiu$(objext) \
......@@ -479,10 +484,11 @@ GNATRTL_NONTASKING_OBJS= \
s-imgwch$(objext) \
s-imgwiu$(objext) \
s-io$(objext) \
s-gloloc$(objext) \
s-maccod$(objext) \
s-mantis$(objext) \
s-mastop$(objext) \
s-memcop$(objext) \
s-memory$(objext) \
s-os_lib$(objext) \
s-osprim$(objext) \
s-pack03$(objext) \
......@@ -556,22 +562,26 @@ GNATRTL_NONTASKING_OBJS= \
s-rident$(objext) \
s-rpc$(objext) \
s-scaval$(objext) \
s-sechas$(objext) \
s-secsta$(objext) \
s-sehamd$(objext) \
s-sehash$(objext) \
s-sequio$(objext) \
s-shasto$(objext) \
s-shsh32$(objext) \
s-shsh64$(objext) \
s-shshco$(objext) \
s-soflin$(objext) \
s-stache$(objext) \
s-stalib$(objext) \
s-stausa$(objext) \
s-stchop$(objext) \
s-stalib$(objext) \
s-stoele$(objext) \
s-stopoo$(objext) \
s-stratt$(objext) \
s-strhas$(objext) \
s-ststop$(objext) \
s-soflin$(objext) \
s-memory$(objext) \
s-memcop$(objext) \
s-string$(objext) \
s-ststop$(objext) \
s-tasloc$(objext) \
s-traceb$(objext) \
s-traces$(objext) \
......
gcc/ada/expect.c
......@@ -143,8 +143,8 @@ __gnat_pipe (int *fd)
HANDLE read, write;
CreatePipe (&read, &write, NULL, 0);
fd[0]=_open_osfhandle ((long)read, 0);
fd[1]=_open_osfhandle ((long)write, 0);
fd[0]=_open_osfhandle ((intptr_t)read, 0);
fd[1]=_open_osfhandle ((intptr_t)write, 0);
return 0; /* always success */
}
......
gcc/ada/g-md5.adb
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . M D 5 --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2008, AdaCore --
-- 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- --
......@@ -16,8 +16,8 @@
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
......@@ -31,525 +31,8 @@
-- --
------------------------------------------------------------------------------
with Ada.Unchecked_Conversion;
-- This package does not require a body, since it is a package renaming. We
-- provide a dummy file containing a No_Body pragma so that previous versions
-- of the body (which did exist) will not interfere.
package body GNAT.MD5 is
use Interfaces;
Padding : constant String :=
(1 => Character'Val (16#80#), 2 .. 64 => ASCII.NUL);
Hex_Digit : constant array (Unsigned_32 range 0 .. 15) of Character :=
('0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
-- Look-up table for each hex digit of the Message-Digest.
-- Used by function Digest (Context).
-- The sixteen values used to rotate the context words.
-- Four for each rounds. Used in procedure Transform.
-- Round 1
S11 : constant := 7;
S12 : constant := 12;
S13 : constant := 17;
S14 : constant := 22;
-- Round 2
S21 : constant := 5;
S22 : constant := 9;
S23 : constant := 14;
S24 : constant := 20;
-- Round 3
S31 : constant := 4;
S32 : constant := 11;
S33 : constant := 16;
S34 : constant := 23;
-- Round 4
S41 : constant := 6;
S42 : constant := 10;
S43 : constant := 15;
S44 : constant := 21;
type Sixteen_Words is array (Natural range 0 .. 15)
of Interfaces.Unsigned_32;
-- Sixteen 32-bit words, converted from block of 64 characters.
-- Used in procedure Decode and Transform.
procedure Decode
(Block : String;
X : out Sixteen_Words);
-- Convert a String of 64 characters into 16 32-bit numbers
-- The following functions (F, FF, G, GG, H, HH, I and II) are the
-- equivalent of the macros of the same name in the example
-- C implementation in the annex of RFC 1321.
function F (X, Y, Z : Unsigned_32) return Unsigned_32;
pragma Inline (F);
procedure FF
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive);
pragma Inline (FF);
function G (X, Y, Z : Unsigned_32) return Unsigned_32;
pragma Inline (G);
procedure GG
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive);
pragma Inline (GG);
function H (X, Y, Z : Unsigned_32) return Unsigned_32;
pragma Inline (H);
procedure HH
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive);
pragma Inline (HH);
function I (X, Y, Z : Unsigned_32) return Unsigned_32;
pragma Inline (I);
procedure II
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive);
pragma Inline (II);
procedure Transform
(C : in out Context;
Block : String);
-- Process one block of 64 characters
------------
-- Decode --
------------
procedure Decode
(Block : String;
X : out Sixteen_Words)
is
Cur : Positive := Block'First;
begin
pragma Assert (Block'Length = 64);
for Index in X'Range loop
X (Index) :=
Unsigned_32 (Character'Pos (Block (Cur))) +
Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 1))), 8) +
Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 2))), 16) +
Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 3))), 24);
Cur := Cur + 4;
end loop;
end Decode;
------------
-- Digest --
------------
function Digest (C : Context) return Message_Digest is
Result : Message_Digest;
Cur : Natural := 1;
-- Index in Result where the next character will be placed
Last_Block : String (1 .. 64);
C1 : Context := C;
procedure Convert (X : Unsigned_32);
-- Put the contribution of one of the four words (A, B, C, D) of the
-- Context in Result. Increments Cur.
-------------
-- Convert --
-------------
procedure Convert (X : Unsigned_32) is
Y : Unsigned_32 := X;
begin
for J in 1 .. 4 loop
Result (Cur + 1) := Hex_Digit (Y and Unsigned_32'(16#0F#));
Y := Shift_Right (Y, 4);
Result (Cur) := Hex_Digit (Y and Unsigned_32'(16#0F#));
Y := Shift_Right (Y, 4);
Cur := Cur + 2;
end loop;
end Convert;
-- Start of processing for Digest
begin
-- Process characters in the context buffer, if any
Last_Block (1 .. C.Last) := C.Buffer (1 .. C.Last);
-- Too many magic literals below, should be defined as constants ???
if C.Last > 55 then
Last_Block (C.Last + 1 .. 64) := Padding (1 .. 64 - C.Last);
Transform (C1, Last_Block);
Last_Block := (others => ASCII.NUL);
else
Last_Block (C.Last + 1 .. 56) := Padding (1 .. 56 - C.Last);
end if;
-- Add the input length (as stored in the context) as 8 characters
Last_Block (57 .. 64) := (others => ASCII.NUL);
declare
L : Unsigned_64 := Unsigned_64 (C.Length) * 8;
Idx : Positive := 57;
begin
while L > 0 loop
Last_Block (Idx) := Character'Val (L and 16#Ff#);
L := Shift_Right (L, 8);
Idx := Idx + 1;
end loop;
end;
Transform (C1, Last_Block);
Convert (C1.A);
Convert (C1.B);
Convert (C1.C);
Convert (C1.D);
return Result;
end Digest;
function Digest (S : String) return Message_Digest is
C : Context;
begin
Update (C, S);
return Digest (C);
end Digest;
function Digest
(A : Ada.Streams.Stream_Element_Array) return Message_Digest
is
C : Context;
begin
Update (C, A);
return Digest (C);
end Digest;
-------
-- F --
-------
function F (X, Y, Z : Unsigned_32) return Unsigned_32 is
begin
return (X and Y) or ((not X) and Z);
end F;
--------
-- FF --
--------
procedure FF
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive)
is
begin
A := A + F (B, C, D) + X + AC;
A := Rotate_Left (A, S);
A := A + B;
end FF;
-------
-- G --
-------
function G (X, Y, Z : Unsigned_32) return Unsigned_32 is
begin
return (X and Z) or (Y and (not Z));
end G;
--------
-- GG --
--------
procedure GG
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive)
is
begin
A := A + G (B, C, D) + X + AC;
A := Rotate_Left (A, S);
A := A + B;
end GG;
-------
-- H --
-------
function H (X, Y, Z : Unsigned_32) return Unsigned_32 is
begin
return X xor Y xor Z;
end H;
--------
-- HH --
--------
procedure HH
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive)
is
begin
A := A + H (B, C, D) + X + AC;
A := Rotate_Left (A, S);
A := A + B;
end HH;
-------
-- I --
-------
function I (X, Y, Z : Unsigned_32) return Unsigned_32 is
begin
return Y xor (X or (not Z));
end I;
--------
-- II --
--------
procedure II
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive)
is
begin
A := A + I (B, C, D) + X + AC;
A := Rotate_Left (A, S);
A := A + B;
end II;
---------------
-- Transform --
---------------
procedure Transform
(C : in out Context;
Block : String)
is
X : Sixteen_Words;
AA : Unsigned_32 := C.A;
BB : Unsigned_32 := C.B;
CC : Unsigned_32 := C.C;
DD : Unsigned_32 := C.D;
begin
pragma Assert (Block'Length = 64);
Decode (Block, X);
-- Round 1
FF (AA, BB, CC, DD, X (00), 16#D76aa478#, S11); -- 1
FF (DD, AA, BB, CC, X (01), 16#E8c7b756#, S12); -- 2
FF (CC, DD, AA, BB, X (02), 16#242070db#, S13); -- 3
FF (BB, CC, DD, AA, X (03), 16#C1bdceee#, S14); -- 4
FF (AA, BB, CC, DD, X (04), 16#f57c0faf#, S11); -- 5
FF (DD, AA, BB, CC, X (05), 16#4787c62a#, S12); -- 6
FF (CC, DD, AA, BB, X (06), 16#a8304613#, S13); -- 7
FF (BB, CC, DD, AA, X (07), 16#fd469501#, S14); -- 8
FF (AA, BB, CC, DD, X (08), 16#698098d8#, S11); -- 9
FF (DD, AA, BB, CC, X (09), 16#8b44f7af#, S12); -- 10
FF (CC, DD, AA, BB, X (10), 16#ffff5bb1#, S13); -- 11
FF (BB, CC, DD, AA, X (11), 16#895cd7be#, S14); -- 12
FF (AA, BB, CC, DD, X (12), 16#6b901122#, S11); -- 13
FF (DD, AA, BB, CC, X (13), 16#fd987193#, S12); -- 14
FF (CC, DD, AA, BB, X (14), 16#a679438e#, S13); -- 15
FF (BB, CC, DD, AA, X (15), 16#49b40821#, S14); -- 16
-- Round 2
GG (AA, BB, CC, DD, X (01), 16#f61e2562#, S21); -- 17
GG (DD, AA, BB, CC, X (06), 16#c040b340#, S22); -- 18
GG (CC, DD, AA, BB, X (11), 16#265e5a51#, S23); -- 19
GG (BB, CC, DD, AA, X (00), 16#e9b6c7aa#, S24); -- 20
GG (AA, BB, CC, DD, X (05), 16#d62f105d#, S21); -- 21
GG (DD, AA, BB, CC, X (10), 16#02441453#, S22); -- 22
GG (CC, DD, AA, BB, X (15), 16#d8a1e681#, S23); -- 23
GG (BB, CC, DD, AA, X (04), 16#e7d3fbc8#, S24); -- 24
GG (AA, BB, CC, DD, X (09), 16#21e1cde6#, S21); -- 25
GG (DD, AA, BB, CC, X (14), 16#c33707d6#, S22); -- 26
GG (CC, DD, AA, BB, X (03), 16#f4d50d87#, S23); -- 27
GG (BB, CC, DD, AA, X (08), 16#455a14ed#, S24); -- 28
GG (AA, BB, CC, DD, X (13), 16#a9e3e905#, S21); -- 29
GG (DD, AA, BB, CC, X (02), 16#fcefa3f8#, S22); -- 30
GG (CC, DD, AA, BB, X (07), 16#676f02d9#, S23); -- 31
GG (BB, CC, DD, AA, X (12), 16#8d2a4c8a#, S24); -- 32
-- Round 3
HH (AA, BB, CC, DD, X (05), 16#fffa3942#, S31); -- 33
HH (DD, AA, BB, CC, X (08), 16#8771f681#, S32); -- 34
HH (CC, DD, AA, BB, X (11), 16#6d9d6122#, S33); -- 35
HH (BB, CC, DD, AA, X (14), 16#fde5380c#, S34); -- 36
HH (AA, BB, CC, DD, X (01), 16#a4beea44#, S31); -- 37
HH (DD, AA, BB, CC, X (04), 16#4bdecfa9#, S32); -- 38
HH (CC, DD, AA, BB, X (07), 16#f6bb4b60#, S33); -- 39
HH (BB, CC, DD, AA, X (10), 16#bebfbc70#, S34); -- 40
HH (AA, BB, CC, DD, X (13), 16#289b7ec6#, S31); -- 41
HH (DD, AA, BB, CC, X (00), 16#eaa127fa#, S32); -- 42
HH (CC, DD, AA, BB, X (03), 16#d4ef3085#, S33); -- 43
HH (BB, CC, DD, AA, X (06), 16#04881d05#, S34); -- 44
HH (AA, BB, CC, DD, X (09), 16#d9d4d039#, S31); -- 45
HH (DD, AA, BB, CC, X (12), 16#e6db99e5#, S32); -- 46
HH (CC, DD, AA, BB, X (15), 16#1fa27cf8#, S33); -- 47
HH (BB, CC, DD, AA, X (02), 16#c4ac5665#, S34); -- 48
-- Round 4
II (AA, BB, CC, DD, X (00), 16#f4292244#, S41); -- 49
II (DD, AA, BB, CC, X (07), 16#432aff97#, S42); -- 50
II (CC, DD, AA, BB, X (14), 16#ab9423a7#, S43); -- 51
II (BB, CC, DD, AA, X (05), 16#fc93a039#, S44); -- 52
II (AA, BB, CC, DD, X (12), 16#655b59c3#, S41); -- 53
II (DD, AA, BB, CC, X (03), 16#8f0ccc92#, S42); -- 54
II (CC, DD, AA, BB, X (10), 16#ffeff47d#, S43); -- 55
II (BB, CC, DD, AA, X (01), 16#85845dd1#, S44); -- 56
II (AA, BB, CC, DD, X (08), 16#6fa87e4f#, S41); -- 57
II (DD, AA, BB, CC, X (15), 16#fe2ce6e0#, S42); -- 58
II (CC, DD, AA, BB, X (06), 16#a3014314#, S43); -- 59
II (BB, CC, DD, AA, X (13), 16#4e0811a1#, S44); -- 60
II (AA, BB, CC, DD, X (04), 16#f7537e82#, S41); -- 61
II (DD, AA, BB, CC, X (11), 16#bd3af235#, S42); -- 62
II (CC, DD, AA, BB, X (02), 16#2ad7d2bb#, S43); -- 63
II (BB, CC, DD, AA, X (09), 16#eb86d391#, S44); -- 64
C.A := C.A + AA;
C.B := C.B + BB;
C.C := C.C + CC;
C.D := C.D + DD;
end Transform;
------------
-- Update --
------------
procedure Update
(C : in out Context;
Input : String)
is
Inp : constant String := C.Buffer (1 .. C.Last) & Input;
Cur : Positive := Inp'First;
begin
C.Length := C.Length + Input'Length;
while Cur + 63 <= Inp'Last loop
Transform (C, Inp (Cur .. Cur + 63));
Cur := Cur + 64;
end loop;
C.Last := Inp'Last - Cur + 1;
C.Buffer (1 .. C.Last) := Inp (Cur .. Inp'Last);
end Update;
procedure Update
(C : in out Context;
Input : Ada.Streams.Stream_Element_Array)
is
subtype Stream_Array is Ada.Streams.Stream_Element_Array (Input'Range);
subtype Stream_String is
String (1 + Integer (Input'First) .. 1 + Integer (Input'Last));
function To_String is new Ada.Unchecked_Conversion
(Stream_Array, Stream_String);
String_Input : constant String := To_String (Input);
begin
Update (C, String_Input);
end 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;
-----------------
-- Wide_Update --
-----------------
procedure Wide_Update
(C : in out Context;
Input : Wide_String)
is
String_Input : String (1 .. 2 * Input'Length);
Cur : Positive := 1;
begin
for Index in Input'Range loop
String_Input (Cur) :=
Character'Val
(Unsigned_32 (Wide_Character'Pos (Input (Index))) and 16#FF#);
Cur := Cur + 1;
String_Input (Cur) :=
Character'Val
(Shift_Right (Unsigned_32 (Wide_Character'Pos (Input (Index))), 8)
and 16#FF#);
Cur := Cur + 1;
end loop;
Update (C, String_Input);
end Wide_Update;
end GNAT.MD5;
pragma No_Body;
gcc/ada/g-md5.ads
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . M D 5 --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2008, AdaCore --
-- 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- --
......@@ -16,8 +16,8 @@
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
......@@ -31,81 +31,12 @@
-- --
------------------------------------------------------------------------------
-- This package implements the MD5 Message-Digest Algorithm as described in
-- RFC 1321. The complete text of RFC 1321 can be found at:
--
-- http://www.ietf.org/rfc/rfc1321.txt
--
-- The implementation is derived from the RSA Data Security, Inc. MD5
-- Message-Digest Algorithm, as described in RFC 1321.
with Ada.Streams;
with Interfaces;
package GNAT.MD5 is
type Context is private;
-- This type is the four-word (16 byte) MD buffer, as described in
-- RFC 1321 (3.3). Its initial value is Initial_Context below.
Initial_Context : constant Context;
-- Initial value of a Context object. May be used to reinitialize
-- a Context value by simple assignment of this value to the object.
procedure Update
(C : in out Context;
Input : String);
procedure Wide_Update
(C : in out Context;
Input : Wide_String);
procedure Update
(C : in out Context;
Input : Ada.Streams.Stream_Element_Array);
-- Modify the Context C. If C has the initial value Initial_Context,
-- then, after a call to one of these procedures, Digest (C) will return
-- the Message-Digest of Input.
--
-- These procedures may be called successively with the same context and
-- different inputs, and these several successive calls will produce
-- the same final context as a call with the concatenation of the inputs.
subtype Message_Digest is String (1 .. 32);
-- The string type returned by function Digest
function Digest (C : Context) return Message_Digest;
-- Extracts the Message-Digest from a context. This function should be
-- used after one or several calls to Update.
function Digest (S : String) return Message_Digest;
function Wide_Digest (W : Wide_String) return Message_Digest;
function Digest
(A : Ada.Streams.Stream_Element_Array)
return Message_Digest;
-- These functions are equivalent to the corresponding Update (or
-- Wide_Update) on a default initialized Context, followed by Digest
-- on the resulting Context.
private
-- Magic numbers
Initial_A : constant := 16#67452301#;
Initial_B : constant := 16#EFCDAB89#;
Initial_C : constant := 16#98BADCFE#;
Initial_D : constant := 16#10325476#;
type Context is record
A : Interfaces.Unsigned_32 := Initial_A;
B : Interfaces.Unsigned_32 := Initial_B;
C : Interfaces.Unsigned_32 := Initial_C;
D : Interfaces.Unsigned_32 := Initial_D;
Buffer : String (1 .. 64) := (others => ASCII.NUL);
Last : Natural := 0;
Length : Natural := 0;
end record;
Initial_Context : constant Context :=
(A => Initial_A, B => Initial_B, C => Initial_C, D => Initial_D,
Buffer => (others => ASCII.NUL), Last => 0, Length => 0);
end GNAT.MD5;
with System.Secure_Hashes.MD5;
package GNAT.MD5 is new System.Secure_Hashes.H
(Block_Words => System.Secure_Hashes.MD5.Block_Words,
State_Words => 4,
Hash_Words => 4,
Hash_Bit_Order => System.Low_Order_First,
Hash_State => System.Secure_Hashes.MD5.Hash_State,
Initial_State => System.Secure_Hashes.MD5.Initial_State,
Transform => System.Secure_Hashes.MD5.Transform);
gcc/ada/g-sha1.adb
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S H A 1 --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2006, AdaCore --
-- 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 2, or (at your option) any later ver- --
-- 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- 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. --
-- --
------------------------------------------------------------------------------
-- Note: the code for this unit is derived from GNAT.MD5
with Ada.Unchecked_Conversion;
package body GNAT.SHA1 is
use Interfaces;
Padding : constant String :=
(1 => Character'Val (16#80#), 2 .. 64 => ASCII.NUL);
Hex_Digit : constant array (Unsigned_32 range 0 .. 15) of Character :=
('0', '1', '2', '3', '4', '5', '6', '7',
'8', '9', 'a', 'b', 'c', 'd', 'e', 'f');
-- Look-up table for each hex digit of the Message-Digest.
-- Used by function Digest (Context).
type Sixteen_Words is array (Natural range 0 .. 15)
of Interfaces.Unsigned_32;
-- Sixteen 32-bit words, converted from block of 64 characters.
-- Used in procedure Decode and Transform.
procedure Decode (Block : String; X : out Sixteen_Words);
-- Convert a String of 64 characters into 16 32-bit numbers
-- The following functions are the four elementary components of each
-- of the four round groups (0 .. 19, 20 .. 39, 40 .. 59, and 60 .. 79)
-- defined in RFC 3174.
function F0 (B, C, D : Unsigned_32) return Unsigned_32;
pragma Inline (F0);
function F1 (B, C, D : Unsigned_32) return Unsigned_32;
pragma Inline (F1);
function F2 (B, C, D : Unsigned_32) return Unsigned_32;
pragma Inline (F2);
function F3 (B, C, D : Unsigned_32) return Unsigned_32;
pragma Inline (F3);
procedure Transform (Ctx : in out Context; Block : String);
-- Process one block of 64 characters
------------
-- Decode --
------------
procedure Decode (Block : String; X : out Sixteen_Words) is
Cur : Positive := Block'First;
begin
pragma Assert (Block'Length = 64);
for Index in X'Range loop
X (Index) :=
Unsigned_32 (Character'Pos (Block (Cur + 3))) +
Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 2))), 8) +
Shift_Left (Unsigned_32 (Character'Pos (Block (Cur + 1))), 16) +
Shift_Left (Unsigned_32 (Character'Pos (Block (Cur))), 24);
Cur := Cur + 4;
end loop;
end Decode;
------------
-- Digest --
------------
function Digest (C : Context) return Message_Digest is
Result : Message_Digest;
Cur : Natural := 1;
-- Index in Result where the next character will be placed
Last_Block : String (1 .. 64);
C1 : Context := C;
procedure Convert (X : Unsigned_32);
-- Put the contribution of one of the five H words of the Context in
-- Result. Increments Cur.
-------------
-- Convert --
-------------
procedure Convert (X : Unsigned_32) is
Y : Unsigned_32 := X;
begin
for J in 1 .. 8 loop
Y := Rotate_Left (Y, 4);
Result (Cur) := Hex_Digit (Y and Unsigned_32'(16#0F#));
Cur := Cur + 1;
end loop;
end Convert;
-- Start of processing for Digest
begin
-- Process characters in the context buffer, if any
pragma Assert (C.Last /= C.Buffer'Last);
Last_Block (1 .. C.Last) := C.Buffer (1 .. C.Last);
if C.Last > 55 then
Last_Block (C.Last + 1 .. 64) := Padding (1 .. 64 - C.Last);
Transform (C1, Last_Block);
Last_Block := (others => ASCII.NUL);
else
Last_Block (C.Last + 1 .. 56) := Padding (1 .. 56 - C.Last);
end if;
-- Add the input length (as stored in the context) as 8 characters
Last_Block (57 .. 64) := (others => ASCII.NUL);
declare
L : Unsigned_64 := Unsigned_64 (C.Length) * 8;
Idx : Positive := 64;
begin
while L > 0 loop
Last_Block (Idx) := Character'Val (L and 16#Ff#);
L := Shift_Right (L, 8);
Idx := Idx - 1;
end loop;
end;
Transform (C1, Last_Block);
Convert (C1.H (0));
Convert (C1.H (1));
Convert (C1.H (2));
Convert (C1.H (3));
Convert (C1.H (4));
return Result;
end Digest;
function Digest (S : String) return Message_Digest is
C : Context;
begin
Update (C, S);
return Digest (C);
end Digest;
function Digest
(A : Ada.Streams.Stream_Element_Array) return Message_Digest
is
C : Context;
begin
Update (C, A);
return Digest (C);
end Digest;
--------
-- F0 --
--------
function F0
(B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
is
begin
return (B and C) or ((not B) and D);
end F0;
--------
-- F1 --
--------
function F1
(B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
is
begin
return B xor C xor D;
end F1;
--------
-- F2 --
--------
function F2
(B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
is
begin
return (B and C) or (B and D) or (C and D);
end F2;
--------
-- F3 --
--------
function F3
(B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
renames F1;
---------------
-- Transform --
---------------
procedure Transform
(Ctx : in out Context;
Block : String)
is
W : array (0 .. 79) of Interfaces.Unsigned_32;
A, B, C, D, E, Temp : Interfaces.Unsigned_32;
begin
pragma Assert (Block'Length = 64);
-- a. Divide data block into sixteen words
Decode (Block, Sixteen_Words (W (0 .. 15)));
-- b. Prepare working block of 80 words
for T in 16 .. 79 loop
-- W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
W (T) := Rotate_Left
(W (T - 3) xor W (T - 8) xor W (T - 14) xor W (T - 16), 1);
end loop;
-- c. Set up transformation variables
A := Ctx.H (0);
B := Ctx.H (1);
C := Ctx.H (2);
D := Ctx.H (3);
E := Ctx.H (4);
-- d. For each of the 80 rounds, compute:
-- TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
-- E = D; D = C; C = S^30(B); B = A; A = TEMP;
for T in 0 .. 19 loop
Temp := Rotate_Left (A, 5) + F0 (B, C, D) + E + W (T) + 16#5A827999#;
E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
end loop;
for T in 20 .. 39 loop
Temp := Rotate_Left (A, 5) + F1 (B, C, D) + E + W (T) + 16#6ED9EBA1#;
E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
end loop;
for T in 40 .. 59 loop
Temp := Rotate_Left (A, 5) + F2 (B, C, D) + E + W (T) + 16#8F1BBCDC#;
E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
end loop;
for T in 60 .. 79 loop
Temp := Rotate_Left (A, 5) + F3 (B, C, D) + E + W (T) + 16#CA62C1D6#;
E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
end loop;
-- e. Update context:
-- H0 = H0 + A, H1 = H1 + B, H2 = H2 + C, H3 = H3 + D, H4 = H4 + E
Ctx.H (0) := Ctx.H (0) + A;
Ctx.H (1) := Ctx.H (1) + B;
Ctx.H (2) := Ctx.H (2) + C;
Ctx.H (3) := Ctx.H (3) + D;
Ctx.H (4) := Ctx.H (4) + E;
end Transform;
------------
-- Update --
------------
procedure Update
(C : in out Context;
Input : String)
is
Inp : constant String := C.Buffer (1 .. C.Last) & Input;
Cur : Positive := Inp'First;
begin
C.Length := C.Length + Input'Length;
while Cur + 63 <= Inp'Last loop
Transform (C, Inp (Cur .. Cur + 63));
Cur := Cur + 64;
end loop;
C.Last := Inp'Last - Cur + 1;
C.Buffer (1 .. C.Last) := Inp (Cur .. Inp'Last);
end Update;
procedure Update
(C : in out Context;
Input : Ada.Streams.Stream_Element_Array)
is
subtype Stream_Array is Ada.Streams.Stream_Element_Array (Input'Range);
subtype Stream_String is
String (1 + Integer (Input'First) .. 1 + Integer (Input'Last));
function To_String is new Ada.Unchecked_Conversion
(Stream_Array, Stream_String);
String_Input : constant String := To_String (Input);
begin
Update (C, String_Input);
end 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;
-----------------
-- Wide_Update --
-----------------
procedure Wide_Update
(C : in out Context;
Input : Wide_String)
is
String_Input : String (1 .. 2 * Input'Length);
Cur : Positive := 1;
begin
for Index in Input'Range loop
String_Input (Cur) :=
Character'Val
(Unsigned_32 (Wide_Character'Pos (Input (Index))) and 16#FF#);
Cur := Cur + 1;
String_Input (Cur) :=
Character'Val
(Shift_Right (Unsigned_32 (Wide_Character'Pos (Input (Index))), 8)
and 16#FF#);
Cur := Cur + 1;
end loop;
Update (C, String_Input);
end Wide_Update;
-- This package does not require a body, since it is a package renaming. We
-- provide a dummy file containing a No_Body pragma so that previous versions
-- of the body (which did exist) will not interfere.
end GNAT.SHA1;
pragma No_Body;
gcc/ada/g-sha1.ads
------------------------------------------------------------------------------
-- --
-- GNAT LIBRARY COMPONENTS --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S H A 1 --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2006, AdaCore --
-- 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- --
......@@ -16,8 +16,8 @@
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
......@@ -31,86 +31,12 @@
-- --
------------------------------------------------------------------------------
-- This package implements the US Secure Hash Algorithm 1 (SHA1) as described
-- in RFC 3174. The complete text of RFC 3174 can be found at:
-- http://www.ietf.org/rfc/rfc3174.txt
-- Note: the code for this unit is derived from GNAT.MD5
with Ada.Streams;
with Interfaces;
package GNAT.SHA1 is
type Context is private;
-- This type holds the five-word (20 byte) buffer H, as described in
-- RFC 3174 (6.1). Its initial value is Initial_Context below.
Initial_Context : constant Context;
-- Initial value of a Context object. May be used to reinitialize
-- a Context value by simple assignment of this value to the object.
procedure Update
(C : in out Context;
Input : String);
procedure Wide_Update
(C : in out Context;
Input : Wide_String);
procedure Update
(C : in out Context;
Input : Ada.Streams.Stream_Element_Array);
-- Modify the Context C. If C has the initial value Initial_Context,
-- then, after a call to one of these procedures, Digest (C) will return
-- the Message-Digest of Input.
--
-- These procedures may be called successively with the same context and
-- different inputs, and these several successive calls will produce
-- the same final context as a call with the concatenation of the inputs.
subtype Message_Digest is String (1 .. 40);
-- The string type returned by function Digest
function Digest (C : Context) return Message_Digest;
-- Extracts the Message-Digest from a context. This function should be
-- used after one or several calls to Update.
function Digest (S : String) return Message_Digest;
function Wide_Digest (W : Wide_String) return Message_Digest;
function Digest
(A : Ada.Streams.Stream_Element_Array) return Message_Digest;
-- These functions are equivalent to the corresponding Update (or
-- Wide_Update) on a default initialized Context, followed by Digest
-- on the resulting Context.
private
-- Magic numbers
Initial_H0 : constant := 16#67452301#;
Initial_H1 : constant := 16#EFCDAB89#;
Initial_H2 : constant := 16#98BADCFE#;
Initial_H3 : constant := 16#10325476#;
Initial_H4 : constant := 16#C3D2E1F0#;
type H_Type is array (0 .. 4) of Interfaces.Unsigned_32;
Initial_H : constant H_Type :=
(0 => Initial_H0,
1 => Initial_H1,
2 => Initial_H2,
3 => Initial_H3,
4 => Initial_H4);
type Context is record
H : H_Type := Initial_H;
Buffer : String (1 .. 64) := (others => ASCII.NUL);
Last : Natural := 0;
Length : Natural := 0;
end record;
Initial_Context : constant Context :=
(H => Initial_H,
Buffer => (others => ASCII.NUL), Last => 0, Length => 0);
end GNAT.SHA1;
with System.Secure_Hashes.SHA1;
package GNAT.SHA1 is new System.Secure_Hashes.H
(Block_Words => System.Secure_Hashes.SHA1.Block_Words,
State_Words => 5,
Hash_Words => 5,
Hash_Bit_Order => System.High_Order_First,
Hash_State => System.Secure_Hashes.SHA1.Hash_State,
Initial_State => System.Secure_Hashes.SHA1.Initial_State,
Transform => System.Secure_Hashes.SHA1.Transform);
gcc/ada/g-sha224.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S H A 2 2 4 --
-- --
-- S p e c --
-- --
-- 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.Secure_Hashes.SHA2_Common;
with System.Secure_Hashes.SHA2_32;
package GNAT.SHA224 is new System.Secure_Hashes.H
(Block_Words => System.Secure_Hashes.SHA2_Common.Block_Words,
State_Words => 8,
Hash_Words => 7,
Hash_Bit_Order => System.High_Order_First,
Hash_State => System.Secure_Hashes.SHA2_32.Hash_State,
Initial_State => System.Secure_Hashes.SHA2_32.SHA224_Init_State,
Transform => System.Secure_Hashes.SHA2_32.Transform);
gcc/ada/g-sha256.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S H A 2 5 6 --
-- --
-- S p e c --
-- --
-- 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.Secure_Hashes.SHA2_Common;
with System.Secure_Hashes.SHA2_32;
package GNAT.SHA256 is new System.Secure_Hashes.H
(Block_Words => System.Secure_Hashes.SHA2_Common.Block_Words,
State_Words => 8,
Hash_Words => 8,
Hash_Bit_Order => System.High_Order_First,
Hash_State => System.Secure_Hashes.SHA2_32.Hash_State,
Initial_State => System.Secure_Hashes.SHA2_32.SHA256_Init_State,
Transform => System.Secure_Hashes.SHA2_32.Transform);
gcc/ada/g-sha384.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S H A 3 8 4 --
-- --
-- S p e c --
-- --
-- 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.Secure_Hashes.SHA2_Common;
with System.Secure_Hashes.SHA2_64;
package GNAT.SHA384 is new System.Secure_Hashes.H
(Block_Words => System.Secure_Hashes.SHA2_Common.Block_Words,
State_Words => 8,
Hash_Words => 6,
Hash_Bit_Order => System.High_Order_First,
Hash_State => System.Secure_Hashes.SHA2_64.Hash_State,
Initial_State => System.Secure_Hashes.SHA2_64.SHA384_Init_State,
Transform => System.Secure_Hashes.SHA2_64.Transform);
gcc/ada/g-sha512.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S H A 5 1 2 --
-- --
-- S p e c --
-- --
-- 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.Secure_Hashes.SHA2_Common;
with System.Secure_Hashes.SHA2_64;
package GNAT.SHA512 is new System.Secure_Hashes.H
(Block_Words => System.Secure_Hashes.SHA2_Common.Block_Words,
State_Words => 8,
Hash_Words => 8,
Hash_Bit_Order => System.High_Order_First,
Hash_State => System.Secure_Hashes.SHA2_64.Hash_State,
Initial_State => System.Secure_Hashes.SHA2_64.SHA512_Init_State,
Transform => System.Secure_Hashes.SHA2_64.Transform);
gcc/ada/gnat_rm.texi
......@@ -377,6 +377,10 @@ The GNAT Library
* GNAT.Semaphores (g-semaph.ads)::
* GNAT.Serial_Communications (g-sercom.ads)::
* GNAT.SHA1 (g-sha1.ads)::
* GNAT.SHA224 (g-sha224.ads)::
* GNAT.SHA256 (g-sha256.ads)::
* GNAT.SHA384 (g-sha384.ads)::
* GNAT.SHA512 (g-sha512.ads)::
* GNAT.Signals (g-signal.ads)::
* GNAT.Sockets (g-socket.ads)::
* GNAT.Source_Info (g-souinf.ads)::
......@@ -13554,6 +13558,10 @@ of GNAT, and will generate a warning message.
* GNAT.Semaphores (g-semaph.ads)::
* GNAT.Serial_Communications (g-sercom.ads)::
* GNAT.SHA1 (g-sha1.ads)::
* GNAT.SHA224 (g-sha224.ads)::
* GNAT.SHA256 (g-sha256.ads)::
* GNAT.SHA384 (g-sha384.ads)::
* GNAT.SHA512 (g-sha512.ads)::
* GNAT.Signals (g-signal.ads)::
* GNAT.Sockets (g-socket.ads)::
* GNAT.Source_Info (g-souinf.ads)::
......@@ -14551,7 +14559,40 @@ port. This is only supported on GNU/Linux and Windows.
@cindex Secure Hash Algorithm SHA-1
@noindent
Implements the SHA-1 Secure Hash Algorithm as described in RFC 3174.
Implements the SHA-1 Secure Hash Algorithm as described in FIPS PUB 180-3
and RFC 3174.
@node GNAT.SHA224 (g-sha224.ads)
@section @code{GNAT.SHA224} (@file{g-sha224.ads})
@cindex @code{GNAT.SHA224} (@file{g-sha224.ads})
@cindex Secure Hash Algorithm SHA-224
@noindent
Implements the SHA-224 Secure Hash Algorithm as described in FIPS PUB 180-3.
@node GNAT.SHA256 (g-sha256.ads)
@section @code{GNAT.SHA256} (@file{g-sha256.ads})
@cindex @code{GNAT.SHA256} (@file{g-sha256.ads})
@cindex Secure Hash Algorithm SHA-256
@noindent
Implements the SHA-256 Secure Hash Algorithm as described in FIPS PUB 180-3.
@node GNAT.SHA384 (g-sha384.ads)
@section @code{GNAT.SHA384} (@file{g-sha384.ads})
@cindex @code{GNAT.SHA384} (@file{g-sha384.ads})
@cindex Secure Hash Algorithm SHA-384
@noindent
Implements the SHA-384 Secure Hash Algorithm as described in FIPS PUB 180-3.
@node GNAT.SHA512 (g-sha512.ads)
@section @code{GNAT.SHA512} (@file{g-sha512.ads})
@cindex @code{GNAT.SHA512} (@file{g-sha512.ads})
@cindex Secure Hash Algorithm SHA-512
@noindent
Implements the SHA-512 Secure Hash Algorithm as described in FIPS PUB 180-3.
@node GNAT.Signals (g-signal.ads)
@section @code{GNAT.Signals} (@file{g-signal.ads})
......
gcc/ada/s-sechas.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . 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 System.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 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
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);
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
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 - 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;
------------
-- Digest --
------------
function Digest (S : String) return Message_Digest is
C : Context;
begin
Update (C, S);
return Digest (C);
end Digest;
------------
-- 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 System.Secure_Hashes;
gcc/ada/s-sechas.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S --
-- --
-- S p e c --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- This package provides common suporting code for a family of secure
-- hash functions (including MD5 and the FIPS PUB 180-3 functions SHA-1,
-- SHA-224, SHA-256, SHA-384 and SHA-512).
with Ada.Streams;
with Interfaces;
package System.Secure_Hashes is
type Buffer_Type is new String;
for Buffer_Type'Alignment use 8;
-- Secure hash functions use a string buffer that is also accessed as an
-- array of words, which may require up to 64 bit alignment.
-- The function-independent part of processing state:
-- A buffer of data being accumulated until a complete block is ready for
-- hashing.
type Message_State (Block_Length : Natural) is record
Last : Natural := 0;
-- Index of last used element in Buffer
Length : Interfaces.Unsigned_64 := 0;
-- Total length of processed data
Buffer : Buffer_Type (1 .. Block_Length);
-- Data buffer
end record;
-- The function-specific part of processing state:
-- Each hash function maintains an internal state as an array of words,
-- which is ultimately converted to a stream representation with the
-- appropriate bit order.
generic
type Word is mod <>;
-- Either 32 or 64 bits
with procedure Swap (X : System.Address);
-- Byte swapping function for a Word at X
Hash_Bit_Order : System.Bit_Order;
-- Bit order of the produced hash
package Hash_Function_State is
type State is array (Natural range <>) of Word;
-- Used to store a hash function's internal state
procedure To_Hash
(H : State;
H_Bits : out Ada.Streams.Stream_Element_Array);
-- Convert H to stream representation with the given bit order.
-- If H_Bits is smaller than the internal hash state, then the state
-- is truncated.
end Hash_Function_State;
-- Generic hashing framework:
-- The user interface for each implemented secure hash function is an
-- instance of this generic package.
generic
Block_Words : Natural;
-- Number of words in each block
State_Words : Natural;
-- Number of words in internal state
Hash_Words : Natural;
-- Number of words in the final hash (must be no greater than
-- State_Words).
Hash_Bit_Order : System.Bit_Order;
-- Bit order used for conversion between bit representation and word
-- representation.
with package Hash_State is new Hash_Function_State (<>);
-- Hash function state package
Initial_State : Hash_State.State;
-- Initial value of the hash function state
with procedure Transform
(H : in out Hash_State.State;
M : in out Message_State);
-- Transformation function updating H by processing a complete data
-- block from M.
package H is
pragma Assert (Hash_Words <= State_Words);
type Context is private;
-- The internal processing state of the hashing function
Initial_Context : constant Context;
-- Initial value of a Context object. May be used to reinitialize
-- a Context value by simple assignment of this value to the object.
procedure Update (C : in out Context; Input : String);
procedure Wide_Update (C : in out Context; Input : Wide_String);
procedure Update
(C : in out Context; Input : Ada.Streams.Stream_Element_Array);
-- Update C to process the given input. Successive calls to
-- Update are equivalent to a single call with the concatenation
-- of the inputs. For the Wide_String version, each Wide_Character is
-- processed low order byte first.
Word_Length : constant Natural := Hash_State.Word'Size / 8;
Hash_Length : constant Natural := Hash_Words * Word_Length;
subtype Message_Digest is String (1 .. 2 * Hash_Length);
-- The fixed-length string returned by Digest, providing the
-- hash in hexadecimal representation.
function Digest (C : Context) return Message_Digest;
-- Return the hash for the data accumulated with C in hexadecimal
-- representation.
function Digest (S : String) return Message_Digest;
function Wide_Digest (W : Wide_String) return Message_Digest;
function Digest
(A : Ada.Streams.Stream_Element_Array) return Message_Digest;
-- These functions are equivalent to the corresponding Update (or
-- Wide_Update) on a default initialized Context, followed by Digest
-- on the resulting Context.
private
Block_Length : constant Natural := Block_Words * Word_Length;
-- Length in bytes of a data block
type Context is record
H_State : Hash_State.State (0 .. State_Words - 1) := Initial_State;
-- Function-specific state
M_State : Message_State (Block_Length);
-- Function-independent state (block buffer)
end record;
Initial_Context : constant Context := (others => <>);
-- Initial values are provided by default initialization of Context
end H;
end System.Secure_Hashes;
gcc/ada/s-sehamd.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S . M D 5 --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-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 GNAT.Byte_Swapping; use GNAT.Byte_Swapping;
package body System.Secure_Hashes.MD5 is
use Interfaces;
-- The sixteen values used to rotate the context words.
-- Four for each rounds. Used in procedure Transform.
-- Round 1
S11 : constant := 7;
S12 : constant := 12;
S13 : constant := 17;
S14 : constant := 22;
-- Round 2
S21 : constant := 5;
S22 : constant := 9;
S23 : constant := 14;
S24 : constant := 20;
-- Round 3
S31 : constant := 4;
S32 : constant := 11;
S33 : constant := 16;
S34 : constant := 23;
-- Round 4
S41 : constant := 6;
S42 : constant := 10;
S43 : constant := 15;
S44 : constant := 21;
-- The following functions (F, FF, G, GG, H, HH, I and II) are the
-- equivalent of the macros of the same name in the example
-- C implementation in the annex of RFC 1321.
function F (X, Y, Z : Unsigned_32) return Unsigned_32;
pragma Inline (F);
procedure FF
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive);
pragma Inline (FF);
function G (X, Y, Z : Unsigned_32) return Unsigned_32;
pragma Inline (G);
procedure GG
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive);
pragma Inline (GG);
function H (X, Y, Z : Unsigned_32) return Unsigned_32;
pragma Inline (H);
procedure HH
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive);
pragma Inline (HH);
function I (X, Y, Z : Unsigned_32) return Unsigned_32;
pragma Inline (I);
procedure II
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive);
pragma Inline (II);
-------
-- F --
-------
function F (X, Y, Z : Unsigned_32) return Unsigned_32 is
begin
return (X and Y) or ((not X) and Z);
end F;
--------
-- FF --
--------
procedure FF
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive)
is
begin
A := A + F (B, C, D) + X + AC;
A := Rotate_Left (A, S);
A := A + B;
end FF;
-------
-- G --
-------
function G (X, Y, Z : Unsigned_32) return Unsigned_32 is
begin
return (X and Z) or (Y and (not Z));
end G;
--------
-- GG --
--------
procedure GG
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive)
is
begin
A := A + G (B, C, D) + X + AC;
A := Rotate_Left (A, S);
A := A + B;
end GG;
-------
-- H --
-------
function H (X, Y, Z : Unsigned_32) return Unsigned_32 is
begin
return X xor Y xor Z;
end H;
--------
-- HH --
--------
procedure HH
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive)
is
begin
A := A + H (B, C, D) + X + AC;
A := Rotate_Left (A, S);
A := A + B;
end HH;
-------
-- I --
-------
function I (X, Y, Z : Unsigned_32) return Unsigned_32 is
begin
return Y xor (X or (not Z));
end I;
--------
-- II --
--------
procedure II
(A : in out Unsigned_32;
B, C, D : Unsigned_32;
X : Unsigned_32;
AC : Unsigned_32;
S : Positive)
is
begin
A := A + I (B, C, D) + X + AC;
A := Rotate_Left (A, S);
A := A + B;
end II;
---------------
-- Transform --
---------------
procedure Transform
(H : in out Hash_State.State;
M : in out Message_State)
is
X : array (0 .. 15) of Interfaces.Unsigned_32;
for X'Address use M.Buffer'Address;
pragma Import (Ada, X);
AA : Unsigned_32 := H (0);
BB : Unsigned_32 := H (1);
CC : Unsigned_32 := H (2);
DD : Unsigned_32 := H (3);
begin
if System.Default_Bit_Order /= Low_Order_First then
for J in X'Range loop
Swap4 (X (J)'Address);
end loop;
end if;
-- Round 1
FF (AA, BB, CC, DD, X (00), 16#D76aa478#, S11); -- 1
FF (DD, AA, BB, CC, X (01), 16#E8c7b756#, S12); -- 2
FF (CC, DD, AA, BB, X (02), 16#242070db#, S13); -- 3
FF (BB, CC, DD, AA, X (03), 16#C1bdceee#, S14); -- 4
FF (AA, BB, CC, DD, X (04), 16#f57c0faf#, S11); -- 5
FF (DD, AA, BB, CC, X (05), 16#4787c62a#, S12); -- 6
FF (CC, DD, AA, BB, X (06), 16#a8304613#, S13); -- 7
FF (BB, CC, DD, AA, X (07), 16#fd469501#, S14); -- 8
FF (AA, BB, CC, DD, X (08), 16#698098d8#, S11); -- 9
FF (DD, AA, BB, CC, X (09), 16#8b44f7af#, S12); -- 10
FF (CC, DD, AA, BB, X (10), 16#ffff5bb1#, S13); -- 11
FF (BB, CC, DD, AA, X (11), 16#895cd7be#, S14); -- 12
FF (AA, BB, CC, DD, X (12), 16#6b901122#, S11); -- 13
FF (DD, AA, BB, CC, X (13), 16#fd987193#, S12); -- 14
FF (CC, DD, AA, BB, X (14), 16#a679438e#, S13); -- 15
FF (BB, CC, DD, AA, X (15), 16#49b40821#, S14); -- 16
-- Round 2
GG (AA, BB, CC, DD, X (01), 16#f61e2562#, S21); -- 17
GG (DD, AA, BB, CC, X (06), 16#c040b340#, S22); -- 18
GG (CC, DD, AA, BB, X (11), 16#265e5a51#, S23); -- 19
GG (BB, CC, DD, AA, X (00), 16#e9b6c7aa#, S24); -- 20
GG (AA, BB, CC, DD, X (05), 16#d62f105d#, S21); -- 21
GG (DD, AA, BB, CC, X (10), 16#02441453#, S22); -- 22
GG (CC, DD, AA, BB, X (15), 16#d8a1e681#, S23); -- 23
GG (BB, CC, DD, AA, X (04), 16#e7d3fbc8#, S24); -- 24
GG (AA, BB, CC, DD, X (09), 16#21e1cde6#, S21); -- 25
GG (DD, AA, BB, CC, X (14), 16#c33707d6#, S22); -- 26
GG (CC, DD, AA, BB, X (03), 16#f4d50d87#, S23); -- 27
GG (BB, CC, DD, AA, X (08), 16#455a14ed#, S24); -- 28
GG (AA, BB, CC, DD, X (13), 16#a9e3e905#, S21); -- 29
GG (DD, AA, BB, CC, X (02), 16#fcefa3f8#, S22); -- 30
GG (CC, DD, AA, BB, X (07), 16#676f02d9#, S23); -- 31
GG (BB, CC, DD, AA, X (12), 16#8d2a4c8a#, S24); -- 32
-- Round 3
HH (AA, BB, CC, DD, X (05), 16#fffa3942#, S31); -- 33
HH (DD, AA, BB, CC, X (08), 16#8771f681#, S32); -- 34
HH (CC, DD, AA, BB, X (11), 16#6d9d6122#, S33); -- 35
HH (BB, CC, DD, AA, X (14), 16#fde5380c#, S34); -- 36
HH (AA, BB, CC, DD, X (01), 16#a4beea44#, S31); -- 37
HH (DD, AA, BB, CC, X (04), 16#4bdecfa9#, S32); -- 38
HH (CC, DD, AA, BB, X (07), 16#f6bb4b60#, S33); -- 39
HH (BB, CC, DD, AA, X (10), 16#bebfbc70#, S34); -- 40
HH (AA, BB, CC, DD, X (13), 16#289b7ec6#, S31); -- 41
HH (DD, AA, BB, CC, X (00), 16#eaa127fa#, S32); -- 42
HH (CC, DD, AA, BB, X (03), 16#d4ef3085#, S33); -- 43
HH (BB, CC, DD, AA, X (06), 16#04881d05#, S34); -- 44
HH (AA, BB, CC, DD, X (09), 16#d9d4d039#, S31); -- 45
HH (DD, AA, BB, CC, X (12), 16#e6db99e5#, S32); -- 46
HH (CC, DD, AA, BB, X (15), 16#1fa27cf8#, S33); -- 47
HH (BB, CC, DD, AA, X (02), 16#c4ac5665#, S34); -- 48
-- Round 4
II (AA, BB, CC, DD, X (00), 16#f4292244#, S41); -- 49
II (DD, AA, BB, CC, X (07), 16#432aff97#, S42); -- 50
II (CC, DD, AA, BB, X (14), 16#ab9423a7#, S43); -- 51
II (BB, CC, DD, AA, X (05), 16#fc93a039#, S44); -- 52
II (AA, BB, CC, DD, X (12), 16#655b59c3#, S41); -- 53
II (DD, AA, BB, CC, X (03), 16#8f0ccc92#, S42); -- 54
II (CC, DD, AA, BB, X (10), 16#ffeff47d#, S43); -- 55
II (BB, CC, DD, AA, X (01), 16#85845dd1#, S44); -- 56
II (AA, BB, CC, DD, X (08), 16#6fa87e4f#, S41); -- 57
II (DD, AA, BB, CC, X (15), 16#fe2ce6e0#, S42); -- 58
II (CC, DD, AA, BB, X (06), 16#a3014314#, S43); -- 59
II (BB, CC, DD, AA, X (13), 16#4e0811a1#, S44); -- 60
II (AA, BB, CC, DD, X (04), 16#f7537e82#, S41); -- 61
II (DD, AA, BB, CC, X (11), 16#bd3af235#, S42); -- 62
II (CC, DD, AA, BB, X (02), 16#2ad7d2bb#, S43); -- 63
II (BB, CC, DD, AA, X (09), 16#eb86d391#, S44); -- 64
H (0) := H (0) + AA;
H (1) := H (1) + BB;
H (2) := H (2) + CC;
H (3) := H (3) + DD;
end Transform;
end System.Secure_Hashes.MD5;
gcc/ada/s-sehamd.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S . M D 5 --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-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. --
-- --
------------------------------------------------------------------------------
-- This package provides supporting code for implementation of the MD5
-- Message-Digest Algorithm as described in RFC 1321. The complete text of
-- RFC 1321 can be found at:
-- http://www.ietf.org/rfc/rfc1321.txt
with GNAT.Byte_Swapping;
with Interfaces;
package System.Secure_Hashes.MD5 is
package Hash_State is
new System.Secure_Hashes.Hash_Function_State
(Word => Interfaces.Unsigned_32,
Swap => GNAT.Byte_Swapping.Swap4,
Hash_Bit_Order => System.Low_Order_First);
-- MD5 operates on 32-bit little endian words
Block_Words : constant := 16;
-- Messages are processed in chunks of 16 words
procedure Transform
(H : in out Hash_State.State;
M : in out Message_State);
-- Transformation function applied for each block
Initial_State : constant Hash_State.State;
-- Initialization vector
private
Initial_A : constant := 16#67452301#;
Initial_B : constant := 16#EFCDAB89#;
Initial_C : constant := 16#98BADCFE#;
Initial_D : constant := 16#10325476#;
Initial_State : constant Hash_State.State :=
(Initial_A, Initial_B, Initial_C, Initial_D);
-- Initialization vector from RFC 1321
end System.Secure_Hashes.MD5;
gcc/ada/s-sehash.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S . S H A 1 --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-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. --
-- --
------------------------------------------------------------------------------
package body System.Secure_Hashes.SHA1 is
use Interfaces;
use GNAT.Byte_Swapping;
-- The following functions are the four elementary components of each
-- of the four round groups (0 .. 19, 20 .. 39, 40 .. 59, and 60 .. 79)
-- defined in RFC 3174.
function F0 (B, C, D : Unsigned_32) return Unsigned_32;
pragma Inline (F0);
function F1 (B, C, D : Unsigned_32) return Unsigned_32;
pragma Inline (F1);
function F2 (B, C, D : Unsigned_32) return Unsigned_32;
pragma Inline (F2);
function F3 (B, C, D : Unsigned_32) return Unsigned_32;
pragma Inline (F3);
--------
-- F0 --
--------
function F0
(B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
is
begin
return (B and C) or ((not B) and D);
end F0;
--------
-- F1 --
--------
function F1
(B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
is
begin
return B xor C xor D;
end F1;
--------
-- F2 --
--------
function F2
(B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
is
begin
return (B and C) or (B and D) or (C and D);
end F2;
--------
-- F3 --
--------
function F3
(B, C, D : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
renames F1;
---------------
-- Transform --
---------------
procedure Transform
(H : in out Hash_State.State;
M : in out Message_State)
is
type Words is array (Natural range <>) of Interfaces.Unsigned_32;
X : Words (0 .. 15);
for X'Address use M.Buffer'Address;
pragma Import (Ada, X);
W : Words (0 .. 79);
A, B, C, D, E, Temp : Interfaces.Unsigned_32;
begin
if System.Default_Bit_Order /= High_Order_First then
for J in X'Range loop
Swap4 (X (J)'Address);
end loop;
end if;
-- a. Divide data block into sixteen words
W (0 .. 15) := X;
-- b. Prepare working block of 80 words
for T in 16 .. 79 loop
-- W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16))
W (T) := Rotate_Left
(W (T - 3) xor W (T - 8) xor W (T - 14) xor W (T - 16), 1);
end loop;
-- c. Set up transformation variables
A := H (0);
B := H (1);
C := H (2);
D := H (3);
E := H (4);
-- d. For each of the 80 rounds, compute:
-- TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t);
-- E = D; D = C; C = S^30(B); B = A; A = TEMP;
for T in 0 .. 19 loop
Temp := Rotate_Left (A, 5) + F0 (B, C, D) + E + W (T) + 16#5A827999#;
E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
end loop;
for T in 20 .. 39 loop
Temp := Rotate_Left (A, 5) + F1 (B, C, D) + E + W (T) + 16#6ED9EBA1#;
E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
end loop;
for T in 40 .. 59 loop
Temp := Rotate_Left (A, 5) + F2 (B, C, D) + E + W (T) + 16#8F1BBCDC#;
E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
end loop;
for T in 60 .. 79 loop
Temp := Rotate_Left (A, 5) + F3 (B, C, D) + E + W (T) + 16#CA62C1D6#;
E := D; D := C; C := Rotate_Left (B, 30); B := A; A := Temp;
end loop;
-- e. Update context:
-- H0 = H0 + A, H1 = H1 + B, H2 = H2 + C, H3 = H3 + D, H4 = H4 + E
H (0) := H (0) + A;
H (1) := H (1) + B;
H (2) := H (2) + C;
H (3) := H (3) + D;
H (4) := H (4) + E;
end Transform;
end System.Secure_Hashes.SHA1;
gcc/ada/s-sehash.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S . S H A 1 --
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-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. --
-- --
------------------------------------------------------------------------------
-- This package provides supporting code for implementation of the SHA-1
-- secure hash function as decsribed in FIPS PUB 180-3. The complete text
-- of FIPS PUB 180-3 can be found at:
-- http://csrc.nist.gov/publications/fips/fips180-3/fips180-3_final.pdf
with GNAT.Byte_Swapping;
with Interfaces;
package System.Secure_Hashes.SHA1 is
package Hash_State is new Hash_Function_State
(Word => Interfaces.Unsigned_32,
Swap => GNAT.Byte_Swapping.Swap4,
Hash_Bit_Order => System.High_Order_First);
-- SHA-1 operates on 32-bit big endian words
Block_Words : constant := 16;
-- Messages are processed in chunks of 16 words
procedure Transform
(H : in out Hash_State.State;
M : in out Message_State);
-- Transformation function applied for each block
Initial_State : constant Hash_State.State;
-- Initialization vector
private
Initial_State : constant Hash_State.State :=
(0 => 16#67452301#,
1 => 16#EFCDAB89#,
2 => 16#98BADCFE#,
3 => 16#10325476#,
4 => 16#C3D2E1F0#);
-- Initialization vector from FIPS PUB 180-3
end System.Secure_Hashes.SHA1;
gcc/ada/s-shsh32.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ 3 2 --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
package body System.Secure_Hashes.SHA2_32 is
use Interfaces;
------------
-- Sigma0 --
------------
function Sigma0 (X : Word) return Word is
begin
return Rotate_Right (X, 2)
xor Rotate_Right (X, 13)
xor Rotate_Right (X, 22);
end Sigma0;
------------
-- Sigma1 --
------------
function Sigma1 (X : Word) return Word is
begin
return Rotate_Right (X, 6)
xor Rotate_Right (X, 11)
xor Rotate_Right (X, 25);
end Sigma1;
--------
-- S0 --
--------
function S0 (X : Word) return Word is
begin
return Rotate_Right (X, 7)
xor Rotate_Right (X, 18)
xor Shift_Right (X, 3);
end S0;
--------
-- S1 --
--------
function S1 (X : Word) return Word is
begin
return Rotate_Right (X, 17)
xor Rotate_Right (X, 19)
xor Shift_Right (X, 10);
end S1;
end System.Secure_Hashes.SHA2_32;
gcc/ada/s-shsh32.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ 3 2 --
-- --
-- S p e c --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- This pacakge provides support for the 32-bit FIPS PUB 180-3 functions
-- SHA-256 and SHA-224.
with Interfaces;
with GNAT.Byte_Swapping;
with System.Secure_Hashes.SHA2_Common;
package System.Secure_Hashes.SHA2_32 is
subtype Word is Interfaces.Unsigned_32;
package Hash_State is new Hash_Function_State
(Word => Word,
Swap => GNAT.Byte_Swapping.Swap4,
Hash_Bit_Order => System.High_Order_First);
-- SHA-224 and SHA-256 operate on 32-bit big endian words
K : constant Hash_State.State (0 .. 63) :=
(16#428a2f98#, 16#71374491#, 16#b5c0fbcf#, 16#e9b5dba5#,
16#3956c25b#, 16#59f111f1#, 16#923f82a4#, 16#ab1c5ed5#,
16#d807aa98#, 16#12835b01#, 16#243185be#, 16#550c7dc3#,
16#72be5d74#, 16#80deb1fe#, 16#9bdc06a7#, 16#c19bf174#,
16#e49b69c1#, 16#efbe4786#, 16#0fc19dc6#, 16#240ca1cc#,
16#2de92c6f#, 16#4a7484aa#, 16#5cb0a9dc#, 16#76f988da#,
16#983e5152#, 16#a831c66d#, 16#b00327c8#, 16#bf597fc7#,
16#c6e00bf3#, 16#d5a79147#, 16#06ca6351#, 16#14292967#,
16#27b70a85#, 16#2e1b2138#, 16#4d2c6dfc#, 16#53380d13#,
16#650a7354#, 16#766a0abb#, 16#81c2c92e#, 16#92722c85#,
16#a2bfe8a1#, 16#a81a664b#, 16#c24b8b70#, 16#c76c51a3#,
16#d192e819#, 16#d6990624#, 16#f40e3585#, 16#106aa070#,
16#19a4c116#, 16#1e376c08#, 16#2748774c#, 16#34b0bcb5#,
16#391c0cb3#, 16#4ed8aa4a#, 16#5b9cca4f#, 16#682e6ff3#,
16#748f82ee#, 16#78a5636f#, 16#84c87814#, 16#8cc70208#,
16#90befffa#, 16#a4506ceb#, 16#bef9a3f7#, 16#c67178f2#);
-- Constants from FIPS PUB 180-3
function Sigma0 (X : Word) return Word;
function Sigma1 (X : Word) return Word;
function S0 (X : Word) return Word;
function S1 (X : Word) return Word;
pragma Inline (Sigma0, Sigma1, S0, S1);
-- Elementary functions Sigma^256_0, Sigma^256_1, sigma^256_0, sigma^256_1
-- from FIPS PUB 180-3.
procedure Transform is new SHA2_Common.Transform
(Hash_State => Hash_State,
K => K,
Rounds => 64,
Sigma0 => Sigma0,
Sigma1 => Sigma1,
S0 => S0,
S1 => S1);
SHA224_Init_State : constant Hash_State.State (0 .. 7) :=
(0 => 16#c1059ed8#,
1 => 16#367cd507#,
2 => 16#3070dd17#,
3 => 16#f70e5939#,
4 => 16#ffc00b31#,
5 => 16#68581511#,
6 => 16#64f98fa7#,
7 => 16#befa4fa4#);
SHA256_Init_State : constant Hash_State.State (0 .. 7) :=
(0 => 16#6a09e667#,
1 => 16#bb67ae85#,
2 => 16#3c6ef372#,
3 => 16#a54ff53a#,
4 => 16#510e527f#,
5 => 16#9b05688c#,
6 => 16#1f83d9ab#,
7 => 16#5be0cd19#);
-- Initialization vectors from FIPS PUB 180-3
end System.Secure_Hashes.SHA2_32;
gcc/ada/s-shsh64.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ 6 4 --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
package body System.Secure_Hashes.SHA2_64 is
use Interfaces;
------------
-- Sigma0 --
------------
function Sigma0 (X : Word) return Word is
begin
return Rotate_Right (X, 28)
xor Rotate_Right (X, 34)
xor Rotate_Right (X, 39);
end Sigma0;
------------
-- Sigma1 --
------------
function Sigma1 (X : Word) return Word is
begin
return Rotate_Right (X, 14)
xor Rotate_Right (X, 18)
xor Rotate_Right (X, 41);
end Sigma1;
--------
-- S0 --
--------
function S0 (X : Word) return Word is
begin
return Rotate_Right (X, 1)
xor Rotate_Right (X, 8)
xor Shift_Right (X, 7);
end S0;
--------
-- S1 --
--------
function S1 (X : Word) return Word is
begin
return Rotate_Right (X, 19)
xor Rotate_Right (X, 61)
xor Shift_Right (X, 6);
end S1;
end System.Secure_Hashes.SHA2_64;
gcc/ada/s-shsh64.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ 6 4 --
-- --
-- S p e c --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- This pacakge provides support for the 64-bit FIPS PUB 180-3 functions
-- (SHA-384 and SHA-512).
with Interfaces;
with GNAT.Byte_Swapping;
with System.Secure_Hashes.SHA2_Common;
package System.Secure_Hashes.SHA2_64 is
subtype Word is Interfaces.Unsigned_64;
package Hash_State is new Hash_Function_State
(Word => Word,
Swap => GNAT.Byte_Swapping.Swap8,
Hash_Bit_Order => System.High_Order_First);
-- SHA-384 and SHA-512 operate on 64-bit big endian words
K : Hash_State.State (0 .. 79) :=
(16#428a2f98d728ae22#, 16#7137449123ef65cd#,
16#b5c0fbcfec4d3b2f#, 16#e9b5dba58189dbbc#,
16#3956c25bf348b538#, 16#59f111f1b605d019#,
16#923f82a4af194f9b#, 16#ab1c5ed5da6d8118#,
16#d807aa98a3030242#, 16#12835b0145706fbe#,
16#243185be4ee4b28c#, 16#550c7dc3d5ffb4e2#,
16#72be5d74f27b896f#, 16#80deb1fe3b1696b1#,
16#9bdc06a725c71235#, 16#c19bf174cf692694#,
16#e49b69c19ef14ad2#, 16#efbe4786384f25e3#,
16#0fc19dc68b8cd5b5#, 16#240ca1cc77ac9c65#,
16#2de92c6f592b0275#, 16#4a7484aa6ea6e483#,
16#5cb0a9dcbd41fbd4#, 16#76f988da831153b5#,
16#983e5152ee66dfab#, 16#a831c66d2db43210#,
16#b00327c898fb213f#, 16#bf597fc7beef0ee4#,
16#c6e00bf33da88fc2#, 16#d5a79147930aa725#,
16#06ca6351e003826f#, 16#142929670a0e6e70#,
16#27b70a8546d22ffc#, 16#2e1b21385c26c926#,
16#4d2c6dfc5ac42aed#, 16#53380d139d95b3df#,
16#650a73548baf63de#, 16#766a0abb3c77b2a8#,
16#81c2c92e47edaee6#, 16#92722c851482353b#,
16#a2bfe8a14cf10364#, 16#a81a664bbc423001#,
16#c24b8b70d0f89791#, 16#c76c51a30654be30#,
16#d192e819d6ef5218#, 16#d69906245565a910#,
16#f40e35855771202a#, 16#106aa07032bbd1b8#,
16#19a4c116b8d2d0c8#, 16#1e376c085141ab53#,
16#2748774cdf8eeb99#, 16#34b0bcb5e19b48a8#,
16#391c0cb3c5c95a63#, 16#4ed8aa4ae3418acb#,
16#5b9cca4f7763e373#, 16#682e6ff3d6b2b8a3#,
16#748f82ee5defb2fc#, 16#78a5636f43172f60#,
16#84c87814a1f0ab72#, 16#8cc702081a6439ec#,
16#90befffa23631e28#, 16#a4506cebde82bde9#,
16#bef9a3f7b2c67915#, 16#c67178f2e372532b#,
16#ca273eceea26619c#, 16#d186b8c721c0c207#,
16#eada7dd6cde0eb1e#, 16#f57d4f7fee6ed178#,
16#06f067aa72176fba#, 16#0a637dc5a2c898a6#,
16#113f9804bef90dae#, 16#1b710b35131c471b#,
16#28db77f523047d84#, 16#32caab7b40c72493#,
16#3c9ebe0a15c9bebc#, 16#431d67c49c100d4c#,
16#4cc5d4becb3e42b6#, 16#597f299cfc657e2a#,
16#5fcb6fab3ad6faec#, 16#6c44198c4a475817#);
-- Constants from FIPS PUB 180-3
function Sigma0 (X : Word) return Word;
function Sigma1 (X : Word) return Word;
function S0 (X : Word) return Word;
function S1 (X : Word) return Word;
pragma Inline (Sigma0, Sigma1, S0, S1);
-- Elementary functions Sigma^512_0, Sigma^512_1, sigma^512_0, sigma^512_1
-- from FIPS PUB 180-3.
procedure Transform is new SHA2_Common.Transform
(Hash_State => Hash_State,
K => K,
Rounds => 80,
Sigma0 => Sigma0,
Sigma1 => Sigma1,
S0 => S0,
S1 => S1);
SHA384_Init_State : constant Hash_State.State :=
(0 => 16#cbbb9d5dc1059ed8#,
1 => 16#629a292a367cd507#,
2 => 16#9159015a3070dd17#,
3 => 16#152fecd8f70e5939#,
4 => 16#67332667ffc00b31#,
5 => 16#8eb44a8768581511#,
6 => 16#db0c2e0d64f98fa7#,
7 => 16#47b5481dbefa4fa4#);
SHA512_Init_State : constant Hash_State.State :=
(0 => 16#6a09e667f3bcc908#,
1 => 16#bb67ae8584caa73b#,
2 => 16#3c6ef372fe94f82b#,
3 => 16#a54ff53a5f1d36f1#,
4 => 16#510e527fade682d1#,
5 => 16#9b05688c2b3e6c1f#,
6 => 16#1f83d9abfb41bd6b#,
7 => 16#5be0cd19137e2179#);
-- Initialization vectors from FIPS PUB 180-3
end System.Secure_Hashes.SHA2_64;
gcc/ada/s-shshco.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ C O M M O N --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
package body System.Secure_Hashes.SHA2_Common is
---------------
-- Transform --
---------------
procedure Transform
(H_St : in out Hash_State.State;
M_St : in out Message_State)
is
subtype Word is Hash_State.Word;
use type Hash_State.Word;
function Ch (X, Y, Z : Word) return Word;
function Maj (X, Y, Z : Word) return Word;
pragma Inline (Ch, Maj);
-- Elementary functions from FIPS PUB 180-3
--------
-- Ch --
--------
function Ch (X, Y, Z : Word) return Word is
begin
return (X and Y) xor ((not X) and Z);
end Ch;
---------
-- Maj --
---------
function Maj (X, Y, Z : Word) return Word is
begin
return (X and Y) xor (X and Z) xor (Y and Z);
end Maj;
type Words is array (Natural range <>) of Word;
X : Words (0 .. 15);
for X'Address use M_St.Buffer'Address;
pragma Import (Ada, X);
W : Words (0 .. Rounds - 1);
A, B, C, D, E, F, G, H, T1, T2 : Word;
-- Start of processing for Transform
begin
if System.Default_Bit_Order /= High_Order_First then
for J in X'Range loop
Hash_State.Swap (X (J)'Address);
end loop;
end if;
-- 1. Prepare message schedule
W (0 .. 15) := X;
for T in 16 .. Rounds - 1 loop
W (T) := S1 (W (T - 2)) + W (T - 7) + S0 (W (T - 15)) + W (T - 16);
end loop;
-- 2. Initialize working variables
A := H_St (0);
B := H_St (1);
C := H_St (2);
D := H_St (3);
E := H_St (4);
F := H_St (5);
G := H_St (6);
H := H_St (7);
-- 3. Perform transformation rounds
for T in 0 .. Rounds - 1 loop
T1 := H + Sigma1 (E) + Ch (E, F, G) + K (T) + W (T);
T2 := Sigma0 (A) + Maj (A, B, C);
H := G;
G := F;
F := E;
E := D + T1;
D := C;
C := B;
B := A;
A := T1 + T2;
end loop;
-- 4. Update hash state
H_St (0) := A + H_St (0);
H_St (1) := B + H_St (1);
H_St (2) := C + H_St (2);
H_St (3) := D + H_St (3);
H_St (4) := E + H_St (4);
H_St (5) := F + H_St (5);
H_St (6) := G + H_St (6);
H_St (7) := H + H_St (7);
end Transform;
end System.Secure_Hashes.SHA2_Common;
gcc/ada/s-shshco.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . S E C U R E _ H A S H E S . S H A 2 _ C O M M O N --
-- --
-- S p e c --
-- --
-- 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. --
-- --
------------------------------------------------------------------------------
-- This package provides supporting code for implementation of the following
-- secure hash functions described in FIPS PUB 180-3: SHA-224, SHA-256,
-- SHA-384, SHA-512. It contains the generic transform operation that is
-- common to the above four functions. The complete text of FIPS PUB 180-3
-- can be found at:
-- http://csrc.nist.gov/publications/fips/fips180-3/fips180-3_final.pdf
package System.Secure_Hashes.SHA2_Common is
Block_Words : constant := 16;
-- All functions operate on blocks of 16 words
generic
with package Hash_State is new Hash_Function_State (<>);
Rounds : Natural;
-- Number of transformation rounds
K : Hash_State.State;
-- Constants used in the transform operation
with function Sigma0 (X : Hash_State.Word) return Hash_State.Word is <>;
with function Sigma1 (X : Hash_State.Word) return Hash_State.Word is <>;
with function S0 (X : Hash_State.Word) return Hash_State.Word is <>;
with function S1 (X : Hash_State.Word) return Hash_State.Word is <>;
-- FIPS PUB 180-3 elementary functions
procedure Transform
(H_St : in out Hash_State.State;
M_St : in out Message_State);
end System.Secure_Hashes.SHA2_Common;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment