cpan/Digest-MD5/MD5.xs

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