2 * This library is free software; you can redistribute it and/or
3 * modify it under the same terms as Perl itself.
5 * Copyright 1998-2000 Gisle Aas.
6 * Copyright 1995-1996 Neil Winton.
7 * Copyright 1991-1992 RSA Data Security, Inc.
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:
13 * Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
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
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.
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.
31 * These notices must be retained in any copies of any part of this
32 * documentation and/or software.
38 #define PERL_NO_GET_CONTEXT /* we want efficiency */
47 # include <patchlevel.h>
48 # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
49 # include <could_not_find_Perl_patchlevel.h>
51 # define PERL_REVISION 5
52 # define PERL_VERSION PATCHLEVEL
53 # define PERL_SUBVERSION SUBVERSION
56 #if PERL_VERSION <= 4 && !defined(PL_dowarn)
57 #define PL_dowarn dowarn
61 #define DOWARN (PL_dowarn & G_WARN_ON)
63 #define DOWARN PL_dowarn
67 #if PERL_REVISION == 5 && PERL_VERSION < 7
68 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
70 #define SvPVbyte(sv, lp) \
71 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
72 ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
75 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
77 sv_utf8_downgrade(sv,0);
90 /* Perl does not guarantee that U32 is exactly 32 bits. Some system
91 * has no integral type with exactly 32 bits. For instance, A Cray has
92 * short, int and long all at 64 bits so we need to apply this macro
93 * to reduce U32 values to 32 bits at appropriate places. If U32
94 * really does have 32 bits then this is a no-op.
96 #if BYTEORDER > 0x4321 || defined(TRUNCATE_U32)
97 #define TO32(x) ((x) & 0xFFFFffff)
98 #define TRUNC32(x) ((x) &= 0xFFFFffff)
101 #define TRUNC32(x) /*nothing*/
104 /* The MD5 algorithm is defined in terms of little endian 32-bit
105 * values. The following macros (and functions) allow us to convert
106 * between native integers and such values.
109 #ifndef U32_ALIGNMENT_REQUIRED
110 #if BYTEORDER == 0x1234 /* 32-bit little endian */
111 #define BYTESWAP(x) (x) /* no-op */
113 #elif BYTEORDER == 0x4321 /* 32-bit big endian */
114 #define BYTESWAP(x) ((((x)&0xFF)<<24) \
116 |(((x)&0x0000FF00)<<8) \
117 |(((x)&0x00FF0000)>>8) )
122 static void u2s(U32 u, U8* s)
124 *s++ = (U8)(u & 0xFF);
125 *s++ = (U8)((u >> 8) & 0xFF);
126 *s++ = (U8)((u >> 16) & 0xFF);
127 *s = (U8)((u >> 24) & 0xFF);
130 #define s2u(s,u) ((u) = (U32)(*s) | \
131 ((U32)(*(s+1)) << 8) | \
132 ((U32)(*(s+2)) << 16) | \
133 ((U32)(*(s+3)) << 24))
136 #define MD5_CTX_SIGNATURE 200003165
138 /* This stucture keeps the current state of algorithm.
141 U32 signature; /* safer cast in get_md5_ctx() */
142 U32 A, B, C, D; /* current digest */
143 U32 bytes_low; /* counts bytes in message */
144 U32 bytes_high; /* turn it into a 64-bit counter */
145 U8 buffer[128]; /* collect complete 64 byte blocks */
149 /* Padding is added at the end of the message in order to fill a
150 * complete 64 byte block (- 8 bytes for the message length). The
151 * padding is also the reason the buffer in MD5_CTX have to be
154 static const unsigned char PADDING[64] = {
155 0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
156 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
157 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
160 /* Constants for MD5Transform routine.
179 /* F, G, H and I are basic MD5 functions.
181 #define F(x, y, z) ((((x) & ((y) ^ (z))) ^ (z)))
182 #define G(x, y, z) F(z, x, y)
183 #define H(x, y, z) ((x) ^ (y) ^ (z))
184 #define I(x, y, z) ((y) ^ ((x) | (~z)))
186 /* ROTATE_LEFT rotates x left n bits.
188 #define ROTATE_LEFT(x, n) (((x) << (n) | ((x) >> (32-(n)))))
190 /* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
191 * Rotation is separate from addition to prevent recomputation.
193 #define FF(a, b, c, d, s, ac) \
194 (a) += F ((b), (c), (d)) + (NEXTx) + (U32)(ac); \
196 (a) = ROTATE_LEFT ((a), (s)); \
200 #define GG(a, b, c, d, x, s, ac) \
201 (a) += G ((b), (c), (d)) + X[x] + (U32)(ac); \
203 (a) = ROTATE_LEFT ((a), (s)); \
207 #define HH(a, b, c, d, x, s, ac) \
208 (a) += H ((b), (c), (d)) + X[x] + (U32)(ac); \
210 (a) = ROTATE_LEFT ((a), (s)); \
214 #define II(a, b, c, d, x, s, ac) \
215 (a) += I ((b), (c), (d)) + X[x] + (U32)(ac); \
217 (a) = ROTATE_LEFT ((a), (s)); \
223 MD5Init(MD5_CTX *ctx)
232 ctx->bytes_low = ctx->bytes_high = 0;
237 MD5Transform(MD5_CTX* ctx, const U8* buf, STRLEN blocks)
240 static int tcount = 0;
248 #ifndef U32_ALIGNMENT_REQUIRED
249 const U32 *x = (U32*)buf; /* really just type casting */
258 #if BYTEORDER == 0x1234 && !defined(U32_ALIGNMENT_REQUIRED)
262 U32 X[16]; /* converted values, used in round 2-4 */
266 #define NEXTx (tmp=*x++, *uptr++ = BYTESWAP(tmp))
268 #define NEXTx (s2u(buf,tmp), buf += 4, *uptr++ = tmp)
273 if (buf == ctx->buffer)
274 fprintf(stderr,"%5d: Transform ctx->buffer", ++tcount);
276 fprintf(stderr,"%5d: Transform %p (%d)", ++tcount, buf, blocks);
281 for (i = 0; i < 16; i++) {
282 fprintf(stderr,"%x,", x[i]);
284 fprintf(stderr,"]\n");
289 FF (a, b, c, d, S11, 0xd76aa478); /* 1 */
290 FF (d, a, b, c, S12, 0xe8c7b756); /* 2 */
291 FF (c, d, a, b, S13, 0x242070db); /* 3 */
292 FF (b, c, d, a, S14, 0xc1bdceee); /* 4 */
293 FF (a, b, c, d, S11, 0xf57c0faf); /* 5 */
294 FF (d, a, b, c, S12, 0x4787c62a); /* 6 */
295 FF (c, d, a, b, S13, 0xa8304613); /* 7 */
296 FF (b, c, d, a, S14, 0xfd469501); /* 8 */
297 FF (a, b, c, d, S11, 0x698098d8); /* 9 */
298 FF (d, a, b, c, S12, 0x8b44f7af); /* 10 */
299 FF (c, d, a, b, S13, 0xffff5bb1); /* 11 */
300 FF (b, c, d, a, S14, 0x895cd7be); /* 12 */
301 FF (a, b, c, d, S11, 0x6b901122); /* 13 */
302 FF (d, a, b, c, S12, 0xfd987193); /* 14 */
303 FF (c, d, a, b, S13, 0xa679438e); /* 15 */
304 FF (b, c, d, a, S14, 0x49b40821); /* 16 */
307 GG (a, b, c, d, 1, S21, 0xf61e2562); /* 17 */
308 GG (d, a, b, c, 6, S22, 0xc040b340); /* 18 */
309 GG (c, d, a, b, 11, S23, 0x265e5a51); /* 19 */
310 GG (b, c, d, a, 0, S24, 0xe9b6c7aa); /* 20 */
311 GG (a, b, c, d, 5, S21, 0xd62f105d); /* 21 */
312 GG (d, a, b, c, 10, S22, 0x2441453); /* 22 */
313 GG (c, d, a, b, 15, S23, 0xd8a1e681); /* 23 */
314 GG (b, c, d, a, 4, S24, 0xe7d3fbc8); /* 24 */
315 GG (a, b, c, d, 9, S21, 0x21e1cde6); /* 25 */
316 GG (d, a, b, c, 14, S22, 0xc33707d6); /* 26 */
317 GG (c, d, a, b, 3, S23, 0xf4d50d87); /* 27 */
318 GG (b, c, d, a, 8, S24, 0x455a14ed); /* 28 */
319 GG (a, b, c, d, 13, S21, 0xa9e3e905); /* 29 */
320 GG (d, a, b, c, 2, S22, 0xfcefa3f8); /* 30 */
321 GG (c, d, a, b, 7, S23, 0x676f02d9); /* 31 */
322 GG (b, c, d, a, 12, S24, 0x8d2a4c8a); /* 32 */
325 HH (a, b, c, d, 5, S31, 0xfffa3942); /* 33 */
326 HH (d, a, b, c, 8, S32, 0x8771f681); /* 34 */
327 HH (c, d, a, b, 11, S33, 0x6d9d6122); /* 35 */
328 HH (b, c, d, a, 14, S34, 0xfde5380c); /* 36 */
329 HH (a, b, c, d, 1, S31, 0xa4beea44); /* 37 */
330 HH (d, a, b, c, 4, S32, 0x4bdecfa9); /* 38 */
331 HH (c, d, a, b, 7, S33, 0xf6bb4b60); /* 39 */
332 HH (b, c, d, a, 10, S34, 0xbebfbc70); /* 40 */
333 HH (a, b, c, d, 13, S31, 0x289b7ec6); /* 41 */
334 HH (d, a, b, c, 0, S32, 0xeaa127fa); /* 42 */
335 HH (c, d, a, b, 3, S33, 0xd4ef3085); /* 43 */
336 HH (b, c, d, a, 6, S34, 0x4881d05); /* 44 */
337 HH (a, b, c, d, 9, S31, 0xd9d4d039); /* 45 */
338 HH (d, a, b, c, 12, S32, 0xe6db99e5); /* 46 */
339 HH (c, d, a, b, 15, S33, 0x1fa27cf8); /* 47 */
340 HH (b, c, d, a, 2, S34, 0xc4ac5665); /* 48 */
343 II (a, b, c, d, 0, S41, 0xf4292244); /* 49 */
344 II (d, a, b, c, 7, S42, 0x432aff97); /* 50 */
345 II (c, d, a, b, 14, S43, 0xab9423a7); /* 51 */
346 II (b, c, d, a, 5, S44, 0xfc93a039); /* 52 */
347 II (a, b, c, d, 12, S41, 0x655b59c3); /* 53 */
348 II (d, a, b, c, 3, S42, 0x8f0ccc92); /* 54 */
349 II (c, d, a, b, 10, S43, 0xffeff47d); /* 55 */
350 II (b, c, d, a, 1, S44, 0x85845dd1); /* 56 */
351 II (a, b, c, d, 8, S41, 0x6fa87e4f); /* 57 */
352 II (d, a, b, c, 15, S42, 0xfe2ce6e0); /* 58 */
353 II (c, d, a, b, 6, S43, 0xa3014314); /* 59 */
354 II (b, c, d, a, 13, S44, 0x4e0811a1); /* 60 */
355 II (a, b, c, d, 4, S41, 0xf7537e82); /* 61 */
356 II (d, a, b, c, 11, S42, 0xbd3af235); /* 62 */
357 II (c, d, a, b, 2, S43, 0x2ad7d2bb); /* 63 */
358 II (b, c, d, a, 9, S44, 0xeb86d391); /* 64 */
375 ctx_dump(MD5_CTX* ctx)
377 static char buf[1024];
378 sprintf(buf, "{A=%x,B=%x,C=%x,D=%x,%d,%d(%d)}",
379 ctx->A, ctx->B, ctx->C, ctx->D,
380 ctx->bytes_low, ctx->bytes_high, (ctx->bytes_low&0x3F));
387 MD5Update(MD5_CTX* ctx, const U8* buf, STRLEN len)
390 STRLEN fill = ctx->bytes_low & 0x3F;
393 static int ucount = 0;
394 fprintf(stderr,"%5i: Update(%s, %p, %d)\n", ++ucount, ctx_dump(ctx),
398 ctx->bytes_low += len;
399 if (ctx->bytes_low < len) /* wrap around */
403 STRLEN missing = 64 - fill;
405 Copy(buf, ctx->buffer + fill, len, U8);
408 Copy(buf, ctx->buffer + fill, missing, U8);
409 MD5Transform(ctx, ctx->buffer, 1);
416 MD5Transform(ctx, buf, blocks);
417 if ( (len &= 0x3F)) {
418 Copy(buf + (blocks << 6), ctx->buffer, len, U8);
424 MD5Final(U8* digest, MD5_CTX *ctx)
426 STRLEN fill = ctx->bytes_low & 0x3F;
427 STRLEN padlen = (fill < 56 ? 56 : 120) - fill;
428 U32 bits_low, bits_high;
430 fprintf(stderr," Final: %s\n", ctx_dump(ctx));
432 Copy(PADDING, ctx->buffer + fill, padlen, U8);
435 bits_low = ctx->bytes_low << 3;
436 bits_high = (ctx->bytes_high << 3) | (ctx->bytes_low >> 29);
438 *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_low); fill += 4;
439 *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_high); fill += 4;
441 u2s(bits_low, ctx->buffer + fill); fill += 4;
442 u2s(bits_high, ctx->buffer + fill); fill += 4;
445 MD5Transform(ctx, ctx->buffer, fill >> 6);
447 fprintf(stderr," Result: %s\n", ctx_dump(ctx));
451 *(U32*)digest = BYTESWAP(ctx->A); digest += 4;
452 *(U32*)digest = BYTESWAP(ctx->B); digest += 4;
453 *(U32*)digest = BYTESWAP(ctx->C); digest += 4;
454 *(U32*)digest = BYTESWAP(ctx->D);
457 u2s(ctx->B, digest+4);
458 u2s(ctx->C, digest+8);
459 u2s(ctx->D, digest+12);
464 #define INT2PTR(any,d) (any)(d)
467 static MD5_CTX* get_md5_ctx(pTHX_ SV* sv)
472 MD5_CTX* ctx = INT2PTR(MD5_CTX*, SvIV(sv));
473 if (ctx && ctx->signature == MD5_CTX_SIGNATURE) {
478 croak("Not a reference to a Digest::MD5 object");
479 return (MD5_CTX*)0; /* some compilers insist on a return value */
483 static char* hex_16(const unsigned char* from, char* to)
485 static const char hexdigits[] = "0123456789abcdef";
486 const unsigned char *end = from + 16;
490 *d++ = hexdigits[(*from >> 4)];
491 *d++ = hexdigits[(*from & 0x0F)];
498 static char* base64_16(const unsigned char* from, char* to)
500 static const char base64[] =
501 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
502 const unsigned char *end = from + 16;
503 unsigned char c1, c2, c3;
508 *d++ = base64[c1>>2];
510 *d++ = base64[(c1 & 0x3) << 4];
515 *d++ = base64[((c1 & 0x3) << 4) | ((c2 & 0xF0) >> 4)];
516 *d++ = base64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
517 *d++ = base64[c3 & 0x3F];
528 static SV* make_mortal_sv(pTHX_ const unsigned char *src, int type)
540 ret = hex_16(src, result);
544 ret = base64_16(src, result);
548 croak("Bad convertion type (%d)", type);
551 return sv_2mortal(newSVpv(ret,len));
555 /********************************************************************/
557 typedef PerlIO* InputStream;
559 MODULE = Digest::MD5 PACKAGE = Digest::MD5
569 if (!SvROK(xclass)) {
571 char *sclass = SvPV(xclass, my_na);
572 New(55, context, 1, MD5_CTX);
573 context->signature = MD5_CTX_SIGNATURE;
574 ST(0) = sv_newmortal();
575 sv_setref_pv(ST(0), sclass, (void*)context);
576 SvREADONLY_on(SvRV(ST(0)));
578 context = get_md5_ctx(aTHX_ xclass);
587 MD5_CTX* cont = get_md5_ctx(aTHX_ self);
588 const char *myname = sv_reftype(SvRV(self),TRUE);
591 New(55, context, 1, MD5_CTX);
592 ST(0) = sv_newmortal();
593 sv_setref_pv(ST(0), myname , (void*)context);
594 SvREADONLY_on(SvRV(ST(0)));
595 memcpy(context,cont,sizeof(MD5_CTX));
608 MD5_CTX* context = get_md5_ctx(aTHX_ self);
613 for (i = 1; i < items; i++) {
614 data = (unsigned char *)(SvPVbyte(ST(i), len));
615 MD5Update(context, data, len);
617 XSRETURN(1); /* self */
624 MD5_CTX* context = get_md5_ctx(aTHX_ self);
625 STRLEN fill = context->bytes_low & 0x3F;
626 #ifdef USE_HEAP_INSTEAD_OF_STACK
627 unsigned char* buffer;
629 unsigned char buffer[4096];
634 #ifdef USE_HEAP_INSTEAD_OF_STACK
635 New(0, buffer, 4096, unsigned char);
639 /* The MD5Update() function is faster if it can work with
640 * complete blocks. This will fill up any buffered block
643 STRLEN missing = 64 - fill;
644 if ( (n = PerlIO_read(fh, buffer, missing)) > 0)
645 MD5Update(context, buffer, n);
647 XSRETURN(1); /* self */
650 /* Process blocks until EOF or error */
651 while ( (n = PerlIO_read(fh, buffer, sizeof(buffer))) > 0) {
652 MD5Update(context, buffer, n);
654 #ifdef USE_HEAP_INSTEAD_OF_STACK
657 if (PerlIO_error(fh)) {
658 croak("Reading from filehandle failed");
662 croak("No filehandle passed");
664 XSRETURN(1); /* self */
670 Digest::MD5::digest = F_BIN
671 Digest::MD5::hexdigest = F_HEX
672 Digest::MD5::b64digest = F_B64
674 unsigned char digeststr[16];
676 MD5Final(digeststr, context);
677 MD5Init(context); /* In case it is reused */
678 ST(0) = make_mortal_sv(aTHX_ digeststr, ix);
684 Digest::MD5::md5 = F_BIN
685 Digest::MD5::md5_hex = F_HEX
686 Digest::MD5::md5_base64 = F_B64
692 unsigned char digeststr[16];
700 SV* sv = SvRV(ST(0));
701 if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
702 msg = "probably called as method";
704 msg = "called with reference argument";
707 else if (items > 1) {
708 data = (unsigned char *)SvPVbyte(ST(0), len);
709 if (len == 11 && memEQ("Digest::MD5", data, 11)) {
710 msg = "probably called as class method";
712 else if (SvROK(ST(0))) {
713 SV* sv = SvRV(ST(0));
714 if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
715 msg = "probably called as method";
719 const char *f = (ix == F_BIN) ? "md5" :
720 (ix == F_HEX) ? "md5_hex" : "md5_base64";
721 warn("&Digest::MD5::%s function %s", f, msg);
725 for (i = 0; i < items; i++) {
726 data = (unsigned char *)(SvPVbyte(ST(i), len));
727 MD5Update(&ctx, data, len);
729 MD5Final(digeststr, &ctx);
730 ST(0) = make_mortal_sv(aTHX_ digeststr, ix);