1 /* $Id$ 2 3 Copyright 1997-2004 Gisle Aas 4 5 This library is free software; you can redistribute it and/or 6 modify it under the same terms as Perl itself. 7 8 9 The tables and some of the code that used to be here was borrowed from 10 metamail, 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 29 extern "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 59 static const char basis_64[] = 60 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; 61 62 #define XX 255 /* illegal base64 char */ 63 #define EQ 254 /* padding */ 64 #define INVALID XX 65 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, 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 112 MODULE = MIME::Base64 PACKAGE = MIME::Base64 113 114 SV* 115 encode_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 194 SV* 195 decode_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 259 MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint 260 261 #ifdef EBCDIC 262 #define qp_isplain(c) ((c) == '\t' || ((!isprint(c) && (c) != '='))) 263 #else 264 #define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) != '=')) 265 #endif 266 267 SV* 268 encode_qp(sv,...) 269 SV* sv 270 PROTOTYPE: $;$$ 271 272 PREINIT: 273 char *eol; 274 STRLEN eol_len; 275 int binary; 276 STRLEN sv_len; 277 STRLEN linelen; 278 char *beg; 279 char *end; 280 char *p; 281 char *p_beg; 282 STRLEN p_len; 283 284 CODE: 285 #if PERL_REVISION == 5 && PERL_VERSION >= 6 286 sv_utf8_downgrade(sv, FALSE); 287 #endif 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); 291 } else { 292 eol = "\n"; 293 eol_len = 1; 294 } 295 296 binary = (items > 2 && SvTRUE(ST(2))); 297 298 beg = SvPV(sv, sv_len); 299 end = beg + sv_len; 300 301 RETVAL = newSV(sv_len + 1); 302 sv_setpv(RETVAL, ""); 303 linelen = 0; 304 305 p = beg; 306 while (1) { 307 p_beg = p; 308 309 /* skip past as much plain text as possible */ 310 while (p < end && qp_isplain(*p)) { 311 p++; 312 } 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) == ' ')) 316 p--; 317 } 318 319 p_len = p - p_beg; 320 if (p_len) { 321 /* output plain text (with line breaks) */ 322 if (eol_len) { 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; 330 if (len > p_len) 331 len = p_len; 332 sv_catpvn(RETVAL, p_beg, len); 333 p_beg += len; 334 p_len -= len; 335 sv_catpvn(RETVAL, "=", 1); 336 sv_catpvn(RETVAL, eol, eol_len); 337 linelen = 0; 338 } 339 } 340 if (p_len) { 341 sv_catpvn(RETVAL, p_beg, p_len); 342 linelen += p_len; 343 } 344 } 345 346 if (p == end) { 347 break; 348 } 349 else if (*p == '\n' && eol_len && !binary) { 350 sv_catpvn(RETVAL, eol, eol_len); 351 p++; 352 linelen = 0; 353 } 354 else { 355 /* output escaped char (with line breaks) */ 356 assert(p < end); 357 if (eol_len && linelen > MAX_LINE - 4) { 358 sv_catpvn(RETVAL, "=", 1); 359 sv_catpvn(RETVAL, eol, eol_len); 360 linelen = 0; 361 } 362 sv_catpvf(RETVAL, "=%02X", (unsigned char)*p); 363 p++; 364 linelen += 3; 365 } 366 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); 371 } 372 } 373 374 if (SvCUR(RETVAL) && eol_len && linelen) { 375 sv_catpvn(RETVAL, "=", 1); 376 sv_catpvn(RETVAL, eol, eol_len); 377 } 378 379 OUTPUT: 380 RETVAL 381 382 SV* 383 decode_qp(sv) 384 SV* sv 385 PROTOTYPE: $ 386 387 PREINIT: 388 STRLEN len; 389 char *str = SvPVbyte(sv, len); 390 char const* end = str + len; 391 char *r; 392 char *whitespace = 0; 393 394 CODE: 395 RETVAL = newSV(len ? len : 1); 396 SvPOK_on(RETVAL); 397 r = SvPVX(RETVAL); 398 while (str < end) { 399 if (*str == ' ' || *str == '\t') { 400 if (!whitespace) 401 whitespace = str; 402 str++; 403 } 404 else if (*str == '\r' && (str + 1) < end && str[1] == '\n') { 405 str++; 406 } 407 else if (*str == '\n') { 408 whitespace = 0; 409 *r++ = *str++; 410 } 411 else { 412 if (whitespace) { 413 while (whitespace < str) { 414 *r++ = *whitespace++; 415 } 416 whitespace = 0; 417 } 418 if (*str == '=') { 419 if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) { 420 char buf[3]; 421 str++; 422 buf[0] = *str++; 423 buf[1] = *str++; 424 buf[2] = '\0'; 425 *r++ = (char)strtol(buf, 0, 16); 426 } 427 else { 428 /* look for soft line break */ 429 char *p = str + 1; 430 while (p < end && (*p == ' ' || *p == '\t')) 431 p++; 432 if (p < end && *p == '\n') 433 str = p + 1; 434 else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n') 435 str = p + 2; 436 else 437 *r++ = *str++; /* give up */ 438 } 439 } 440 else { 441 *r++ = *str++; 442 } 443 } 444 } 445 if (whitespace) { 446 while (whitespace < str) { 447 *r++ = *whitespace++; 448 } 449 } 450 *r = '\0'; 451 SvCUR_set(RETVAL, r - SvPVX(RETVAL)); 452 453 OUTPUT: 454 RETVAL 455 456 457 MODULE = MIME::Base64 PACKAGE = MIME::Base64 458