[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

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