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-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 32with GNAT.Byte_Swapping; use GNAT.Byte_Swapping; 33 34package 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 342end GNAT.Secure_Hashes.MD5; 343