+2014-08-04 Robert Dewar <dewar@adacore.com>
+
+ * sem_prag.adb, osint.adb, osint.ads: Minor reformatting.
+
+2014-08-04 Yannick Moy <moy@adacore.com>
+
+ * sem_ch3.adb (Derive_Type_Declaration,
+ Process_Discriminants): Remove SPARK-specific legality checks.
+
+2014-08-04 Thomas Quinot <quinot@adacore.com>
+
+ * g-sechas.ads, g-sechas.adb (HMAC_Initial_Context): New subprogram.
+ * gnat_rm.texi (GNAT.MD5/SHA1/SHA224/SHA256/SHA512): Document support
+ for HMAC.
+
2014-08-04 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch7.adb (Analyze_Package_Body_Helper): When verifying the
-- --
-- B o d y --
-- --
--- Copyright (C) 2009-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2014, 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- --
-- the message size in bits (excluding padding).
procedure Final
- (C : Context;
- Hash_Bits : out Stream_Element_Array)
+ (C : Context;
+ Hash_Bits : out Stream_Element_Array)
is
FC : Context := C;
pragma Assert (FC.M_State.Last = 0);
Hash_State.To_Hash (FC.H_State, Hash_Bits);
+
+ -- HMAC case: hash outer pad
+
+ if C.KL /= 0 then
+ declare
+ Outer_C : Context;
+ Opad : Stream_Element_Array :=
+ (1 .. Stream_Element_Offset (Block_Length) => 16#5c#);
+
+ begin
+ for J in C.Key'Range loop
+ Opad (J) := Opad (J) xor C.Key (J);
+ end loop;
+
+ Update (Outer_C, Opad);
+ Update (Outer_C, Hash_Bits);
+
+ Final (Outer_C, Hash_Bits);
+ end;
+ end if;
end Final;
+ --------------------------
+ -- HMAC_Initial_Context --
+ --------------------------
+
+ function HMAC_Initial_Context (Key : String) return Context is
+ begin
+ if Key'Length = 0 then
+ raise Constraint_Error with "null key";
+ end if;
+
+ return C : Context (KL => (if Key'Length <= Key_Length'Last
+ then Key'Length
+ else Stream_Element_Offset (Hash_Length)))
+ do
+ -- Set Key (if longer than block length, first hash it)
+
+ if C.KL = Key'Length then
+ declare
+ SK : String (1 .. Key'Length);
+ for SK'Address use C.Key'Address;
+ pragma Import (Ada, SK);
+ begin
+ SK := Key;
+ end;
+
+ else
+ C.Key := Digest (Key);
+ end if;
+
+ -- Hash inner pad
+
+ declare
+ Ipad : Stream_Element_Array :=
+ (1 .. Stream_Element_Offset (Block_Length) => 16#36#);
+
+ begin
+ for J in C.Key'Range loop
+ Ipad (J) := Ipad (J) xor C.Key (J);
+ end loop;
+
+ Update (C, Ipad);
+ end;
+ end return;
+ end HMAC_Initial_Context;
+
------------
-- Update --
------------
S : String;
Fill_Buffer : Fill_Buffer_Access)
is
- Last : Natural := S'First - 1;
+ Last : Natural;
begin
C.M_State.Length := C.M_State.Length + S'Length;
+ Last := S'First - 1;
while Last < S'Last loop
Fill_Buffer (C.M_State, S, Last + 1, Last);
-- --
-- S p e c --
-- --
--- Copyright (C) 2009-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 2009-2014, 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- --
-- Initial value of a Context object. May be used to reinitialize
-- a Context value by simple assignment of this value to the object.
+ function HMAC_Initial_Context (Key : String) return Context;
+ -- Initial Context for HMAC computation with the given Key
+
procedure Update (C : in out Context; Input : String);
procedure Wide_Update (C : in out Context; Input : Wide_String);
procedure Update
-- the hash in binary representation.
function Digest (C : Context) return Binary_Message_Digest;
- -- Return hash for the data accumulated with C
+ -- Return hash or HMAC for the data accumulated with C
function Digest (S : String) return Binary_Message_Digest;
function Wide_Digest (W : Wide_String) return Binary_Message_Digest;
-- hexadecimal representation.
function Digest (C : Context) return Message_Digest;
- -- Return hash for the data accumulated with C in hexadecimal
+ -- Return hash or HMAC for the data accumulated with C in hexadecimal
-- representation.
function Digest (S : String) return Message_Digest;
Block_Length : constant Natural := Block_Words * Word_Length;
-- Length in bytes of a data block
- type Context is record
+ subtype Key_Length is
+ Stream_Element_Offset range 0 .. Stream_Element_Offset (Block_Length);
+
+ -- KL is 0 for a normal hash context, > 0 for HMAC
+
+ type Context (KL : Key_Length := 0) is record
+ Key : Stream_Element_Array (1 .. KL);
+ -- HMAC key
+
H_State : Hash_State.State (0 .. State_Words - 1) := Initial_State;
-- Function-specific state
-- Function-independent state (block buffer)
end record;
- Initial_Context : constant Context := (others => <>);
+ Initial_Context : constant Context (KL => 0) := (others => <>);
-- Initial values are provided by default initialization of Context
end H;
@cindex Message Digest MD5
@noindent
-Implements the MD5 Message-Digest Algorithm as described in RFC 1321.
+Implements the MD5 Message-Digest Algorithm as described in RFC 1321, and
+the HMAC-MD5 message authentication function as described in RFC 2104 and
+FIPS PUB 198.
@node GNAT.Memory_Dump (g-memdum.ads)
@section @code{GNAT.Memory_Dump} (@file{g-memdum.ads})
@noindent
Implements the SHA-1 Secure Hash Algorithm as described in FIPS PUB 180-3
-and RFC 3174.
+and RFC 3174, and the HMAC-SHA1 message authentication function as described
+in RFC 2104 and FIPS PUB 198.
@node GNAT.SHA224 (g-sha224.ads)
@section @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.
+Implements the SHA-224 Secure Hash Algorithm as described in FIPS PUB 180-3,
+and the HMAC-SHA224 message authentication function as described
+in RFC 2104 and FIPS PUB 198.
@node GNAT.SHA256 (g-sha256.ads)
@section @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.
+Implements the SHA-256 Secure Hash Algorithm as described in FIPS PUB 180-3,
+and the HMAC-SHA256 message authentication function as described
+in RFC 2104 and FIPS PUB 198.
@node GNAT.SHA384 (g-sha384.ads)
@section @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.
+Implements the SHA-384 Secure Hash Algorithm as described in FIPS PUB 180-3,
+and the HMAC-SHA384 message authentication function as described
+in RFC 2104 and FIPS PUB 198.
@node GNAT.SHA512 (g-sha512.ads)
@section @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.
+Implements the SHA-512 Secure Hash Algorithm as described in FIPS PUB 180-3,
+and the HMAC-SHA512 message authentication function as described
+in RFC 2104 and FIPS PUB 198.
@node GNAT.Signals (g-signal.ads)
@section @code{GNAT.Signals} (@file{g-signal.ads})
T : File_Type;
Found : out File_Name_Type;
Attr : access File_Attributes;
- Full_Name : Boolean := False) is
+ Full_Name : Boolean := False)
+ is
begin
Get_Name_String (N);
if T = Config and then Full_Name then
declare
Full_Path : constant String :=
- Normalize_Pathname (Get_Name_String (N));
+ Normalize_Pathname (Get_Name_String (N));
Full_Size : constant Natural := Full_Path'Length;
-
begin
Name_Buffer (1 .. Full_Size) := Full_Path;
Name_Len := Full_Size;
-- set and the file name ends in ".dg", in which case we look for the
-- generated file only in the current directory, since that is where it is
-- always built.
+ --
-- In the case of configuration files, full path names are needed for some
-- ASIS queries. The flag Full_Name indicates that the name of the file
-- should be normalized to include a full path.
else
Check_SPARK_05_Restriction ("discriminant type is not allowed", N);
-
- -- The following check is only relevant when SPARK_Mode is on as
- -- it is not a standard Ada legality rule. A derived type cannot
- -- have discriminants if the parent type is discriminated.
-
- if SPARK_Mode = On and then Has_Discriminants (Parent_Type) then
- SPARK_Msg_N
- ("discriminants not allowed if parent type is discriminated",
- Defining_Identifier
- (First (Discriminant_Specifications (N))));
- end if;
end if;
end if;
end if;
end if;
- -- The following checks are only relevant when SPARK_Mode is on as
- -- they are not standard Ada legality rules.
-
- if SPARK_Mode = On then
- if Is_Access_Type (Discr_Type) then
- SPARK_Msg_N
- ("discriminant cannot have an access type",
- Discriminant_Type (Discr));
-
- elsif not Is_Discrete_Type (Discr_Type) then
- SPARK_Msg_N
- ("discriminant must have a discrete type",
- Discriminant_Type (Discr));
- end if;
+ -- Handling of discriminants that are access types
- -- Normal Ada rules
+ if Is_Access_Type (Discr_Type) then
- else
- if Is_Access_Type (Discr_Type) then
+ -- Ada 2005 (AI-230): Access discriminant allowed in non-
+ -- limited record types
- -- Ada 2005 (AI-230): Access discriminant allowed in non-
- -- limited record types
-
- if Ada_Version < Ada_2005 then
- Check_Access_Discriminant_Requires_Limited
- (Discr, Discriminant_Type (Discr));
- end if;
-
- if Ada_Version = Ada_83 and then Comes_From_Source (Discr) then
- Error_Msg_N
- ("(Ada 83) access discriminant not allowed", Discr);
- end if;
+ if Ada_Version < Ada_2005 then
+ Check_Access_Discriminant_Requires_Limited
+ (Discr, Discriminant_Type (Discr));
+ end if;
- elsif not Is_Discrete_Type (Discr_Type) then
+ if Ada_Version = Ada_83 and then Comes_From_Source (Discr) then
Error_Msg_N
- ("discriminants must have a discrete or access type",
- Discriminant_Type (Discr));
+ ("(Ada 83) access discriminant not allowed", Discr);
end if;
+
+ -- If not access type, must be a discrete type
+
+ elsif not Is_Discrete_Type (Discr_Type) then
+ Error_Msg_N
+ ("discriminants must have a discrete or access type",
+ Discriminant_Type (Discr));
end if;
Set_Etype (Defining_Identifier (Discr), Discr_Type);
-- expression of the discriminant; the default expression must be of
-- the type of the discriminant. (RM 3.7.1) Since this expression is
-- a default expression, we do the special preanalysis, since this
- -- expression does not freeze (see "Handling of Default and Per-
- -- Object Expressions" in spec of package Sem).
+ -- expression does not freeze (see section "Handling of Default and
+ -- Per-Object Expressions" in spec of package Sem).
if Present (Expression (Discr)) then
Preanalyze_Spec_Expression (Expression (Discr), Discr_Type);
elsif not Comes_From_Source (Stmt)
and then
(Nkind (Stmt) /= N_Subprogram_Declaration
- or else No (Generic_Parent (Specification (Stmt))))
+ or else No (Generic_Parent (Specification (Stmt))))
then
null;
projects / thirdparty / gcc.git / commitdiff
