[perl5.git] / ext / Digest / MD5 / MD5.xs

/* $Id: MD5.xs,v 1.45 2005/11/26 11:06:20 gisle Exp $ */

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