1 /* $Id: Base64.xs,v 1.41 2004/01/08 14:07:26 gisle Exp $
3 Copyright 1997-2004 Gisle Aas
5 This library is free software; you can redistribute it and/or
6 modify it under the same terms as Perl itself.
9 The tables and some of the code that used to be here was borrowed from
10 metamail, which comes with this message:
12 Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore)
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.
39 # include <patchlevel.h>
40 # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
41 # include <could_not_find_Perl_patchlevel.h>
45 #if PATCHLEVEL <= 4 && !defined(PL_dowarn)
46 #define PL_dowarn dowarn
50 #define DOWARN (PL_dowarn & G_WARN_ON)
52 #define DOWARN PL_dowarn
56 #define MAX_LINE 76 /* size of encoded lines */
58 static char basis_64[] =
59 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
61 #define XX 255 /* illegal base64 char */
62 #define EQ 254 /* padding */
65 static unsigned char index_64[256] = {
66 XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
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,62, XX,XX,XX,63,
69 52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX,
70 XX, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11,12,13,14,
71 15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX,
72 XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
73 41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX,
75 XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
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,
86 # if PERL_REVISION == 5 && PERL_VERSION < 7
87 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
89 # define SvPVbyte(sv, lp) \
90 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
91 ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
93 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
95 sv_utf8_downgrade(sv,0);
100 # define SvPVbyte SvPV
103 #ifndef NATIVE_TO_ASCII
104 # define NATIVE_TO_ASCII(ch) (ch)
107 MODULE = MIME::Base64 PACKAGE = MIME::Base64
110 encode_base64(sv,...)
115 char *str; /* string to encode */
116 SSize_t len; /* length of the string */
117 char *eol; /* the end-of-line sequence to use */
118 STRLEN eollen; /* length of the EOL sequence */
119 char *r; /* result string */
120 STRLEN rlen; /* length of result string */
121 unsigned char c1, c2, c3;
125 #if PERL_REVISION == 5 && PERL_VERSION >= 6
126 sv_utf8_downgrade(sv, FALSE);
128 str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
131 /* set up EOL from the second argument if present, default to "\n" */
132 if (items > 1 && SvOK(ST(1))) {
133 eol = SvPV(ST(1), eollen);
139 /* calculate the length of the result */
140 rlen = (len+2) / 3 * 4; /* encoded bytes */
142 /* add space for EOL */
143 rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
146 /* allocate a result buffer */
147 RETVAL = newSV(rlen ? rlen : 1);
149 SvCUR_set(RETVAL, rlen);
153 for (chunk=0; len > 0; len -= 3, chunk++) {
154 if (chunk == (MAX_LINE/4)) {
156 char *e = eol + eollen;
162 c2 = len > 1 ? *str++ : '\0';
163 *r++ = basis_64[c1>>2];
164 *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
167 *r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
168 *r++ = basis_64[c3 & 0x3F];
169 } else if (len == 2) {
170 *r++ = basis_64[(c2 & 0xF) << 2];
172 } else { /* len == 1 */
178 /* append eol to the result string */
180 char *e = eol + eollen;
184 *r = '\0'; /* every SV in perl should be NUL-terminated */
196 register unsigned char *str = (unsigned char*)SvPVbyte(sv, len);
197 unsigned char const* end = str + len;
203 /* always enough, but might be too much */
204 STRLEN rlen = len * 3 / 4;
205 RETVAL = newSV(rlen ? rlen : 1);
213 unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
220 warn("Premature end of base64 data");
221 if (i < 2) goto thats_it;
222 if (i == 2) c[2] = EQ;
229 if (c[0] == EQ || c[1] == EQ) {
230 if (DOWARN) warn("Premature padding of base64 data");
233 /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
235 *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);
239 *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2);
243 *r++ = ((c[2] & 0x03) << 6) | c[3];
247 SvCUR_set(RETVAL, r - SvPVX(RETVAL));
254 MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint
256 #define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) != '='))
275 #if PERL_REVISION == 5 && PERL_VERSION >= 6
276 sv_utf8_downgrade(sv, FALSE);
278 /* set up EOL from the second argument if present, default to "\n" */
279 if (items > 1 && SvOK(ST(1))) {
280 eol = SvPV(ST(1), eol_len);
286 beg = SvPV(sv, sv_len);
289 RETVAL = newSV(sv_len + 1);
290 sv_setpv(RETVAL, "");
297 /* skip past as much plain text as possible */
298 while (p < end && qp_isplain(*p)) {
301 if (p == end || *p == '\n') {
302 /* whitespace at end of line must be encoded */
303 while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
309 /* output plain text (with line breaks) */
311 STRLEN max_last_line = (p == end || *p == '\n')
312 ? MAX_LINE /* .......\n */
313 : ((p + 1) == end || *(p + 1) == '\n')
314 ? MAX_LINE - 3 /* ....=XX\n */
315 : MAX_LINE - 4; /* ...=XX=\n */
316 while (p_len + linelen > max_last_line) {
317 STRLEN len = MAX_LINE - 1 - linelen;
320 sv_catpvn(RETVAL, p_beg, len);
323 sv_catpvn(RETVAL, "=", 1);
324 sv_catpvn(RETVAL, eol, eol_len);
329 sv_catpvn(RETVAL, p_beg, p_len);
337 else if (*p == '\n' && eol_len) {
338 sv_catpvn(RETVAL, eol, eol_len);
343 /* output escaped char (with line breaks) */
345 if (eol_len && linelen > MAX_LINE - 4) {
346 sv_catpvn(RETVAL, "=", 1);
347 sv_catpvn(RETVAL, eol, eol_len);
350 sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
355 /* optimize reallocs a bit */
356 if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
357 STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
358 SvGROW(RETVAL, expected_len);
372 char *str = SvPVbyte(sv, len);
373 char const* end = str + len;
375 char *whitespace = 0;
378 RETVAL = newSV(len ? len : 1);
382 if (*str == ' ' || *str == '\t') {
387 else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
390 else if (*str == '\n') {
396 while (whitespace < str) {
397 *r++ = *whitespace++;
402 if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
408 *r++ = (char)strtol(buf, 0, 16);
411 /* look for soft line break */
413 while (p < end && (*p == ' ' || *p == '\t'))
415 if (p < end && *p == '\n')
417 else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n')
420 *r++ = *str++; /* give up */
429 while (whitespace < str) {
430 *r++ = *whitespace++;
434 SvCUR_set(RETVAL, r - SvPVX(RETVAL));
440 MODULE = MIME::Base64 PACKAGE = MIME::Base64