/* $Id: Base64.xs,v 3.4 2004/08/24 16:29:35 gisle Exp $ Copyright 1997-2004 Gisle Aas This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The tables and some of the code that used to be here was borrowed from metamail, which comes with this message: Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore) Permission to use, copy, modify, and distribute this material for any purpose and without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies, and that the name of Bellcore not be used in advertising or publicity pertaining to this material without the specific, prior written permission of an authorized representative of Bellcore. BELLCORE MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY OF THIS MATERIAL FOR ANY PURPOSE. IT IS PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. */ #ifdef __cplusplus extern "C" { #endif #define PERL_NO_GET_CONTEXT /* we want efficiency */ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #ifdef __cplusplus } #endif #ifndef PATCHLEVEL # include # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL))) # include # endif #endif #if PATCHLEVEL <= 4 && !defined(PL_dowarn) #define PL_dowarn dowarn #endif #ifdef G_WARN_ON #define DOWARN (PL_dowarn & G_WARN_ON) #else #define DOWARN PL_dowarn #endif #define MAX_LINE 76 /* size of encoded lines */ static const char basis_64[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; #define XX 255 /* illegal base64 char */ #define EQ 254 /* padding */ #define INVALID XX static const unsigned char index_64[256] = { XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63, 52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX, XX, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11,12,13,14, 15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX, XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40, 41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, }; #ifdef SvPVbyte # if PERL_REVISION == 5 && PERL_VERSION < 7 /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ # undef SvPVbyte # define SvPVbyte(sv, lp) \ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) static char * my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) { sv_utf8_downgrade(sv,0); return SvPV(sv,*lp); } # endif #else # define SvPVbyte SvPV #endif #ifndef isXDIGIT # define isXDIGIT isxdigit #endif #ifndef NATIVE_TO_ASCII # define NATIVE_TO_ASCII(ch) (ch) #endif MODULE = MIME::Base64 PACKAGE = MIME::Base64 SV* encode_base64(sv,...) SV* sv PROTOTYPE: $;$ PREINIT: 2898 char *str; /* string to encode */ 2898 SSize_t len; /* length of the string */ 2898 char *eol; /* the end-of-line sequence to use */ 2898 STRLEN eollen; /* length of the EOL sequence */ 2898 char *r; /* result string */ 2898 STRLEN rlen; /* length of result string */ 2898 unsigned char c1, c2, c3; 2898 int chunk; CODE: #if PERL_REVISION == 5 && PERL_VERSION >= 6 2898 sv_utf8_downgrade(sv, FALSE); #endif 2897 str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */ 2897 len = (SSize_t)rlen; /* set up EOL from the second argument if present, default to "\n" */ 2897 if (items > 1 && SvOK(ST(1))) { 2384 eol = SvPV(ST(1), eollen); } else { 513 eol = "\n"; 513 eollen = 1; } /* calculate the length of the result */ 2897 rlen = (len+2) / 3 * 4; /* encoded bytes */ 2897 if (rlen) { /* add space for EOL */ 2896 rlen += ((rlen-1) / MAX_LINE + 1) * eollen; } /* allocate a result buffer */ 2897 RETVAL = newSV(rlen ? rlen : 1); 2897 SvPOK_on(RETVAL); 2897 SvCUR_set(RETVAL, rlen); 2897 r = SvPVX(RETVAL); /* encode */ 66996 for (chunk=0; len > 0; len -= 3, chunk++) { 64099 if (chunk == (MAX_LINE/4)) { 2760 char *c = eol; 2760 char *e = eol + eollen; 3668 while (c < e) 908 *r++ = *c++; 2760 chunk = 0; } 64099 c1 = *str++; 64099 c2 = len > 1 ? *str++ : '\0'; 64099 *r++ = basis_64[c1>>2]; 64099 *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)]; 64099 if (len > 2) { 61470 c3 = *str++; 61470 *r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)]; 61470 *r++ = basis_64[c3 & 0x3F]; 2629 } else if (len == 2) { 1419 *r++ = basis_64[(c2 & 0xF) << 2]; 1419 *r++ = '='; } else { /* len == 1 */ 1210 *r++ = '='; 1210 *r++ = '='; } } 2897 if (rlen) { /* append eol to the result string */ 2896 char *c = eol; 2896 char *e = eol + eollen; 3409 while (c < e) 513 *r++ = *c++; } 2897 *r = '\0'; /* every SV in perl should be NUL-terminated */ OUTPUT: RETVAL SV* decode_base64(sv) SV* sv PROTOTYPE: $ PREINIT: 2656 STRLEN len; 2656 register unsigned char *str = (unsigned char*)SvPVbyte(sv, len); 2656 unsigned char const* end = str + len; 2656 char *r; 2656 unsigned char c[4]; CODE: { /* always enough, but might be too much */ 2656 STRLEN rlen = len * 3 / 4; 2656 RETVAL = newSV(rlen ? rlen : 1); } 2656 SvPOK_on(RETVAL); 2656 r = SvPVX(RETVAL); 53248 while (str < end) { 53149 int i = 0; 212784 do { 212784 unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)]; 212784 if (uc != INVALID) 212239 c[i++] = uc; 212784 if (str == end) { 2480 if (i < 4) { 93 if (i && DOWARN) 2 warn("Premature end of base64 data"); 93 if (i < 2) goto thats_it; 6 if (i == 2) c[2] = EQ; 6 c[3] = EQ; } 6 break; } 210304 } while (i < 4); 53062 if (c[0] == EQ || c[1] == EQ) { 5 if (DOWARN) warn("Premature padding of base64 data"); 2 break; } /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/ 53057 *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4); 53057 if (c[2] == EQ) 1125 break; 51932 *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2); 51932 if (c[3] == EQ) 1340 break; 50592 *r++ = ((c[2] & 0x03) << 6) | c[3]; } thats_it: 2656 SvCUR_set(RETVAL, r - SvPVX(RETVAL)); 2656 *r = '\0'; OUTPUT: RETVAL MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint #define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) != '=')) SV* encode_qp(sv,...) SV* sv PROTOTYPE: $;$$ PREINIT: 46 char *eol; 46 STRLEN eol_len; 46 int binary; 46 STRLEN sv_len; 46 STRLEN linelen; 46 char *beg; 46 char *end; 46 char *p; 46 char *p_beg; 46 STRLEN p_len; CODE: #if PERL_REVISION == 5 && PERL_VERSION >= 6 46 sv_utf8_downgrade(sv, FALSE); #endif /* set up EOL from the second argument if present, default to "\n" */ 44 if (items > 1 && SvOK(ST(1))) { 2 eol = SvPV(ST(1), eol_len); } else { 42 eol = "\n"; 42 eol_len = 1; } 44 binary = (items > 2 && SvTRUE(ST(2))); 44 beg = SvPV(sv, sv_len); 44 end = beg + sv_len; 44 RETVAL = newSV(sv_len + 1); 44 sv_setpv(RETVAL, ""); 44 linelen = 0; 44 p = beg; 1902 while (1) { 1902 p_beg = p; /* skip past as much plain text as possible */ 5958 while (p < end && qp_isplain(*p)) { 4056 p++; } 1902 if (p == end || *p == '\n') { /* whitespace at end of line must be encoded */ 147 while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' ')) 40 p--; } 1902 p_len = p - p_beg; 1902 if (p_len) { /* output plain text (with line breaks) */ 81 if (eol_len) { 80 STRLEN max_last_line = (p == end || *p == '\n') ? MAX_LINE /* .......\n */ : ((p + 1) == end || *(p + 1) == '\n') ? MAX_LINE - 3 /* ....=XX\n */ 80 : MAX_LINE - 4; /* ...=XX=\n */ 121 while (p_len + linelen > max_last_line) { 41 STRLEN len = MAX_LINE - 1 - linelen; 41 if (len > p_len) 3 len = p_len; 41 sv_catpvn(RETVAL, p_beg, len); 41 p_beg += len; 41 p_len -= len; 41 sv_catpvn(RETVAL, "=", 1); 41 sv_catpvn(RETVAL, eol, eol_len); 41 linelen = 0; } } 81 if (p_len) { 77 sv_catpvn(RETVAL, p_beg, p_len); 77 linelen += p_len; } } 1902 if (p == end) { 44 break; } 1858 else if (*p == '\n' && eol_len && !binary) { 32 sv_catpvn(RETVAL, eol, eol_len); 32 p++; 32 linelen = 0; } else { /* output escaped char (with line breaks) */ 1826 assert(p < end); 1826 if (eol_len && linelen > MAX_LINE - 4) { 60 sv_catpvn(RETVAL, "=", 1); 60 sv_catpvn(RETVAL, eol, eol_len); 60 linelen = 0; } 1826 sv_catpvf(RETVAL, "=%02X", (unsigned char)*p); 1826 p++; 1826 linelen += 3; } /* optimize reallocs a bit */ 1858 if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) { 14 STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg); 14 SvGROW(RETVAL, expected_len); } } 44 if (SvCUR(RETVAL) && eol_len && linelen) { 26 sv_catpvn(RETVAL, "=", 1); 26 sv_catpvn(RETVAL, eol, eol_len); } OUTPUT: RETVAL SV* decode_qp(sv) SV* sv PROTOTYPE: $ PREINIT: 51 STRLEN len; 51 char *str = SvPVbyte(sv, len); 51 char const* end = str + len; 51 char *r; 51 char *whitespace = 0; CODE: 51 RETVAL = newSV(len ? len : 1); 51 SvPOK_on(RETVAL); 51 r = SvPVX(RETVAL); 5587 while (str < end) { 5536 if (*str == ' ' || *str == '\t') { 148 if (!whitespace) 139 whitespace = str; 148 str++; } 5388 else if (*str == '\r' && (str + 1) < end && str[1] == '\n') { 7 str++; } 5381 else if (*str == '\n') { 46 whitespace = 0; 46 *r++ = *str++; } else { 5335 if (whitespace) { 269 while (whitespace < str) { 136 *r++ = *whitespace++; } 133 whitespace = 0; } 5335 if (*str == '=') { 1786 if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) { 1662 char buf[3]; 1662 str++; 1662 buf[0] = *str++; 1662 buf[1] = *str++; 1662 buf[2] = '\0'; 1662 *r++ = (char)strtol(buf, 0, 16); } else { /* look for soft line break */ 124 char *p = str + 1; 139 while (p < end && (*p == ' ' || *p == '\t')) 15 p++; 124 if (p < end && *p == '\n') 119 str = p + 1; 5 else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n') 3 str = p + 2; else 2 *r++ = *str++; /* give up */ } } else { 3549 *r++ = *str++; } } } 51 if (whitespace) { 3 while (whitespace < str) { 2 *r++ = *whitespace++; } } 51 *r = '\0'; 51 SvCUR_set(RETVAL, r - SvPVX(RETVAL)); OUTPUT: RETVAL MODULE = MIME::Base64 PACKAGE = MIME::Base64