Natools

Check-in [0f22d2b71f]
Login
Overview
Comment:hmac: new package providing a generic HMAC implementation using a formal hash function
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0f22d2b71fd71af99cdb190a3441e83337cd1990
User & Date: nat on 2014-04-04 21:18:43
Other Links: manifest | tags
Context
2014-04-05
17:08
natools-gnat_hmac-*: new packages instances of Natools.HMAC with NAT-provided hash functions check-in: 20773f86ed user: nat tags: trunk
2014-04-04
21:18
hmac: new package providing a generic HMAC implementation using a formal hash function check-in: 0f22d2b71f user: nat tags: trunk
2014-04-03
20:21
Adjustments to pass GNAT 4.9 compilatiion without warning check-in: b8364499b7 user: nat tags: trunk
Changes

Added src/natools-hmac.adb version [37002ea868].













































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
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 version [a0ed1e90f1].
















































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
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;