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