1 /* $Id: MD5.xs,v 1.39 2003/07/05 05:25:37 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.
48 # include <patchlevel.h>
49 # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
50 # include <could_not_find_Perl_patchlevel.h>
52 # define PERL_REVISION 5
53 # define PERL_VERSION PATCHLEVEL
54 # define PERL_SUBVERSION SUBVERSION
57 #if PERL_VERSION <= 4 && !defined(PL_dowarn)
58 #define PL_dowarn dowarn
62 #define DOWARN (PL_dowarn & G_WARN_ON)
64 #define DOWARN PL_dowarn
68 #if PERL_REVISION == 5 && PERL_VERSION < 7
69 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
71 #define SvPVbyte(sv, lp) \
72 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
73 ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
76 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
78 sv_utf8_downgrade(sv,0);
86 /* Perl does not guarantee that U32 is exactly 32 bits. Some system
87 * has no integral type with exactly 32 bits. For instance, A Cray has
88 * short, int and long all at 64 bits so we need to apply this macro
89 * to reduce U32 values to 32 bits at appropriate places. If U32
90 * really does have 32 bits then this is a no-op.
92 #if BYTEORDER > 0x4321 || defined(TRUNCATE_U32)
93 #define TO32(x) ((x) & 0xFFFFffff)
94 #define TRUNC32(x) ((x) &= 0xFFFFffff)
97 #define TRUNC32(x) /*nothing*/
100 /* The MD5 algorithm is defined in terms of little endian 32-bit
101 * values. The following macros (and functions) allow us to convert
102 * between native integers and such values.
105 #ifndef U32_ALIGNMENT_REQUIRED
106 #if BYTEORDER == 0x1234 /* 32-bit little endian */
107 #define BYTESWAP(x) (x) /* no-op */
109 #elif BYTEORDER == 0x4321 /* 32-bit big endian */
110 #define BYTESWAP(x) ((((x)&0xFF)<<24) \
112 |(((x)&0x0000FF00)<<8) \
113 |(((x)&0x00FF0000)>>8) )
118 static void u2s(U32 u, U8* s)
120 *s++ = (U8)(u & 0xFF);
121 *s++ = (U8)((u >> 8) & 0xFF);
122 *s++ = (U8)((u >> 16) & 0xFF);
123 *s = (U8)((u >> 24) & 0xFF);
126 #define s2u(s,u) ((u) = (U32)(*s) | \
127 ((U32)(*(s+1)) << 8) | \
128 ((U32)(*(s+2)) << 16) | \
129 ((U32)(*(s+3)) << 24))
132 #define MD5_CTX_SIGNATURE 200003165
134 /* This stucture keeps the current state of algorithm.
137 U32 signature; /* safer cast in get_md5_ctx() */
138 U32 A, B, C, D; /* current digest */
139 U32 bytes_low; /* counts bytes in message */
140 U32 bytes_high; /* turn it into a 64-bit counter */
141 U8 buffer[128]; /* collect complete 64 byte blocks */
145 /* Padding is added at the end of the message in order to fill a
146 * complete 64 byte block (- 8 bytes for the message length). The
147 * padding is also the reason the buffer in MD5_CTX have to be
150 static unsigned char PADDING[64] = {
151 0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
152 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
153 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
156 /* Constants for MD5Transform routine.
175 /* F, G, H and I are basic MD5 functions.
177 #define F(x, y, z) ((((x) & ((y) ^ (z))) ^ (z)))
178 #define G(x, y, z) F(z, x, y)
179 #define H(x, y, z) ((x) ^ (y) ^ (z))
180 #define I(x, y, z) ((y) ^ ((x) | (~z)))
182 /* ROTATE_LEFT rotates x left n bits.
184 #define ROTATE_LEFT(x, n) (((x) << (n) | ((x) >> (32-(n)))))
186 /* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
187 * Rotation is separate from addition to prevent recomputation.
189 #define FF(a, b, c, d, s, ac) \
190 (a) += F ((b), (c), (d)) + (NEXTx) + (U32)(ac); \
192 (a) = ROTATE_LEFT ((a), (s)); \
196 #define GG(a, b, c, d, x, s, ac) \
197 (a) += G ((b), (c), (d)) + X[x] + (U32)(ac); \
199 (a) = ROTATE_LEFT ((a), (s)); \
203 #define HH(a, b, c, d, x, s, ac) \
204 (a) += H ((b), (c), (d)) + X[x] + (U32)(ac); \
206 (a) = ROTATE_LEFT ((a), (s)); \
210 #define II(a, b, c, d, x, s, ac) \
211 (a) += I ((b), (c), (d)) + X[x] + (U32)(ac); \
213 (a) = ROTATE_LEFT ((a), (s)); \
219 MD5Init(MD5_CTX *ctx)
228 ctx->bytes_low = ctx->bytes_high = 0;
233 MD5Transform(MD5_CTX* ctx, const U8* buf, STRLEN blocks)
236 static int tcount = 0;
244 #ifndef U32_ALIGNMENT_REQUIRED
245 const U32 *x = (U32*)buf; /* really just type casting */
254 #if BYTEORDER == 0x1234 && !defined(U32_ALIGNMENT_REQUIRED)
258 U32 X[16]; /* converted values, used in round 2-4 */
262 #define NEXTx (tmp=*x++, *uptr++ = BYTESWAP(tmp))
264 #define NEXTx (s2u(buf,tmp), buf += 4, *uptr++ = tmp)
269 if (buf == ctx->buffer)
270 fprintf(stderr,"%5d: Transform ctx->buffer", ++tcount);
272 fprintf(stderr,"%5d: Transform %p (%d)", ++tcount, buf, blocks);
277 for (i = 0; i < 16; i++) {
278 fprintf(stderr,"%x,", x[i]);
280 fprintf(stderr,"]\n");
285 FF (a, b, c, d, S11, 0xd76aa478); /* 1 */
286 FF (d, a, b, c, S12, 0xe8c7b756); /* 2 */
287 FF (c, d, a, b, S13, 0x242070db); /* 3 */
288 FF (b, c, d, a, S14, 0xc1bdceee); /* 4 */
289 FF (a, b, c, d, S11, 0xf57c0faf); /* 5 */
290 FF (d, a, b, c, S12, 0x4787c62a); /* 6 */
291 FF (c, d, a, b, S13, 0xa8304613); /* 7 */
292 FF (b, c, d, a, S14, 0xfd469501); /* 8 */
293 FF (a, b, c, d, S11, 0x698098d8); /* 9 */
294 FF (d, a, b, c, S12, 0x8b44f7af); /* 10 */
295 FF (c, d, a, b, S13, 0xffff5bb1); /* 11 */
296 FF (b, c, d, a, S14, 0x895cd7be); /* 12 */
297 FF (a, b, c, d, S11, 0x6b901122); /* 13 */
298 FF (d, a, b, c, S12, 0xfd987193); /* 14 */
299 FF (c, d, a, b, S13, 0xa679438e); /* 15 */
300 FF (b, c, d, a, S14, 0x49b40821); /* 16 */
303 GG (a, b, c, d, 1, S21, 0xf61e2562); /* 17 */
304 GG (d, a, b, c, 6, S22, 0xc040b340); /* 18 */
305 GG (c, d, a, b, 11, S23, 0x265e5a51); /* 19 */
306 GG (b, c, d, a, 0, S24, 0xe9b6c7aa); /* 20 */
307 GG (a, b, c, d, 5, S21, 0xd62f105d); /* 21 */
308 GG (d, a, b, c, 10, S22, 0x2441453); /* 22 */
309 GG (c, d, a, b, 15, S23, 0xd8a1e681); /* 23 */
310 GG (b, c, d, a, 4, S24, 0xe7d3fbc8); /* 24 */
311 GG (a, b, c, d, 9, S21, 0x21e1cde6); /* 25 */
312 GG (d, a, b, c, 14, S22, 0xc33707d6); /* 26 */
313 GG (c, d, a, b, 3, S23, 0xf4d50d87); /* 27 */
314 GG (b, c, d, a, 8, S24, 0x455a14ed); /* 28 */
315 GG (a, b, c, d, 13, S21, 0xa9e3e905); /* 29 */
316 GG (d, a, b, c, 2, S22, 0xfcefa3f8); /* 30 */
317 GG (c, d, a, b, 7, S23, 0x676f02d9); /* 31 */
318 GG (b, c, d, a, 12, S24, 0x8d2a4c8a); /* 32 */
321 HH (a, b, c, d, 5, S31, 0xfffa3942); /* 33 */
322 HH (d, a, b, c, 8, S32, 0x8771f681); /* 34 */
323 HH (c, d, a, b, 11, S33, 0x6d9d6122); /* 35 */
324 HH (b, c, d, a, 14, S34, 0xfde5380c); /* 36 */
325 HH (a, b, c, d, 1, S31, 0xa4beea44); /* 37 */
326 HH (d, a, b, c, 4, S32, 0x4bdecfa9); /* 38 */
327 HH (c, d, a, b, 7, S33, 0xf6bb4b60); /* 39 */
328 HH (b, c, d, a, 10, S34, 0xbebfbc70); /* 40 */
329 HH (a, b, c, d, 13, S31, 0x289b7ec6); /* 41 */
330 HH (d, a, b, c, 0, S32, 0xeaa127fa); /* 42 */
331 HH (c, d, a, b, 3, S33, 0xd4ef3085); /* 43 */
332 HH (b, c, d, a, 6, S34, 0x4881d05); /* 44 */
333 HH (a, b, c, d, 9, S31, 0xd9d4d039); /* 45 */
334 HH (d, a, b, c, 12, S32, 0xe6db99e5); /* 46 */
335 HH (c, d, a, b, 15, S33, 0x1fa27cf8); /* 47 */
336 HH (b, c, d, a, 2, S34, 0xc4ac5665); /* 48 */
339 II (a, b, c, d, 0, S41, 0xf4292244); /* 49 */
340 II (d, a, b, c, 7, S42, 0x432aff97); /* 50 */
341 II (c, d, a, b, 14, S43, 0xab9423a7); /* 51 */
342 II (b, c, d, a, 5, S44, 0xfc93a039); /* 52 */
343 II (a, b, c, d, 12, S41, 0x655b59c3); /* 53 */
344 II (d, a, b, c, 3, S42, 0x8f0ccc92); /* 54 */
345 II (c, d, a, b, 10, S43, 0xffeff47d); /* 55 */
346 II (b, c, d, a, 1, S44, 0x85845dd1); /* 56 */
347 II (a, b, c, d, 8, S41, 0x6fa87e4f); /* 57 */
348 II (d, a, b, c, 15, S42, 0xfe2ce6e0); /* 58 */
349 II (c, d, a, b, 6, S43, 0xa3014314); /* 59 */
350 II (b, c, d, a, 13, S44, 0x4e0811a1); /* 60 */
351 II (a, b, c, d, 4, S41, 0xf7537e82); /* 61 */
352 II (d, a, b, c, 11, S42, 0xbd3af235); /* 62 */
353 II (c, d, a, b, 2, S43, 0x2ad7d2bb); /* 63 */
354 II (b, c, d, a, 9, S44, 0xeb86d391); /* 64 */
371 ctx_dump(MD5_CTX* ctx)
373 static char buf[1024];
374 sprintf(buf, "{A=%x,B=%x,C=%x,D=%x,%d,%d(%d)}",
375 ctx->A, ctx->B, ctx->C, ctx->D,
376 ctx->bytes_low, ctx->bytes_high, (ctx->bytes_low&0x3F));
383 MD5Update(MD5_CTX* ctx, const U8* buf, STRLEN len)
386 STRLEN fill = ctx->bytes_low & 0x3F;
389 static int ucount = 0;
390 fprintf(stderr,"%5i: Update(%s, %p, %d)\n", ++ucount, ctx_dump(ctx),
394 ctx->bytes_low += len;
395 if (ctx->bytes_low < len) /* wrap around */
399 STRLEN missing = 64 - fill;
401 Copy(buf, ctx->buffer + fill, len, U8);
404 Copy(buf, ctx->buffer + fill, missing, U8);
405 MD5Transform(ctx, ctx->buffer, 1);
412 MD5Transform(ctx, buf, blocks);
413 if ( (len &= 0x3F)) {
414 Copy(buf + (blocks << 6), ctx->buffer, len, U8);
420 MD5Final(U8* digest, MD5_CTX *ctx)
422 STRLEN fill = ctx->bytes_low & 0x3F;
423 STRLEN padlen = (fill < 56 ? 56 : 120) - fill;
424 U32 bits_low, bits_high;
426 fprintf(stderr," Final: %s\n", ctx_dump(ctx));
428 Copy(PADDING, ctx->buffer + fill, padlen, U8);
431 bits_low = ctx->bytes_low << 3;
432 bits_high = (ctx->bytes_high << 3) | (ctx->bytes_low >> 29);
434 *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_low); fill += 4;
435 *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_high); fill += 4;
437 u2s(bits_low, ctx->buffer + fill); fill += 4;
438 u2s(bits_high, ctx->buffer + fill); fill += 4;
441 MD5Transform(ctx, ctx->buffer, fill >> 6);
443 fprintf(stderr," Result: %s\n", ctx_dump(ctx));
447 *(U32*)digest = BYTESWAP(ctx->A); digest += 4;
448 *(U32*)digest = BYTESWAP(ctx->B); digest += 4;
449 *(U32*)digest = BYTESWAP(ctx->C); digest += 4;
450 *(U32*)digest = BYTESWAP(ctx->D);
453 u2s(ctx->B, digest+4);
454 u2s(ctx->C, digest+8);
455 u2s(ctx->D, digest+12);
460 #define INT2PTR(any,d) (any)(d)
463 static MD5_CTX* get_md5_ctx(SV* sv)
468 MD5_CTX* ctx = INT2PTR(MD5_CTX*, SvIV(sv));
469 if (ctx && ctx->signature == MD5_CTX_SIGNATURE) {
474 croak("Not a reference to a Digest::MD5 object");
475 return (MD5_CTX*)0; /* some compilers insist on a return value */
479 static char* hex_16(const unsigned char* from, char* to)
481 static char *hexdigits = "0123456789abcdef";
482 const unsigned char *end = from + 16;
486 *d++ = hexdigits[(*from >> 4)];
487 *d++ = hexdigits[(*from & 0x0F)];
494 static char* base64_16(const unsigned char* from, char* to)
496 static char* base64 =
497 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
498 const unsigned char *end = from + 16;
499 unsigned char c1, c2, c3;
504 *d++ = base64[c1>>2];
506 *d++ = base64[(c1 & 0x3) << 4];
511 *d++ = base64[((c1 & 0x3) << 4) | ((c2 & 0xF0) >> 4)];
512 *d++ = base64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
513 *d++ = base64[c3 & 0x3F];
524 static SV* make_mortal_sv(const unsigned char *src, int type)
536 ret = hex_16(src, result);
540 ret = base64_16(src, result);
544 croak("Bad convertion type (%d)", type);
547 return sv_2mortal(newSVpv(ret,len));
551 /********************************************************************/
553 typedef PerlIO* InputStream;
555 MODULE = Digest::MD5 PACKAGE = Digest::MD5
565 if (!SvROK(xclass)) {
567 char *sclass = SvPV(xclass, my_na);
568 New(55, context, 1, MD5_CTX);
569 context->signature = MD5_CTX_SIGNATURE;
570 ST(0) = sv_newmortal();
571 sv_setref_pv(ST(0), sclass, (void*)context);
572 SvREADONLY_on(SvRV(ST(0)));
574 context = get_md5_ctx(xclass);
583 MD5_CTX* cont = get_md5_ctx(self);
584 char *myname = sv_reftype(SvRV(self),TRUE);
588 New(55, context, 1, MD5_CTX);
589 ST(0) = sv_newmortal();
590 sv_setref_pv(ST(0), myname , (void*)context);
591 SvREADONLY_on(SvRV(ST(0)));
592 memcpy(context,cont,sizeof(MD5_CTX));
605 MD5_CTX* context = get_md5_ctx(self);
610 for (i = 1; i < items; i++) {
611 data = (unsigned char *)(SvPVbyte(ST(i), len));
612 MD5Update(context, data, len);
614 XSRETURN(1); /* self */
621 MD5_CTX* context = get_md5_ctx(self);
622 STRLEN fill = context->bytes_low & 0x3F;
623 unsigned char buffer[4096];
628 /* The MD5Update() function is faster if it can work with
629 * complete blocks. This will fill up any buffered block
632 STRLEN missing = 64 - fill;
633 if ( (n = PerlIO_read(fh, buffer, missing)))
634 MD5Update(context, buffer, n);
636 XSRETURN(1); /* self */
639 /* Process blocks until EOF or error */
640 while ( (n = PerlIO_read(fh, buffer, sizeof(buffer)))) {
641 MD5Update(context, buffer, n);
644 if (PerlIO_error(fh)) {
645 croak("Reading from filehandle failed");
649 croak("No filehandle passed");
651 XSRETURN(1); /* self */
657 Digest::MD5::digest = F_BIN
658 Digest::MD5::hexdigest = F_HEX
659 Digest::MD5::b64digest = F_B64
661 unsigned char digeststr[16];
663 MD5Final(digeststr, context);
664 MD5Init(context); /* In case it is reused */
665 ST(0) = make_mortal_sv(digeststr, ix);
671 Digest::MD5::md5 = F_BIN
672 Digest::MD5::md5_hex = F_HEX
673 Digest::MD5::md5_base64 = F_B64
679 unsigned char digeststr[16];
687 SV* sv = SvRV(ST(0));
688 if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
689 msg = "probably called as method";
691 msg = "called with reference argument";
694 else if (items > 1) {
695 data = (unsigned char *)SvPVbyte(ST(0), len);
696 if (len == 11 && memEQ("Digest::MD5", data, 11)) {
697 msg = "probably called as class method";
701 char *f = (ix == F_BIN) ? "md5" :
702 (ix == F_HEX) ? "md5_hex" : "md5_base64";
703 warn("&Digest::MD5::%s function %s", f, msg);
707 for (i = 0; i < items; i++) {
708 data = (unsigned char *)(SvPVbyte(ST(i), len));
709 MD5Update(&ctx, data, len);
711 MD5Final(digeststr, &ctx);
712 ST(0) = make_mortal_sv(digeststr, ix);