source: trunk/essentials/dev-lang/perl/ext/MIME/Base64/Base64.xs@ 3298

Last change on this file since 3298 was 3181, checked in by bird, 19 years ago

perl 5.8.8
File size: 10.7 KB
Line 
1/* $Id: Base64.xs,v 3.5 2005/11/26 10:44:14 gisle Exp $
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#ifdef __cplusplus
29extern "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#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
46#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
47 #define PL_dowarn dowarn
48#endif
49
50#ifdef G_WARN_ON
51 #define DOWARN (PL_dowarn & G_WARN_ON)
52#else
53 #define DOWARN PL_dowarn
54#endif
55
56
57#define MAX_LINE 76 /* size of encoded lines */
58
59static const char basis_64[] =
60 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
61
62#define XX 255 /* illegal base64 char */
63#define EQ 254 /* padding */
64#define INVALID XX
65
66static const 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
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
103
104#ifndef isXDIGIT
105# define isXDIGIT isxdigit
106#endif
107
108#ifndef NATIVE_TO_ASCII
109# define NATIVE_TO_ASCII(ch) (ch)
110#endif
111
112MODULE = MIME::Base64 PACKAGE = MIME::Base64
113
114SV*
115encode_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:
130#if PERL_REVISION == 5 && PERL_VERSION >= 6
131 sv_utf8_downgrade(sv, FALSE);
132#endif
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++;
167 c2 = len > 1 ? *str++ : '\0';
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
194SV*
195decode_base64(sv)
196 SV* sv
197 PROTOTYPE: $
198
199 PREINIT:
200 STRLEN len;
201 register unsigned char *str = (unsigned char*)SvPVbyte(sv, len);
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 {
218 unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
219 if (uc != INVALID)
220 c[i++] = uc;
221
222 if (str == end) {
223 if (i < 4) {
224 if (i && DOWARN)
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);
233
234 if (c[0] == EQ || c[1] == EQ) {
235 if (DOWARN) warn("Premature padding of base64 data");
236 break;
237 }
238 /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
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
257
258
259MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint
260
261#define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) != '='))
262
263SV*
264encode_qp(sv,...)
265 SV* sv
266 PROTOTYPE: $;$$
267
268 PREINIT:
269 char *eol;
270 STRLEN eol_len;
271 int binary;
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
292 binary = (items > 2 && SvTRUE(ST(2)));
293
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 }
309 if (p == end || *p == '\n') {
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) {
319 STRLEN max_last_line = (p == end || *p == '\n')
320 ? MAX_LINE /* .......\n */
321 : ((p + 1) == end || *(p + 1) == '\n')
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
342 if (p == end) {
343 break;
344 }
345 else if (*p == '\n' && eol_len && !binary) {
346 sv_catpvn(RETVAL, eol, eol_len);
347 p++;
348 linelen = 0;
349 }
350 else {
351 /* output escaped char (with line breaks) */
352 assert(p < end);
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 }
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
370 if (SvCUR(RETVAL) && eol_len && linelen) {
371 sv_catpvn(RETVAL, "=", 1);
372 sv_catpvn(RETVAL, eol, eol_len);
373 }
374
375 OUTPUT:
376 RETVAL
377
378SV*
379decode_qp(sv)
380 SV* sv
381 PROTOTYPE: $
382
383 PREINIT:
384 STRLEN len;
385 char *str = SvPVbyte(sv, len);
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 }
414 if (*str == '=') {
415 if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
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 }
435 }
436 else {
437 *r++ = *str++;
438 }
439 }
440 }
441 if (whitespace) {
442 while (whitespace < str) {
443 *r++ = *whitespace++;
444 }
445 }
446 *r = '\0';
447 SvCUR_set(RETVAL, r - SvPVX(RETVAL));
448
449 OUTPUT:
450 RETVAL
451
452
453MODULE = MIME::Base64 PACKAGE = MIME::Base64
Note: See TracBrowser for help on using the repository browser.