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.
47 #include "patchlevel.h"
48 #if PATCHLEVEL <= 4 && !defined(PL_dowarn)
49 #define PL_dowarn dowarn
53 #if PERL_REVISION == 5 && PERL_VERSION < 7
54 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
56 #define SvPVbyte(sv, lp) \
57 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
58 ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
61 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
63 sv_utf8_downgrade(sv,0);
71 /* Perl does not guarantee that U32 is exactly 32 bits. Some system
72 * has no integral type with exactly 32 bits. For instance, A Cray has
73 * short, int and long all at 64 bits so we need to apply this macro
74 * to reduce U32 values to 32 bits at appropriate places. If U32
75 * really does have 32 bits then this is a no-op.
77 #if BYTEORDER > 0x4321 || defined(TRUNCATE_U32)
78 #define TO32(x) ((x) & 0xFFFFffff)
79 #define TRUNC32(x) ((x) &= 0xFFFFffff)
82 #define TRUNC32(x) /*nothing*/
85 /* The MD5 algorithm is defined in terms of little endian 32-bit
86 * values. The following macros (and functions) allow us to convert
87 * between native integers and such values.
90 #ifndef U32_ALIGNMENT_REQUIRED
91 #if BYTEORDER == 0x1234 /* 32-bit little endian */
92 #define BYTESWAP(x) (x) /* no-op */
94 #elif BYTEORDER == 0x4321 /* 32-bit big endian */
95 #define BYTESWAP(x) ((((x)&0xFF)<<24) \
97 |(((x)&0x0000FF00)<<8) \
98 |(((x)&0x00FF0000)>>8) )
103 static void u2s(U32 u, U8* s)
105 *s++ = (U8)(u & 0xFF);
106 *s++ = (U8)((u >> 8) & 0xFF);
107 *s++ = (U8)((u >> 16) & 0xFF);
108 *s = (U8)((u >> 24) & 0xFF);
111 #define s2u(s,u) ((u) = (U32)(*s) | \
112 ((U32)(*(s+1)) << 8) | \
113 ((U32)(*(s+2)) << 16) | \
114 ((U32)(*(s+3)) << 24))
117 #define MD5_CTX_SIGNATURE 200003165
119 /* This stucture keeps the current state of algorithm.
122 U32 signature; /* safer cast in get_md5_ctx() */
123 U32 A, B, C, D; /* current digest */
124 U32 bytes_low; /* counts bytes in message */
125 U32 bytes_high; /* turn it into a 64-bit counter */
126 U8 buffer[128]; /* collect complete 64 byte blocks */
130 /* Padding is added at the end of the message in order to fill a
131 * complete 64 byte block (- 8 bytes for the message length). The
132 * padding is also the reason the buffer in MD5_CTX have to be
135 static unsigned char PADDING[64] = {
136 0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
137 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
138 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
141 /* Constants for MD5Transform routine.
160 /* F, G, H and I are basic MD5 functions.
162 #define F(x, y, z) ((((x) & ((y) ^ (z))) ^ (z)))
163 #define G(x, y, z) F(z, x, y)
164 #define H(x, y, z) ((x) ^ (y) ^ (z))
165 #define I(x, y, z) ((y) ^ ((x) | (~z)))
167 /* ROTATE_LEFT rotates x left n bits.
169 #define ROTATE_LEFT(x, n) (((x) << (n) | ((x) >> (32-(n)))))
171 /* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
172 * Rotation is separate from addition to prevent recomputation.
174 #define FF(a, b, c, d, s, ac) \
175 (a) += F ((b), (c), (d)) + (NEXTx) + (U32)(ac); \
177 (a) = ROTATE_LEFT ((a), (s)); \
181 #define GG(a, b, c, d, x, s, ac) \
182 (a) += G ((b), (c), (d)) + X[x] + (U32)(ac); \
184 (a) = ROTATE_LEFT ((a), (s)); \
188 #define HH(a, b, c, d, x, s, ac) \
189 (a) += H ((b), (c), (d)) + X[x] + (U32)(ac); \
191 (a) = ROTATE_LEFT ((a), (s)); \
195 #define II(a, b, c, d, x, s, ac) \
196 (a) += I ((b), (c), (d)) + X[x] + (U32)(ac); \
198 (a) = ROTATE_LEFT ((a), (s)); \
204 MD5Init(MD5_CTX *ctx)
213 ctx->bytes_low = ctx->bytes_high = 0;
218 MD5Transform(MD5_CTX* ctx, const U8* buf, STRLEN blocks)
221 static int tcount = 0;
229 #ifndef U32_ALIGNMENT_REQUIRED
230 const U32 *x = (U32*)buf; /* really just type casting */
239 #if BYTEORDER == 0x1234 && !defined(U32_ALIGNMENT_REQUIRED)
243 U32 X[16]; /* converted values, used in round 2-4 */
247 #define NEXTx (tmp=*x++, *uptr++ = BYTESWAP(tmp))
249 #define NEXTx (s2u(buf,tmp), buf += 4, *uptr++ = tmp)
254 if (buf == ctx->buffer)
255 fprintf(stderr,"%5d: Transform ctx->buffer", ++tcount);
257 fprintf(stderr,"%5d: Transform %p (%d)", ++tcount, buf, blocks);
262 for (i = 0; i < 16; i++) {
263 fprintf(stderr,"%x,", x[i]);
265 fprintf(stderr,"]\n");
270 FF (a, b, c, d, S11, 0xd76aa478); /* 1 */
271 FF (d, a, b, c, S12, 0xe8c7b756); /* 2 */
272 FF (c, d, a, b, S13, 0x242070db); /* 3 */
273 FF (b, c, d, a, S14, 0xc1bdceee); /* 4 */
274 FF (a, b, c, d, S11, 0xf57c0faf); /* 5 */
275 FF (d, a, b, c, S12, 0x4787c62a); /* 6 */
276 FF (c, d, a, b, S13, 0xa8304613); /* 7 */
277 FF (b, c, d, a, S14, 0xfd469501); /* 8 */
278 FF (a, b, c, d, S11, 0x698098d8); /* 9 */
279 FF (d, a, b, c, S12, 0x8b44f7af); /* 10 */
280 FF (c, d, a, b, S13, 0xffff5bb1); /* 11 */
281 FF (b, c, d, a, S14, 0x895cd7be); /* 12 */
282 FF (a, b, c, d, S11, 0x6b901122); /* 13 */
283 FF (d, a, b, c, S12, 0xfd987193); /* 14 */
284 FF (c, d, a, b, S13, 0xa679438e); /* 15 */
285 FF (b, c, d, a, S14, 0x49b40821); /* 16 */
288 GG (a, b, c, d, 1, S21, 0xf61e2562); /* 17 */
289 GG (d, a, b, c, 6, S22, 0xc040b340); /* 18 */
290 GG (c, d, a, b, 11, S23, 0x265e5a51); /* 19 */
291 GG (b, c, d, a, 0, S24, 0xe9b6c7aa); /* 20 */
292 GG (a, b, c, d, 5, S21, 0xd62f105d); /* 21 */
293 GG (d, a, b, c, 10, S22, 0x2441453); /* 22 */
294 GG (c, d, a, b, 15, S23, 0xd8a1e681); /* 23 */
295 GG (b, c, d, a, 4, S24, 0xe7d3fbc8); /* 24 */
296 GG (a, b, c, d, 9, S21, 0x21e1cde6); /* 25 */
297 GG (d, a, b, c, 14, S22, 0xc33707d6); /* 26 */
298 GG (c, d, a, b, 3, S23, 0xf4d50d87); /* 27 */
299 GG (b, c, d, a, 8, S24, 0x455a14ed); /* 28 */
300 GG (a, b, c, d, 13, S21, 0xa9e3e905); /* 29 */
301 GG (d, a, b, c, 2, S22, 0xfcefa3f8); /* 30 */
302 GG (c, d, a, b, 7, S23, 0x676f02d9); /* 31 */
303 GG (b, c, d, a, 12, S24, 0x8d2a4c8a); /* 32 */
306 HH (a, b, c, d, 5, S31, 0xfffa3942); /* 33 */
307 HH (d, a, b, c, 8, S32, 0x8771f681); /* 34 */
308 HH (c, d, a, b, 11, S33, 0x6d9d6122); /* 35 */
309 HH (b, c, d, a, 14, S34, 0xfde5380c); /* 36 */
310 HH (a, b, c, d, 1, S31, 0xa4beea44); /* 37 */
311 HH (d, a, b, c, 4, S32, 0x4bdecfa9); /* 38 */
312 HH (c, d, a, b, 7, S33, 0xf6bb4b60); /* 39 */
313 HH (b, c, d, a, 10, S34, 0xbebfbc70); /* 40 */
314 HH (a, b, c, d, 13, S31, 0x289b7ec6); /* 41 */
315 HH (d, a, b, c, 0, S32, 0xeaa127fa); /* 42 */
316 HH (c, d, a, b, 3, S33, 0xd4ef3085); /* 43 */
317 HH (b, c, d, a, 6, S34, 0x4881d05); /* 44 */
318 HH (a, b, c, d, 9, S31, 0xd9d4d039); /* 45 */
319 HH (d, a, b, c, 12, S32, 0xe6db99e5); /* 46 */
320 HH (c, d, a, b, 15, S33, 0x1fa27cf8); /* 47 */
321 HH (b, c, d, a, 2, S34, 0xc4ac5665); /* 48 */
324 II (a, b, c, d, 0, S41, 0xf4292244); /* 49 */
325 II (d, a, b, c, 7, S42, 0x432aff97); /* 50 */
326 II (c, d, a, b, 14, S43, 0xab9423a7); /* 51 */
327 II (b, c, d, a, 5, S44, 0xfc93a039); /* 52 */
328 II (a, b, c, d, 12, S41, 0x655b59c3); /* 53 */
329 II (d, a, b, c, 3, S42, 0x8f0ccc92); /* 54 */
330 II (c, d, a, b, 10, S43, 0xffeff47d); /* 55 */
331 II (b, c, d, a, 1, S44, 0x85845dd1); /* 56 */
332 II (a, b, c, d, 8, S41, 0x6fa87e4f); /* 57 */
333 II (d, a, b, c, 15, S42, 0xfe2ce6e0); /* 58 */
334 II (c, d, a, b, 6, S43, 0xa3014314); /* 59 */
335 II (b, c, d, a, 13, S44, 0x4e0811a1); /* 60 */
336 II (a, b, c, d, 4, S41, 0xf7537e82); /* 61 */
337 II (d, a, b, c, 11, S42, 0xbd3af235); /* 62 */
338 II (c, d, a, b, 2, S43, 0x2ad7d2bb); /* 63 */
339 II (b, c, d, a, 9, S44, 0xeb86d391); /* 64 */
356 ctx_dump(MD5_CTX* ctx)
358 static char buf[1024];
359 sprintf(buf, "{A=%x,B=%x,C=%x,D=%x,%d,%d(%d)}",
360 ctx->A, ctx->B, ctx->C, ctx->D,
361 ctx->bytes_low, ctx->bytes_high, (ctx->bytes_low&0x3F));
368 MD5Update(MD5_CTX* ctx, const U8* buf, STRLEN len)
371 STRLEN fill = ctx->bytes_low & 0x3F;
374 static int ucount = 0;
375 fprintf(stderr,"%5i: Update(%s, %p, %d)\n", ++ucount, ctx_dump(ctx),
379 ctx->bytes_low += len;
380 if (ctx->bytes_low < len) /* wrap around */
384 STRLEN missing = 64 - fill;
386 Copy(buf, ctx->buffer + fill, len, U8);
389 Copy(buf, ctx->buffer + fill, missing, U8);
390 MD5Transform(ctx, ctx->buffer, 1);
397 MD5Transform(ctx, buf, blocks);
398 if ( (len &= 0x3F)) {
399 Copy(buf + (blocks << 6), ctx->buffer, len, U8);
405 MD5Final(U8* digest, MD5_CTX *ctx)
407 STRLEN fill = ctx->bytes_low & 0x3F;
408 STRLEN padlen = (fill < 56 ? 56 : 120) - fill;
409 U32 bits_low, bits_high;
411 fprintf(stderr," Final: %s\n", ctx_dump(ctx));
413 Copy(PADDING, ctx->buffer + fill, padlen, U8);
416 bits_low = ctx->bytes_low << 3;
417 bits_high = (ctx->bytes_high << 3) | (ctx->bytes_low >> 29);
419 *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_low); fill += 4;
420 *(U32*)(ctx->buffer + fill) = BYTESWAP(bits_high); fill += 4;
422 u2s(bits_low, ctx->buffer + fill); fill += 4;
423 u2s(bits_high, ctx->buffer + fill); fill += 4;
426 MD5Transform(ctx, ctx->buffer, fill >> 6);
428 fprintf(stderr," Result: %s\n", ctx_dump(ctx));
432 *(U32*)digest = BYTESWAP(ctx->A); digest += 4;
433 *(U32*)digest = BYTESWAP(ctx->B); digest += 4;
434 *(U32*)digest = BYTESWAP(ctx->C); digest += 4;
435 *(U32*)digest = BYTESWAP(ctx->D);
438 u2s(ctx->B, digest+4);
439 u2s(ctx->C, digest+8);
440 u2s(ctx->D, digest+12);
445 #define INT2PTR(any,d) (any)(d)
448 static MD5_CTX* get_md5_ctx(SV* sv)
453 MD5_CTX* ctx = INT2PTR(MD5_CTX*, SvIV(sv));
454 if (ctx && ctx->signature == MD5_CTX_SIGNATURE) {
459 croak("Not a reference to a Digest::MD5 object");
460 return (MD5_CTX*)0; /* some compilers insist on a return value */
464 static char* hex_16(const unsigned char* from, char* to)
466 static char *hexdigits = "0123456789abcdef";
467 const unsigned char *end = from + 16;
471 *d++ = hexdigits[(*from >> 4)];
472 *d++ = hexdigits[(*from & 0x0F)];
479 static char* base64_16(const unsigned char* from, char* to)
481 static char* base64 =
482 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
483 const unsigned char *end = from + 16;
484 unsigned char c1, c2, c3;
489 *d++ = base64[c1>>2];
491 *d++ = base64[(c1 & 0x3) << 4];
496 *d++ = base64[((c1 & 0x3) << 4) | ((c2 & 0xF0) >> 4)];
497 *d++ = base64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
498 *d++ = base64[c3 & 0x3F];
509 static SV* make_mortal_sv(const unsigned char *src, int type)
521 ret = hex_16(src, result);
525 ret = base64_16(src, result);
529 croak("Bad convertion type (%d)", type);
532 return sv_2mortal(newSVpv(ret,len));
536 /********************************************************************/
538 typedef PerlIO* InputStream;
540 MODULE = Digest::MD5 PACKAGE = Digest::MD5
550 if (!SvROK(xclass)) {
552 char *sclass = SvPV(xclass, my_na);
553 New(55, context, 1, MD5_CTX);
554 context->signature = MD5_CTX_SIGNATURE;
555 ST(0) = sv_newmortal();
556 sv_setref_pv(ST(0), sclass, (void*)context);
557 SvREADONLY_on(SvRV(ST(0)));
559 context = get_md5_ctx(xclass);
568 MD5_CTX* cont = get_md5_ctx(self);
569 char *myname = sv_reftype(SvRV(self),TRUE);
573 New(55, context, 1, MD5_CTX);
574 ST(0) = sv_newmortal();
575 sv_setref_pv(ST(0), myname , (void*)context);
576 SvREADONLY_on(SvRV(ST(0)));
577 memcpy(context,cont,sizeof(MD5_CTX));
590 MD5_CTX* context = get_md5_ctx(self);
595 for (i = 1; i < items; i++) {
596 data = (unsigned char *)(SvPVbyte(ST(i), len));
597 MD5Update(context, data, len);
599 XSRETURN(1); /* self */
606 MD5_CTX* context = get_md5_ctx(self);
607 STRLEN fill = context->bytes_low & 0x3F;
608 unsigned char buffer[4096];
613 /* The MD5Update() function is faster if it can work with
614 * complete blocks. This will fill up any buffered block
617 STRLEN missing = 64 - fill;
618 if ( (n = PerlIO_read(fh, buffer, missing)))
619 MD5Update(context, buffer, n);
621 XSRETURN(1); /* self */
624 /* Process blocks until EOF */
625 while ( (n = PerlIO_read(fh, buffer, sizeof(buffer)))) {
626 MD5Update(context, buffer, n);
629 XSRETURN(1); /* self */
635 Digest::MD5::digest = F_BIN
636 Digest::MD5::hexdigest = F_HEX
637 Digest::MD5::b64digest = F_B64
639 unsigned char digeststr[16];
641 MD5Final(digeststr, context);
642 MD5Init(context); /* In case it is reused */
643 ST(0) = make_mortal_sv(digeststr, ix);
649 Digest::MD5::md5 = F_BIN
650 Digest::MD5::md5_hex = F_HEX
651 Digest::MD5::md5_base64 = F_B64
657 unsigned char digeststr[16];
665 SV* sv = SvRV(ST(0));
666 if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
667 msg = "probably called as method";
669 msg = "called with reference argument";
672 else if (items > 1) {
673 data = (unsigned char *)SvPVbyte(ST(0), len);
674 if (len == 11 && memEQ("Digest::MD5", data, 11)) {
675 msg = "probably called as class method";
679 char *f = (ix == F_BIN) ? "md5" :
680 (ix == F_HEX) ? "md5_hex" : "md5_base64";
681 warn("&Digest::MD5::%s function %s", f, msg);
685 for (i = 0; i < items; i++) {
686 data = (unsigned char *)(SvPVbyte(ST(i), len));
687 MD5Update(&ctx, data, len);
689 MD5Final(digeststr, &ctx);
690 ST(0) = make_mortal_sv(digeststr, ix);