[perl5.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 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

#ifndef PERL_VERSION
#    include <patchlevel.h>
#    if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
#        include <could_not_find_Perl_patchlevel.h>
#    endif
#    define PERL_REVISION       5
#    define PERL_VERSION        PATCHLEVEL
#    define PERL_SUBVERSION     SUBVERSION
#endif

#if PERL_VERSION <= 4 && !defined(PL_dowarn)
   #define PL_dowarn dowarn
#endif

#ifdef G_WARN_ON
   #define DOWARN (PL_dowarn & G_WARN_ON)
#else
   #define DOWARN PL_dowarn
#endif

#ifdef SvPVbyte
   #if PERL_REVISION == 5 && PERL_VERSION < 7
       /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
       #undef SvPVbyte
       #define SvPVbyte(sv, lp) \
	  ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
     	   ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))

       static char *
       my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
       {
	   sv_utf8_downgrade(sv,0);
           return SvPV(sv,*lp);
       }
   #endif
#else
   #define SvPVbyte SvPV
#endif

#ifndef dTHX
   #define pTHX_
   #define aTHX_
#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

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