gcc/ada/libgnat/g-sehamd.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT LIBRARY COMPONENTS                          --
   4 --                                                                          --
   5 --               G N A T . S E C U R E _ H A S H E S . M D 5                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --         Copyright (C) 2002-2017, 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 GNAT.Byte_Swapping; use GNAT.Byte_Swapping;
  33
  34 package body GNAT.Secure_Hashes.MD5 is
  35
  36    use Interfaces;
  37
  38    --  The sixteen values used to rotate the context words. Four for each
  39    --  rounds. Used in procedure Transform.
  40
  41    --  Round 1
  42
  43    S11 : constant := 7;
  44    S12 : constant := 12;
  45    S13 : constant := 17;
  46    S14 : constant := 22;
  47
  48    --  Round 2
  49
  50    S21 : constant := 5;
  51    S22 : constant := 9;
  52    S23 : constant := 14;
  53    S24 : constant := 20;
  54
  55    --  Round 3
  56
  57    S31 : constant := 4;
  58    S32 : constant := 11;
  59    S33 : constant := 16;
  60    S34 : constant := 23;
  61
  62    --  Round 4
  63
  64    S41 : constant := 6;
  65    S42 : constant := 10;
  66    S43 : constant := 15;
  67    S44 : constant := 21;
  68
  69    --  The following functions (F, FF, G, GG, H, HH, I and II) are the
  70    --  equivalent of the macros of the same name in the example C
  71    --  implementation in the annex of RFC 1321.
  72
  73    function F (X, Y, Z : Unsigned_32) return Unsigned_32;
  74    pragma Inline (F);
  75
  76    procedure FF
  77      (A       : in out Unsigned_32;
  78       B, C, D : Unsigned_32;
  79       X       : Unsigned_32;
  80       AC      : Unsigned_32;
  81       S       : Positive);
  82    pragma Inline (FF);
  83
  84    function G (X, Y, Z : Unsigned_32) return Unsigned_32;
  85    pragma Inline (G);
  86
  87    procedure GG
  88      (A       : in out Unsigned_32;
  89       B, C, D : Unsigned_32;
  90       X       : Unsigned_32;
  91       AC      : Unsigned_32;
  92       S       : Positive);
  93    pragma Inline (GG);
  94
  95    function H (X, Y, Z : Unsigned_32) return Unsigned_32;
  96    pragma Inline (H);
  97
  98    procedure HH
  99      (A       : in out Unsigned_32;
 100       B, C, D : Unsigned_32;
 101       X       : Unsigned_32;
 102       AC      : Unsigned_32;
 103       S       : Positive);
 104    pragma Inline (HH);
 105
 106    function I (X, Y, Z : Unsigned_32) return Unsigned_32;
 107    pragma Inline (I);
 108
 109    procedure II
 110      (A       : in out Unsigned_32;
 111       B, C, D : Unsigned_32;
 112       X       : Unsigned_32;
 113       AC      : Unsigned_32;
 114       S       : Positive);
 115    pragma Inline (II);
 116
 117    -------
 118    -- F --
 119    -------
 120
 121    function F (X, Y, Z : Unsigned_32) return Unsigned_32 is
 122    begin
 123       return (X and Y) or ((not X) and Z);
 124    end F;
 125
 126    --------
 127    -- FF --
 128    --------
 129
 130    procedure FF
 131      (A       : in out Unsigned_32;
 132       B, C, D : Unsigned_32;
 133       X       : Unsigned_32;
 134       AC      : Unsigned_32;
 135       S       : Positive)
 136    is
 137    begin
 138       A := A + F (B, C, D) + X + AC;
 139       A := Rotate_Left (A, S);
 140       A := A + B;
 141    end FF;
 142
 143    -------
 144    -- G --
 145    -------
 146
 147    function G (X, Y, Z : Unsigned_32) return Unsigned_32 is
 148    begin
 149       return (X and Z) or (Y and (not Z));
 150    end G;
 151
 152    --------
 153    -- GG --
 154    --------
 155
 156    procedure GG
 157      (A       : in out Unsigned_32;
 158       B, C, D : Unsigned_32;
 159       X       : Unsigned_32;
 160       AC      : Unsigned_32;
 161       S       : Positive)
 162    is
 163    begin
 164       A := A + G (B, C, D) + X + AC;
 165       A := Rotate_Left (A, S);
 166       A := A + B;
 167    end GG;
 168
 169    -------
 170    -- H --
 171    -------
 172
 173    function H (X, Y, Z : Unsigned_32) return Unsigned_32 is
 174    begin
 175       return X xor Y xor Z;
 176    end H;
 177
 178    --------
 179    -- HH --
 180    --------
 181
 182    procedure HH
 183      (A       : in out Unsigned_32;
 184       B, C, D : Unsigned_32;
 185       X       : Unsigned_32;
 186       AC      : Unsigned_32;
 187       S       : Positive)
 188    is
 189    begin
 190       A := A + H (B, C, D) + X + AC;
 191       A := Rotate_Left (A, S);
 192       A := A + B;
 193    end HH;
 194
 195    -------
 196    -- I --
 197    -------
 198
 199    function I (X, Y, Z : Unsigned_32) return Unsigned_32 is
 200    begin
 201       return Y xor (X or (not Z));
 202    end I;
 203
 204    --------
 205    -- II --
 206    --------
 207
 208    procedure II
 209      (A       : in out Unsigned_32;
 210       B, C, D : Unsigned_32;
 211       X       : Unsigned_32;
 212       AC      : Unsigned_32;
 213       S       : Positive)
 214    is
 215    begin
 216       A := A + I (B, C, D) + X + AC;
 217       A := Rotate_Left (A, S);
 218       A := A + B;
 219    end II;
 220
 221    ---------------
 222    -- Transform --
 223    ---------------
 224
 225    procedure Transform
 226      (H : in out Hash_State.State;
 227       M : in out Message_State)
 228    is
 229       use System;
 230
 231       X : array (0 .. 15) of Interfaces.Unsigned_32;
 232       for X'Address use M.Buffer'Address;
 233       pragma Import (Ada, X);
 234
 235       AA : Unsigned_32 := H (0);
 236       BB : Unsigned_32 := H (1);
 237       CC : Unsigned_32 := H (2);
 238       DD : Unsigned_32 := H (3);
 239
 240    begin
 241       if Default_Bit_Order /= Low_Order_First then
 242          for J in X'Range loop
 243             Swap4 (X (J)'Address);
 244          end loop;
 245       end if;
 246
 247       --  Round 1
 248
 249       FF (AA, BB, CC, DD, X (00), 16#D76aa478#, S11); --  1
 250       FF (DD, AA, BB, CC, X (01), 16#E8c7b756#, S12); --  2
 251       FF (CC, DD, AA, BB, X (02), 16#242070db#, S13); --  3
 252       FF (BB, CC, DD, AA, X (03), 16#C1bdceee#, S14); --  4
 253
 254       FF (AA, BB, CC, DD, X (04), 16#f57c0faf#, S11); --  5
 255       FF (DD, AA, BB, CC, X (05), 16#4787c62a#, S12); --  6
 256       FF (CC, DD, AA, BB, X (06), 16#a8304613#, S13); --  7
 257       FF (BB, CC, DD, AA, X (07), 16#fd469501#, S14); --  8
 258
 259       FF (AA, BB, CC, DD, X (08), 16#698098d8#, S11); --  9
 260       FF (DD, AA, BB, CC, X (09), 16#8b44f7af#, S12); --  10
 261       FF (CC, DD, AA, BB, X (10), 16#ffff5bb1#, S13); --  11
 262       FF (BB, CC, DD, AA, X (11), 16#895cd7be#, S14); --  12
 263
 264       FF (AA, BB, CC, DD, X (12), 16#6b901122#, S11); --  13
 265       FF (DD, AA, BB, CC, X (13), 16#fd987193#, S12); --  14
 266       FF (CC, DD, AA, BB, X (14), 16#a679438e#, S13); --  15
 267       FF (BB, CC, DD, AA, X (15), 16#49b40821#, S14); --  16
 268
 269       --  Round 2
 270
 271       GG (AA, BB, CC, DD, X (01), 16#f61e2562#, S21); --  17
 272       GG (DD, AA, BB, CC, X (06), 16#c040b340#, S22); --  18
 273       GG (CC, DD, AA, BB, X (11), 16#265e5a51#, S23); --  19
 274       GG (BB, CC, DD, AA, X (00), 16#e9b6c7aa#, S24); --  20
 275
 276       GG (AA, BB, CC, DD, X (05), 16#d62f105d#, S21); --  21
 277       GG (DD, AA, BB, CC, X (10), 16#02441453#, S22); --  22
 278       GG (CC, DD, AA, BB, X (15), 16#d8a1e681#, S23); --  23
 279       GG (BB, CC, DD, AA, X (04), 16#e7d3fbc8#, S24); --  24
 280
 281       GG (AA, BB, CC, DD, X (09), 16#21e1cde6#, S21); --  25
 282       GG (DD, AA, BB, CC, X (14), 16#c33707d6#, S22); --  26
 283       GG (CC, DD, AA, BB, X (03), 16#f4d50d87#, S23); --  27
 284       GG (BB, CC, DD, AA, X (08), 16#455a14ed#, S24); --  28
 285
 286       GG (AA, BB, CC, DD, X (13), 16#a9e3e905#, S21); --  29
 287       GG (DD, AA, BB, CC, X (02), 16#fcefa3f8#, S22); --  30
 288       GG (CC, DD, AA, BB, X (07), 16#676f02d9#, S23); --  31
 289       GG (BB, CC, DD, AA, X (12), 16#8d2a4c8a#, S24); --  32
 290
 291       --  Round 3
 292
 293       HH (AA, BB, CC, DD, X (05), 16#fffa3942#, S31); --  33
 294       HH (DD, AA, BB, CC, X (08), 16#8771f681#, S32); --  34
 295       HH (CC, DD, AA, BB, X (11), 16#6d9d6122#, S33); --  35
 296       HH (BB, CC, DD, AA, X (14), 16#fde5380c#, S34); --  36
 297
 298       HH (AA, BB, CC, DD, X (01), 16#a4beea44#, S31); --  37
 299       HH (DD, AA, BB, CC, X (04), 16#4bdecfa9#, S32); --  38
 300       HH (CC, DD, AA, BB, X (07), 16#f6bb4b60#, S33); --  39
 301       HH (BB, CC, DD, AA, X (10), 16#bebfbc70#, S34); --  40
 302
 303       HH (AA, BB, CC, DD, X (13), 16#289b7ec6#, S31); --  41
 304       HH (DD, AA, BB, CC, X (00), 16#eaa127fa#, S32); --  42
 305       HH (CC, DD, AA, BB, X (03), 16#d4ef3085#, S33); --  43
 306       HH (BB, CC, DD, AA, X (06), 16#04881d05#, S34); --  44
 307
 308       HH (AA, BB, CC, DD, X (09), 16#d9d4d039#, S31); --  45
 309       HH (DD, AA, BB, CC, X (12), 16#e6db99e5#, S32); --  46
 310       HH (CC, DD, AA, BB, X (15), 16#1fa27cf8#, S33); --  47
 311       HH (BB, CC, DD, AA, X (02), 16#c4ac5665#, S34); --  48
 312
 313       --  Round 4
 314
 315       II (AA, BB, CC, DD, X (00), 16#f4292244#, S41); --  49
 316       II (DD, AA, BB, CC, X (07), 16#432aff97#, S42); --  50
 317       II (CC, DD, AA, BB, X (14), 16#ab9423a7#, S43); --  51
 318       II (BB, CC, DD, AA, X (05), 16#fc93a039#, S44); --  52
 319
 320       II (AA, BB, CC, DD, X (12), 16#655b59c3#, S41); --  53
 321       II (DD, AA, BB, CC, X (03), 16#8f0ccc92#, S42); --  54
 322       II (CC, DD, AA, BB, X (10), 16#ffeff47d#, S43); --  55
 323       II (BB, CC, DD, AA, X (01), 16#85845dd1#, S44); --  56
 324
 325       II (AA, BB, CC, DD, X (08), 16#6fa87e4f#, S41); --  57
 326       II (DD, AA, BB, CC, X (15), 16#fe2ce6e0#, S42); --  58
 327       II (CC, DD, AA, BB, X (06), 16#a3014314#, S43); --  59
 328       II (BB, CC, DD, AA, X (13), 16#4e0811a1#, S44); --  60
 329
 330       II (AA, BB, CC, DD, X (04), 16#f7537e82#, S41); --  61
 331       II (DD, AA, BB, CC, X (11), 16#bd3af235#, S42); --  62
 332       II (CC, DD, AA, BB, X (02), 16#2ad7d2bb#, S43); --  63
 333       II (BB, CC, DD, AA, X (09), 16#eb86d391#, S44); --  64
 334
 335       H (0) := H (0) + AA;
 336       H (1) := H (1) + BB;
 337       H (2) := H (2) + CC;
 338       H (3) := H (3) + DD;
 339
 340    end Transform;
 341
 342 end GNAT.Secure_Hashes.MD5;