1/* 2 * This library is free software; you can redistribute it and/or 3 * modify it under the same terms as Perl itself. 4 * 5 * Copyright 1998-2000 Gisle Aas. 6 * Copyright 1995-1996 Neil Winton. 7 * Copyright 1991-1992 RSA Data Security, Inc. 8 * 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: 12 * 13 * Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All 14 * rights reserved. 15 * 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 19 * or this function. 20 * 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. 25 * 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. 30 * 31 * These notices must be retained in any copies of any part of this 32 * documentation and/or software. 33 */ 34 35#define PERL_NO_GET_CONTEXT /* we want efficiency */ 36#include "EXTERN.h" 37#include "perl.h" 38#include "XSUB.h" 39#include <sys/types.h> 40#include <md5.h> 41 42#ifndef PERL_UNUSED_VAR 43# define PERL_UNUSED_VAR(x) ((void)x) 44#endif 45 46#ifndef PERL_MAGIC_ext 47# define PERL_MAGIC_ext '~' 48#endif 49 50#ifndef Newxz 51# define Newxz(v,n,t) Newz(0,v,n,t) 52#endif 53 54#ifndef SvMAGIC_set 55# define SvMAGIC_set(sv, mg) (SvMAGIC(sv) = (mg)) 56#endif 57 58#ifndef sv_magicext 59# define sv_magicext(sv, obj, type, vtbl, name, namlen) \ 60 THX_sv_magicext(aTHX_ sv, obj, type, vtbl, name, namlen) 61static MAGIC *THX_sv_magicext(pTHX_ SV *sv, SV *obj, int type, 62 MGVTBL const *vtbl, char const *name, I32 namlen) 63{ 64 MAGIC *mg; 65 if (obj || namlen) 66 /* exceeded intended usage of this reserve implementation */ 67 return NULL; 68 Newxz(mg, 1, MAGIC); 69 mg->mg_virtual = (MGVTBL*)vtbl; 70 mg->mg_type = type; 71 mg->mg_ptr = (char *)name; 72 mg->mg_len = -1; 73 (void) SvUPGRADE(sv, SVt_PVMG); 74 mg->mg_moremagic = SvMAGIC(sv); 75 SvMAGIC_set(sv, mg); 76 SvMAGICAL_off(sv); 77 mg_magical(sv); 78 return mg; 79} 80#endif 81 82#if PERL_VERSION < 8 83# undef SvPVbyte 84# define SvPVbyte(sv, lp) (sv_utf8_downgrade((sv), 0), SvPV((sv), (lp))) 85#endif 86 87#if defined(USE_ITHREADS) && defined(MGf_DUP) 88STATIC int dup_md5_ctx(pTHX_ MAGIC *mg, CLONE_PARAMS *params) 89{ 90 MD5_CTX *new_ctx; 91 PERL_UNUSED_VAR(params); 92 New(55, new_ctx, 1, MD5_CTX); 93 memcpy(new_ctx, mg->mg_ptr, sizeof(MD5_CTX)); 94 mg->mg_ptr = (char *)new_ctx; 95 return 0; 96} 97#endif 98 99#if defined(MGf_DUP) && defined(USE_ITHREADS) 100STATIC const MGVTBL vtbl_md5 = { 101 NULL, /* get */ 102 NULL, /* set */ 103 NULL, /* len */ 104 NULL, /* clear */ 105 NULL, /* free */ 106 NULL, /* copy */ 107 dup_md5_ctx, /* dup */ 108 NULL /* local */ 109}; 110#else 111/* declare as 5 member, not normal 8 to save image space*/ 112STATIC const struct { 113 int (*svt_get)(SV* sv, MAGIC* mg); 114 int (*svt_set)(SV* sv, MAGIC* mg); 115 U32 (*svt_len)(SV* sv, MAGIC* mg); 116 int (*svt_clear)(SV* sv, MAGIC* mg); 117 int (*svt_free)(SV* sv, MAGIC* mg); 118} vtbl_md5 = { 119 NULL, NULL, NULL, NULL, NULL 120}; 121#endif 122 123static MD5_CTX* get_md5_ctx(pTHX_ SV* sv) 124{ 125 MAGIC *mg; 126 127 if (!sv_derived_from(sv, "Digest::MD5")) 128 croak("Not a reference to a Digest::MD5 object"); 129 130 for (mg = SvMAGIC(SvRV(sv)); mg; mg = mg->mg_moremagic) { 131 if (mg->mg_type == PERL_MAGIC_ext 132 && mg->mg_virtual == (const MGVTBL * const)&vtbl_md5) { 133 return (MD5_CTX *)mg->mg_ptr; 134 } 135 } 136 137 croak("Failed to get MD5_CTX pointer"); 138 return (MD5_CTX*)0; /* some compilers insist on a return value */ 139} 140 141static SV * new_md5_ctx(pTHX_ MD5_CTX *context, const char *klass) 142{ 143 SV *sv = newSV(0); 144 SV *obj = newRV_noinc(sv); 145#ifdef USE_ITHREADS 146 MAGIC *mg; 147#endif 148 149 sv_bless(obj, gv_stashpv(klass, 0)); 150 151#ifdef USE_ITHREADS 152 mg = 153#endif 154 sv_magicext(sv, NULL, PERL_MAGIC_ext, (const MGVTBL * const)&vtbl_md5, (const char *)context, 0); 155 156#if defined(USE_ITHREADS) && defined(MGf_DUP) 157 mg->mg_flags |= MGf_DUP; 158#endif 159 160 return obj; 161} 162 163 164static char* hex_16(const unsigned char* from, char* to) 165{ 166 static const char hexdigits[] = "0123456789abcdef"; 167 const unsigned char *end = from + 16; 168 char *d = to; 169 170 while (from < end) { 171 *d++ = hexdigits[(*from >> 4)]; 172 *d++ = hexdigits[(*from & 0x0F)]; 173 from++; 174 } 175 *d = '\0'; 176 return to; 177} 178 179static char* base64_16(const unsigned char* from, char* to) 180{ 181 static const char base64[] = 182 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; 183 const unsigned char *end = from + 16; 184 unsigned char c1, c2, c3; 185 char *d = to; 186 187 while (1) { 188 c1 = *from++; 189 *d++ = base64[c1>>2]; 190 if (from == end) { 191 *d++ = base64[(c1 & 0x3) << 4]; 192 break; 193 } 194 c2 = *from++; 195 c3 = *from++; 196 *d++ = base64[((c1 & 0x3) << 4) | ((c2 & 0xF0) >> 4)]; 197 *d++ = base64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)]; 198 *d++ = base64[c3 & 0x3F]; 199 } 200 *d = '\0'; 201 return to; 202} 203 204/* Formats */ 205#define F_BIN 0 206#define F_HEX 1 207#define F_B64 2 208 209static SV* make_mortal_sv(pTHX_ const unsigned char *src, int type) 210{ 211 STRLEN len; 212 char result[33]; 213 char *ret; 214 215 switch (type) { 216 case F_BIN: 217 ret = (char*)src; 218 len = 16; 219 break; 220 case F_HEX: 221 ret = hex_16(src, result); 222 len = 32; 223 break; 224 case F_B64: 225 ret = base64_16(src, result); 226 len = 22; 227 break; 228 default: 229 croak("Bad conversion type (%d)", type); 230 break; 231 } 232 return sv_2mortal(newSVpv(ret,len)); 233} 234 235 236/********************************************************************/ 237 238typedef PerlIO* InputStream; 239 240MODULE = Digest::MD5 PACKAGE = Digest::MD5 241 242PROTOTYPES: DISABLE 243 244void 245new(xclass) 246 SV* xclass 247 PREINIT: 248 MD5_CTX* context; 249 PPCODE: 250 if (!SvROK(xclass)) { 251 STRLEN my_na; 252 const char *sclass = SvPV(xclass, my_na); 253 New(55, context, 1, MD5_CTX); 254 ST(0) = sv_2mortal(new_md5_ctx(aTHX_ context, sclass)); 255 } else { 256 context = get_md5_ctx(aTHX_ xclass); 257 } 258 MD5Init(context); 259 XSRETURN(1); 260 261void 262clone(self) 263 SV* self 264 PREINIT: 265 MD5_CTX* cont = get_md5_ctx(aTHX_ self); 266 const char *myname = sv_reftype(SvRV(self),TRUE); 267 MD5_CTX* context; 268 PPCODE: 269 New(55, context, 1, MD5_CTX); 270 ST(0) = sv_2mortal(new_md5_ctx(aTHX_ context, myname)); 271 memcpy(context,cont,sizeof(MD5_CTX)); 272 XSRETURN(1); 273 274void 275DESTROY(context) 276 MD5_CTX* context 277 CODE: 278 Safefree(context); 279 280void 281add(self, ...) 282 SV* self 283 PREINIT: 284 MD5_CTX* context = get_md5_ctx(aTHX_ self); 285 int i; 286 unsigned char *data; 287 STRLEN len; 288 PPCODE: 289 for (i = 1; i < items; i++) { 290 U32 had_utf8 = SvUTF8(ST(i)); 291 data = (unsigned char *)(SvPVbyte(ST(i), len)); 292 MD5Update(context, data, len); 293 if (had_utf8) sv_utf8_upgrade(ST(i)); 294 } 295 XSRETURN(1); /* self */ 296 297void 298addfile(self, fh) 299 SV* self 300 InputStream fh 301 PREINIT: 302 MD5_CTX* context = get_md5_ctx(aTHX_ self); 303 STRLEN fill = (context->count >> 3) & (MD5_BLOCK_LENGTH - 1); 304#ifdef USE_HEAP_INSTEAD_OF_STACK 305 unsigned char* buffer; 306#else 307 unsigned char buffer[4096]; 308#endif 309 int n; 310 CODE: 311 if (fh) { 312#ifdef USE_HEAP_INSTEAD_OF_STACK 313 New(0, buffer, 4096, unsigned char); 314 assert(buffer); 315#endif 316 if (fill) { 317 /* The MD5Update() function is faster if it can work with 318 * complete blocks. This will fill up any buffered block 319 * first. 320 */ 321 STRLEN missing = 64 - fill; 322 if ( (n = PerlIO_read(fh, buffer, missing)) > 0) 323 MD5Update(context, buffer, n); 324 else 325 XSRETURN(1); /* self */ 326 } 327 328 /* Process blocks until EOF or error */ 329 while ( (n = PerlIO_read(fh, buffer, sizeof(buffer))) > 0) { 330 MD5Update(context, buffer, n); 331 } 332#ifdef USE_HEAP_INSTEAD_OF_STACK 333 Safefree(buffer); 334#endif 335 if (PerlIO_error(fh)) { 336 croak("Reading from filehandle failed"); 337 } 338 } 339 else { 340 croak("No filehandle passed"); 341 } 342 XSRETURN(1); /* self */ 343 344void 345digest(context) 346 MD5_CTX* context 347 ALIAS: 348 Digest::MD5::digest = F_BIN 349 Digest::MD5::hexdigest = F_HEX 350 Digest::MD5::b64digest = F_B64 351 PREINIT: 352 unsigned char digeststr[16]; 353 PPCODE: 354 MD5Final(digeststr, context); 355 MD5Init(context); /* In case it is reused */ 356 ST(0) = make_mortal_sv(aTHX_ digeststr, ix); 357 XSRETURN(1); 358 359void 360context(ctx, ...) 361 MD5_CTX* ctx 362 PREINIT: 363 char out[16]; 364 U32 w; 365 PPCODE: 366 if (items > 2) { 367 STRLEN len; 368 ctx->count = SvUV(ST(1)) << 3; 369 unsigned char *buf = (unsigned char *)(SvPV(ST(2), len)); 370 ctx->state[0] = buf[ 0] | (buf[ 1]<<8) | (buf[ 2]<<16) | (buf[ 3]<<24); 371 ctx->state[1] = buf[ 4] | (buf[ 5]<<8) | (buf[ 6]<<16) | (buf[ 7]<<24); 372 ctx->state[2] = buf[ 8] | (buf[ 9]<<8) | (buf[10]<<16) | (buf[11]<<24); 373 ctx->state[3] = buf[12] | (buf[13]<<8) | (buf[14]<<16) | (buf[15]<<24); 374 if (items == 4) { 375 buf = (unsigned char *)(SvPV(ST(3), len)); 376 MD5Update(ctx, buf, len); 377 } 378 XSRETURN(1); /* ctx */ 379 } else if (items != 1) { 380 XSRETURN(0); 381 } 382 383 w=ctx->state[0]; out[ 0]=(char)w; out[ 1]=(char)(w>>8); out[ 2]=(char)(w>>16); out[ 3]=(char)(w>>24); 384 w=ctx->state[0]; out[ 4]=(char)w; out[ 5]=(char)(w>>8); out[ 6]=(char)(w>>16); out[ 7]=(char)(w>>24); 385 w=ctx->state[0]; out[ 8]=(char)w; out[ 9]=(char)(w>>8); out[10]=(char)(w>>16); out[11]=(char)(w>>24); 386 w=ctx->state[0]; out[12]=(char)w; out[13]=(char)(w>>8); out[14]=(char)(w>>16); out[15]=(char)(w>>24); 387 388 EXTEND(SP, 3); 389 ST(0) = sv_2mortal(newSViv((ctx->count >> 3) 390 - ((ctx->count >> 3) % MD5_BLOCK_LENGTH))); 391 ST(1) = sv_2mortal(newSVpv(out, 16)); 392 393 if (((ctx->count >> 3) & (MD5_BLOCK_LENGTH - 1)) == 0) 394 XSRETURN(2); 395 396 ST(2) = sv_2mortal(newSVpv((char *)ctx->buffer, 397 (ctx->count >> 3) & (MD5_BLOCK_LENGTH - 1))); 398 399 XSRETURN(3); 400 401void 402md5(...) 403 ALIAS: 404 Digest::MD5::md5 = F_BIN 405 Digest::MD5::md5_hex = F_HEX 406 Digest::MD5::md5_base64 = F_B64 407 PREINIT: 408 MD5_CTX ctx; 409 int i; 410 unsigned char *data; 411 STRLEN len; 412 unsigned char digeststr[16]; 413 PPCODE: 414 MD5Init(&ctx); 415 416 if ((PL_dowarn & G_WARN_ON) || ckWARN(WARN_SYNTAX)) { 417 const char *msg = 0; 418 if (items == 1) { 419 if (SvROK(ST(0))) { 420 SV* sv = SvRV(ST(0)); 421 char *name; 422 if (SvOBJECT(sv) && (name = HvNAME(SvSTASH(sv))) 423 && strEQ(name, "Digest::MD5")) 424 msg = "probably called as method"; 425 else 426 msg = "called with reference argument"; 427 } 428 } 429 else if (items > 1) { 430 data = (unsigned char *)SvPV(ST(0), len); 431 if (len == 11 && memEQ("Digest::MD5", data, 11)) { 432 msg = "probably called as class method"; 433 } 434 else if (SvROK(ST(0))) { 435 SV* sv = SvRV(ST(0)); 436 char *name; 437 if (SvOBJECT(sv) && (name = HvNAME(SvSTASH(sv))) 438 && strEQ(name, "Digest::MD5")) 439 msg = "probably called as method"; 440 } 441 } 442 if (msg) { 443 const char *f = (ix == F_BIN) ? "md5" : 444 (ix == F_HEX) ? "md5_hex" : "md5_base64"; 445 warn("&Digest::MD5::%s function %s", f, msg); 446 } 447 } 448 449 for (i = 0; i < items; i++) { 450 U32 had_utf8 = SvUTF8(ST(i)); 451 data = (unsigned char *)(SvPVbyte(ST(i), len)); 452 MD5Update(&ctx, data, len); 453 if (had_utf8) sv_utf8_upgrade(ST(i)); 454 } 455 MD5Final(digeststr, &ctx); 456 ST(0) = make_mortal_sv(aTHX_ digeststr, ix); 457 XSRETURN(1); 458