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

/* $Id: MD5.xs,v 1.40 2003/07/22 05:59:27 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
#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

/* 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 unsigned char PADDING[64] = {
  0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
};

/* Constants for MD5Transform routine.
 */
#define S11 7
#define S12 12
#define S13 17
#define S14 22
#define S21 5
#define S22 9
#define S23 14
#define S24 20
#define S31 4
#define S32 11
#define S33 16
#define S34 23
#define S41 6
#define S42 10
#define S43 15
#define S44 21

/* F, G, H and I are basic MD5 functions.
 */
#define F(x, y, z) ((((x) & ((y) ^ (z))) ^ (z)))
#define G(x, y, z) F(z, x, y)
#define H(x, y, z) ((x) ^ (y) ^ (z))
#define I(x, y, z) ((y) ^ ((x) | (~z)))

/* ROTATE_LEFT rotates x left n bits.
 */
#define ROTATE_LEFT(x, n) (((x) << (n) | ((x) >> (32-(n)))))

/* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
 * Rotation is separate from addition to prevent recomputation.
 */
#define FF(a, b, c, d, s, ac)                    \
 (a) += F ((b), (c), (d)) + (NEXTx) + (U32)(ac); \
 TRUNC32((a));                                   \
 (a) = ROTATE_LEFT ((a), (s));                   \
 (a) += (b);                                     \
 TRUNC32((a));

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

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

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


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

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


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

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

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

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

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

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

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

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

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

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

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

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

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


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


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

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

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

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

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


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

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

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

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

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

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


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

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

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

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

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

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


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

typedef PerlIO* InputStream;

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

PROTOTYPES: DISABLE

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

void
clone(self)
	SV* self
    PREINIT:
	MD5_CTX* cont = get_md5_ctx(self);
	char *myname = sv_reftype(SvRV(self),TRUE);
	MD5_CTX* context;
    PPCODE:
	STRLEN my_na;
	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(self);
	int i;
	unsigned char *data;
	STRLEN len;
    PPCODE:
	for (i = 1; i < items; i++) {
	    data = (unsigned char *)(SvPVbyte(ST(i), len));
	    MD5Update(context, data, len);
	}
	XSRETURN(1);  /* self */

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

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