/* MD5C.C - RSA Data Security, Inc., MD5 message-digest algorithm
 */

/* Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
rights reserved.

License to copy and use this software is granted provided that it
is identified as the "RSA Data Security, Inc. MD5 Message-Digest
Algorithm" in all material mentioning or referencing this software
or this function.

License is also granted to make and use derivative works provided
that such works are identified as "derived from the RSA Data
Security, Inc. MD5 Message-Digest Algorithm" in all material
mentioning or referencing the derived work.

RSA Data Security, Inc. makes no representations concerning either
the merchantability of this software or the suitability of this
software for any particular purpose. It is provided "as is"
without express or implied warranty of any kind.

These notices must be retained in any copies of any part of this
documentation and/or software.
 */

/* Synched up with: Not in FSF. */
/* This file has been Mule-ized. */

#include <config.h>
#include "lisp.h"

#include "buffer.h"
#include "insdel.h"
#include "lstream.h"
#ifdef FILE_CODING
#include "file-coding.h"
#endif

typedef unsigned char *POINTER;/* POINTER defines a generic pointer type */
typedef unsigned short int UINT2;/* UINT2 defines a two byte word */
typedef unsigned int UINT4;/* UINT4 defines a four byte word */

#define PROTO_LIST(list) list
#define MD_CTX MD5_CTX
#define MDInit MD5Init
#define MDUpdate MD5Update
#define MDFinal MD5Final

/* MD5 context. */
typedef struct {
  UINT4 state[4];                                   /* state (ABCD) */
  UINT4 count[2];        /* number of bits, modulo 2^64 (lsb first) */
  unsigned char buffer[64];                         /* input buffer */
} MD5_CTX;

void MD5Init PROTO_LIST ((MD5_CTX *));
void MD5Update PROTO_LIST
  ((MD5_CTX *, CONST unsigned char *, unsigned int));
void MD5Final PROTO_LIST ((unsigned char [16], MD5_CTX *));

/* Constants for MD5Transform routine.
 */
#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

static void MD5Transform PROTO_LIST ((UINT4 [4], CONST unsigned char [64]));
static void Encode PROTO_LIST
  ((unsigned char *, UINT4 *, unsigned int));
static void Decode PROTO_LIST
  ((UINT4 *, CONST unsigned char *, unsigned int));
static void MD5_memcpy PROTO_LIST ((POINTER, CONST POINTER, unsigned int));
static void MD5_memset PROTO_LIST ((POINTER, int, unsigned int));

static unsigned char PADDING[64] = {
  0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
};

/* F, G, H and I are basic MD5 functions.
 */
#define F(x, y, z) (((x) & (y)) | ((~x) & (z)))
#define G(x, y, z) (((x) & (z)) | ((y) & (~z)))
#define H(x, y, z) ((x) ^ (y) ^ (z))
#define I(x, y, z) ((y) ^ ((x) | (~z)))

/* ROTATE_LEFT rotates x left n bits.
 */
#define ROTATE_LEFT(x, n) (((x) << (n)) | ((x) >> (32-(n))))

/* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
Rotation is separate from addition to prevent recomputation.
 */
#define FF(a, b, c, d, x, s, ac) { \
 (a) += F ((b), (c), (d)) + (x) + (UINT4)(ac); \
 (a) = ROTATE_LEFT ((a), (s)); \
 (a) += (b); \
  }
#define GG(a, b, c, d, x, s, ac) { \
 (a) += G ((b), (c), (d)) + (x) + (UINT4)(ac); \
 (a) = ROTATE_LEFT ((a), (s)); \
 (a) += (b); \
  }
#define HH(a, b, c, d, x, s, ac) { \
 (a) += H ((b), (c), (d)) + (x) + (UINT4)(ac); \
 (a) = ROTATE_LEFT ((a), (s)); \
 (a) += (b); \
  }
#define II(a, b, c, d, x, s, ac) { \
 (a) += I ((b), (c), (d)) + (x) + (UINT4)(ac); \
 (a) = ROTATE_LEFT ((a), (s)); \
 (a) += (b); \
  }

/* MD5 initialization. Begins an MD5 operation, writing a new context.
 */
void
MD5Init (MD5_CTX *context)
{
  context->count[0] = context->count[1] = 0;

  /* Load magic initialization constants. */
  context->state[0] = 0x67452301;
  context->state[1] = 0xefcdab89;
  context->state[2] = 0x98badcfe;
  context->state[3] = 0x10325476;
}

/* MD5 block update operation. Continues an MD5 message-digest
  operation, processing another message block, and updating the
  context.
 */
void
MD5Update (MD5_CTX *context, CONST unsigned char *input, unsigned int inputLen)
{
  unsigned int i, indice, partLen;

  /* Compute number of bytes mod 64 */
  indice = (unsigned int)((context->count[0] >> 3) & 0x3F);

  /* Update number of bits */
  if ((context->count[0] += ((UINT4)inputLen << 3))
      < ((UINT4)inputLen << 3))
    context->count[1]++;
  context->count[1] += ((UINT4)inputLen >> 29);

  partLen = 64 - indice;

  /* Transform as many times as possible. */
  if (inputLen >= partLen)
    {
      MD5_memcpy ((POINTER)&context->buffer[indice], (CONST POINTER)input,
		  partLen);
      MD5Transform (context->state, context->buffer);

      for (i = partLen; i + 63 < inputLen; i += 64)
	MD5Transform (context->state, &input[i]);

      indice = 0;
    }
  else
    i = 0;

  /* Buffer remaining input */
  MD5_memcpy ((POINTER)&context->buffer[indice], (CONST POINTER)&input[i],
	      inputLen-i);
}

/* MD5 finalization. Ends an MD5 message-digest operation, writing the
  message digest and zeroizing the context.  */
void
MD5Final (unsigned char digest[16], MD5_CTX *context)
{
  unsigned char bits[8];
  unsigned int indice, padLen;

  /* Save number of bits */
  Encode (bits, context->count, 8);

  /* Pad out to 56 mod 64.
*/
  indice = (unsigned int)((context->count[0] >> 3) & 0x3f);
  padLen = (indice < 56) ? (56 - indice) : (120 - indice);
  MD5Update (context, PADDING, padLen);

  /* Append length (before padding) */
  MD5Update (context, bits, 8);
  /* Store state in digest */
  Encode (digest, context->state, 16);

  /* Zeroize sensitive information.
*/
  MD5_memset ((POINTER)context, 0, sizeof (*context));
}

/* MD5 basic transformation. Transforms state based on block.
 */
static void
MD5Transform (UINT4 state[4], CONST unsigned char block[64])
{
  UINT4 a = state[0], b = state[1], c = state[2], d = state[3], x[16];

  Decode (x, block, 64);

  /* Round 1 */
  FF (a, b, c, d, x[ 0], S11, 0xd76aa478); /* 1 */
  FF (d, a, b, c, x[ 1], S12, 0xe8c7b756); /* 2 */
  FF (c, d, a, b, x[ 2], S13, 0x242070db); /* 3 */
  FF (b, c, d, a, x[ 3], S14, 0xc1bdceee); /* 4 */
  FF (a, b, c, d, x[ 4], S11, 0xf57c0faf); /* 5 */
  FF (d, a, b, c, x[ 5], S12, 0x4787c62a); /* 6 */
  FF (c, d, a, b, x[ 6], S13, 0xa8304613); /* 7 */
  FF (b, c, d, a, x[ 7], S14, 0xfd469501); /* 8 */
  FF (a, b, c, d, x[ 8], S11, 0x698098d8); /* 9 */
  FF (d, a, b, c, x[ 9], S12, 0x8b44f7af); /* 10 */
  FF (c, d, a, b, x[10], S13, 0xffff5bb1); /* 11 */
  FF (b, c, d, a, x[11], S14, 0x895cd7be); /* 12 */
  FF (a, b, c, d, x[12], S11, 0x6b901122); /* 13 */
  FF (d, a, b, c, x[13], S12, 0xfd987193); /* 14 */
  FF (c, d, a, b, x[14], S13, 0xa679438e); /* 15 */
  FF (b, c, d, a, x[15], S14, 0x49b40821); /* 16 */

 /* Round 2 */
  GG (a, b, c, d, x[ 1], S21, 0xf61e2562); /* 17 */
  GG (d, a, b, c, x[ 6], S22, 0xc040b340); /* 18 */
  GG (c, d, a, b, x[11], S23, 0x265e5a51); /* 19 */
  GG (b, c, d, a, x[ 0], S24, 0xe9b6c7aa); /* 20 */
  GG (a, b, c, d, x[ 5], S21, 0xd62f105d); /* 21 */
  GG (d, a, b, c, x[10], S22,  0x2441453); /* 22 */
  GG (c, d, a, b, x[15], S23, 0xd8a1e681); /* 23 */
  GG (b, c, d, a, x[ 4], S24, 0xe7d3fbc8); /* 24 */
  GG (a, b, c, d, x[ 9], S21, 0x21e1cde6); /* 25 */
  GG (d, a, b, c, x[14], S22, 0xc33707d6); /* 26 */
  GG (c, d, a, b, x[ 3], S23, 0xf4d50d87); /* 27 */
  GG (b, c, d, a, x[ 8], S24, 0x455a14ed); /* 28 */
  GG (a, b, c, d, x[13], S21, 0xa9e3e905); /* 29 */
  GG (d, a, b, c, x[ 2], S22, 0xfcefa3f8); /* 30 */
  GG (c, d, a, b, x[ 7], S23, 0x676f02d9); /* 31 */
  GG (b, c, d, a, x[12], S24, 0x8d2a4c8a); /* 32 */

  /* Round 3 */
  HH (a, b, c, d, x[ 5], S31, 0xfffa3942); /* 33 */
  HH (d, a, b, c, x[ 8], S32, 0x8771f681); /* 34 */
  HH (c, d, a, b, x[11], S33, 0x6d9d6122); /* 35 */
  HH (b, c, d, a, x[14], S34, 0xfde5380c); /* 36 */
  HH (a, b, c, d, x[ 1], S31, 0xa4beea44); /* 37 */
  HH (d, a, b, c, x[ 4], S32, 0x4bdecfa9); /* 38 */
  HH (c, d, a, b, x[ 7], S33, 0xf6bb4b60); /* 39 */
  HH (b, c, d, a, x[10], S34, 0xbebfbc70); /* 40 */
  HH (a, b, c, d, x[13], S31, 0x289b7ec6); /* 41 */
  HH (d, a, b, c, x[ 0], S32, 0xeaa127fa); /* 42 */
  HH (c, d, a, b, x[ 3], S33, 0xd4ef3085); /* 43 */
  HH (b, c, d, a, x[ 6], S34,  0x4881d05); /* 44 */
  HH (a, b, c, d, x[ 9], S31, 0xd9d4d039); /* 45 */
  HH (d, a, b, c, x[12], S32, 0xe6db99e5); /* 46 */
  HH (c, d, a, b, x[15], S33, 0x1fa27cf8); /* 47 */
  HH (b, c, d, a, x[ 2], S34, 0xc4ac5665); /* 48 */

  /* Round 4 */
  II (a, b, c, d, x[ 0], S41, 0xf4292244); /* 49 */
  II (d, a, b, c, x[ 7], S42, 0x432aff97); /* 50 */
  II (c, d, a, b, x[14], S43, 0xab9423a7); /* 51 */
  II (b, c, d, a, x[ 5], S44, 0xfc93a039); /* 52 */
  II (a, b, c, d, x[12], S41, 0x655b59c3); /* 53 */
  II (d, a, b, c, x[ 3], S42, 0x8f0ccc92); /* 54 */
  II (c, d, a, b, x[10], S43, 0xffeff47d); /* 55 */
  II (b, c, d, a, x[ 1], S44, 0x85845dd1); /* 56 */
  II (a, b, c, d, x[ 8], S41, 0x6fa87e4f); /* 57 */
  II (d, a, b, c, x[15], S42, 0xfe2ce6e0); /* 58 */
  II (c, d, a, b, x[ 6], S43, 0xa3014314); /* 59 */
  II (b, c, d, a, x[13], S44, 0x4e0811a1); /* 60 */
  II (a, b, c, d, x[ 4], S41, 0xf7537e82); /* 61 */
  II (d, a, b, c, x[11], S42, 0xbd3af235); /* 62 */
  II (c, d, a, b, x[ 2], S43, 0x2ad7d2bb); /* 63 */
  II (b, c, d, a, x[ 9], S44, 0xeb86d391); /* 64 */

  state[0] += a;
  state[1] += b;
  state[2] += c;
  state[3] += d;

  /* Zeroize sensitive information.
*/
  MD5_memset ((POINTER)x, 0, sizeof (x));
}

/* Encodes input (UINT4) into output (unsigned char). Assumes len is
  a multiple of 4.
 */
static void
Encode (unsigned char *output, UINT4 *input, unsigned int len)
{
  unsigned int i, j;

  for (i = 0, j = 0; j < len; i++, j += 4)
    {
      output[j] = (unsigned char)(input[i] & 0xff);
      output[j+1] = (unsigned char)((input[i] >> 8) & 0xff);
      output[j+2] = (unsigned char)((input[i] >> 16) & 0xff);
      output[j+3] = (unsigned char)((input[i] >> 24) & 0xff);
    }
}

/* Decodes input (unsigned char) into output (UINT4). Assumes len is
  a multiple of 4.
 */
static void
Decode (UINT4 *output, CONST unsigned char *input, unsigned int len)
{
  unsigned int i, j;

  for (i = 0, j = 0; j < len; i++, j += 4)
    output[i] = ((UINT4)input[j]) | (((UINT4)input[j+1]) << 8) |
      (((UINT4)input[j+2]) << 16) | (((UINT4)input[j+3]) << 24);
}

static void
MD5_memcpy (POINTER output, CONST POINTER input, unsigned int len)
{
  memcpy (output, input, len);
}

static void
MD5_memset (POINTER output, int value, unsigned int len)
{
  memset (output, value, len);
}

/* unused */
#if 0
static void
LispMDString (char *string)
{
  MD_CTX context;
  unsigned char digest[16];
  unsigned int len = strlen(string);

  MDInit (&context);
  MDUpdate (&context, string, len);
  MDFinal (digest, &context);
}
#endif


/* XEmacs interface code. */
Lisp_Object Qmd5;

DEFUN ("md5", Fmd5, 1, 5, 0, /*
Return the MD5 (a secure message digest algorithm) of an object.
OBJECT is either a string or a buffer.
Optional arguments START and END denote buffer positions for computing the
hash of a portion of OBJECT.  The optional CODING argument specifies the coding
system the text is to be represented in while computing the digest.  This only
has meaning with MULE, and defaults to the current format of the data.
If ERROR-ME-NOT is nil, report an error if the coding system can't be
determined.  Else assume binary coding if all else fails.
*/
       (object, start, end, coding, error_me_not))
{
  /* This function can GC */
  MD_CTX context;
  unsigned char digest[16];
  unsigned char thehash[32];
  int i;

  MDInit (&context);

  if (NILP (object))
    {
      MDUpdate (&context, (CONST unsigned char *) "", 0);
    }
  else
    {
      Lisp_Object instream, outstream;
      Lstream *istr, *ostr;
      static Extbyte_dynarr *conversion_out_dynarr;
      char tempbuf[1024]; /* some random amount */
      struct gcpro gcpro1, gcpro2;
#ifdef FILE_CODING
      Lisp_Object conv_out_stream, coding_system;
      Lstream *costr;
      struct gcpro gcpro3;
#endif

      if (!conversion_out_dynarr)
	conversion_out_dynarr = Dynarr_new (Extbyte);
      else
	Dynarr_reset (conversion_out_dynarr);

      /* set up the in stream */
      if (BUFFERP (object))
	{
	  struct buffer *b = decode_buffer (object, 1);
	  Bufpos begv, endv;
	  /* Figure out where we need to get info from */
	  get_buffer_range_char (b, start, end, &begv, &endv, GB_ALLOW_NIL);

	  instream = make_lisp_buffer_input_stream (b, begv, endv, 0);
	}
      else
	{
	  Bytecount bstart, bend;
	  CHECK_STRING (object);
	  get_string_range_byte (object, start, end, &bstart, &bend,
				 GB_HISTORICAL_STRING_BEHAVIOR);
	  instream = make_lisp_string_input_stream (object, bstart, bend);
	}
      istr = XLSTREAM (instream);

#ifdef FILE_CODING
      /* Find out what format the buffer will be saved in, so we can make
	 the digest based on what it will look like on disk */
      if (NILP(coding))
	{
	  if (BUFFERP(object)) 
	    {
	      /* Use the file coding for this buffer by default */
	      coding_system = XBUFFER(object)->buffer_file_coding_system;
	    }
	  else
	    {
	      /* attempt to autodetect the coding of the string.  Note: this VERY hit-and-miss */
	      enum eol_type eol = EOL_AUTODETECT;
	      coding_system = Fget_coding_system(Qundecided);
	      determine_real_coding_system(istr, &coding_system, &eol);
	    }
	  if (NILP(coding_system)) 
	    coding_system = Fget_coding_system(Qbinary);
	  else
	    {
	      coding_system = Ffind_coding_system (coding_system);
	      if (NILP(coding_system))
		coding_system = Fget_coding_system(Qbinary);
	    }
	}
      else
	{
	  coding_system = Ffind_coding_system (coding);
	  if (NILP(coding_system))
	    if (NILP(error_me_not))
	      signal_simple_error("No such coding system", coding);
	    else
	      coding_system = Fget_coding_system(Qbinary); /* default to binary */
	}
#endif

      /* setup the out stream */
      outstream = make_dynarr_output_stream((unsigned_char_dynarr *)conversion_out_dynarr);
      ostr = XLSTREAM (outstream);
#ifdef FILE_CODING
      /* setup the conversion stream */
      conv_out_stream = make_encoding_output_stream (ostr, coding_system);
      costr = XLSTREAM (conv_out_stream);
      GCPRO3 (instream, outstream, conv_out_stream);
#else
      GCPRO2 (instream, outstream);
#endif

      /* Get the data while doing the conversion */
      while (1) {
	int size_in_bytes = Lstream_read (istr, tempbuf, sizeof (tempbuf));
	if (!size_in_bytes)
	  break;
	/* It does seem the flushes are necessary... */
#ifdef FILE_CODING
	Lstream_write (costr, tempbuf, size_in_bytes);
	Lstream_flush (costr);
#else
	Lstream_write (ostr, tempbuf, size_in_bytes);
#endif
	Lstream_flush (ostr);

	/* Update the digest */
	
	MDUpdate (&context, (unsigned char *)Dynarr_atp(conversion_out_dynarr, 0), 
		  Dynarr_length(conversion_out_dynarr));
	/* reset the dynarr */
	Lstream_rewind(ostr);
      }
      Lstream_close (istr);
#ifdef FILE_CODING
      Lstream_close (costr);
#endif
      Lstream_close (ostr);

      UNGCPRO;
      Lstream_delete (istr);
      Lstream_delete (ostr);
#ifdef FILE_CODING
      Lstream_delete (costr);
#endif
    }

  MDFinal (digest, &context);
  for (i = 0; i < 16; i++)
    sprintf ((char *) (thehash + (i * 2)), "%02x", digest[i]);

  return (make_string (thehash, 32));
}

void
syms_of_md5 (void)
{
  DEFSUBR (Fmd5);
  defsymbol (&Qmd5, "md5");
}

void
vars_of_md5 (void)
{
  Fprovide (Qmd5);
}