ADDED src/natools-hmac.adb Index: src/natools-hmac.adb ================================================================== --- src/natools-hmac.adb +++ src/natools-hmac.adb @@ -0,0 +1,172 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2014, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Conversion; + +package body Natools.HMAC is + + function To_Stream_Element_Array (Key : String) + return Ada.Streams.Stream_Element_Array; + pragma Inline (To_Stream_Element_Array); + -- Convert a String into a Stream_Element_Array + + function Pad + (Key : Ada.Streams.Stream_Element_Array; + Pattern : Ada.Streams.Stream_Element) + return Ada.Streams.Stream_Element_Array; + -- Scramble Key with the given pattern + + Outer_Pattern : constant Ada.Streams.Stream_Element := 16#5C#; + Inner_Pattern : constant Ada.Streams.Stream_Element := 16#36#; + + + ------------------------------ + -- Local Helper Subprograms -- + ------------------------------ + + function To_Stream_Element_Array (Key : String) + return Ada.Streams.Stream_Element_Array + is + subtype Ad_Hoc_String is String (Key'Range); + subtype Ad_Hoc_Array + is Ada.Streams.Stream_Element_Array (1 .. Key'Length); + + function Unchecked_Conversion is new Ada.Unchecked_Conversion + (Ad_Hoc_String, Ad_Hoc_Array); + begin + return Unchecked_Conversion (Key); + end To_Stream_Element_Array; + + + function Pad + (Key : Ada.Streams.Stream_Element_Array; + Pattern : Ada.Streams.Stream_Element) + return Ada.Streams.Stream_Element_Array + is + use type Ada.Streams.Stream_Element; + + Result : Ada.Streams.Stream_Element_Array (Key'Range); + begin + for I in Result'Range loop + Result (I) := Key (I) xor Pattern; + end loop; + + return Result; + end Pad; + + + + -------------------- + -- HAMC Interface -- + -------------------- + + procedure Setup + (C : out Context; + Key : in Ada.Streams.Stream_Element_Array) is + begin + C := Create (Key); + end Setup; + + + procedure Setup + (C : out Context; + Key : in String) is + begin + C := Create (Key); + end Setup; + + + function Create (Key : Ada.Streams.Stream_Element_Array) return Context is + Result : Context + := (Key => (others => 0), + Hash => Initial_Context); + + use type Ada.Streams.Stream_Element_Count; + begin + if Key'Length <= Block_Size_In_SE then + Result.Key (1 .. Key'Length) := Key; + else + declare + Local_Hash : Hash_Context := Initial_Context; + begin + Update (Local_Hash, Key); + + declare + Hashed_Key : constant Ada.Streams.Stream_Element_Array + := Digest (Local_Hash); + begin + Result.Key (1 .. Hashed_Key'Length) := Hashed_Key; + end; + end; + end if; + + Update (Result.Hash, Pad (Result.Key, Inner_Pattern)); + + return Result; + end Create; + + + function Create (Key : String) return Context is + begin + return Create (To_Stream_Element_Array (Key)); + end Create; + + + procedure Update + (C : in out Context; + Input : in Ada.Streams.Stream_Element_Array) is + begin + Update (C.Hash, Input); + end Update; + + + procedure Update + (C : in out Context; + Input : in String) is + begin + Update (C.Hash, To_Stream_Element_Array (Input)); + end Update; + + + function Digest (C : Context) return Ada.Streams.Stream_Element_Array is + Local_Hash : Hash_Context := Initial_Context; + begin + Update (Local_Hash, Pad (C.Key, Outer_Pattern)); + Update (Local_Hash, Digest (C.Hash)); + return Digest (Local_Hash); + end Digest; + + + function Digest (Key : String; Message : Ada.Streams.Stream_Element_Array) + return Ada.Streams.Stream_Element_Array + is + Local_Context : Context := Create (Key); + begin + Update (Local_Context, Message); + return Digest (Local_Context); + end Digest; + + + function Digest (Key, Message : Ada.Streams.Stream_Element_Array) + return Ada.Streams.Stream_Element_Array + is + Local_Context : Context := Create (Key); + begin + Update (Local_Context, Message); + return Digest (Local_Context); + end Digest; + +end Natools.HMAC; ADDED src/natools-hmac.ads Index: src/natools-hmac.ads ================================================================== --- src/natools-hmac.ads +++ src/natools-hmac.ads @@ -0,0 +1,79 @@ +------------------------------------------------------------------------------ +-- Copyright (c) 2014, Natacha Porté -- +-- -- +-- Permission to use, copy, modify, and distribute this software for any -- +-- purpose with or without fee is hereby granted, provided that the above -- +-- copyright notice and this permission notice appear in all copies. -- +-- -- +-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES -- +-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF -- +-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR -- +-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES -- +-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN -- +-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF -- +-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. -- +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- Natools.HMAC provides an implementation of keyed-hash message -- +-- authentication code (HMAC) based on cryptographic hash function provided -- +-- as formal parameters. -- +------------------------------------------------------------------------------ + +with Ada.Streams; + +generic + type Hash_Context is private; + Initial_Context : in Hash_Context; + + with procedure Update + (Context : in out Hash_Context; + Input : in Ada.Streams.Stream_Element_Array); + + with function Digest (Context : Hash_Context) + return Ada.Streams.Stream_Element_Array; + + Block_Size_In_SE : in Ada.Streams.Stream_Element_Count; + +package Natools.HMAC is + + type Context is private; + + procedure Setup + (C : out Context; + Key : in Ada.Streams.Stream_Element_Array); + procedure Setup + (C : out Context; + Key : in String); + -- Reset C with the given Key + + function Create (Key : Ada.Streams.Stream_Element_Array) return Context; + function Create (Key : String) return Context; + -- Create a new Context initialized with the given Key. + -- This is equivalent to calling Setup on the returned object. + + procedure Update + (C : in out Context; + Input : in Ada.Streams.Stream_Element_Array); + procedure Update + (C : in out Context; + Input : in String); + -- Append Input to the HMACed message + + function Digest (C : Context) return Ada.Streams.Stream_Element_Array; + -- Return the HMAC of the message given to C + + function Digest (Key : String; Message : Ada.Streams.Stream_Element_Array) + return Ada.Streams.Stream_Element_Array; + function Digest (Key, Message : Ada.Streams.Stream_Element_Array) + return Ada.Streams.Stream_Element_Array; + -- Return directly the HMAC of Message with the given Key + +private + + type Context is record + Key : Ada.Streams.Stream_Element_Array (1 .. Block_Size_In_SE); + Hash : Hash_Context; + end record; + +end Natools.HMAC;