[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

#ifndef SvPVbyte
   #define SvPVbyte SvPV
#endif

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