From 4ff2b6dcc98d42fb75c4491ab3871cef10857ebf Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Aug 2014 14:47:56 +0200 Subject: [PATCH] [multiple changes] 2014-08-04 Robert Dewar * sem_prag.adb, osint.adb, osint.ads: Minor reformatting. 2014-08-04 Yannick Moy * sem_ch3.adb (Derive_Type_Declaration, Process_Discriminants): Remove SPARK-specific legality checks. 2014-08-04 Thomas Quinot * g-sechas.ads, g-sechas.adb (HMAC_Initial_Context): New subprogram. * gnat_rm.texi (GNAT.MD5/SHA1/SHA224/SHA256/SHA512): Document support for HMAC. From-SVN: r213577 --- gcc/ada/ChangeLog | 15 +++++++++ gcc/ada/g-sechas.adb | 74 +++++++++++++++++++++++++++++++++++++++++--- gcc/ada/g-sechas.ads | 21 ++++++++++--- gcc/ada/gnat_rm.texi | 23 ++++++++++---- gcc/ada/osint.adb | 6 ++-- gcc/ada/osint.ads | 1 + gcc/ada/sem_ch3.adb | 64 ++++++++++++-------------------------- gcc/ada/sem_prag.adb | 2 +- 8 files changed, 142 insertions(+), 64 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e3a56a9796e..6a2564369d5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2014-08-04 Robert Dewar + + * sem_prag.adb, osint.adb, osint.ads: Minor reformatting. + +2014-08-04 Yannick Moy + + * sem_ch3.adb (Derive_Type_Declaration, + Process_Discriminants): Remove SPARK-specific legality checks. + +2014-08-04 Thomas Quinot + + * 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 * sem_ch7.adb (Analyze_Package_Body_Helper): When verifying the diff --git a/gcc/ada/g-sechas.adb b/gcc/ada/g-sechas.adb index 4b396f112ed..0e70b5dd48f 100644 --- a/gcc/ada/g-sechas.adb +++ b/gcc/ada/g-sechas.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -218,8 +218,8 @@ package body GNAT.Secure_Hashes is -- 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; @@ -274,8 +274,73 @@ package body GNAT.Secure_Hashes is 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 -- ------------ @@ -285,11 +350,12 @@ package body GNAT.Secure_Hashes is 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); diff --git a/gcc/ada/g-sechas.ads b/gcc/ada/g-sechas.ads index f3f71601de5..c00150e17ba 100644 --- a/gcc/ada/g-sechas.ads +++ b/gcc/ada/g-sechas.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -144,6 +144,9 @@ package GNAT.Secure_Hashes is -- 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 @@ -163,7 +166,7 @@ package GNAT.Secure_Hashes is -- 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; @@ -178,7 +181,7 @@ package GNAT.Secure_Hashes is -- 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; @@ -193,7 +196,15 @@ package GNAT.Secure_Hashes is 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 @@ -201,7 +212,7 @@ package GNAT.Secure_Hashes is -- 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; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index cd215f521bf..8dce342e154 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -19952,7 +19952,9 @@ a modified version of the Blum-Blum-Shub generator. @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}) @@ -20088,7 +20090,8 @@ port. This is only supported on GNU/Linux and Windows. @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}) @@ -20096,7 +20099,9 @@ and RFC 3174. @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}) @@ -20104,7 +20109,9 @@ Implements the SHA-224 Secure Hash Algorithm as described in FIPS PUB 180-3. @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}) @@ -20112,7 +20119,9 @@ Implements the SHA-256 Secure Hash Algorithm as described in FIPS PUB 180-3. @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}) @@ -20120,7 +20129,9 @@ Implements the SHA-384 Secure Hash Algorithm as described in FIPS PUB 180-3. @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}) diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 3fd796c4953..9ba18083fea 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1174,7 +1174,8 @@ package body Osint is 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); @@ -1200,9 +1201,8 @@ package body Osint is 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; diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index caddf666b2a..eb569c01e1f 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -77,6 +77,7 @@ package Osint is -- 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. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index aa410e4fec1..424cc696bfb 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -15062,17 +15062,6 @@ package body Sem_Ch3 is 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; @@ -18038,44 +18027,29 @@ package body Sem_Ch3 is 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); @@ -18085,8 +18059,8 @@ package body Sem_Ch3 is -- 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); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 43ae0652517..40ce62ff471 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -19359,7 +19359,7 @@ package body Sem_Prag is 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; -- 2.30.2