package util

#
# $Id: md5.icn,v 1.1 2004/09/05 16:07:56 rparlett Exp $
#

$define S11 7
$define S12 12
$define S13 17
$define S14 22
$define S21 5
$define S22 9
$define S23 14
$define S24 20
$define S31 4
$define S32 11
$define S33 16
$define S34 23
$define S41 6
$define S42 10
$define S43 15
$define S44 21

$define BIT32 16rffffffff

#
# An MD5 message digest implementation.  Example use :
# @example
# @ m := MD5()
# @ m.update("here is some input")
# @ m.update("here is some more")
# @ s := m.final()
#
# This will leave s containing a 16 char string, being the
# digest.   
#
class MD5(a, b, c, d, bit_count, buffer)
   method F(x, y, z)
      return ior(iand(x, y), iand(icom(x), z));
   end

   method G(x, y, z)
      return ior(iand(x, z), iand(y, icom(z)))
   end

   method H(x, y, z)
      return ixor(ixor(x, y), z)
   end

   method I(x, y, z)
      return ixor(y, ior(x, icom(z)))
   end

   method rotate_left(x, n)
      return ior(ishift(x, n), ishift(iand(x, BIT32), -(32 - n)))
   end

   method FF(a, b, c, d, x, s, ac)
      a +:= F(b, c, d) + x + ac
      a := rotate_left(a, s) + b
      return iand(a, BIT32)
   end

   method GG(a, b, c, d, x, s, ac)
      a +:= G(b, c, d) + x + ac
      a := rotate_left(a, s) + b
      return iand(a, BIT32)
   end

   method HH(a, b, c, d, x, s, ac)
      a +:= H(b, c, d) + x + ac
      a := rotate_left(a, s) + b
      return iand(a, BIT32)
   end

   method II(a, b, c, d, x, s, ac)
      a +:= I(b, c, d) + x + ac
      a := rotate_left(a, s) + b
      return iand(a, BIT32)
   end

   #
   # Add some input data to the computation
   # @param input a string
   #
   method update(input)
      local part_len, block

      # Update number of bits
      bit_count +:= 8 * (*input)

      buffer ||:= input
      buffer ? {
         while block := move(64) do
            transform(block)
         buffer := tab(0)
      }
   end

   #
   # Call final and then convert the result to a 32 bit string
   # of lower case hex digits.
   #
   method final_str()
      local s
      s := ""
      every s ||:= format_int_to_string(ord(!final()), 16, 2)
      return map(s)
   end

   #
   # Complete and return the computation of the digest as
   # a string of 16 characters.
   #
   method final()
      local bits, pad_len, s

      bits := encode(iand(bit_count, BIT32)) ||
         encode(iand(ishift(bit_count, -32), BIT32))

      if *buffer < 56 then
         pad_len := 56 - *buffer
      else
         pad_len := 120 - *buffer
      padding := char(16r80) || repl(char(0), pad_len - 1)
      
      update(padding)
      update(bits)

      s := encode(a) || encode(b) || encode(c) || encode(d)

      reset()

      return s
   end

   method transform(block)
      local x, a, b, c, d

      x := decode(block)

      a := self.a
      b := self.b
      c := self.c
      d := self.d

      a := FF (a, b, c, d, x[ 1], S11, 16rd76aa478)
      d := FF (d, a, b, c, x[ 2], S12, 16re8c7b756)
      c := FF (c, d, a, b, x[ 3], S13, 16r242070db)
      b := FF (b, c, d, a, x[ 4], S14, 16rc1bdceee)
      a := FF (a, b, c, d, x[ 5], S11, 16rf57c0faf)
      d := FF (d, a, b, c, x[ 6], S12, 16r4787c62a)
      c := FF (c, d, a, b, x[ 7], S13, 16ra8304613)
      b := FF (b, c, d, a, x[ 8], S14, 16rfd469501)
      a := FF (a, b, c, d, x[ 9], S11, 16r698098d8)
      d := FF (d, a, b, c, x[10], S12, 16r8b44f7af)
      c := FF (c, d, a, b, x[11], S13, 16rffff5bb1)
      b := FF (b, c, d, a, x[12], S14, 16r895cd7be)
      a := FF (a, b, c, d, x[13], S11, 16r6b901122)
      d := FF (d, a, b, c, x[14], S12, 16rfd987193)
      c := FF (c, d, a, b, x[15], S13, 16ra679438e)
      b := FF (b, c, d, a, x[16], S14, 16r49b40821)

      a := GG (a, b, c, d, x[ 2], S21, 16rf61e2562)
      d := GG (d, a, b, c, x[ 7], S22, 16rc040b340)
      c := GG (c, d, a, b, x[12], S23, 16r265e5a51)
      b := GG (b, c, d, a, x[ 1], S24, 16re9b6c7aa)
      a := GG (a, b, c, d, x[ 6], S21, 16rd62f105d)
      d := GG (d, a, b, c, x[11], S22,  16r2441453)
      c := GG (c, d, a, b, x[16], S23, 16rd8a1e681)
      b := GG (b, c, d, a, x[ 5], S24, 16re7d3fbc8)
      a := GG (a, b, c, d, x[10], S21, 16r21e1cde6)
      d := GG (d, a, b, c, x[15], S22, 16rc33707d6)
      c := GG (c, d, a, b, x[ 4], S23, 16rf4d50d87)
      b := GG (b, c, d, a, x[ 9], S24, 16r455a14ed)
      a := GG (a, b, c, d, x[14], S21, 16ra9e3e905)
      d := GG (d, a, b, c, x[ 3], S22, 16rfcefa3f8)
      c := GG (c, d, a, b, x[ 8], S23, 16r676f02d9)
      b := GG (b, c, d, a, x[13], S24, 16r8d2a4c8a)

      a := HH (a, b, c, d, x[ 6], S31, 16rfffa3942)
      d := HH (d, a, b, c, x[ 9], S32, 16r8771f681)
      c := HH (c, d, a, b, x[12], S33, 16r6d9d6122)
      b := HH (b, c, d, a, x[15], S34, 16rfde5380c)
      a := HH (a, b, c, d, x[ 2], S31, 16ra4beea44)
      d := HH (d, a, b, c, x[ 5], S32, 16r4bdecfa9)
      c := HH (c, d, a, b, x[ 8], S33, 16rf6bb4b60)
      b := HH (b, c, d, a, x[11], S34, 16rbebfbc70)
      a := HH (a, b, c, d, x[14], S31, 16r289b7ec6)
      d := HH (d, a, b, c, x[ 1], S32, 16reaa127fa)
      c := HH (c, d, a, b, x[ 4], S33, 16rd4ef3085)
      b := HH (b, c, d, a, x[ 7], S34,  16r4881d05)
      a := HH (a, b, c, d, x[10], S31, 16rd9d4d039)
      d := HH (d, a, b, c, x[13], S32, 16re6db99e5)
      c := HH (c, d, a, b, x[16], S33, 16r1fa27cf8)
      b := HH (b, c, d, a, x[ 3], S34, 16rc4ac5665)

      a := II (a, b, c, d, x[ 1], S41, 16rf4292244)
      d := II (d, a, b, c, x[ 8], S42, 16r432aff97)
      c := II (c, d, a, b, x[15], S43, 16rab9423a7)
      b := II (b, c, d, a, x[ 6], S44, 16rfc93a039)
      a := II (a, b, c, d, x[13], S41, 16r655b59c3)
      d := II (d, a, b, c, x[ 4], S42, 16r8f0ccc92)
      c := II (c, d, a, b, x[11], S43, 16rffeff47d)
      b := II (b, c, d, a, x[ 2], S44, 16r85845dd1)
      a := II (a, b, c, d, x[ 9], S41, 16r6fa87e4f)
      d := II (d, a, b, c, x[16], S42, 16rfe2ce6e0)
      c := II (c, d, a, b, x[ 7], S43, 16ra3014314)
      b := II (b, c, d, a, x[14], S44, 16r4e0811a1)
      a := II (a, b, c, d, x[ 5], S41, 16rf7537e82)
      d := II (d, a, b, c, x[12], S42, 16rbd3af235)
      c := II (c, d, a, b, x[ 3], S43, 16r2ad7d2bb)
      b := II (b, c, d, a, x[10], S44, 16reb86d391)

      self.a := iand(self.a + a, BIT32)
      self.b := iand(self.b + b, BIT32)
      self.c := iand(self.c + c, BIT32)
      self.d := iand(self.d + d, BIT32)
   end

   #
   # Transform a 32 bit number to 4 corresponding bytes
   # @p
   method encode(n)
      return char(iand(n, 16rff)) ||
         char(iand(ishift(n, -8), 16rff)) ||
         char(iand(ishift(n, -16), 16rff)) ||
         char(iand(ishift(n, -24), 16rff))
   end

   #
   # Transform 64 char string into 16 x 32 bit words
   # @p
   method decode(block)
      local l, s
      l := []
      block ? {
         repeat {
            s := move(4) | break
            put(l, ord(s[1]) + ishift(ord(s[2]), 8) +
                ishift(ord(s[3]), 16) + ishift(ord(s[4]), 24))
         }
      }
      return l
   end

   #
   # Reset this object, so it may be used for another
   # computation.  Called by {final()}.
   #
   method reset()
      bit_count := 0
      a := 16r67452301
      b := 16refcdab89
      c := 16r98badcfe
      d := 16r10325476
      buffer := ""
   end

   initially
      reset()
end