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

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