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

/* $Id: MD5.xs,v 1.35 2003/01/05 00:54:17 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

#include <patchlevel.h>
#ifndef PERL_VERSION
#    include <could_not_find_Perl_patchlevel.h>
#endif
#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
   #define PL_dowarn 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)))
	 	    MD5Update(context, buffer, n);
	        else
		    XSRETURN(1);  /* self */
	    }

	    /* Process blocks until EOF */
            while ( (n = PerlIO_read(fh, buffer, sizeof(buffer)))) {
	        MD5Update(context, buffer, n);
	    }
	}
	XSRETURN(1);  /* self */

void
digest(context)
	MD5_CTX* context
    ALIAS:
	Digest::MD5::digest    = F_BIN
	Digest::MD5::hexdigest = F_HEX
	Digest::MD5::b64digest = F_B64
    PREINIT:
	unsigned char digeststr[16];
    PPCODE:
        MD5Final(digeststr, context);
	MD5Init(context);  /* In case it is reused */
        ST(0) = make_mortal_sv(digeststr, ix);
        XSRETURN(1);

void
md5(...)
    ALIAS:
	Digest::MD5::md5        = F_BIN
	Digest::MD5::md5_hex    = F_HEX
	Digest::MD5::md5_base64 = F_B64
    PREINIT:
	MD5_CTX ctx;
	int i;
	unsigned char *data;
        STRLEN len;
	unsigned char digeststr[16];
    PPCODE:
	MD5Init(&ctx);

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