package util

#
# $Id: md5.icn,v 1.2 2006-07-10 13:44:28 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, padding

      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