1 /*
2 
3 Copyright 1997-2004 Gisle Aas
4 
5 This library is free software; you can redistribute it and/or
6 modify it under the same terms as Perl itself.
7 
8 
9 The tables and some of the code that used to be here was borrowed from
10 metamail, which comes with this message:
11 
12   Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore)
13 
14   Permission to use, copy, modify, and distribute this material
15   for any purpose and without fee is hereby granted, provided
16   that the above copyright notice and this permission notice
17   appear in all copies, and that the name of Bellcore not be
18   used in advertising or publicity pertaining to this
19   material without the specific, prior written permission
20   of an authorized representative of Bellcore.	BELLCORE
21   MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY
22   OF THIS MATERIAL FOR ANY PURPOSE.  IT IS PROVIDED "AS IS",
23   WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
24 
25 */
26 
27 
28 #ifdef __cplusplus
29 extern "C" {
30 #endif
31 #define PERL_NO_GET_CONTEXT     /* we want efficiency */
32 #include "EXTERN.h"
33 #include "perl.h"
34 #include "XSUB.h"
35 #ifdef __cplusplus
36 }
37 #endif
38 
39 #define MAX_LINE  76 /* size of encoded lines */
40 
41 static const char basis_64[] =
42    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
43 
44 #define XX      255	/* illegal base64 char */
45 #define EQ      254	/* padding */
46 #define INVALID XX
47 
48 static const unsigned char index_64[256] = {
49     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
50     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
51     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63,
52     52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX,
53     XX, 0, 1, 2,  3, 4, 5, 6,  7, 8, 9,10, 11,12,13,14,
54     15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX,
55     XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
56     41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX,
57 
58     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
59     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
60     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
61     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
62     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
63     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
64     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
65     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
66 };
67 
68 #ifdef SvPVbyte
69 #   if PERL_REVISION == 5 && PERL_VERSION < 7
70        /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
71 #       undef SvPVbyte
72 #       define SvPVbyte(sv, lp) \
73           ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
74            ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
75        static char *
76        my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
77        {
78            sv_utf8_downgrade(sv,0);
79            return SvPV(sv,*lp);
80        }
81 #   endif
82 #else
83 #   define SvPVbyte SvPV
84 #endif
85 
86 #ifndef isXDIGIT
87 #   define isXDIGIT isxdigit
88 #endif
89 
90 #ifndef NATIVE_TO_ASCII
91 #   define NATIVE_TO_ASCII(ch) (ch)
92 #endif
93 
94 MODULE = MIME::Base64		PACKAGE = MIME::Base64
95 
96 SV*
97 encode_base64(sv,...)
98 	SV* sv
99 	PROTOTYPE: $;$
100 
101 	PREINIT:
102 	char *str;     /* string to encode */
103 	SSize_t len;   /* length of the string */
104 	const char*eol;/* the end-of-line sequence to use */
105 	STRLEN eollen; /* length of the EOL sequence */
106 	char *r;       /* result string */
107 	STRLEN rlen;   /* length of result string */
108 	unsigned char c1, c2, c3;
109 	int chunk;
110 	U32 had_utf8;
111 
112 	CODE:
113 #if PERL_REVISION == 5 && PERL_VERSION >= 6
114 	had_utf8 = SvUTF8(sv);
115 	sv_utf8_downgrade(sv, FALSE);
116 #endif
117 	str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
118 	len = (SSize_t)rlen;
119 
120 	/* set up EOL from the second argument if present, default to "\n" */
121 	if (items > 1 && SvOK(ST(1))) {
122 	    eol = SvPV(ST(1), eollen);
123 	} else {
124 	    eol = "\n";
125 	    eollen = 1;
126 	}
127 
128 	/* calculate the length of the result */
129 	rlen = (len+2) / 3 * 4;	 /* encoded bytes */
130 	if (rlen) {
131 	    /* add space for EOL */
132 	    rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
133 	}
134 
135 	/* allocate a result buffer */
136 	RETVAL = newSV(rlen ? rlen : 1);
137 	SvPOK_on(RETVAL);
138 	SvCUR_set(RETVAL, rlen);
139 	r = SvPVX(RETVAL);
140 
141 	/* encode */
142 	for (chunk=0; len > 0; len -= 3, chunk++) {
143 	    if (chunk == (MAX_LINE/4)) {
144 		const char *c = eol;
145 		const char *e = eol + eollen;
146 		while (c < e)
147 		    *r++ = *c++;
148 		chunk = 0;
149 	    }
150 	    c1 = *str++;
151 	    c2 = len > 1 ? *str++ : '\0';
152 	    *r++ = basis_64[c1>>2];
153 	    *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
154 	    if (len > 2) {
155 		c3 = *str++;
156 		*r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
157 		*r++ = basis_64[c3 & 0x3F];
158 	    } else if (len == 2) {
159 		*r++ = basis_64[(c2 & 0xF) << 2];
160 		*r++ = '=';
161 	    } else { /* len == 1 */
162 		*r++ = '=';
163 		*r++ = '=';
164 	    }
165 	}
166 	if (rlen) {
167 	    /* append eol to the result string */
168 	    const char *c = eol;
169 	    const char *e = eol + eollen;
170 	    while (c < e)
171 		*r++ = *c++;
172 	}
173 	*r = '\0';  /* every SV in perl should be NUL-terminated */
174 #if PERL_REVISION == 5 && PERL_VERSION >= 6
175 	if (had_utf8)
176 	    sv_utf8_upgrade(sv);
177 #endif
178 
179 	OUTPUT:
180 	RETVAL
181 
182 SV*
183 decode_base64(sv)
184 	SV* sv
185 	PROTOTYPE: $
186 
187 	PREINIT:
188 	STRLEN len;
189 	register unsigned char *str = (unsigned char*)SvPV(sv, len);
190 	unsigned char const* end = str + len;
191 	char *r;
192 	unsigned char c[4];
193 
194 	CODE:
195 	{
196 	    /* always enough, but might be too much */
197 	    STRLEN rlen = len * 3 / 4;
198 	    RETVAL = newSV(rlen ? rlen : 1);
199 	}
200         SvPOK_on(RETVAL);
201         r = SvPVX(RETVAL);
202 
203 	while (str < end) {
204 	    int i = 0;
205             do {
206 		unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
207 		if (uc != INVALID)
208 		    c[i++] = uc;
209 
210 		if (str == end) {
211 		    if (i < 4) {
212 			if (i < 2) goto thats_it;
213 			if (i == 2) c[2] = EQ;
214 			c[3] = EQ;
215 		    }
216 		    break;
217 		}
218             } while (i < 4);
219 
220 	    if (c[0] == EQ || c[1] == EQ) {
221 		break;
222             }
223 	    /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
224 
225 	    *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);
226 
227 	    if (c[2] == EQ)
228 		break;
229 	    *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2);
230 
231 	    if (c[3] == EQ)
232 		break;
233 	    *r++ = ((c[2] & 0x03) << 6) | c[3];
234 	}
235 
236       thats_it:
237 	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
238 	*r = '\0';
239 
240 	OUTPUT:
241 	RETVAL
242 
243 int
244 encoded_base64_length(sv,...)
245 	SV* sv
246 	PROTOTYPE: $;$
247 
248 	PREINIT:
249 	SSize_t len;   /* length of the string */
250 	STRLEN eollen; /* length of the EOL sequence */
251 	U32 had_utf8;
252 
253 	CODE:
254 #if PERL_REVISION == 5 && PERL_VERSION >= 6
255 	had_utf8 = SvUTF8(sv);
256 	sv_utf8_downgrade(sv, FALSE);
257 #endif
258 	len = SvCUR(sv);
259 #if PERL_REVISION == 5 && PERL_VERSION >= 6
260 	if (had_utf8)
261 	    sv_utf8_upgrade(sv);
262 #endif
263 
264 	if (items > 1 && SvOK(ST(1))) {
265 	    eollen = SvCUR(ST(1));
266 	} else {
267 	    eollen = 1;
268 	}
269 
270 	RETVAL = (len+2) / 3 * 4;	 /* encoded bytes */
271 	if (RETVAL) {
272 	    RETVAL += ((RETVAL-1) / MAX_LINE + 1) * eollen;
273 	}
274 
275 	OUTPUT:
276 	RETVAL
277 
278 int
279 decoded_base64_length(sv)
280 	SV* sv
281 	PROTOTYPE: $
282 
283 	PREINIT:
284 	STRLEN len;
285 	register unsigned char *str = (unsigned char*)SvPV(sv, len);
286 	unsigned char const* end = str + len;
287 	int i = 0;
288 
289 	CODE:
290 	RETVAL = 0;
291 	while (str < end) {
292 	    unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
293 	    if (uc == INVALID)
294 		continue;
295 	    if (uc == EQ)
296 	        break;
297 	    if (i++) {
298 		RETVAL++;
299 		if (i == 4)
300 		    i = 0;
301 	    }
302 	}
303 
304 	OUTPUT:
305 	RETVAL
306 
307 
308 MODULE = MIME::Base64		PACKAGE = MIME::QuotedPrint
309 
310 #ifdef EBCDIC
311 #define qp_isplain(c) ((c) == '\t' || ((!isprint(c) && (c) != '=')))
312 #else
313 #define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) != '='))
314 #endif
315 
316 SV*
317 encode_qp(sv,...)
318 	SV* sv
319 	PROTOTYPE: $;$$
320 
321 	PREINIT:
322 	const char *eol;
323 	STRLEN eol_len;
324 	int binary;
325 	STRLEN sv_len;
326 	STRLEN linelen;
327 	char *beg;
328 	char *end;
329 	char *p;
330 	char *p_beg;
331 	STRLEN p_len;
332 	U32 had_utf8;
333 
334 	CODE:
335 #if PERL_REVISION == 5 && PERL_VERSION >= 6
336         had_utf8 = SvUTF8(sv);
337 	sv_utf8_downgrade(sv, FALSE);
338 #endif
339 	/* set up EOL from the second argument if present, default to "\n" */
340 	if (items > 1 && SvOK(ST(1))) {
341 	    eol = SvPV(ST(1), eol_len);
342 	} else {
343 	    eol = "\n";
344 	    eol_len = 1;
345 	}
346 
347 	binary = (items > 2 && SvTRUE(ST(2)));
348 
349 	beg = SvPV(sv, sv_len);
350 	end = beg + sv_len;
351 
352 	RETVAL = newSV(sv_len + 1);
353 	sv_setpv(RETVAL, "");
354 	linelen = 0;
355 
356 	p = beg;
357 	while (1) {
358 	    p_beg = p;
359 
360 	    /* skip past as much plain text as possible */
361 	    while (p < end && qp_isplain(*p)) {
362 	        p++;
363 	    }
364 	    if (p == end || *p == '\n') {
365 		/* whitespace at end of line must be encoded */
366 		while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
367 		    p--;
368 	    }
369 
370 	    p_len = p - p_beg;
371 	    if (p_len) {
372 	        /* output plain text (with line breaks) */
373 	        if (eol_len) {
374 		    while (p_len > MAX_LINE - 1 - linelen) {
375 			STRLEN len = MAX_LINE - 1 - linelen;
376 			sv_catpvn(RETVAL, p_beg, len);
377 			p_beg += len;
378 			p_len -= len;
379 			sv_catpvn(RETVAL, "=", 1);
380 			sv_catpvn(RETVAL, eol, eol_len);
381 		        linelen = 0;
382 		    }
383                 }
384 		if (p_len) {
385 	            sv_catpvn(RETVAL, p_beg, p_len);
386 	            linelen += p_len;
387 		}
388 	    }
389 
390 	    if (p == end) {
391 		break;
392             }
393 	    else if (*p == '\n' && eol_len && !binary) {
394 		if (linelen == 1 && SvCUR(RETVAL) > eol_len + 1 && SvEND(RETVAL)[-eol_len - 2] == '=') {
395 		    /* fixup useless soft linebreak */
396 		    SvEND(RETVAL)[-eol_len - 2] = SvEND(RETVAL)[-1];
397 		    SvCUR_set(RETVAL, SvCUR(RETVAL) - 1);
398 		}
399 		else {
400 		    sv_catpvn(RETVAL, eol, eol_len);
401 		}
402 		p++;
403 		linelen = 0;
404 	    }
405 	    else {
406 		/* output escaped char (with line breaks) */
407 	        assert(p < end);
408 		if (eol_len && linelen > MAX_LINE - 4 && !(linelen == MAX_LINE - 3 && p + 1 < end && p[1] == '\n' && !binary)) {
409 		    sv_catpvn(RETVAL, "=", 1);
410 		    sv_catpvn(RETVAL, eol, eol_len);
411 		    linelen = 0;
412 		}
413 	        sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
414 	        p++;
415 	        linelen += 3;
416 	    }
417 
418 	    /* optimize reallocs a bit */
419 	    if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
420 		STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
421      		SvGROW(RETVAL, expected_len);
422 	    }
423         }
424 
425 	if (SvCUR(RETVAL) && eol_len && linelen) {
426 	    sv_catpvn(RETVAL, "=", 1);
427 	    sv_catpvn(RETVAL, eol, eol_len);
428 	}
429 #if PERL_REVISION == 5 && PERL_VERSION >= 6
430 	if (had_utf8)
431 	    sv_utf8_upgrade(sv);
432 #endif
433 
434 	OUTPUT:
435 	RETVAL
436 
437 SV*
438 decode_qp(sv)
439 	SV* sv
440 	PROTOTYPE: $
441 
442         PREINIT:
443 	STRLEN len;
444 	char *str = SvPVbyte(sv, len);
445 	char const* end = str + len;
446 	char *r;
447 	char *whitespace = 0;
448 
449         CODE:
450 	RETVAL = newSV(len ? len : 1);
451         SvPOK_on(RETVAL);
452         r = SvPVX(RETVAL);
453 	while (str < end) {
454 	    if (*str == ' ' || *str == '\t') {
455 		if (!whitespace)
456 		    whitespace = str;
457 		str++;
458 	    }
459 	    else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
460 		str++;
461 	    }
462 	    else if (*str == '\n') {
463 		whitespace = 0;
464 		*r++ = *str++;
465 	    }
466 	    else {
467 		if (whitespace) {
468 		    while (whitespace < str) {
469 			*r++ = *whitespace++;
470 		    }
471 		    whitespace = 0;
472                 }
473             	if (*str == '=') {
474 		    if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
475 	                char buf[3];
476                         str++;
477 	                buf[0] = *str++;
478 		        buf[1] = *str++;
479 	                buf[2] = '\0';
480 		        *r++ = (char)strtol(buf, 0, 16);
481 	            }
482 		    else {
483 		        /* look for soft line break */
484 		        char *p = str + 1;
485 		        while (p < end && (*p == ' ' || *p == '\t'))
486 		            p++;
487 		        if (p < end && *p == '\n')
488 		     	    str = p + 1;
489 		        else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n')
490 		            str = p + 2;
491 		        else
492 		            *r++ = *str++; /* give up */
493 		    }
494 		}
495 		else {
496 		    *r++ = *str++;
497 		}
498 	    }
499 	}
500 	if (whitespace) {
501 	    while (whitespace < str) {
502 		*r++ = *whitespace++;
503 	    }
504         }
505 	*r = '\0';
506 	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
507 
508         OUTPUT:
509 	RETVAL
510 
511 
512 MODULE = MIME::Base64		PACKAGE = MIME::Base64
513