1 /* $Id: MD5.xs,v 1.42 2003/12/06 22:35:16 gisle Exp $ */
4 * This library is free software; you can redistribute it and/or
5 * modify it under the same terms as Perl itself.
7 * Copyright 1998-2000 Gisle Aas.
8 * Copyright 1995-1996 Neil Winton.
9 * Copyright 1991-1992 RSA Data Security, Inc.
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:
15 * Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
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
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.
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.
33 * These notices must be retained in any copies of any part of this
34 * documentation and/or software.
40 #define PERL_NO_GET_CONTEXT /* we want efficiency */
49 # include <patchlevel.h>
50 # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
51 # include <could_not_find_Perl_patchlevel.h>
53 # define PERL_REVISION 5
54 # define PERL_VERSION PATCHLEVEL
55 # define PERL_SUBVERSION SUBVERSION
58 #if PERL_VERSION <= 4 && !defined(PL_dowarn)
59 #define PL_dowarn dowarn
63 #define DOWARN (PL_dowarn & G_WARN_ON)
65 #define DOWARN PL_dowarn
69 #if PERL_REVISION == 5 && PERL_VERSION < 7
70 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
72 #define SvPVbyte(sv, lp) \
73 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
74 ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
77 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
79 sv_utf8_downgrade(sv,0);
92 /* Perl does not guarantee that U32 is exactly 32 bits. Some system
93 * has no integral type with exactly 32 bits. For instance, A Cray has
94 * short, int and long all at 64 bits so we need to apply this macro
95 * to reduce U32 values to 32 bits at appropriate places. If U32
96 * really does have 32 bits then this is a no-op.
98 #if BYTEORDER > 0x4321 || defined(TRUNCATE_U32)
99 #define TO32(x) ((x) & 0xFFFFffff)
100 #define TRUNC32(x) ((x) &= 0xFFFFffff)
103 #define TRUNC32(x) /*nothing*/
106 /* The MD5 algorithm is defined in terms of little endian 32-bit
107 * values. The following macros (and functions) allow us to convert
108 * between native integers and such values.
111 #ifndef U32_ALIGNMENT_REQUIRED
112 #if BYTEORDER == 0x1234 /* 32-bit little endian */
113 #define BYTESWAP(x) (x) /* no-op */
115 #elif BYTEORDER == 0x4321 /* 32-bit big endian */
116 #define BYTESWAP(x) ((((x)&0xFF)<<24) \
118 |(((x)&0x0000FF00)<<8) \
119 |(((x)&0x00FF0000)>>8) )
124 static void u2s(U32 u, U8* s)
126 *s++ = (U8)(u & 0xFF);
127 *s++ = (U8)((u >> 8) & 0xFF);
128 *s++ = (U8)((u >> 16) & 0xFF);
129 *s = (U8)((u >> 24) & 0xFF);
132 #define s2u(s,u) ((u) = (U32)(*s) | \
133 ((U32)(*(s+1)) << 8) | \
134 ((U32)(*(s+2)) << 16) | \
135 ((U32)(*(s+3)) << 24))
138 #define MD5_CTX_SIGNATURE 200003165
140 /* This stucture keeps the current state of algorithm.
143 U32 signature; /* safer cast in get_md5_ctx() */
144 U32 A, B, C, D; /* current digest */
145 U32 bytes_low; /* counts bytes in message */
146 U32 bytes_high; /* turn it into a 64-bit counter */
147 U8 buffer[128]; /* collect complete 64 byte blocks */
151 /* Padding is added at the end of the message in order to fill a
152 * complete 64 byte block (- 8 bytes for the message length). The
153 * padding is also the reason the buffer in MD5_CTX have to be
156 static unsigned char PADDING[64] = {
157 0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
158 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
159 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
162 /* Constants for MD5Transform routine.
181 /* F, G, H and I are basic MD5 functions.
183 #define F(x, y, z) ((((x) & ((y) ^ (z))) ^ (z)))
184 #define G(x, y, z) F(z, x, y)
185 #define H(x, y, z) ((x) ^ (y) ^ (z))
186 #define I(x, y, z) ((y) ^ ((x) | (~z)))
188 /* ROTATE_LEFT rotates x left n bits.
190 #define ROTATE_LEFT(x, n) (((x) << (n) | ((x) >> (32-(n)))))
192 /* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
193 * Rotation is separate from addition to prevent recomputation.
195 #define FF(a, b, c, d, s, ac) \
196 (a) += F ((b), (c), (d)) + (NEXTx) + (U32)(ac); \
198 (a) = ROTATE_LEFT ((a), (s)); \
202 #define GG(a, b, c, d, x, s, ac) \
203 (a) += G ((b), (c), (d)) + X[x] + (U32)(ac); \
205 (a) = ROTATE_LEFT ((a), (s)); \
209 #define HH(a, b, c, d, x, s, ac) \
210 (a) += H ((b), (c), (d)) + X[x] + (U32)(ac); \
212 (a) = ROTATE_LEFT ((a), (s)); \
216 #define II(a, b, c, d, x, s, ac) \
217 (a) += I ((b), (c), (d)) + X[x] + (U32)(ac); \
219 (a) = ROTATE_LEFT ((a), (s)); \
225 MD5Init(MD5_CTX *ctx)
234 ctx->bytes_low = ctx->bytes_high = 0;
239 MD5Transform(MD5_CTX* ctx, const U8* buf, STRLEN blocks)
242 static int tcount = 0;
250 #ifndef U32_ALIGNMENT_REQUIRED
251 const U32 *x = (U32*)buf; /* really just type casting */
260 #if BYTEORDER == 0x1234 && !defined(U32_ALIGNMENT_REQUIRED)
264 U32 X[16]; /* converted values, used in round 2-4 */
268 #define NEXTx (tmp=*x++, *uptr++ = BYTESWAP(tmp))
270 #define NEXTx (s2u(buf,tmp), buf += 4, *uptr++ = tmp)
275 if (buf == ctx->buffer)
276 fprintf(stderr,"%5d: Transform ctx->buffer", ++tcount);
278 fprintf(stderr,"%5d: Transform %p (%d)", ++tcount, buf, blocks);
283 for (i = 0; i < 16; i++) {
284 fprintf(stderr,"%x,", x[i]);
286 fprintf(stderr,"]\n");
291 FF (a, b, c, d, S11, 0xd76aa478); /* 1 */
292 FF (d, a, b, c, S12, 0xe8c7b756); /* 2 */
293 FF (c, d, a, b, S13, 0x242070db); /* 3 */
294 FF (b, c, d, a, S14, 0xc1bdceee); /* 4 */
295 FF (a, b, c, d, S11, 0xf57c0faf); /* 5 */
296 FF (d, a, b, c, S12, 0x4787c62a); /* 6 */
297 FF (c, d, a, b, S13, 0xa8304613); /* 7 */
298 FF (b, c, d, a, S14, 0xfd469501); /* 8 */
299 FF (a, b, c, d, S11, 0x698098d8); /* 9 */
300 FF (d, a, b, c, S12, 0x8b44f7af); /* 10 */
301 FF (c, d, a, b, S13, 0xffff5bb1); /* 11 */
302 FF (b, c, d, a, S14, 0x895cd7be); /* 12 */
303 FF (a, b, c, d, S11, 0x6b901122); /* 13 */
304 FF (d, a, b, c, S12, 0xfd987193); /* 14 */
305 FF (c, d, a, b, S13, 0xa679438e); /* 15 */
306 FF (b, c, d, a, S14, 0x49b40821); /* 16 */
309 GG (a, b, c, d, 1, S21, 0xf61e2562); /* 17 */
310 GG (d, a, b, c, 6, S22, 0xc040b340); /* 18 */
311 GG (c, d, a, b, 11, S23, 0x265e5a51); /* 19 */
312 GG (b, c, d, a, 0, S24, 0xe9b6c7aa); /* 20 */
313 GG (a, b, c, d, 5, S21, 0xd62f105d); /* 21 */
314 GG (d, a, b, c, 10, S22, 0x2441453); /* 22 */
315 GG (c, d, a, b, 15, S23, 0xd8a1e681); /* 23 */
316 GG (b, c, d, a, 4, S24, 0xe7d3fbc8); /* 24 */
317 GG (a, b, c, d, 9, S21, 0x21e1cde6); /* 25 */
318 GG (d, a, b, c, 14, S22, 0xc33707d6); /* 26 */
319 GG (c, d, a, b, 3, S23, 0xf4d50d87); /* 27 */
320 GG (b, c, d, a, 8, S24, 0x455a14ed); /* 28 */
321 GG (a, b, c, d, 13, S21, 0xa9e3e905); /* 29 */
322 GG (d, a, b, c, 2, S22, 0xfcefa3f8); /* 30 */
323 GG (c, d, a, b, 7, S23, 0x676f02d9); /* 31 */
324 GG (b, c, d, a, 12, S24, 0x8d2a4c8a); /* 32 */
327 HH (a, b, c, d, 5, S31, 0xfffa3942); /* 33 */
328 HH (d, a, b, c, 8, S32, 0x8771f681); /* 34 */
329 HH (c, d, a, b, 11, S33, 0x6d9d6122); /* 35 */
330 HH (b, c, d, a, 14, S34, 0xfde5380c); /* 36 */
331 HH (a, b, c, d, 1, S31, 0xa4beea44); /* 37 */
332 HH (d, a, b, c, 4, S32, 0x4bdecfa9); /* 38 */
333 HH (c, d, a, b, 7, S33, 0xf6bb4b60); /* 39 */
334 HH (b, c, d, a, 10, S34, 0xbebfbc70); /* 40 */
335 HH (a, b, c, d, 13, S31, 0x289b7ec6); /* 41 */
336 HH (d, a, b, c, 0, S32, 0xeaa127fa); /* 42 */
337 HH (c, d, a, b, 3, S33, 0xd4ef3085); /* 43 */
338 HH (b, c, d, a, 6, S34, 0x4881d05); /* 44 */
339 HH (a, b, c, d, 9, S31, 0xd9d4d039); /* 45 */
340 HH (d, a, b, c, 12, S32, 0xe6db99e5); /* 46 */
341 HH (c, d, a, b, 15, S33, 0x1fa27cf8); /* 47 */
342 HH (b, c, d, a, 2, S34, 0xc4ac5665); /* 48 */
345 II (a, b, c, d, 0, S41, 0xf4292244); /* 49 */
346 II (d, a, b, c, 7, S42, 0x432aff97); /* 50 */
347 II (c, d, a, b, 14, S43, 0xab9423a7); /* 51 */
348 II (b, c, d, a, 5, S44, 0xfc93a039); /* 52 */
349 II (a, b, c, d, 12, S41, 0x655b59c3); /* 53 */
350 II (d, a, b, c, 3, S42, 0x8f0ccc92); /* 54 */
351 II (c, d, a, b, 10, S43, 0xffeff47d); /* 55 */
352 II (b, c, d, a, 1, S44, 0x85845dd1); /* 56 */
353 II (a, b, c, d, 8, S41, 0x6fa87e4f); /* 57 */
354 II (d, a, b, c, 15, S42, 0xfe2ce6e0); /* 58 */
355 II (c, d, a, b, 6, S43, 0xa3014314); /* 59 */
356 II (b, c, d, a, 13, S44, 0x4e0811a1); /* 60 */
357 II (a, b, c, d, 4, S41, 0xf7537e82); /* 61 */
358 II (d, a, b, c, 11, S42, 0xbd3af235); /* 62 */
359 II (c, d, a, b, 2, S43, 0x2ad7d2bb); /* 63 */
360 II (b, c, d, a, 9, S44, 0xeb86d391); /* 64 */
377 ctx_dump(MD5_CTX* ctx)
379 static char buf[1024];
380 sprintf(buf, "{A=%x,B=%x,C=%x,D=%x,%d,%d(%d)}",
381 ctx->A, ctx->B, ctx->C, ctx->D,
382 ctx->bytes_low, ctx->bytes_high, (ctx->bytes_low&0x3F));
389 MD5Update(MD5_CTX* ctx, const U8* buf, STRLEN len)
392 STRLEN fill = ctx->bytes_low & 0x3F;
395 static int ucount = 0;
396 fprintf(stderr,"%5i: Update(%s, %p, %d)\n", ++ucount, ctx_dump(ctx),
400 ctx->bytes_low += len;
401 if (ctx->bytes_low < len) /* wrap around */
405 STRLEN missing = 64 - fill;
407 Copy(buf, ctx->buffer + fill, len, U8);
410 Copy(buf, ctx->buffer + fill, missing, U8);
411 MD5Transform(ctx, ctx->buffer, 1);
418 MD5Transform(ctx, buf, blocks);
419 if ( (len &= 0x3F)) {
420 Copy(buf + (blocks << 6), ctx->buffer, len, U8);
426 MD5Final(U8* digest, MD5_CTX *ctx)
428 STRLEN fill = ctx->bytes_low & 0x3F;
429 STRLEN padlen = (fill < 56 ? 56 : 120) - fill;
430 U32 bits_low, bits_high;
432 fprintf(stderr," Final: %s\n", ctx_dump(ctx));
434 Copy(PADDING, ctx->buffer + fill, padlen, U8);
437 bits_low = ctx->bytes_low << 3;
438 bits_high = (ctx->bytes_high << 3) | (ctx->bytes_low >> 29);
440 *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_low); fill += 4;
441 *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_high); fill += 4;
443 u2s(bits_low, ctx->buffer + fill); fill += 4;
444 u2s(bits_high, ctx->buffer + fill); fill += 4;
447 MD5Transform(ctx, ctx->buffer, fill >> 6);
449 fprintf(stderr," Result: %s\n", ctx_dump(ctx));
453 *(U32*)digest = BYTESWAP(ctx->A); digest += 4;
454 *(U32*)digest = BYTESWAP(ctx->B); digest += 4;
455 *(U32*)digest = BYTESWAP(ctx->C); digest += 4;
456 *(U32*)digest = BYTESWAP(ctx->D);
459 u2s(ctx->B, digest+4);
460 u2s(ctx->C, digest+8);
461 u2s(ctx->D, digest+12);
466 #define INT2PTR(any,d) (any)(d)
469 static MD5_CTX* get_md5_ctx(pTHX_ SV* sv)
474 MD5_CTX* ctx = INT2PTR(MD5_CTX*, SvIV(sv));
475 if (ctx && ctx->signature == MD5_CTX_SIGNATURE) {
480 croak("Not a reference to a Digest::MD5 object");
481 return (MD5_CTX*)0; /* some compilers insist on a return value */
485 static char* hex_16(const unsigned char* from, char* to)
487 static char *hexdigits = "0123456789abcdef";
488 const unsigned char *end = from + 16;
492 *d++ = hexdigits[(*from >> 4)];
493 *d++ = hexdigits[(*from & 0x0F)];
500 static char* base64_16(const unsigned char* from, char* to)
502 static char* base64 =
503 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
504 const unsigned char *end = from + 16;
505 unsigned char c1, c2, c3;
510 *d++ = base64[c1>>2];
512 *d++ = base64[(c1 & 0x3) << 4];
517 *d++ = base64[((c1 & 0x3) << 4) | ((c2 & 0xF0) >> 4)];
518 *d++ = base64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
519 *d++ = base64[c3 & 0x3F];
530 static SV* make_mortal_sv(pTHX_ const unsigned char *src, int type)
542 ret = hex_16(src, result);
546 ret = base64_16(src, result);
550 croak("Bad convertion type (%d)", type);
553 return sv_2mortal(newSVpv(ret,len));
557 /********************************************************************/
559 typedef PerlIO* InputStream;
561 MODULE = Digest::MD5 PACKAGE = Digest::MD5
571 if (!SvROK(xclass)) {
573 char *sclass = SvPV(xclass, my_na);
574 New(55, context, 1, MD5_CTX);
575 context->signature = MD5_CTX_SIGNATURE;
576 ST(0) = sv_newmortal();
577 sv_setref_pv(ST(0), sclass, (void*)context);
578 SvREADONLY_on(SvRV(ST(0)));
580 context = get_md5_ctx(aTHX_ xclass);
589 MD5_CTX* cont = get_md5_ctx(aTHX_ self);
590 char *myname = sv_reftype(SvRV(self),TRUE);
594 New(55, context, 1, MD5_CTX);
595 ST(0) = sv_newmortal();
596 sv_setref_pv(ST(0), myname , (void*)context);
597 SvREADONLY_on(SvRV(ST(0)));
598 memcpy(context,cont,sizeof(MD5_CTX));
611 MD5_CTX* context = get_md5_ctx(aTHX_ self);
616 for (i = 1; i < items; i++) {
617 data = (unsigned char *)(SvPVbyte(ST(i), len));
618 MD5Update(context, data, len);
620 XSRETURN(1); /* self */
627 MD5_CTX* context = get_md5_ctx(aTHX_ self);
628 STRLEN fill = context->bytes_low & 0x3F;
629 unsigned char buffer[4096];
634 /* The MD5Update() function is faster if it can work with
635 * complete blocks. This will fill up any buffered block
638 STRLEN missing = 64 - fill;
639 if ( (n = PerlIO_read(fh, buffer, missing)) > 0)
640 MD5Update(context, buffer, n);
642 XSRETURN(1); /* self */
645 /* Process blocks until EOF or error */
646 while ( (n = PerlIO_read(fh, buffer, sizeof(buffer))) > 0) {
647 MD5Update(context, buffer, n);
650 if (PerlIO_error(fh)) {
651 croak("Reading from filehandle failed");
655 croak("No filehandle passed");
657 XSRETURN(1); /* self */
663 Digest::MD5::digest = F_BIN
664 Digest::MD5::hexdigest = F_HEX
665 Digest::MD5::b64digest = F_B64
667 unsigned char digeststr[16];
669 MD5Final(digeststr, context);
670 MD5Init(context); /* In case it is reused */
671 ST(0) = make_mortal_sv(aTHX_ digeststr, ix);
677 Digest::MD5::md5 = F_BIN
678 Digest::MD5::md5_hex = F_HEX
679 Digest::MD5::md5_base64 = F_B64
685 unsigned char digeststr[16];
693 SV* sv = SvRV(ST(0));
694 if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
695 msg = "probably called as method";
697 msg = "called with reference argument";
700 else if (items > 1) {
701 data = (unsigned char *)SvPVbyte(ST(0), len);
702 if (len == 11 && memEQ("Digest::MD5", data, 11)) {
703 msg = "probably called as class method";
707 char *f = (ix == F_BIN) ? "md5" :
708 (ix == F_HEX) ? "md5_hex" : "md5_base64";
709 warn("&Digest::MD5::%s function %s", f, msg);
713 for (i = 0; i < items; i++) {
714 data = (unsigned char *)(SvPVbyte(ST(i), len));
715 MD5Update(&ctx, data, len);
717 MD5Final(digeststr, &ctx);
718 ST(0) = make_mortal_sv(aTHX_ digeststr, ix);