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