OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [g-sechas.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT LIBRARY COMPONENTS                          --
4
--                                                                          --
5
--                   G N A T . S E C U R E _ H A S H E S                    --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--           Copyright (C) 2009, Free Software Foundation, Inc.             --
10
--                                                                          --
11
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
12
-- terms of the  GNU General Public License as published  by the Free Soft- --
13
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
14
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
15
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
16
-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
17
--                                                                          --
18
-- As a special exception under Section 7 of GPL version 3, you are granted --
19
-- additional permissions described in the GCC Runtime Library Exception,   --
20
-- version 3.1, as published by the Free Software Foundation.               --
21
--                                                                          --
22
-- You should have received a copy of the GNU General Public License and    --
23
-- a copy of the GCC Runtime Library Exception along with this program;     --
24
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
25
-- <http://www.gnu.org/licenses/>.                                          --
26
--                                                                          --
27
-- GNAT was originally developed  by the GNAT team at  New York University. --
28
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
29
--                                                                          --
30
------------------------------------------------------------------------------
31
 
32
with System;     use System;
33
with Interfaces; use Interfaces;
34
 
35
package body GNAT.Secure_Hashes is
36
 
37
   use Ada.Streams;
38
 
39
   Hex_Digit : constant array (Stream_Element range 0 .. 15) of Character :=
40
                 "0123456789abcdef";
41
 
42
   type Fill_Buffer_Access is
43
     access procedure
44
       (M     : in out Message_State;
45
        S     : String;
46
        First : Natural;
47
        Last  : out Natural);
48
   --  A procedure to transfer data from S, starting at First, into M's block
49
   --  buffer until either the block buffer is full or all data from S has been
50
   --  consumed.
51
 
52
   procedure Fill_Buffer_Copy
53
     (M     : in out Message_State;
54
      S     : String;
55
      First : Natural;
56
      Last  : out Natural);
57
   --  Transfer procedure which just copies data from S to M
58
 
59
   procedure Fill_Buffer_Swap
60
     (M     : in out Message_State;
61
      S     : String;
62
      First : Natural;
63
      Last  : out Natural);
64
   --  Transfer procedure which swaps bytes from S when copying into M. S must
65
   --  have even length. Note that the swapping is performed considering pairs
66
   --  starting at S'First, even if S'First /= First (that is, if
67
   --  First = S'First then the first copied byte is always S (S'First + 1),
68
   --  and if First = S'First + 1 then the first copied byte is always
69
   --  S (S'First).
70
 
71
   procedure To_String (SEA : Stream_Element_Array; S : out String);
72
   --  Return the hexadecimal representation of SEA
73
 
74
   ----------------------
75
   -- Fill_Buffer_Copy --
76
   ----------------------
77
 
78
   procedure Fill_Buffer_Copy
79
     (M     : in out Message_State;
80
      S     : String;
81
      First : Natural;
82
      Last  : out Natural)
83
   is
84
      Buf_String : String (M.Buffer'Range);
85
      for Buf_String'Address use M.Buffer'Address;
86
      pragma Import (Ada, Buf_String);
87
 
88
      Length : constant Natural :=
89
                 Natural'Min (M.Block_Length - M.Last, S'Last - First + 1);
90
 
91
   begin
92
      pragma Assert (Length > 0);
93
 
94
      Buf_String (M.Last + 1 .. M.Last + Length) :=
95
        S (First .. First + Length - 1);
96
      M.Last := M.Last + Length;
97
      Last := First + Length - 1;
98
   end Fill_Buffer_Copy;
99
 
100
   ----------------------
101
   -- Fill_Buffer_Swap --
102
   ----------------------
103
 
104
   procedure Fill_Buffer_Swap
105
     (M     : in out Message_State;
106
      S     : String;
107
      First : Natural;
108
      Last  : out Natural)
109
   is
110
      pragma Assert (S'Length mod 2 = 0);
111
      Length : constant Natural :=
112
                  Natural'Min (M.Block_Length - M.Last, S'Last - First + 1);
113
   begin
114
      Last := First;
115
      while Last - First < Length loop
116
         M.Buffer (M.Last + 1 + Last - First) :=
117
           (if (Last - S'First) mod 2 = 0
118
            then S (Last + 1)
119
            else S (Last - 1));
120
         Last := Last + 1;
121
      end loop;
122
      M.Last := M.Last + Length;
123
      Last := First + Length - 1;
124
   end Fill_Buffer_Swap;
125
 
126
   ---------------
127
   -- To_String --
128
   ---------------
129
 
130
   procedure To_String (SEA : Stream_Element_Array; S : out String) is
131
      pragma Assert (S'Length = 2 * SEA'Length);
132
   begin
133
      for J in SEA'Range loop
134
         declare
135
            S_J : constant Natural := 1 + Natural (J - SEA'First) * 2;
136
         begin
137
            S (S_J)     := Hex_Digit (SEA (J) / 16);
138
            S (S_J + 1) := Hex_Digit (SEA (J) mod 16);
139
         end;
140
      end loop;
141
   end To_String;
142
 
143
   -------
144
   -- H --
145
   -------
146
 
147
   package body H is
148
 
149
      procedure Update
150
        (C           : in out Context;
151
         S           : String;
152
         Fill_Buffer : Fill_Buffer_Access);
153
      --  Internal common routine for all Update procedures
154
 
155
      procedure Final
156
        (C         : Context;
157
         Hash_Bits : out Ada.Streams.Stream_Element_Array);
158
      --  Perform final hashing operations (data padding) and extract the
159
      --  (possibly truncated) state of C into Hash_Bits.
160
 
161
      ------------
162
      -- Digest --
163
      ------------
164
 
165
      function Digest (C : Context) return Message_Digest is
166
         Hash_Bits : Stream_Element_Array
167
                       (1 .. Stream_Element_Offset (Hash_Length));
168
      begin
169
         Final (C, Hash_Bits);
170
         return MD : Message_Digest do
171
            To_String (Hash_Bits, MD);
172
         end return;
173
      end Digest;
174
 
175
      function Digest (S : String) return Message_Digest is
176
         C : Context;
177
      begin
178
         Update (C, S);
179
         return Digest (C);
180
      end Digest;
181
 
182
      function Digest (A : Stream_Element_Array) return Message_Digest is
183
         C : Context;
184
      begin
185
         Update (C, A);
186
         return Digest (C);
187
      end Digest;
188
 
189
      -----------
190
      -- Final --
191
      -----------
192
 
193
      --  Once a complete message has been processed, it is padded with one
194
      --  1 bit followed by enough 0 bits so that the last block is
195
      --  2 * Word'Size bits short of being completed. The last 2 * Word'Size
196
      --  bits are set to the message size in bits (excluding padding).
197
 
198
      procedure Final
199
        (C          : Context;
200
         Hash_Bits  : out Stream_Element_Array)
201
      is
202
         FC : Context := C;
203
 
204
         Zeroes : Natural;
205
         --  Number of 0 bytes in padding
206
 
207
         Message_Length : Unsigned_64 := FC.M_State.Length;
208
         --  Message length in bytes
209
 
210
         Size_Length : constant Natural :=
211
                         2 * Hash_State.Word'Size / 8;
212
         --  Length in bytes of the size representation
213
 
214
      begin
215
         Zeroes := (Block_Length - 1 - Size_Length - FC.M_State.Last)
216
                     mod FC.M_State.Block_Length;
217
         declare
218
            Pad : String (1 .. 1 + Zeroes + Size_Length) :=
219
                    (1 => Character'Val (128), others => ASCII.NUL);
220
 
221
            Index       : Natural;
222
            First_Index : Natural;
223
 
224
         begin
225
            First_Index := (if Hash_Bit_Order = Low_Order_First
226
                            then Pad'Last - Size_Length + 1
227
                            else Pad'Last);
228
 
229
            Index := First_Index;
230
            while Message_Length > 0 loop
231
               if Index = First_Index then
232
 
233
                  --  Message_Length is in bytes, but we need to store it as
234
                  --  a bit count).
235
 
236
                  Pad (Index) := Character'Val
237
                                   (Shift_Left (Message_Length and 16#1f#, 3));
238
                  Message_Length := Shift_Right (Message_Length, 5);
239
 
240
               else
241
                  Pad (Index) := Character'Val (Message_Length and 16#ff#);
242
                  Message_Length := Shift_Right (Message_Length, 8);
243
               end if;
244
 
245
               Index := Index +
246
                          (if Hash_Bit_Order = Low_Order_First then 1 else -1);
247
            end loop;
248
 
249
            Update (FC, Pad);
250
         end;
251
 
252
         pragma Assert (FC.M_State.Last = 0);
253
 
254
         Hash_State.To_Hash (FC.H_State, Hash_Bits);
255
      end Final;
256
 
257
      ------------
258
      -- Update --
259
      ------------
260
 
261
      procedure Update
262
        (C           : in out Context;
263
         S           : String;
264
         Fill_Buffer : Fill_Buffer_Access)
265
      is
266
         Last : Natural := S'First - 1;
267
 
268
      begin
269
         C.M_State.Length := C.M_State.Length + S'Length;
270
 
271
         while Last < S'Last loop
272
            Fill_Buffer (C.M_State, S, Last + 1, Last);
273
 
274
            if C.M_State.Last = Block_Length then
275
               Transform (C.H_State, C.M_State);
276
               C.M_State.Last := 0;
277
            end if;
278
         end loop;
279
 
280
      end Update;
281
 
282
      ------------
283
      -- Update --
284
      ------------
285
 
286
      procedure Update (C : in out Context; Input : String) is
287
      begin
288
         Update (C, Input, Fill_Buffer_Copy'Access);
289
      end Update;
290
 
291
      ------------
292
      -- Update --
293
      ------------
294
 
295
      procedure Update (C : in out Context; Input : Stream_Element_Array) is
296
         S : String (1 .. Input'Length);
297
         for S'Address use Input'Address;
298
         pragma Import (Ada, S);
299
      begin
300
         Update (C, S, Fill_Buffer_Copy'Access);
301
      end Update;
302
 
303
      -----------------
304
      -- Wide_Update --
305
      -----------------
306
 
307
      procedure Wide_Update (C : in out Context; Input : Wide_String) is
308
         S : String (1 .. 2 * Input'Length);
309
         for S'Address use Input'Address;
310
         pragma Import (Ada, S);
311
      begin
312
         Update
313
           (C, S,
314
            (if System.Default_Bit_Order /= Low_Order_First
315
             then Fill_Buffer_Swap'Access
316
             else Fill_Buffer_Copy'Access));
317
      end Wide_Update;
318
 
319
      -----------------
320
      -- Wide_Digest --
321
      -----------------
322
 
323
      function Wide_Digest (W : Wide_String) return Message_Digest is
324
         C : Context;
325
      begin
326
         Wide_Update (C, W);
327
         return Digest (C);
328
      end Wide_Digest;
329
 
330
   end H;
331
 
332
   -------------------------
333
   -- Hash_Function_State --
334
   -------------------------
335
 
336
   package body Hash_Function_State is
337
 
338
      -------------
339
      -- To_Hash --
340
      -------------
341
 
342
      procedure To_Hash (H : State; H_Bits : out Stream_Element_Array) is
343
         Hash_Words : constant Natural := H'Size / Word'Size;
344
         Result     : State (1 .. Hash_Words) :=
345
                        H (H'Last - Hash_Words + 1 .. H'Last);
346
 
347
         R_SEA : Stream_Element_Array (1 .. Result'Size / 8);
348
         for R_SEA'Address use Result'Address;
349
         pragma Import (Ada, R_SEA);
350
 
351
      begin
352
         if System.Default_Bit_Order /= Hash_Bit_Order then
353
            for J in Result'Range loop
354
               Swap (Result (J)'Address);
355
            end loop;
356
         end if;
357
 
358
         --  Return truncated hash
359
 
360
         pragma Assert (H_Bits'Length <= R_SEA'Length);
361
         H_Bits := R_SEA (R_SEA'First .. R_SEA'First + H_Bits'Length - 1);
362
      end To_Hash;
363
 
364
   end Hash_Function_State;
365
 
366
end GNAT.Secure_Hashes;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.