[p5sagit/p5-mst-13.2.git] / ext / Digest / MD5 / MD5.xs

/* 
 * This library is free software; you can redistribute it and/or
 * modify it under the same terms as Perl itself.
 * 
 *  Copyright 1998-2000 Gisle Aas.
 *  Copyright 1995-1996 Neil Winton.
 *  Copyright 1991-1992 RSA Data Security, Inc.
 *
 * This code is derived from Neil Winton's MD5-1.7 Perl module, which in
 * turn is derived from the reference implementation in RFC 1231 which
 * comes with this message:
 *
 * 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.
 */

#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif

/* Define this to turn on verbose debugging prints */
#undef MD5_DEBUG

/* Perl does not guarantee that U32 is exactly 32 bits.  Some system
 * has no integral type with exactly 32 bits.  For instance, A Cray has
 * short, int and long all at 64 bits so we need to apply this macro
 * to reduce U32 values to 32 bits at appropriate places. If U32
 * really does have 32 bits then this is a no-op.
 */
#if BYTEORDER > 0x4321 || defined(TRUNCATE_U32)
  #define TO32(x)    ((x) &  0xFFFFffff)
  #define TRUNC32(x) ((x) &= 0xFFFFffff)
#else
  #define TO32(x)    (x)
  #define TRUNC32(x) /*nothing*/
#endif

/* The MD5 algorithm is defined in terms of little endian 32-bit
 * values.  The following macros (and functions) allow us to convert
 * between native integers and such values.
 */
#undef BYTESWAP
#ifndef U32_ALIGNMENT_REQUIRED
 #if BYTEORDER == 0x1234      /* 32-bit little endian */
  #define BYTESWAP(x) (x)     /* no-op */

 #elif BYTEORDER == 0x4321    /* 32-bit big endian */
  #define BYTESWAP(x) 	((((x)&0xFF)<<24)	\
			|(((x)>>24)&0xFF)	\
			|(((x)&0x0000FF00)<<8)	\
			|(((x)&0x00FF0000)>>8)	)
 #endif
#endif

#ifndef BYTESWAP
static void u2s(U32 u, U8* s)
{
    *s++ = u         & 0xFF;
    *s++ = (u >>  8) & 0xFF;
    *s++ = (u >> 16) & 0xFF;
    *s   = (u >> 24) & 0xFF;
}

#define s2u(s,u) ((u) =  (U32)(*s)            |  \
                        ((U32)(*(s+1)) << 8)  |  \
                        ((U32)(*(s+2)) << 16) |  \
                        ((U32)(*(s+3)) << 24))
#endif

#define MD5_CTX_SIGNATURE 200003165

/* This stucture keeps the current state of algorithm.
 */
typedef struct {
  U32 signature;   /* safer cast in get_md5_ctx() */
  U32 A, B, C, D;  /* current digest */
  U32 bytes_low;   /* counts bytes in message */
  U32 bytes_high;  /* turn it into a 64-bit counter */
  U8 buffer[128];  /* collect complete 64 byte blocks */
} MD5_CTX;


/* Padding is added at the end of the message in order to fill a
 * complete 64 byte block (- 8 bytes for the message length).  The
 * padding is also the reason the buffer in MD5_CTX have to be
 * 128 bytes.
 */
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
};

/* 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

/* F, G, H and I are basic MD5 functions.
 */
#define F(x, y, z) ((((x) & ((y) ^ (z))) ^ (z)))
#define G(x, y, z) F(z, x, y)
#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, s, ac)                    \
 (a) += F ((b), (c), (d)) + (NEXTx) + (U32)(ac); \
 TRUNC32((a));                                   \
 (a) = ROTATE_LEFT ((a), (s));                   \
 (a) += (b);                                     \
 TRUNC32((a));

#define GG(a, b, c, d, x, s, ac)                 \
 (a) += G ((b), (c), (d)) + X[x] + (U32)(ac);    \
 TRUNC32((a));                                   \
 (a) = ROTATE_LEFT ((a), (s));                   \
 (a) += (b);                                     \
 TRUNC32((a));

#define HH(a, b, c, d, x, s, ac)                 \
 (a) += H ((b), (c), (d)) + X[x] + (U32)(ac);    \
 TRUNC32((a));                                   \
 (a) = ROTATE_LEFT ((a), (s));                   \
 (a) += (b);                                     \
 TRUNC32((a));

#define II(a, b, c, d, x, s, ac)                 \
 (a) += I ((b), (c), (d)) + X[x] + (U32)(ac);    \
 TRUNC32((a));                                   \
 (a) = ROTATE_LEFT ((a), (s));                   \
 (a) += (b);                                     \
 TRUNC32((a));


static void
MD5Init(MD5_CTX *ctx)
{
  /* Start state */
  ctx->A = 0x67452301;
  ctx->B = 0xefcdab89;
  ctx->C = 0x98badcfe;
  ctx->D = 0x10325476;

  /* message length */
  ctx->bytes_low = ctx->bytes_high = 0;
}


static void
MD5Transform(MD5_CTX* ctx, const U8* buf, STRLEN blocks)
{
#ifdef MD5_DEBUG
    static int tcount = 0;
#endif

    U32 A = ctx->A;
    U32 B = ctx->B;
    U32 C = ctx->C;
    U32 D = ctx->D;

#ifndef U32_ALIGNMENT_REQUIRED
    const U32 *x = (U32*)buf;  /* really just type casting */
#endif

    do {
	U32 a = A;
	U32 b = B;
	U32 c = C;
	U32 d = D;

#if BYTEORDER == 0x1234 && !defined(U32_ALIGNMENT_REQUIRED)
	const U32 *X = x;
        #define NEXTx  (*x++)
#else
	U32 X[16];      /* converted values, used in round 2-4 */
	U32 *uptr = X;
	U32 tmp;
 #ifdef BYTESWAP
        #define NEXTx  (tmp=*x++, *uptr++ = BYTESWAP(tmp))
 #else
        #define NEXTx  (s2u(buf,tmp), buf += 4, *uptr++ = tmp)
 #endif
#endif

#ifdef MD5_DEBUG
	if (buf == ctx->buffer)
	    fprintf(stderr,"%5d: Transform ctx->buffer", ++tcount);
	else 
	    fprintf(stderr,"%5d: Transform %p (%d)", ++tcount, buf, blocks);

	{
	    int i;
	    fprintf(stderr,"[");
	    for (i = 0; i < 16; i++) {
		fprintf(stderr,"%x,", x[i]);
	    }
	    fprintf(stderr,"]\n");
	}
#endif

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

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

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

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

	A += a;  TRUNC32(A);
	B += b;  TRUNC32(B);
	C += c;  TRUNC32(C);
	D += d;  TRUNC32(D);

    } while (--blocks);
    ctx->A = A;
    ctx->B = B;
    ctx->C = C;
    ctx->D = D;
}


#ifdef MD5_DEBUG
static char*
ctx_dump(MD5_CTX* ctx)
{
    static char buf[1024];
    sprintf(buf, "{A=%x,B=%x,C=%x,D=%x,%d,%d(%d)}",
	    ctx->A, ctx->B, ctx->C, ctx->D,
	    ctx->bytes_low, ctx->bytes_high, (ctx->bytes_low&0x3F));
    return buf;
}
#endif


static void
MD5Update(MD5_CTX* ctx, const U8* buf, STRLEN len)
{
    STRLEN blocks;
    STRLEN fill = ctx->bytes_low & 0x3F;

#ifdef MD5_DEBUG  
    static int ucount = 0;
    fprintf(stderr,"%5i: Update(%s, %p, %d)\n", ++ucount, ctx_dump(ctx),
	                                        buf, len);
#endif

    ctx->bytes_low += len;
    if (ctx->bytes_low < len) /* wrap around */
	ctx->bytes_high++;

    if (fill) {
	STRLEN missing = 64 - fill;
	if (len < missing) {
	    Copy(buf, ctx->buffer + fill, len, U8);
	    return;
	}
	Copy(buf, ctx->buffer + fill, missing, U8);
	MD5Transform(ctx, ctx->buffer, 1);
	buf += missing;
	len -= missing;
    }

    blocks = len >> 6;
    if (blocks)
	MD5Transform(ctx, buf, blocks);
    if ( (len &= 0x3F)) {
	Copy(buf + (blocks << 6), ctx->buffer, len, U8);
    }
}


static void
MD5Final(U8* digest, MD5_CTX *ctx)
{
    STRLEN fill = ctx->bytes_low & 0x3F;
    STRLEN padlen = (fill < 56 ? 56 : 120) - fill;
    U32 bits_low, bits_high;
#ifdef MD5_DEBUG
    fprintf(stderr,"       Final:  %s\n", ctx_dump(ctx));
#endif
    Copy(PADDING, ctx->buffer + fill, padlen, U8);
    fill += padlen;

    bits_low = ctx->bytes_low << 3;
    bits_high = (ctx->bytes_high << 3) | (ctx->bytes_low  >> 29);
#ifdef BYTESWAP
    *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_low);    fill += 4;
    *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_high);   fill += 4;
#else
    u2s(bits_low,  ctx->buffer + fill);   fill += 4;
    u2s(bits_high, ctx->buffer + fill);   fill += 4;
#endif

    MD5Transform(ctx, ctx->buffer, fill >> 6);
#ifdef MD5_DEBUG
    fprintf(stderr,"       Result: %s\n", ctx_dump(ctx));
#endif

#ifdef BYTESWAP
    *(U32*)digest = BYTESWAP(ctx->A);  digest += 4;
    *(U32*)digest = BYTESWAP(ctx->B);  digest += 4;
    *(U32*)digest = BYTESWAP(ctx->C);  digest += 4;
    *(U32*)digest = BYTESWAP(ctx->D);
#else
    u2s(ctx->A, digest);
    u2s(ctx->B, digest+4);
    u2s(ctx->C, digest+8);
    u2s(ctx->D, digest+12);
#endif
}

#ifndef INT2PTR
#define INT2PTR(any,d)	(any)(d)
#endif

static MD5_CTX* get_md5_ctx(SV* sv)
{
    if (SvROK(sv)) {
	sv = SvRV(sv);
	if (SvIOK(sv)) {
	    MD5_CTX* ctx = INT2PTR(MD5_CTX*, SvIV(sv));
	    if (ctx && ctx->signature == MD5_CTX_SIGNATURE) {
		return ctx;
            }
        }
    }
    croak("Not a reference to a Digest::MD5 object");
    return (MD5_CTX*)0; /* some compilers insist on a return value */
}


static char* hex_16(const unsigned char* from, char* to)
{
    static char *hexdigits = "0123456789abcdef";
    const unsigned char *end = from + 16;
    char *d = to;

    while (from < end) {
	*d++ = hexdigits[(*from >> 4)];
	*d++ = hexdigits[(*from & 0x0F)];
	from++;
    }
    *d = '\0';
    return to;
}

static char* base64_16(const unsigned char* from, char* to)
{
    static char* base64 =
	"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
    const unsigned char *end = from + 16;
    unsigned char c1, c2, c3;
    char *d = to;

    while (1) {
	c1 = *from++;
	*d++ = base64[c1>>2];
	if (from == end) {
	    *d++ = base64[(c1 & 0x3) << 4];
	    break;
	}
	c2 = *from++;
	c3 = *from++;
	*d++ = base64[((c1 & 0x3) << 4) | ((c2 & 0xF0) >> 4)];
	*d++ = base64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
	*d++ = base64[c3 & 0x3F];
    }
    *d = '\0';
    return to;
}

/* Formats */
#define F_BIN 0
#define F_HEX 1
#define F_B64 2

static SV* make_mortal_sv(const unsigned char *src, int type)
{
    STRLEN len;
    char result[33];
    char *ret;
    
    switch (type) {
    case F_BIN:
	ret = (char*)src;
	len = 16;
	break;
    case F_HEX:
	ret = hex_16(src, result);
	len = 32;
	break;
    case F_B64:
	ret = base64_16(src, result);
	len = 22;
	break;
    default:
	croak("Bad convertion type (%d)", type);
	break;
    }
    return sv_2mortal(newSVpv(ret,len));
}


/********************************************************************/

typedef PerlIO* InputStream;

MODULE = Digest::MD5		PACKAGE = Digest::MD5

PROTOTYPES: DISABLE

void
new(xclass)
	SV* xclass
    PREINIT:
	MD5_CTX* context;
    PPCODE:
	if (!SvROK(xclass)) {
	    STRLEN my_na;
	    char *sclass = SvPV(xclass, my_na);
	    New(55, context, 1, MD5_CTX);
	    context->signature = MD5_CTX_SIGNATURE;
	    ST(0) = sv_newmortal();
	    sv_setref_pv(ST(0), sclass, (void*)context);
	    SvREADONLY_on(SvRV(ST(0)));
	} else {
	    context = get_md5_ctx(xclass);
	}
        MD5Init(context);
	XSRETURN(1);

void
DESTROY(context)
	MD5_CTX* context
    CODE:
        Safefree(context);

void
add(self, ...)
	SV* self
    PREINIT:
	MD5_CTX* context = get_md5_ctx(self);
	int i;
	unsigned char *data;
	STRLEN len;
    PPCODE:
	for (i = 1; i < items; i++) {
	    data = (unsigned char *)(SvPVbyte(ST(i), len));
	    MD5Update(context, data, len);
	}
	XSRETURN(1);  /* self */

void
addfile(self, fh)
	SV* self
	InputStream fh
    PREINIT:
	MD5_CTX* context = get_md5_ctx(self);
	STRLEN fill = context->bytes_low & 0x3F;
	unsigned char buffer[4096];
	int  n;
    CODE:
	if (fh) {
            if (fill) {
	        /* The MD5Update() function is faster if it can work with
	         * complete blocks.  This will fill up any buffered block
	         * first.
	         */
	        STRLEN missing = 64 - fill;
	        if ( (n = PerlIO_read(fh, buffer, missing)))
	 	    MD5Update(context, buffer, n);
	        else
		    XSRETURN(1);  /* self */
	    }

	    /* Process blocks until EOF */
            while ( (n = PerlIO_read(fh, buffer, sizeof(buffer)))) {
	        MD5Update(context, buffer, n);
	    }
	}
	XSRETURN(1);  /* self */

void
digest(context)
	MD5_CTX* context
    ALIAS:
	Digest::MD5::digest    = F_BIN
	Digest::MD5::hexdigest = F_HEX
	Digest::MD5::b64digest = F_B64
    PREINIT:
	unsigned char digeststr[16];
    PPCODE:
        MD5Final(digeststr, context);
	MD5Init(context);  /* In case it is reused */
        ST(0) = make_mortal_sv(digeststr, ix);
        XSRETURN(1);

void
md5(...)
    ALIAS:
	Digest::MD5::md5        = F_BIN
	Digest::MD5::md5_hex    = F_HEX
	Digest::MD5::md5_base64 = F_B64
    PREINIT:
	MD5_CTX ctx;
	int i;
	unsigned char *data;
        STRLEN len;
	unsigned char digeststr[16];
    PPCODE:
	MD5Init(&ctx);
	for (i = 0; i < items; i++) {
	    data = (unsigned char *)(SvPVbyte(ST(i), len));
	    MD5Update(&ctx, data, len);
	}
	MD5Final(digeststr, &ctx);
        ST(0) = make_mortal_sv(digeststr, ix);
        XSRETURN(1);
Commit	Line	Data
3357b1b1	1	/*
	2	* This library is free software; you can redistribute it and/or
	3	* modify it under the same terms as Perl itself.
	4	*
	5	* Copyright 1998-2000 Gisle Aas.
	6	* Copyright 1995-1996 Neil Winton.
	7	* Copyright 1991-1992 RSA Data Security, Inc.
	8	*
	9	* This code is derived from Neil Winton's MD5-1.7 Perl module, which in
	10	* turn is derived from the reference implementation in RFC 1231 which
	11	* comes with this message:
	12	*
	13	* Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
	14	* rights reserved.
	15	*
	16	* License to copy and use this software is granted provided that it
	17	* is identified as the "RSA Data Security, Inc. MD5 Message-Digest
	18	* Algorithm" in all material mentioning or referencing this software
	19	* or this function.
	20	*
	21	* License is also granted to make and use derivative works provided
	22	* that such works are identified as "derived from the RSA Data
	23	* Security, Inc. MD5 Message-Digest Algorithm" in all material
	24	* mentioning or referencing the derived work.
	25	*
	26	* RSA Data Security, Inc. makes no representations concerning either
	27	* the merchantability of this software or the suitability of this
	28	* software for any particular purpose. It is provided "as is"
	29	* without express or implied warranty of any kind.
	30	*
	31	* These notices must be retained in any copies of any part of this
	32	* documentation and/or software.
	33	*/
	34
	35	#ifdef __cplusplus
	36	extern "C" {
	37	#endif
	38	#include "EXTERN.h"
	39	#include "perl.h"
	40	#include "XSUB.h"
	41	#ifdef __cplusplus
	42	}
	43	#endif
	44
516a5887	45	/* Define this to turn on verbose debugging prints */
516a5887	46	#undef MD5_DEBUG
3357b1b1	47
	48	/* Perl does not guarantee that U32 is exactly 32 bits. Some system
	49	* has no integral type with exactly 32 bits. For instance, A Cray has
	50	* short, int and long all at 64 bits so we need to apply this macro
	51	* to reduce U32 values to 32 bits at appropriate places. If U32
	52	* really does have 32 bits then this is a no-op.
	53	*/
	54	#if BYTEORDER > 0x4321 \|\| defined(TRUNCATE_U32)
	55	#define TO32(x) ((x) & 0xFFFFffff)
	56	#define TRUNC32(x) ((x) &= 0xFFFFffff)
	57	#else
	58	#define TO32(x) (x)
	59	#define TRUNC32(x) /nothing/
	60	#endif
	61
	62	/* The MD5 algorithm is defined in terms of little endian 32-bit
	63	* values. The following macros (and functions) allow us to convert
	64	* between native integers and such values.
	65	*/
	66	#undef BYTESWAP
	67	#ifndef U32_ALIGNMENT_REQUIRED
	68	#if BYTEORDER == 0x1234 /* 32-bit little endian */
	69	#define BYTESWAP(x) (x) /* no-op */
	70
	71	#elif BYTEORDER == 0x4321 /* 32-bit big endian */
	72	#define BYTESWAP(x) ((((x)&0xFF)<<24) \
	73	\|(((x)>>24)&0xFF) \
	74	\|(((x)&0x0000FF00)<<8) \
	75	\|(((x)&0x00FF0000)>>8) )
	76	#endif
	77	#endif
	78
	79	#ifndef BYTESWAP
	80	static void u2s(U32 u, U8* s)
	81	{
	82	*s++ = u & 0xFF;
	83	*s++ = (u >> 8) & 0xFF;
	84	*s++ = (u >> 16) & 0xFF;
	85	*s = (u >> 24) & 0xFF;
	86	}
	87
	88	#define s2u(s,u) ((u) = (U32)(*s) \| \
	89	((U32)(*(s+1)) << 8) \| \
	90	((U32)(*(s+2)) << 16) \| \
	91	((U32)(*(s+3)) << 24))
	92	#endif
	93
	94	#define MD5_CTX_SIGNATURE 200003165
	95
	96	/* This stucture keeps the current state of algorithm.
	97	*/
	98	typedef struct {
	99	U32 signature; /* safer cast in get_md5_ctx() */
	100	U32 A, B, C, D; /* current digest */
	101	U32 bytes_low; /* counts bytes in message */
	102	U32 bytes_high; /* turn it into a 64-bit counter */
	103	U8 buffer[128]; /* collect complete 64 byte blocks */
	104	} MD5_CTX;
	105
	106
	107	/* Padding is added at the end of the message in order to fill a
	108	* complete 64 byte block (- 8 bytes for the message length). The
	109	* padding is also the reason the buffer in MD5_CTX have to be
	110	* 128 bytes.
111	*/
112	static unsigned char PADDING[64] = {
113	0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
114	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
115	0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
116	};
117
118	/* Constants for MD5Transform routine.
119	*/
120	#define S11 7
121	#define S12 12
122	#define S13 17
123	#define S14 22
124	#define S21 5
125	#define S22 9
126	#define S23 14
127	#define S24 20
128	#define S31 4
129	#define S32 11
130	#define S33 16
131	#define S34 23
132	#define S41 6
133	#define S42 10
134	#define S43 15
135	#define S44 21
136
137	/* F, G, H and I are basic MD5 functions.
138	*/
124f80e2	139	#define F(x, y, z) ((((x) & ((y) ^ (z))) ^ (z)))
3357b1b1	140	#define G(x, y, z) F(z, x, y)
	141	#define H(x, y, z) ((x) ^ (y) ^ (z))
	142	#define I(x, y, z) ((y) ^ ((x) \| (~z)))
	143
	144	/* ROTATE_LEFT rotates x left n bits.
	145	*/
	146	#define ROTATE_LEFT(x, n) (((x) << (n) \| ((x) >> (32-(n)))))
	147
	148	/* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
	149	* Rotation is separate from addition to prevent recomputation.
	150	*/
	151	#define FF(a, b, c, d, s, ac) \
	152	(a) += F ((b), (c), (d)) + (NEXTx) + (U32)(ac); \
	153	TRUNC32((a)); \
	154	(a) = ROTATE_LEFT ((a), (s)); \
	155	(a) += (b); \
	156	TRUNC32((a));
	157
	158	#define GG(a, b, c, d, x, s, ac) \
	159	(a) += G ((b), (c), (d)) + X[x] + (U32)(ac); \
	160	TRUNC32((a)); \
	161	(a) = ROTATE_LEFT ((a), (s)); \
	162	(a) += (b); \
	163	TRUNC32((a));
	164
	165	#define HH(a, b, c, d, x, s, ac) \
	166	(a) += H ((b), (c), (d)) + X[x] + (U32)(ac); \
	167	TRUNC32((a)); \
	168	(a) = ROTATE_LEFT ((a), (s)); \
	169	(a) += (b); \
	170	TRUNC32((a));
	171
	172	#define II(a, b, c, d, x, s, ac) \
	173	(a) += I ((b), (c), (d)) + X[x] + (U32)(ac); \
	174	TRUNC32((a)); \
	175	(a) = ROTATE_LEFT ((a), (s)); \
	176	(a) += (b); \
	177	TRUNC32((a));
	178
	179
	180	static void
	181	MD5Init(MD5_CTX *ctx)
	182	{
	183	/* Start state */
	184	ctx->A = 0x67452301;
	185	ctx->B = 0xefcdab89;
	186	ctx->C = 0x98badcfe;
	187	ctx->D = 0x10325476;
	188
	189	/* message length */
	190	ctx->bytes_low = ctx->bytes_high = 0;
	191	}
	192
	193
	194	static void
	195	MD5Transform(MD5_CTX* ctx, const U8* buf, STRLEN blocks)
	196	{
516a5887	197	#ifdef MD5_DEBUG
3357b1b1	198	static int tcount = 0;
516a5887	199	#endif
3357b1b1	200
	201	U32 A = ctx->A;
	202	U32 B = ctx->B;
	203	U32 C = ctx->C;
	204	U32 D = ctx->D;
	205
	206	#ifndef U32_ALIGNMENT_REQUIRED
	207	const U32 x = (U32)buf; /* really just type casting */
	208	#endif
	209
	210	do {
	211	U32 a = A;
	212	U32 b = B;
	213	U32 c = C;
	214	U32 d = D;
	215
	216	#if BYTEORDER == 0x1234 && !defined(U32_ALIGNMENT_REQUIRED)
	217	const U32 *X = x;
	218	#define NEXTx (*x++)
	219	#else
	220	U32 X[16]; /* converted values, used in round 2-4 */
	221	U32 *uptr = X;
	222	U32 tmp;
	223	#ifdef BYTESWAP
	224	#define NEXTx (tmp=x++, uptr++ = BYTESWAP(tmp))
	225	#else
	226	#define NEXTx (s2u(buf,tmp), buf += 4, *uptr++ = tmp)
	227	#endif
	228	#endif
	229
	230	#ifdef MD5_DEBUG
	231	if (buf == ctx->buffer)
	232	fprintf(stderr,"%5d: Transform ctx->buffer", ++tcount);
	233	else
	234	fprintf(stderr,"%5d: Transform %p (%d)", ++tcount, buf, blocks);
	235
	236	{
	237	int i;
	238	fprintf(stderr,"[");
	239	for (i = 0; i < 16; i++) {
	240	fprintf(stderr,"%x,", x[i]);
	241	}
	242	fprintf(stderr,"]\n");
	243	}
	244	#endif
	245
	246	/* Round 1 */
	247	FF (a, b, c, d, S11, 0xd76aa478); /* 1 */
	248	FF (d, a, b, c, S12, 0xe8c7b756); /* 2 */
	249	FF (c, d, a, b, S13, 0x242070db); /* 3 */
	250	FF (b, c, d, a, S14, 0xc1bdceee); /* 4 */
	251	FF (a, b, c, d, S11, 0xf57c0faf); /* 5 */
	252	FF (d, a, b, c, S12, 0x4787c62a); /* 6 */
	253	FF (c, d, a, b, S13, 0xa8304613); /* 7 */
	254	FF (b, c, d, a, S14, 0xfd469501); /* 8 */
	255	FF (a, b, c, d, S11, 0x698098d8); /* 9 */
	256	FF (d, a, b, c, S12, 0x8b44f7af); /* 10 */
	257	FF (c, d, a, b, S13, 0xffff5bb1); /* 11 */
	258	FF (b, c, d, a, S14, 0x895cd7be); /* 12 */
	259	FF (a, b, c, d, S11, 0x6b901122); /* 13 */
	260	FF (d, a, b, c, S12, 0xfd987193); /* 14 */
	261	FF (c, d, a, b, S13, 0xa679438e); /* 15 */
	262	FF (b, c, d, a, S14, 0x49b40821); /* 16 */
	263
264	/* Round 2 */
265	GG (a, b, c, d, 1, S21, 0xf61e2562); /* 17 */
266	GG (d, a, b, c, 6, S22, 0xc040b340); /* 18 */
267	GG (c, d, a, b, 11, S23, 0x265e5a51); /* 19 */
268	GG (b, c, d, a, 0, S24, 0xe9b6c7aa); /* 20 */
269	GG (a, b, c, d, 5, S21, 0xd62f105d); /* 21 */
270	GG (d, a, b, c, 10, S22, 0x2441453); /* 22 */
271	GG (c, d, a, b, 15, S23, 0xd8a1e681); /* 23 */
272	GG (b, c, d, a, 4, S24, 0xe7d3fbc8); /* 24 */
273	GG (a, b, c, d, 9, S21, 0x21e1cde6); /* 25 */
274	GG (d, a, b, c, 14, S22, 0xc33707d6); /* 26 */
275	GG (c, d, a, b, 3, S23, 0xf4d50d87); /* 27 */
276	GG (b, c, d, a, 8, S24, 0x455a14ed); /* 28 */
277	GG (a, b, c, d, 13, S21, 0xa9e3e905); /* 29 */
278	GG (d, a, b, c, 2, S22, 0xfcefa3f8); /* 30 */
279	GG (c, d, a, b, 7, S23, 0x676f02d9); /* 31 */
280	GG (b, c, d, a, 12, S24, 0x8d2a4c8a); /* 32 */
281
282	/* Round 3 */
283	HH (a, b, c, d, 5, S31, 0xfffa3942); /* 33 */
284	HH (d, a, b, c, 8, S32, 0x8771f681); /* 34 */
285	HH (c, d, a, b, 11, S33, 0x6d9d6122); /* 35 */
286	HH (b, c, d, a, 14, S34, 0xfde5380c); /* 36 */
287	HH (a, b, c, d, 1, S31, 0xa4beea44); /* 37 */
288	HH (d, a, b, c, 4, S32, 0x4bdecfa9); /* 38 */
289	HH (c, d, a, b, 7, S33, 0xf6bb4b60); /* 39 */
290	HH (b, c, d, a, 10, S34, 0xbebfbc70); /* 40 */
291	HH (a, b, c, d, 13, S31, 0x289b7ec6); /* 41 */
292	HH (d, a, b, c, 0, S32, 0xeaa127fa); /* 42 */
293	HH (c, d, a, b, 3, S33, 0xd4ef3085); /* 43 */
294	HH (b, c, d, a, 6, S34, 0x4881d05); /* 44 */
295	HH (a, b, c, d, 9, S31, 0xd9d4d039); /* 45 */
296	HH (d, a, b, c, 12, S32, 0xe6db99e5); /* 46 */
297	HH (c, d, a, b, 15, S33, 0x1fa27cf8); /* 47 */
298	HH (b, c, d, a, 2, S34, 0xc4ac5665); /* 48 */
299
300	/* Round 4 */
301	II (a, b, c, d, 0, S41, 0xf4292244); /* 49 */
302	II (d, a, b, c, 7, S42, 0x432aff97); /* 50 */
303	II (c, d, a, b, 14, S43, 0xab9423a7); /* 51 */
304	II (b, c, d, a, 5, S44, 0xfc93a039); /* 52 */
305	II (a, b, c, d, 12, S41, 0x655b59c3); /* 53 */
306	II (d, a, b, c, 3, S42, 0x8f0ccc92); /* 54 */
307	II (c, d, a, b, 10, S43, 0xffeff47d); /* 55 */
308	II (b, c, d, a, 1, S44, 0x85845dd1); /* 56 */
309	II (a, b, c, d, 8, S41, 0x6fa87e4f); /* 57 */
310	II (d, a, b, c, 15, S42, 0xfe2ce6e0); /* 58 */
311	II (c, d, a, b, 6, S43, 0xa3014314); /* 59 */
312	II (b, c, d, a, 13, S44, 0x4e0811a1); /* 60 */
313	II (a, b, c, d, 4, S41, 0xf7537e82); /* 61 */
314	II (d, a, b, c, 11, S42, 0xbd3af235); /* 62 */
315	II (c, d, a, b, 2, S43, 0x2ad7d2bb); /* 63 */
316	II (b, c, d, a, 9, S44, 0xeb86d391); /* 64 */
317
318	A += a; TRUNC32(A);
319	B += b; TRUNC32(B);
320	C += c; TRUNC32(C);
321	D += d; TRUNC32(D);
322
323	} while (--blocks);
324	ctx->A = A;
325	ctx->B = B;
326	ctx->C = C;
327	ctx->D = D;
328	}
329
330
331	#ifdef MD5_DEBUG
332	static char*
333	ctx_dump(MD5_CTX* ctx)
334	{
335	static char buf[1024];
336	sprintf(buf, "{A=%x,B=%x,C=%x,D=%x,%d,%d(%d)}",
337	ctx->A, ctx->B, ctx->C, ctx->D,
338	ctx->bytes_low, ctx->bytes_high, (ctx->bytes_low&0x3F));
339	return buf;
340	}
341	#endif
342
343
344	static void
345	MD5Update(MD5_CTX* ctx, const U8* buf, STRLEN len)
346	{
347	STRLEN blocks;
348	STRLEN fill = ctx->bytes_low & 0x3F;
349
350	#ifdef MD5_DEBUG
351	static int ucount = 0;
352	fprintf(stderr,"%5i: Update(%s, %p, %d)\n", ++ucount, ctx_dump(ctx),
353	buf, len);
354	#endif
355
356	ctx->bytes_low += len;
357	if (ctx->bytes_low < len) /* wrap around */
358	ctx->bytes_high++;
359
360	if (fill) {
361	STRLEN missing = 64 - fill;
362	if (len < missing) {
363	Copy(buf, ctx->buffer + fill, len, U8);
364	return;
365	}
366	Copy(buf, ctx->buffer + fill, missing, U8);
367	MD5Transform(ctx, ctx->buffer, 1);
368	buf += missing;
369	len -= missing;
370	}
371
372	blocks = len >> 6;
373	if (blocks)
374	MD5Transform(ctx, buf, blocks);
375	if ( (len &= 0x3F)) {
376	Copy(buf + (blocks << 6), ctx->buffer, len, U8);
377	}
378	}
379
380
381	static void
382	MD5Final(U8* digest, MD5_CTX *ctx)
383	{
384	STRLEN fill = ctx->bytes_low & 0x3F;
385	STRLEN padlen = (fill < 56 ? 56 : 120) - fill;
386	U32 bits_low, bits_high;
387	#ifdef MD5_DEBUG
388	fprintf(stderr," Final: %s\n", ctx_dump(ctx));
389	#endif
390	Copy(PADDING, ctx->buffer + fill, padlen, U8);
391	fill += padlen;
392
393	bits_low = ctx->bytes_low << 3;
394	bits_high = (ctx->bytes_high << 3) \| (ctx->bytes_low >> 29);
395	#ifdef BYTESWAP
396	(U32)(ctx->buffer + fill) = BYTESWAP(bits_low); fill += 4;
397	(U32)(ctx->buffer + fill) = BYTESWAP(bits_high); fill += 4;
398	#else
399	u2s(bits_low, ctx->buffer + fill); fill += 4;
400	u2s(bits_high, ctx->buffer + fill); fill += 4;
401	#endif
402
403	MD5Transform(ctx, ctx->buffer, fill >> 6);
404	#ifdef MD5_DEBUG
405	fprintf(stderr," Result: %s\n", ctx_dump(ctx));
406	#endif
407
408	#ifdef BYTESWAP
409	(U32)digest = BYTESWAP(ctx->A); digest += 4;
410	(U32)digest = BYTESWAP(ctx->B); digest += 4;
411	(U32)digest = BYTESWAP(ctx->C); digest += 4;
412	(U32)digest = BYTESWAP(ctx->D);
413	#else
414	u2s(ctx->A, digest);
415	u2s(ctx->B, digest+4);
416	u2s(ctx->C, digest+8);
417	u2s(ctx->D, digest+12);
418	#endif
419	}
420
421	#ifndef INT2PTR
422	#define INT2PTR(any,d) (any)(d)
423	#endif
424
425	static MD5_CTX* get_md5_ctx(SV* sv)
426	{
427	if (SvROK(sv)) {
428	sv = SvRV(sv);
429	if (SvIOK(sv)) {
430	MD5_CTX* ctx = INT2PTR(MD5_CTX*, SvIV(sv));
431	if (ctx && ctx->signature == MD5_CTX_SIGNATURE) {
432	return ctx;
433	}
434	}
435	}
436	croak("Not a reference to a Digest::MD5 object");
437	return (MD5_CTX)0; / some compilers insist on a return value */
438	}
439
440
441	static char* hex_16(const unsigned char* from, char* to)
442	{
443	static char *hexdigits = "0123456789abcdef";
444	const unsigned char *end = from + 16;
445	char *d = to;
446
447	while (from < end) {
448	d++ = hexdigits[(from >> 4)];
449	d++ = hexdigits[(from & 0x0F)];
450	from++;
451	}
452	*d = '\0';
453	return to;
454	}
455
456	static char* base64_16(const unsigned char* from, char* to)
457	{
458	static char* base64 =
459	"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
460	const unsigned char *end = from + 16;
461	unsigned char c1, c2, c3;
462	char *d = to;
463
464	while (1) {
465	c1 = *from++;
466	*d++ = base64[c1>>2];
467	if (from == end) {
468	*d++ = base64[(c1 & 0x3) << 4];
469	break;
470	}
471	c2 = *from++;
472	c3 = *from++;
473	*d++ = base64[((c1 & 0x3) << 4) \| ((c2 & 0xF0) >> 4)];
474	*d++ = base64[((c2 & 0xF) << 2) \| ((c3 & 0xC0) >>6)];
475	*d++ = base64[c3 & 0x3F];
476	}
477	*d = '\0';
478	return to;
479	}
480
481	/* Formats */
482	#define F_BIN 0
483	#define F_HEX 1
484	#define F_B64 2
485
486	static SV* make_mortal_sv(const unsigned char *src, int type)
487	{
488	STRLEN len;
489	char result[33];
490	char *ret;
491
492	switch (type) {
493	case F_BIN:
494	ret = (char*)src;
495	len = 16;
496	break;
497	case F_HEX:
498	ret = hex_16(src, result);
499	len = 32;
500	break;
501	case F_B64:
502	ret = base64_16(src, result);
503	len = 22;
504	break;
505	default:
506	croak("Bad convertion type (%d)", type);
507	break;
508	}
509	return sv_2mortal(newSVpv(ret,len));
510	}
511
512
513	/********************************************************************/
514
515	typedef PerlIO* InputStream;
516
517	MODULE = Digest::MD5 PACKAGE = Digest::MD5
518
519	PROTOTYPES: DISABLE
520
521	void
522	new(xclass)
523	SV* xclass
524	PREINIT:
525	MD5_CTX* context;
526	PPCODE:
527	if (!SvROK(xclass)) {
528	STRLEN my_na;
529	char *sclass = SvPV(xclass, my_na);
530	New(55, context, 1, MD5_CTX);
531	context->signature = MD5_CTX_SIGNATURE;
532	ST(0) = sv_newmortal();
533	sv_setref_pv(ST(0), sclass, (void*)context);
534	SvREADONLY_on(SvRV(ST(0)));
535	} else {
536	context = get_md5_ctx(xclass);
537	}
538	MD5Init(context);
539	XSRETURN(1);
540
541	void
542	DESTROY(context)
543	MD5_CTX* context
544	CODE:
545	Safefree(context);
546
547	void
548	add(self, ...)
549	SV* self
550	PREINIT:
551	MD5_CTX* context = get_md5_ctx(self);
552	int i;
553	unsigned char *data;
554	STRLEN len;
555	PPCODE:
556	for (i = 1; i < items; i++) {
844f0213	557	data = (unsigned char *)(SvPVbyte(ST(i), len));
3357b1b1	558	MD5Update(context, data, len);
	559	}
	560	XSRETURN(1); /* self */
	561
	562	void
	563	addfile(self, fh)
	564	SV* self
	565	InputStream fh
	566	PREINIT:
	567	MD5_CTX* context = get_md5_ctx(self);
	568	STRLEN fill = context->bytes_low & 0x3F;
	569	unsigned char buffer[4096];
	570	int n;
	571	CODE:
	572	if (fh) {
	573	if (fill) {
	574	/* The MD5Update() function is faster if it can work with
	575	* complete blocks. This will fill up any buffered block
	576	* first.
	577	*/
	578	STRLEN missing = 64 - fill;
	579	if ( (n = PerlIO_read(fh, buffer, missing)))
	580	MD5Update(context, buffer, n);
	581	else
	582	XSRETURN(1); /* self */
	583	}
	584
	585	/* Process blocks until EOF */
	586	while ( (n = PerlIO_read(fh, buffer, sizeof(buffer)))) {
	587	MD5Update(context, buffer, n);
	588	}
	589	}
	590	XSRETURN(1); /* self */
	591
	592	void
	593	digest(context)
	594	MD5_CTX* context
	595	ALIAS:
	596	Digest::MD5::digest = F_BIN
	597	Digest::MD5::hexdigest = F_HEX
	598	Digest::MD5::b64digest = F_B64
	599	PREINIT:
	600	unsigned char digeststr[16];
	601	PPCODE:
	602	MD5Final(digeststr, context);
	603	MD5Init(context); /* In case it is reused */
	604	ST(0) = make_mortal_sv(digeststr, ix);
	605	XSRETURN(1);
	606
	607	void
	608	md5(...)
	609	ALIAS:
	610	Digest::MD5::md5 = F_BIN
	611	Digest::MD5::md5_hex = F_HEX
	612	Digest::MD5::md5_base64 = F_B64
	613	PREINIT:
	614	MD5_CTX ctx;
	615	int i;
	616	unsigned char *data;
	617	STRLEN len;
	618	unsigned char digeststr[16];
	619	PPCODE:
	620	MD5Init(&ctx);
	621	for (i = 0; i < items; i++) {
844f0213	622	data = (unsigned char *)(SvPVbyte(ST(i), len));
3357b1b1	623	MD5Update(&ctx, data, len);
	624	}
	625	MD5Final(digeststr, &ctx);
	626	ST(0) = make_mortal_sv(digeststr, ix);
	627	XSRETURN(1);