1/*
2
3Copyright 1997-2004 Gisle Aas
4
5This library is free software; you can redistribute it and/or
6modify it under the same terms as Perl itself.
7
8
9The tables and some of the code that used to be here was borrowed from
10metamail, 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
35static const char basis_64[] =
36   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
37
38#define XX      255	/* illegal base64 char */
39#define EQ      254	/* padding */
40#define INVALID XX
41
42static 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_ 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
88MODULE = MIME::Base64		PACKAGE = MIME::Base64
89
90SV*
91encode_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
176SV*
177decode_base64(sv)
178	SV* sv
179	PROTOTYPE: $
180
181	PREINIT:
182	STRLEN len;
183	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
237int
238encoded_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
272int
273decoded_base64_length(sv)
274	SV* sv
275	PROTOTYPE: $
276
277	PREINIT:
278	STRLEN len;
279	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
302MODULE = 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
310SV*
311encode_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
431SV*
432decode_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
506MODULE = MIME::Base64		PACKAGE = MIME::Base64
507