/pliant/admin/md5.pli
 
 1  # This is Pliant MD5 Message Digest Algorithm implementation 
 2  # should be conforming to RFC 1321 
 3  # 
 4  # Translation to Pliant has been performed by Hubert Tonneau. 
 5  # Please find below the original C implementation copyright: 
 6  # 
 7  # ********************************************************************** 
 8  # ** md5.h -- Header file for implementation of MD5                   ** 
 9  # ** RSA Data Security, Inc. MD5 Message Digest Algorithm             ** 
 10  # ** Created: 2/17/90 RLR                                             ** 
 11  # ** Revised: 12/27/90 SRD,AJ,BSK,JT Reference C version              ** 
 12  # ** Revised (for MD5): RLR 4/27/91                                   ** 
 13  # **   -- G modified to have y&~z instead of y&z                      ** 
 14  # **   -- FF, GG, HH modified to add in last register done            ** 
 15  # **   -- Access pattern: round 2 works mod 5, round 3 works mod 3    ** 
 16  # **   -- distinct additive constant for each step                    ** 
 17  # **   -- round 4 added, working mod 7                                ** 
 18  # ********************************************************************** 
 19  # 
 20  # ********************************************************************** 
 21  # ** Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. ** 
 22  # **                                                                  ** 
 23  # ** License to copy and use this software is granted provided that   ** 
 24  # ** it is identified as the "RSA Data Security, Inc. MD5 Message     ** 
 25  # ** Digest Algorithm" in all material mentioning or referencing this ** 
 26  # ** software or this function.                                       ** 
 27  # **                                                                  ** 
 28  # ** License is also granted to make and use derivative works         ** 
 29  # ** provided that such works are identified as "derived from the RSA ** 
 30  # ** Data Security, Inc. MD5 Message Digest Algorithm" in all         ** 
 31  # ** material mentioning or referencing the derived work.             ** 
 32  # **                                                                  ** 
 33  # ** RSA Data Security, Inc. makes no representations concerning      ** 
 34  # ** either the merchantability of this software or the suitability   ** 
 35  # ** of this software for any particular purpose.  It is provided "as ** 
 36  # ** is" without express or implied warranty of any kind.             ** 
 37  # **                                                                  ** 
 38  # ** These notices must be retained in any copies of any part of this ** 
 39  # ** documentation and/or software.                                   ** 
 40  # ********************************************************************** 
 41   
 42   
 43  module "/pliant/language/unsafe.pli" 
 44  module "/pliant/language/context.pli" 
 45  module "/pliant/language/stream.pli" 
 46   
 47  type MD5_CTX 
 48    field (Array uInt32 2) bitscount 
 49    field (Array uInt32 4) buf 
 50    field (Array uInt8 64) in 
 51    field (Array uInt8 16) digest 
 52   
 53  constant MD5DigestSize 16 
 54   
 55   
 56 
 
 57   
 58   
 59  function F x y z -> t 
 60    arg uInt32 t 
 61    := (.and. y) .or. (.not. .and. z) 
 62     
 63  function G x y z -> t 
 64    arg uInt32 t 
 65    := (.and. z) .or. (.and. .not. z) 
 66     
 67  function H x y z -> t 
 68    arg uInt32 t 
 69    := .xor. .xor. z 
 70     
 71  function I x y z -> t 
 72    arg uInt32 t 
 73    := .xor. (.or. .not. z) 
 74     
 75  function ROTATE_LEFT x n -> r 
 76    arg uInt32 x ; arg Int n ; arg uInt32 r 
 77    var Int nn := n%32 
 78    if nn=0 
 79      := x 
 80    else 
 81      := (.*. 2^nn) .or. (2^(32-nn)) 
 82      check ((.*. 2^(32-nn)) .or. (2^nn))=x 
 83     
 84   
 85  function FF a b c d x s ac 
 86    arg_rw uInt32 a ; arg uInt32 x ; arg Int s ; arg uInt ac 
 87    := .+. (d) .+. .+. ac 
 88    := ROTATE_LEFT s 
 89    := .+. b 
 90   
 91  function GG a b c d x s ac 
 92    arg_rw uInt32 a ; arg uInt32 x ; arg Int s ; arg uInt ac 
 93    := .+. (d) .+. .+. ac 
 94    := ROTATE_LEFT s 
 95    := .+. b 
 96   
 97  function HH a b c d x s ac 
 98    arg_rw uInt32 a ; arg uInt32 x ; arg Int s ; arg uInt ac 
 99    := .+. (d) .+. .+. ac 
 100    := ROTATE_LEFT s 
 101    := .+. b 
 102   
 103  function II a b c d x s ac 
 104    arg_rw uInt32 a ; arg uInt32 x ; arg Int s ; arg uInt ac 
 105    := .+. (d) .+. .+. ac 
 106    := ROTATE_LEFT s 
 107    := .+. b 
 108   
 109  function Transform buf in 
 110    arg_rw (Array uInt32 4) buf ; arg (Array uInt32 16) in 
 111    var uInt32 := buf 0 
 112    var uInt32 := buf 1 
 113    var uInt32 := buf 2 
 114    var uInt32 := buf 3 
 115    # round 1 
 116    constant S11 7 
 117    constant S12 12 
 118    constant S13 17 
 119    constant S14 22 
 120    FF in:0 S11 3614090360 
 121    FF in:1 S12 3905402710 
 122    FF in:2 S13  606105819 
 123    FF in:3 S14 3250441966 
 124    FF in:4 S11 4118548399 
 125    FF in:5 S12 1200080426 
 126    FF in:6 S13 2821735955 
 127    FF in:7 S14 4249261313 
 128    FF in:8 S11 1770035416 
 129    FF in:9 S12 2336552879 
 130    FF in:10 S13 4294925233 
 131    FF in:11 S14 2304563134 
 132    FF in:12 S11 1804603682 
 133    FF in:13 S12 4254626195 
 134    FF in:14 S13 2792965006 
 135    FF in:15 S14 1236535329 
 136    # round 2 
 137    constant S21 5 
 138    constant S22 9 
 139    constant S23 14 
 140    constant S24 20 
 141    GG in:1 S21 4129170786 
 142    GG in:6 S22 3225465664 
 143    GG in:11 S23  643717713 
 144    GG in:0 S24 3921069994 
 145    GG in:5 S21 3593408605 
 146    GG in:10 S22   38016083 
 147    GG in:15 S23 3634488961 
 148    GG in:4 S24 3889429448 
 149    GG in:9 S21  568446438 
 150    GG in:14 S22 3275163606 
 151    GG in:3 S23 4107603335 
 152    GG in:8 S24 1163531501 
 153    GG in:13 S21 2850285829 
 154    GG in:2 S22 4243563512 
 155    GG in:7 S23 1735328473 
 156    GG in:12 S24 2368359562 
 157    # round 3 
 158    constant S31 4 
 159    constant S32 11 
 160    constant S33 16 
 161    constant S34 23 
 162    HH in:5 S31 4294588738 
 163    HH in:8 S32 2272392833 
 164    HH in:11 S33 1839030562 
 165    HH in:14 S34 4259657740 
 166    HH in:1 S31 2763975236 
 167    HH in:4 S32 1272893353 
 168    HH in:7 S33 4139469664 
 169    HH in:10 S34 3200236656 
 170    HH in:13 S31  681279174 
 171    HH in:0 S32 3936430074 
 172    HH in:3 S33 3572445317 
 173    HH in:6 S34   76029189 
 174    HH in:9 S31 3654602809 
 175    HH in:12 S32 3873151461 
 176    HH in:15 S33  530742520 
 177    HH in:2 S34 3299628645 
 178    # round 4 
 179    constant S41 6 
 180    constant S42 10 
 181    constant S43 15 
 182    constant S44 21 
 183    II in:0 S41 4096336452 
 184    II in:7 S42 1126891415 
 185    II in:14 S43 2878612391 
 186    II in:5 S44 4237533241 
 187    II in:12 S41 1700485571 
 188    II in:3 S42 2399980690 
 189    II in:10 S43 4293915773 
 190    II in:1 S44 2240044497 
 191    II in:8 S41 1873313359 
 192    II in:15 S42 4264355552 
 193    II in:6 S43 2734768916 
 194    II in:13 S44 1309151649 
 195    II in:4 S41 4149444226 
 196    II in:11 S42 3174756917 
 197    II in:2 S43  718787259 
 198    II in:9 S44 3951481745 
 199    buf := buf:.+. a 
 200    buf := buf:.+. b 
 201    buf := buf:.+. c 
 202    buf := buf:.+. d 
 203   
 204  function MD5Init ctx 
 205    arg_w MD5_CTX ctx 
 206    implicit ctx 
 207      bitscount := 0 ; bitscount := 0 
 208      buf := 067452301h 
 209      buf := 0EFCDAB89h 
 210      buf := 098BADCFEh 
 211      buf := 010325476h 
 212   
 213  function MD5Update ctx buffer len 
 214    arg_rw MD5_CTX ctx ; arg Address buffer ; arg Int len 
 215    implicit ctx 
 216      var Int mdi := (bitscount:0\2^3) .and. 3Fh 
 217      if (bitscount:.+. len*2^3)<bitscount:0 
 218        bitscount:+= 1 
 219      bitscount := bitscount:.+. len*2^3 
 220      bitscount := bitscount:.+. len\2^29 
 221      for (var Int u) len-1 
 222        in mdi := (buffer translate uInt8 u) map uInt8 
 223        mdi += 1 
 224        if mdi=64 
 225          var (Array uInt32 16) temp 
 226          for (var Int i) 0 15 
 227            temp := (in i*4+3)*2^24 .or. (in i*4+2)*2^16 .or. (in i*4+1)*2^.or. (in i*4+0) 
 228          Transform buf temp 
 229          mdi := 0 
 230             
 231     
 232  function MD5Final ctx 
 233    arg_rw MD5_CTX ctx 
 234    implicit ctx 
 235      var (Array uInt32 16) temp 
 236      temp 14 := bitscount 0 
 237      temp 15 := bitscount 1 
 238      var Int mdi := (bitscount:0\2^3) .and. 3Fh 
 239      var Str padding := character:80h+(repeat 63 character:0) 
 240      MD5Update ctx padding:characters (shunt mdi<56 56-mdi 64+56-mdi) 
 241      var Int mdi := (bitscount:0\2^3) .and. 3Fh 
 242      for (var Int i) 0 13 
 243        temp := (in i*4+3)*2^24 .or. (in i*4+2)*2^16 .or. (in i*4+1)*2^.or. (in i*4+0) 
 244      Transform buf temp 
 245      for 0 3 
 246        for (var Int j) 0 3 
 247          digest i*4+:= (buf:i\2^(8*j)) .and. 0FFh 
 248          
 249   
 250 
 
 251   
 252   
 253  function MD5BinarySignature ctx -> sign 
 254    arg_rw MD5_CTX ctx ; arg Str sign 
 255    sign := repeat MD5DigestSize " " 
 256    memory_copy (addressof ctx:digest) sign:characters MD5DigestSize 
 257   
 258  function MD5HexaSignature ctx -> hexsign 
 259    arg_rw MD5_CTX ctx ; arg Str hexsign 
 260    hexsign := repeat 2*MD5DigestSize " " 
 261    var Str hexdigits := "0123456789ABCDEF" 
 262    for (var Int i) 0 MD5DigestSize-1 
 263      hexsign 2*:= hexdigits ctx:digest:i\16 
 264      hexsign 2*i+:= hexdigits ctx:digest:i%16 
 265   
 266   
 267  function string_md5_binary_signature string -> sign 
 268    arg Str string sign 
 269    var MD5_CTX ctx 
 270    MD5Init ctx 
 271    MD5Update ctx string:characters string:len 
 272    MD5Final ctx 
 273    sign := MD5BinarySignature ctx 
 274   
 275  function string_md5_hexa_signature string -> hexsign 
 276    arg Str string hexsign 
 277    var MD5_CTX ctx 
 278    MD5Init ctx 
 279    MD5Update ctx string:characters string:len 
 280    MD5Final ctx 
 281    hexsign := MD5HexaSignature ctx 
 282   
 283   
 284  function file_md5_hexa_signature filename -> hexsign 
 285    arg Str filename hexsign 
 286    var MD5_CTX ctx 
 287    MD5Init ctx 
 288    (var Stream data) open filename in+safe+bigcache 
 289    while not data:atend 
 290      data read_available (var Address buffer) (var Int size) 
 291      MD5Update ctx buffer size 
 292    data close 
 293    MD5Final ctx 
 294    hexsign := MD5HexaSignature ctx 
 295   
 296  function file_md5_hexa_signature filename size -> hexsign 
 297    arg Str filename ; arg Int size ; arg Str hexsign 
 298    var MD5_CTX ctx 
 299    MD5Init ctx 
 300    (var Stream data) open filename in+safe+bigcache 
 301    var Int size2 := 0 
 302    while not data:atend 
 303      data read_available (var Address buffer) (var Int step) 
 304      MD5Update ctx buffer step 
 305      size2 += step 
 306    data close 
 307    MD5Final ctx 
 308    hexsign := MD5HexaSignature ctx 
 309    if size2<>size 
 310      hexsign := "" 
 311   
 312   
 313  export MD5_CTX MD5Init MD5Update MD5Final MD5BinarySignature MD5HexaSignature 
 314  export string_md5_binary_signature string_md5_hexa_signature 
 315  export file_md5_hexa_signature 
 316   
 317   
 318 
 
 319   
 320   
 321  if pliant_debugging_level>=3 
 322    if string_md5_hexa_signature:""<>"D41D8CD98F00B204E9800998ECF8427E" 
 323      error error_id_unexpected "MD5 implementation is buggy" 
 324    if string_md5_hexa_signature:"This is a sample string"<>"1E55C45D6638B0DBC9B33B8F03CBC4F8" 
 325      error error_id_unexpected "MD5 implementation is buggy"