ext/Digest/MD5/MD5.xs

   1 /* $Id: MD5.xs,v 1.35 2003/01/05 00:54:17 gisle Exp $ */
   2
   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
  12  * turn is derived from the reference implementation in RFC 1321 which
  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
  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
  52 #endif
  53
  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
  74    #define SvPVbyte SvPV
  75 #endif
  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 {
 111     *s++ = (U8)(u         & 0xFF);
 112     *s++ = (U8)((u >>  8) & 0xFF);
 113     *s++ = (U8)((u >> 16) & 0xFF);
 114     *s   = (U8)((u >> 24) & 0xFF);
 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  */
 168 #define F(x, y, z) ((((x) & ((y) ^ (z))) ^ (z)))
 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 {
 226 #ifdef MD5_DEBUG
 227     static int tcount = 0;
 228 #endif
 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
 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
 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++) {
 602             data = (unsigned char *)(SvPVbyte(ST(i), len));
 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);
 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             }
 689         }
 690
 691         for (i = 0; i < items; i++) {
 692             data = (unsigned char *)(SvPVbyte(ST(i), len));
 693             MD5Update(&ctx, data, len);
 694         }
 695         MD5Final(digeststr, &ctx);
 696         ST(0) = make_mortal_sv(digeststr, ix);
 697         XSRETURN(1);