1 /* $Id: MD5.xs,v 1.35 2003/01/05 00:54:17 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>
54 #if PATCHLEVEL <= 4 && !defined(PL_dowarn)
55 #define PL_dowarn dowarn
59 #if PERL_REVISION == 5 && PERL_VERSION < 7
60 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
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))
67 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
69 sv_utf8_downgrade(sv,0);
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.
83 #if BYTEORDER > 0x4321 || defined(TRUNCATE_U32)
84 #define TO32(x) ((x) & 0xFFFFffff)
85 #define TRUNC32(x) ((x) &= 0xFFFFffff)
88 #define TRUNC32(x) /*nothing*/
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.
96 #ifndef U32_ALIGNMENT_REQUIRED
97 #if BYTEORDER == 0x1234 /* 32-bit little endian */
98 #define BYTESWAP(x) (x) /* no-op */
100 #elif BYTEORDER == 0x4321 /* 32-bit big endian */
101 #define BYTESWAP(x) ((((x)&0xFF)<<24) \
103 |(((x)&0x0000FF00)<<8) \
104 |(((x)&0x00FF0000)>>8) )
109 static void u2s(U32 u, U8* s)
111 *s++ = (U8)(u & 0xFF);
112 *s++ = (U8)((u >> 8) & 0xFF);
113 *s++ = (U8)((u >> 16) & 0xFF);
114 *s = (U8)((u >> 24) & 0xFF);
117 #define s2u(s,u) ((u) = (U32)(*s) | \
118 ((U32)(*(s+1)) << 8) | \
119 ((U32)(*(s+2)) << 16) | \
120 ((U32)(*(s+3)) << 24))
123 #define MD5_CTX_SIGNATURE 200003165
125 /* This stucture keeps the current state of algorithm.
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 */
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
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
147 /* Constants for MD5Transform routine.
166 /* F, G, H and I are basic MD5 functions.
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)))
173 /* ROTATE_LEFT rotates x left n bits.
175 #define ROTATE_LEFT(x, n) (((x) << (n) | ((x) >> (32-(n)))))
177 /* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
178 * Rotation is separate from addition to prevent recomputation.
180 #define FF(a, b, c, d, s, ac) \
181 (a) += F ((b), (c), (d)) + (NEXTx) + (U32)(ac); \
183 (a) = ROTATE_LEFT ((a), (s)); \
187 #define GG(a, b, c, d, x, s, ac) \
188 (a) += G ((b), (c), (d)) + X[x] + (U32)(ac); \
190 (a) = ROTATE_LEFT ((a), (s)); \
194 #define HH(a, b, c, d, x, s, ac) \
195 (a) += H ((b), (c), (d)) + X[x] + (U32)(ac); \
197 (a) = ROTATE_LEFT ((a), (s)); \
201 #define II(a, b, c, d, x, s, ac) \
202 (a) += I ((b), (c), (d)) + X[x] + (U32)(ac); \
204 (a) = ROTATE_LEFT ((a), (s)); \
210 MD5Init(MD5_CTX *ctx)
219 ctx->bytes_low = ctx->bytes_high = 0;
224 MD5Transform(MD5_CTX* ctx, const U8* buf, STRLEN blocks)
227 static int tcount = 0;
235 #ifndef U32_ALIGNMENT_REQUIRED
236 const U32 *x = (U32*)buf; /* really just type casting */
245 #if BYTEORDER == 0x1234 && !defined(U32_ALIGNMENT_REQUIRED)
249 U32 X[16]; /* converted values, used in round 2-4 */
253 #define NEXTx (tmp=*x++, *uptr++ = BYTESWAP(tmp))
255 #define NEXTx (s2u(buf,tmp), buf += 4, *uptr++ = tmp)
260 if (buf == ctx->buffer)
261 fprintf(stderr,"%5d: Transform ctx->buffer", ++tcount);
263 fprintf(stderr,"%5d: Transform %p (%d)", ++tcount, buf, blocks);
268 for (i = 0; i < 16; i++) {
269 fprintf(stderr,"%x,", x[i]);
271 fprintf(stderr,"]\n");
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 */
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 */
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 */
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 */
362 ctx_dump(MD5_CTX* ctx)
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));
374 MD5Update(MD5_CTX* ctx, const U8* buf, STRLEN len)
377 STRLEN fill = ctx->bytes_low & 0x3F;
380 static int ucount = 0;
381 fprintf(stderr,"%5i: Update(%s, %p, %d)\n", ++ucount, ctx_dump(ctx),
385 ctx->bytes_low += len;
386 if (ctx->bytes_low < len) /* wrap around */
390 STRLEN missing = 64 - fill;
392 Copy(buf, ctx->buffer + fill, len, U8);
395 Copy(buf, ctx->buffer + fill, missing, U8);
396 MD5Transform(ctx, ctx->buffer, 1);
403 MD5Transform(ctx, buf, blocks);
404 if ( (len &= 0x3F)) {
405 Copy(buf + (blocks << 6), ctx->buffer, len, U8);
411 MD5Final(U8* digest, MD5_CTX *ctx)
413 STRLEN fill = ctx->bytes_low & 0x3F;
414 STRLEN padlen = (fill < 56 ? 56 : 120) - fill;
415 U32 bits_low, bits_high;
417 fprintf(stderr," Final: %s\n", ctx_dump(ctx));
419 Copy(PADDING, ctx->buffer + fill, padlen, U8);
422 bits_low = ctx->bytes_low << 3;
423 bits_high = (ctx->bytes_high << 3) | (ctx->bytes_low >> 29);
425 *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_low); fill += 4;
426 *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_high); fill += 4;
428 u2s(bits_low, ctx->buffer + fill); fill += 4;
429 u2s(bits_high, ctx->buffer + fill); fill += 4;
432 MD5Transform(ctx, ctx->buffer, fill >> 6);
434 fprintf(stderr," Result: %s\n", ctx_dump(ctx));
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);
444 u2s(ctx->B, digest+4);
445 u2s(ctx->C, digest+8);
446 u2s(ctx->D, digest+12);
451 #define INT2PTR(any,d) (any)(d)
454 static MD5_CTX* get_md5_ctx(SV* sv)
459 MD5_CTX* ctx = INT2PTR(MD5_CTX*, SvIV(sv));
460 if (ctx && ctx->signature == MD5_CTX_SIGNATURE) {
465 croak("Not a reference to a Digest::MD5 object");
466 return (MD5_CTX*)0; /* some compilers insist on a return value */
470 static char* hex_16(const unsigned char* from, char* to)
472 static char *hexdigits = "0123456789abcdef";
473 const unsigned char *end = from + 16;
477 *d++ = hexdigits[(*from >> 4)];
478 *d++ = hexdigits[(*from & 0x0F)];
485 static char* base64_16(const unsigned char* from, char* to)
487 static char* base64 =
488 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
489 const unsigned char *end = from + 16;
490 unsigned char c1, c2, c3;
495 *d++ = base64[c1>>2];
497 *d++ = base64[(c1 & 0x3) << 4];
502 *d++ = base64[((c1 & 0x3) << 4) | ((c2 & 0xF0) >> 4)];
503 *d++ = base64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
504 *d++ = base64[c3 & 0x3F];
515 static SV* make_mortal_sv(const unsigned char *src, int type)
527 ret = hex_16(src, result);
531 ret = base64_16(src, result);
535 croak("Bad convertion type (%d)", type);
538 return sv_2mortal(newSVpv(ret,len));
542 /********************************************************************/
544 typedef PerlIO* InputStream;
546 MODULE = Digest::MD5 PACKAGE = Digest::MD5
556 if (!SvROK(xclass)) {
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)));
565 context = get_md5_ctx(xclass);
574 MD5_CTX* cont = get_md5_ctx(self);
575 char *myname = sv_reftype(SvRV(self),TRUE);
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));
596 MD5_CTX* context = get_md5_ctx(self);
601 for (i = 1; i < items; i++) {
602 data = (unsigned char *)(SvPVbyte(ST(i), len));
603 MD5Update(context, data, len);
605 XSRETURN(1); /* self */
612 MD5_CTX* context = get_md5_ctx(self);
613 STRLEN fill = context->bytes_low & 0x3F;
614 unsigned char buffer[4096];
619 /* The MD5Update() function is faster if it can work with
620 * complete blocks. This will fill up any buffered block
623 STRLEN missing = 64 - fill;
624 if ( (n = PerlIO_read(fh, buffer, missing)))
625 MD5Update(context, buffer, n);
627 XSRETURN(1); /* self */
630 /* Process blocks until EOF */
631 while ( (n = PerlIO_read(fh, buffer, sizeof(buffer)))) {
632 MD5Update(context, buffer, n);
635 XSRETURN(1); /* self */
641 Digest::MD5::digest = F_BIN
642 Digest::MD5::hexdigest = F_HEX
643 Digest::MD5::b64digest = F_B64
645 unsigned char digeststr[16];
647 MD5Final(digeststr, context);
648 MD5Init(context); /* In case it is reused */
649 ST(0) = make_mortal_sv(digeststr, ix);
655 Digest::MD5::md5 = F_BIN
656 Digest::MD5::md5_hex = F_HEX
657 Digest::MD5::md5_base64 = F_B64
663 unsigned char digeststr[16];
671 SV* sv = SvRV(ST(0));
672 if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
673 msg = "probably called as method";
675 msg = "called with reference argument";
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";
685 char *f = (ix == F_BIN) ? "md5" :
686 (ix == F_HEX) ? "md5_hex" : "md5_base64";
687 warn("&Digest::MD5::%s function %s", f, msg);
691 for (i = 0; i < items; i++) {
692 data = (unsigned char *)(SvPVbyte(ST(i), len));
693 MD5Update(&ctx, data, len);
695 MD5Final(digeststr, &ctx);
696 ST(0) = make_mortal_sv(digeststr, ix);