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