[perl5.git] / cpan / 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 1321 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
#define PERL_NO_GET_CONTEXT     /* we want efficiency */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#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++ = (U8)(u         & 0xFF);
    *s++ = (U8)((u >>  8) & 0xFF);
    *s++ = (U8)((u >> 16) & 0xFF);
    *s   = (U8)((u >> 24) & 0xFF);
}

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

/* This stucture keeps the current state of algorithm.
 */
typedef struct {
  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;

#ifdef USE_ITHREADS
STATIC int dup_md5_ctx(pTHX_ MAGIC *mg, CLONE_PARAMS *params)
{
    MD5_CTX *new_ctx;
    PERL_UNUSED_VAR(params);
    New(55, new_ctx, 1, MD5_CTX);
    memcpy(new_ctx, mg->mg_ptr, sizeof(MD5_CTX));
    mg->mg_ptr = (char *)new_ctx;
    return 0;
}
#endif

STATIC MGVTBL vtbl_md5 = {
    NULL, /* get */
    NULL, /* set */
    NULL, /* len */
    NULL, /* clear */
    NULL, /* free */
#ifdef MGf_COPY
    NULL, /* copy */
#endif
#ifdef MGf_DUP
# ifdef USE_ITHREADS
    dup_md5_ctx,
# else
    NULL, /* dup */
# endif
#endif
#ifdef MGf_LOCAL
    NULL /* local */
#endif
};


/* 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 const 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(pTHX_ SV* sv)
{
    MAGIC *mg;

    if (!sv_derived_from(sv, "Digest::MD5"))
	croak("Not a reference to a Digest::MD5 object");

    for (mg = SvMAGIC(SvRV(sv)); mg; mg = mg->mg_moremagic) {
	if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &vtbl_md5) {
	    return (MD5_CTX *)mg->mg_ptr;
	}
    }

    croak("Failed to get MD5_CTX pointer");
    return (MD5_CTX*)0; /* some compilers insist on a return value */
}

static SV * new_md5_ctx(pTHX_ MD5_CTX *context, const char *klass)
{
    SV *sv = newSV(0);
    SV *obj = newRV_noinc(sv);
#ifdef USE_ITHREADS
    MAGIC *mg;
#endif

    sv_bless(obj, gv_stashpv(klass, 0));

#ifdef USE_ITHREADS
    mg =
#endif
	sv_magicext(sv, NULL, PERL_MAGIC_ext, &vtbl_md5, (const char *)context, 0);

#ifdef USE_ITHREADS
    mg->mg_flags |= MGf_DUP;
#endif

    return obj;
}


static char* hex_16(const unsigned char* from, char* to)
{
    static const 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 const 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(pTHX_ 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;
	    const char *sclass = SvPV(xclass, my_na);
	    New(55, context, 1, MD5_CTX);
	    ST(0) = sv_2mortal(new_md5_ctx(aTHX_ context, sclass));
	} else {
	    context = get_md5_ctx(aTHX_ xclass);
	}
	MD5Init(context);
	XSRETURN(1);

void
clone(self)
	SV* self
    PREINIT:
	MD5_CTX* cont = get_md5_ctx(aTHX_ self);
	const char *myname = sv_reftype(SvRV(self),TRUE);
	MD5_CTX* context;
    PPCODE:
	New(55, context, 1, MD5_CTX);
	ST(0) = sv_2mortal(new_md5_ctx(aTHX_ context, myname));
	memcpy(context,cont,sizeof(MD5_CTX));
	XSRETURN(1);

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

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

void
addfile(self, fh)
	SV* self
	InputStream fh
    PREINIT:
	MD5_CTX* context = get_md5_ctx(aTHX_ self);
	STRLEN fill = context->bytes_low & 0x3F;
#ifdef USE_HEAP_INSTEAD_OF_STACK
	unsigned char* buffer;
#else
	unsigned char buffer[4096];
#endif
	int  n;
    CODE:
	if (fh) {
#ifdef USE_HEAP_INSTEAD_OF_STACK
	    New(0, buffer, 4096, unsigned char);
	    assert(buffer);
#endif
            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)) > 0)
	 	    MD5Update(context, buffer, n);
	        else
		    XSRETURN(1);  /* self */
	    }

	    /* Process blocks until EOF or error */
            while ( (n = PerlIO_read(fh, buffer, sizeof(buffer))) > 0) {
	        MD5Update(context, buffer, n);
	    }
#ifdef USE_HEAP_INSTEAD_OF_STACK
	    Safefree(buffer);
#endif
	    if (PerlIO_error(fh)) {
		croak("Reading from filehandle failed");
	    }
	}
	else {
	    croak("No filehandle passed");
	}
	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(aTHX_ 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 & G_WARN_ON) {
            const char *msg = 0;
	    if (items == 1) {
		if (SvROK(ST(0))) {
                    SV* sv = SvRV(ST(0));
		    if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
		        msg = "probably called as method";
		    else
			msg = "called with reference argument";
		}
	    }
	    else if (items > 1) {
		data = (unsigned char *)SvPV(ST(0), len);
		if (len == 11 && memEQ("Digest::MD5", data, 11)) {
		    msg = "probably called as class method";
		}
		else if (SvROK(ST(0))) {
		    SV* sv = SvRV(ST(0));
		    if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
		        msg = "probably called as method";
		}
	    }
	    if (msg) {
	        const char *f = (ix == F_BIN) ? "md5" :
		                (ix == F_HEX) ? "md5_hex" : "md5_base64";
	        warn("&Digest::MD5::%s function %s", f, msg);
	    }
	}

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