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)
THX_sv_magicext(pTHX_ SV * sv,SV * obj,int type,MGVTBL const * vtbl,char const * name,I32 namlen)61 static 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)
dup_md5_ctx(pTHX_ MAGIC * mg,CLONE_PARAMS * params)88 STATIC 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)
100 STATIC 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*/
112 STATIC 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
get_md5_ctx(pTHX_ SV * sv)123 static 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
new_md5_ctx(pTHX_ MD5_CTX * context,const char * klass)141 static 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
hex_16(const unsigned char * from,char * to)164 static 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
base64_16(const unsigned char * from,char * to)179 static 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
make_mortal_sv(pTHX_ const unsigned char * src,int type)209 static 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
238 typedef PerlIO* InputStream;
239
240 MODULE = Digest::MD5 PACKAGE = Digest::MD5
241
242 PROTOTYPES: DISABLE
243
244 void
new(xclass)245 new(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
261 void
262 clone(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
274 void
275 DESTROY(context)
276 MD5_CTX* context
277 CODE:
278 Safefree(context);
279
280 void
281 add(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
297 void
298 addfile(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
344 void
345 digest(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
359 void
360 context(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
401 void
402 md5(...)
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