1 /* $Id: MD5.xs,v 1.45 2005/11/26 11:06:20 gisle Exp $ */
2
3 /*
4 * This library is free software; you can redistribute it and/or
5 * modify it under the same terms as Perl itself.
6 *
7 * Copyright 1998-2000 Gisle Aas.
8 * Copyright 1995-1996 Neil Winton.
9 * Copyright 1991-1992 RSA Data Security, Inc.
10 *
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:
14 *
15 * Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
16 * rights reserved.
17 *
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
21 * or this function.
22 *
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.
27 *
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.
32 *
33 * These notices must be retained in any copies of any part of this
34 * documentation and/or software.
35 */
36
37 #ifdef __cplusplus
38 extern "C" {
39 #endif
40 #define PERL_NO_GET_CONTEXT /* we want efficiency */
41 #include "EXTERN.h"
42 #include "perl.h"
43 #include "XSUB.h"
44 #ifdef __cplusplus
45 }
46 #endif
47 #include <sys/types.h>
48 #include <md5.h>
49
50 __RCSID("$MirOS: src/gnu/usr.bin/perl/ext/Digest/MD5/MD5.xs,v 1.3 2014/03/13 01:58:58 tg Exp $");
51
52 #ifndef PERL_VERSION
53 # include <patchlevel.h>
54 # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
55 # include <could_not_find_Perl_patchlevel.h>
56 # endif
57 # define PERL_REVISION 5
58 # define PERL_VERSION PATCHLEVEL
59 # define PERL_SUBVERSION SUBVERSION
60 #endif
61
62 #if PERL_VERSION <= 4 && !defined(PL_dowarn)
63 #define PL_dowarn dowarn
64 #endif
65
66 #ifdef G_WARN_ON
67 #define DOWARN (PL_dowarn & G_WARN_ON)
68 #else
69 #define DOWARN PL_dowarn
70 #endif
71
72 #ifndef INT2PTR
73 #define INT2PTR(any,d) (any)(d)
74 #endif
75
get_md5_ctx(pTHX_ SV * sv)76 static MD5_CTX* get_md5_ctx(pTHX_ SV* sv)
77 {
78 if (SvROK(sv)) {
79 sv = SvRV(sv);
80 if (SvIOK(sv)) {
81 MD5_CTX* ctx = INT2PTR(MD5_CTX*, SvIV(sv));
82 if (ctx) {
83 return ctx;
84 }
85 }
86 }
87 croak("Not a reference to a Digest::MD5 object");
88 return (MD5_CTX*)0; /* some compilers insist on a return value */
89 }
90
91
hex_16(const unsigned char * from,char * to)92 static char* hex_16(const unsigned char* from, char* to)
93 {
94 static const char hexdigits[] = "0123456789abcdef";
95 const unsigned char *end = from + 16;
96 char *d = to;
97
98 while (from < end) {
99 *d++ = hexdigits[(*from >> 4)];
100 *d++ = hexdigits[(*from & 0x0F)];
101 from++;
102 }
103 *d = '\0';
104 return to;
105 }
106
base64_16(const unsigned char * from,char * to)107 static char* base64_16(const unsigned char* from, char* to)
108 {
109 static const char base64[] =
110 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
111 const unsigned char *end = from + 16;
112 unsigned char c1, c2, c3;
113 char *d = to;
114
115 while (1) {
116 c1 = *from++;
117 *d++ = base64[c1>>2];
118 if (from == end) {
119 *d++ = base64[(c1 & 0x3) << 4];
120 break;
121 }
122 c2 = *from++;
123 c3 = *from++;
124 *d++ = base64[((c1 & 0x3) << 4) | ((c2 & 0xF0) >> 4)];
125 *d++ = base64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
126 *d++ = base64[c3 & 0x3F];
127 }
128 *d = '\0';
129 return to;
130 }
131
132 /* Formats */
133 #define F_BIN 0
134 #define F_HEX 1
135 #define F_B64 2
136
make_mortal_sv(pTHX_ const unsigned char * src,int type)137 static SV* make_mortal_sv(pTHX_ const unsigned char *src, int type)
138 {
139 STRLEN len;
140 char result[33];
141 char *ret;
142
143 switch (type) {
144 case F_BIN:
145 ret = (char*)src;
146 len = 16;
147 break;
148 case F_HEX:
149 ret = hex_16(src, result);
150 len = 32;
151 break;
152 case F_B64:
153 ret = base64_16(src, result);
154 len = 22;
155 break;
156 default:
157 croak("Bad convertion type (%d)", type);
158 break;
159 }
160 return sv_2mortal(newSVpv(ret,len));
161 }
162
163
164 /********************************************************************/
165
166 typedef PerlIO* InputStream;
167
168 MODULE = Digest::MD5 PACKAGE = Digest::MD5
169
170 PROTOTYPES: DISABLE
171
172 void
new(xclass)173 new(xclass)
174 SV* xclass
175 PREINIT:
176 MD5_CTX* context;
177 PPCODE:
178 if (!SvROK(xclass)) {
179 STRLEN my_na;
180 char *sclass = SvPV(xclass, my_na);
181 New(55, context, 1, MD5_CTX);
182 ST(0) = sv_newmortal();
183 sv_setref_pv(ST(0), sclass, (void*)context);
184 SvREADONLY_on(SvRV(ST(0)));
185 } else {
186 context = get_md5_ctx(aTHX_ xclass);
187 }
188 MD5Init(context);
189 XSRETURN(1);
190
191 void
192 clone(self)
193 SV* self
194 PREINIT:
195 MD5_CTX* cont = get_md5_ctx(aTHX_ self);
196 char *myname = sv_reftype(SvRV(self),TRUE);
197 MD5_CTX* context;
198 PPCODE:
199 New(55, context, 1, MD5_CTX);
200 ST(0) = sv_newmortal();
201 sv_setref_pv(ST(0), myname , (void*)context);
202 SvREADONLY_on(SvRV(ST(0)));
203 memcpy(context,cont,sizeof(MD5_CTX));
204 XSRETURN(1);
205
206 void
207 DESTROY(context)
208 MD5_CTX* context
209 CODE:
210 Safefree(context);
211
212 void
213 add(self, ...)
214 SV* self
215 PREINIT:
216 MD5_CTX* context = get_md5_ctx(aTHX_ self);
217 int i;
218 unsigned char *data;
219 STRLEN len;
220 PPCODE:
221 for (i = 1; i < items; i++) {
222 data = (unsigned char *)(SvPVbyte(ST(i), len));
223 MD5Update(context, data, len);
224 }
225 XSRETURN(1); /* self */
226
227 void
228 addfile(self, fh)
229 SV* self
230 InputStream fh
231 PREINIT:
232 MD5_CTX* context = get_md5_ctx(aTHX_ self);
233 STRLEN fill = (context->count >> 3) & (MD5_BLOCK_LENGTH - 1);
234 #ifdef USE_HEAP_INSTEAD_OF_STACK
235 unsigned char* buffer;
236 #else
237 unsigned char buffer[4096];
238 #endif
239 int n;
240 CODE:
241 if (fh) {
242 #ifdef USE_HEAP_INSTEAD_OF_STACK
243 New(0, buffer, 4096, unsigned char);
244 assert(buffer);
245 #endif
246 if (fill) {
247 /* The MD5Update() function is faster if it can work with
248 * complete blocks. This will fill up any buffered block
249 * first.
250 */
251 STRLEN missing = 64 - fill;
252 if ( (n = PerlIO_read(fh, buffer, missing)) > 0)
253 MD5Update(context, buffer, n);
254 else
255 XSRETURN(1); /* self */
256 }
257
258 /* Process blocks until EOF or error */
259 while ( (n = PerlIO_read(fh, buffer, sizeof(buffer))) > 0) {
260 MD5Update(context, buffer, n);
261 }
262 #ifdef USE_HEAP_INSTEAD_OF_STACK
263 Safefree(buffer);
264 #endif
265 if (PerlIO_error(fh)) {
266 croak("Reading from filehandle failed");
267 }
268 }
269 else {
270 croak("No filehandle passed");
271 }
272 XSRETURN(1); /* self */
273
274 void
275 digest(context)
276 MD5_CTX* context
277 ALIAS:
278 Digest::MD5::digest = F_BIN
279 Digest::MD5::hexdigest = F_HEX
280 Digest::MD5::b64digest = F_B64
281 PREINIT:
282 unsigned char digeststr[16];
283 PPCODE:
284 MD5Final(digeststr, context);
285 MD5Init(context); /* In case it is reused */
286 ST(0) = make_mortal_sv(aTHX_ digeststr, ix);
287 XSRETURN(1);
288
289 void
290 md5(...)
291 ALIAS:
292 Digest::MD5::md5 = F_BIN
293 Digest::MD5::md5_hex = F_HEX
294 Digest::MD5::md5_base64 = F_B64
295 PREINIT:
296 MD5_CTX ctx;
297 int i;
298 unsigned char *data;
299 STRLEN len;
300 unsigned char digeststr[16];
301 PPCODE:
302 MD5Init(&ctx);
303
304 if (DOWARN) {
305 char *msg = 0;
306 if (items == 1) {
307 if (SvROK(ST(0))) {
308 SV* sv = SvRV(ST(0));
309 if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
310 msg = "probably called as method";
311 else
312 msg = "called with reference argument";
313 }
314 }
315 else if (items > 1) {
316 data = (unsigned char *)SvPVbyte(ST(0), len);
317 if (len == 11 && memEQ("Digest::MD5", data, 11)) {
318 msg = "probably called as class method";
319 }
320 }
321 if (msg) {
322 char *f = (ix == F_BIN) ? "md5" :
323 (ix == F_HEX) ? "md5_hex" : "md5_base64";
324 warn("&Digest::MD5::%s function %s", f, msg);
325 }
326 }
327
328 for (i = 0; i < items; i++) {
329 data = (unsigned char *)(SvPVbyte(ST(i), len));
330 MD5Update(&ctx, data, len);
331 }
332 MD5Final(digeststr, &ctx);
333 ST(0) = make_mortal_sv(aTHX_ digeststr, ix);
334 XSRETURN(1);
335