1 /* $Id: Base64.xs,v 3.5 2005/11/26 10:44:14 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.
31 #define PERL_NO_GET_CONTEXT /* we want efficiency */
40 # include <patchlevel.h>
41 # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
42 # include <could_not_find_Perl_patchlevel.h>
46 #if PATCHLEVEL <= 4 && !defined(PL_dowarn)
47 #define PL_dowarn dowarn
51 #define DOWARN (PL_dowarn & G_WARN_ON)
53 #define DOWARN PL_dowarn
57 #define MAX_LINE 76 /* size of encoded lines */
59 static const char basis_64[] =
60 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
62 #define XX 255 /* illegal base64 char */
63 #define EQ 254 /* padding */
66 static 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,
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,
87 # if PERL_REVISION == 5 && PERL_VERSION < 7
88 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
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))
94 my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
96 sv_utf8_downgrade(sv,0);
101 # define SvPVbyte SvPV
105 # define isXDIGIT isxdigit
108 #ifndef NATIVE_TO_ASCII
109 # define NATIVE_TO_ASCII(ch) (ch)
112 MODULE = MIME::Base64 PACKAGE = MIME::Base64
115 encode_base64(sv,...)
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;
130 #if PERL_REVISION == 5 && PERL_VERSION >= 6
131 sv_utf8_downgrade(sv, FALSE);
133 str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
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);
144 /* calculate the length of the result */
145 rlen = (len+2) / 3 * 4; /* encoded bytes */
147 /* add space for EOL */
148 rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
151 /* allocate a result buffer */
152 RETVAL = newSV(rlen ? rlen : 1);
154 SvCUR_set(RETVAL, rlen);
158 for (chunk=0; len > 0; len -= 3, chunk++) {
159 if (chunk == (MAX_LINE/4)) {
161 char *e = eol + eollen;
167 c2 = len > 1 ? *str++ : '\0';
168 *r++ = basis_64[c1>>2];
169 *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
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];
177 } else { /* len == 1 */
183 /* append eol to the result string */
185 char *e = eol + eollen;
189 *r = '\0'; /* every SV in perl should be NUL-terminated */
201 register unsigned char *str = (unsigned char*)SvPVbyte(sv, len);
202 unsigned char const* end = str + len;
208 /* always enough, but might be too much */
209 STRLEN rlen = len * 3 / 4;
210 RETVAL = newSV(rlen ? rlen : 1);
218 unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
225 warn("Premature end of base64 data");
226 if (i < 2) goto thats_it;
227 if (i == 2) c[2] = EQ;
234 if (c[0] == EQ || c[1] == EQ) {
235 if (DOWARN) warn("Premature padding of base64 data");
238 /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
240 *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);
244 *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2);
248 *r++ = ((c[2] & 0x03) << 6) | c[3];
252 SvCUR_set(RETVAL, r - SvPVX(RETVAL));
259 MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint
262 #define qp_isplain(c) ((c) == '\t' || ((!isprint(c) && (c) != '=')))
264 #define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) != '='))
285 #if PERL_REVISION == 5 && PERL_VERSION >= 6
286 sv_utf8_downgrade(sv, FALSE);
288 /* set up EOL from the second argument if present, default to "\n" */
289 if (items > 1 && SvOK(ST(1))) {
290 eol = SvPV(ST(1), eol_len);
296 binary = (items > 2 && SvTRUE(ST(2)));
298 beg = SvPV(sv, sv_len);
301 RETVAL = newSV(sv_len + 1);
302 sv_setpv(RETVAL, "");
309 /* skip past as much plain text as possible */
310 while (p < end && qp_isplain(*p)) {
313 if (p == end || *p == '\n') {
314 /* whitespace at end of line must be encoded */
315 while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
321 /* output plain text (with line breaks) */
323 STRLEN max_last_line = (p == end || *p == '\n')
324 ? MAX_LINE /* .......\n */
325 : ((p + 1) == end || *(p + 1) == '\n')
326 ? MAX_LINE - 3 /* ....=XX\n */
327 : MAX_LINE - 4; /* ...=XX=\n */
328 while (p_len + linelen > max_last_line) {
329 STRLEN len = MAX_LINE - 1 - linelen;
332 sv_catpvn(RETVAL, p_beg, len);
335 sv_catpvn(RETVAL, "=", 1);
336 sv_catpvn(RETVAL, eol, eol_len);
341 sv_catpvn(RETVAL, p_beg, p_len);
349 else if (*p == '\n' && eol_len && !binary) {
350 sv_catpvn(RETVAL, eol, eol_len);
355 /* output escaped char (with line breaks) */
357 if (eol_len && linelen > MAX_LINE - 4) {
358 sv_catpvn(RETVAL, "=", 1);
359 sv_catpvn(RETVAL, eol, eol_len);
362 sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
367 /* optimize reallocs a bit */
368 if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
369 STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
370 SvGROW(RETVAL, expected_len);
374 if (SvCUR(RETVAL) && eol_len && linelen) {
375 sv_catpvn(RETVAL, "=", 1);
376 sv_catpvn(RETVAL, eol, eol_len);
389 char *str = SvPVbyte(sv, len);
390 char const* end = str + len;
392 char *whitespace = 0;
395 RETVAL = newSV(len ? len : 1);
399 if (*str == ' ' || *str == '\t') {
404 else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
407 else if (*str == '\n') {
413 while (whitespace < str) {
414 *r++ = *whitespace++;
419 if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
425 *r++ = (char)strtol(buf, 0, 16);
428 /* look for soft line break */
430 while (p < end && (*p == ' ' || *p == '\t'))
432 if (p < end && *p == '\n')
434 else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n')
437 *r++ = *str++; /* give up */
446 while (whitespace < str) {
447 *r++ = *whitespace++;
451 SvCUR_set(RETVAL, r - SvPVX(RETVAL));
457 MODULE = MIME::Base64 PACKAGE = MIME::Base64