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