1 /* $Id: Base64.xs,v 1.32 2003/01/05 07:49:07 gisle Exp $
3 Copyright 1997-2003 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.
38 #include "patchlevel.h"
39 #if PATCHLEVEL <= 4 && !defined(PL_dowarn)
40 #define PL_dowarn dowarn
43 #define MAX_LINE 76 /* size of encoded lines */
45 static char basis_64[] =
46 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
48 #define XX 255 /* illegal base64 char */
49 #define EQ 254 /* padding */
52 static unsigned char index_64[256] = {
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,62, XX,XX,XX,63,
56 52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX,
57 XX, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11,12,13,14,
58 15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX,
59 XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
60 41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX,
62 XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
63 XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
64 XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
65 XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
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,XX, XX,XX,XX,XX,
69 XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
73 # if PERL_REVISION == 5 && PERL_VERSION < 7
74 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
76 # define SvPVbyte(sv, lp) \
77 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
78 ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
80 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
82 sv_utf8_downgrade(sv,0);
87 # define SvPVbyte SvPV
90 #ifndef NATIVE_TO_ASCII
91 # define NATIVE_TO_ASCII(ch) (ch)
94 MODULE = MIME::Base64 PACKAGE = MIME::Base64
102 char *str; /* string to encode */
103 SSize_t len; /* length of the string */
104 char *eol; /* the end-of-line sequence to use */
105 STRLEN eollen; /* length of the EOL sequence */
106 char *r; /* result string */
107 STRLEN rlen; /* length of result string */
108 unsigned char c1, c2, c3;
112 #if PERL_REVISION == 5 && PERL_VERSION >= 6
113 sv_utf8_downgrade(sv, FALSE);
115 str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
118 /* set up EOL from the second argument if present, default to "\n" */
119 if (items > 1 && SvOK(ST(1))) {
120 eol = SvPV(ST(1), eollen);
126 /* calculate the length of the result */
127 rlen = (len+2) / 3 * 4; /* encoded bytes */
129 /* add space for EOL */
130 rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
133 /* allocate a result buffer */
134 RETVAL = newSV(rlen ? rlen : 1);
136 SvCUR_set(RETVAL, rlen);
140 for (chunk=0; len > 0; len -= 3, chunk++) {
141 if (chunk == (MAX_LINE/4)) {
143 char *e = eol + eollen;
150 *r++ = basis_64[c1>>2];
151 *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
154 *r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
155 *r++ = basis_64[c3 & 0x3F];
156 } else if (len == 2) {
157 *r++ = basis_64[(c2 & 0xF) << 2];
159 } else { /* len == 1 */
165 /* append eol to the result string */
167 char *e = eol + eollen;
171 *r = '\0'; /* every SV in perl should be NUL-terminated */
183 register unsigned char *str = (unsigned char*)SvPVbyte(sv, len);
184 unsigned char const* end = str + len;
190 /* always enough, but might be too much */
191 STRLEN rlen = len * 3 / 4;
192 RETVAL = newSV(rlen ? rlen : 1);
200 unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
207 warn("Premature end of base64 data");
208 if (i < 2) goto thats_it;
209 if (i == 2) c[2] = EQ;
216 if (c[0] == EQ || c[1] == EQ) {
217 if (PL_dowarn) warn("Premature padding of base64 data");
220 /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
222 *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);
226 *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2);
230 *r++ = ((c[2] & 0x03) << 6) | c[3];
234 SvCUR_set(RETVAL, r - SvPVX(RETVAL));
241 MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint
243 #define qp_isplain(c) ((c) == '\t' || ((c) >= ' ' && (c) <= '~') && (c) != '=')
262 #if PERL_REVISION == 5 && PERL_VERSION >= 6
263 sv_utf8_downgrade(sv, FALSE);
265 /* set up EOL from the second argument if present, default to "\n" */
266 if (items > 1 && SvOK(ST(1))) {
267 eol = SvPV(ST(1), eol_len);
273 beg = SvPV(sv, sv_len);
276 RETVAL = newSV(sv_len + 1);
277 sv_setpv(RETVAL, "");
284 /* skip past as much plain text as possible */
285 while (p < end && qp_isplain(*p)) {
288 if (*p == '\n' || p == end) {
289 /* whitespace at end of line must be encoded */
290 while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
296 /* output plain text (with line breaks) */
298 STRLEN max_last_line = (*p == '\n' || p == end)
299 ? MAX_LINE /* .......\n */
300 : (*(p + 1) == '\n' || (p + 1) == end)
301 ? MAX_LINE - 3 /* ....=XX\n */
302 : MAX_LINE - 4; /* ...=XX=\n */
303 while (p_len + linelen > max_last_line) {
304 STRLEN len = MAX_LINE - 1 - linelen;
307 sv_catpvn(RETVAL, p_beg, len);
310 sv_catpvn(RETVAL, "=", 1);
311 sv_catpvn(RETVAL, eol, eol_len);
316 sv_catpvn(RETVAL, p_beg, p_len);
322 sv_catpvn(RETVAL, eol, eol_len);
327 /* output escaped char (with line breaks) */
328 if (eol_len && linelen > MAX_LINE - 4) {
329 sv_catpvn(RETVAL, "=", 1);
330 sv_catpvn(RETVAL, eol, eol_len);
333 sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
342 /* optimize reallocs a bit */
343 if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
344 STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
345 SvGROW(RETVAL, expected_len);
359 char *str = SvPVbyte(sv, len);
360 char const* end = str + len;
362 char *whitespace = 0;
365 RETVAL = newSV(len ? len : 1);
369 if (*str == ' ' || *str == '\t') {
374 else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
377 else if (*str == '\n') {
383 while (whitespace < str) {
384 *r++ = *whitespace++;
388 if (*str == '=' && (str + 2) < end && isxdigit(str[1]) && isxdigit(str[2])) {
394 *r++ = (char)strtol(buf, 0, 16);
396 else if (*str == '=' && (str + 1) < end && str[1] == '\n') {
399 else if (*str == '=' && (str + 2) < end && str[1] == '\r' && str[2] == '\n') {
408 SvCUR_set(RETVAL, r - SvPVX(RETVAL));
414 MODULE = MIME::Base64 PACKAGE = MIME::Base64