| 1 | /* |
| 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 | #define MAX_LINE 76 /* size of encoded lines */ |
| 40 | |
| 41 | static const char basis_64[] = |
| 42 | "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; |
| 43 | |
| 44 | #define XX 255 /* illegal base64 char */ |
| 45 | #define EQ 254 /* padding */ |
| 46 | #define INVALID XX |
| 47 | |
| 48 | static const unsigned char index_64[256] = { |
| 49 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 50 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 51 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63, |
| 52 | 52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX, |
| 53 | XX, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11,12,13,14, |
| 54 | 15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX, |
| 55 | XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40, |
| 56 | 41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX, |
| 57 | |
| 58 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 59 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 60 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 61 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,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 | }; |
| 67 | |
| 68 | #ifdef SvPVbyte |
| 69 | # if PERL_REVISION == 5 && PERL_VERSION < 7 |
| 70 | /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ |
| 71 | # undef SvPVbyte |
| 72 | # define SvPVbyte(sv, lp) \ |
| 73 | ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ |
| 74 | ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) |
| 75 | static char * |
| 76 | my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) |
| 77 | { |
| 78 | sv_utf8_downgrade(sv,0); |
| 79 | return SvPV(sv,*lp); |
| 80 | } |
| 81 | # endif |
| 82 | #else |
| 83 | # define SvPVbyte SvPV |
| 84 | #endif |
| 85 | |
| 86 | #ifndef isXDIGIT |
| 87 | # define isXDIGIT isxdigit |
| 88 | #endif |
| 89 | |
| 90 | #ifndef NATIVE_TO_ASCII |
| 91 | # define NATIVE_TO_ASCII(ch) (ch) |
| 92 | #endif |
| 93 | |
| 94 | MODULE = MIME::Base64 PACKAGE = MIME::Base64 |
| 95 | |
| 96 | SV* |
| 97 | encode_base64(sv,...) |
| 98 | SV* sv |
| 99 | PROTOTYPE: $;$ |
| 100 | |
| 101 | PREINIT: |
| 102 | char *str; /* string to encode */ |
| 103 | SSize_t len; /* length of the string */ |
| 104 | const 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; |
| 109 | int chunk; |
| 110 | U32 had_utf8; |
| 111 | |
| 112 | CODE: |
| 113 | #if PERL_REVISION == 5 && PERL_VERSION >= 6 |
| 114 | had_utf8 = SvUTF8(sv); |
| 115 | sv_utf8_downgrade(sv, FALSE); |
| 116 | #endif |
| 117 | str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */ |
| 118 | len = (SSize_t)rlen; |
| 119 | |
| 120 | /* set up EOL from the second argument if present, default to "\n" */ |
| 121 | if (items > 1 && SvOK(ST(1))) { |
| 122 | eol = SvPV(ST(1), eollen); |
| 123 | } else { |
| 124 | eol = "\n"; |
| 125 | eollen = 1; |
| 126 | } |
| 127 | |
| 128 | /* calculate the length of the result */ |
| 129 | rlen = (len+2) / 3 * 4; /* encoded bytes */ |
| 130 | if (rlen) { |
| 131 | /* add space for EOL */ |
| 132 | rlen += ((rlen-1) / MAX_LINE + 1) * eollen; |
| 133 | } |
| 134 | |
| 135 | /* allocate a result buffer */ |
| 136 | RETVAL = newSV(rlen ? rlen : 1); |
| 137 | SvPOK_on(RETVAL); |
| 138 | SvCUR_set(RETVAL, rlen); |
| 139 | r = SvPVX(RETVAL); |
| 140 | |
| 141 | /* encode */ |
| 142 | for (chunk=0; len > 0; len -= 3, chunk++) { |
| 143 | if (chunk == (MAX_LINE/4)) { |
| 144 | const char *c = eol; |
| 145 | const char *e = eol + eollen; |
| 146 | while (c < e) |
| 147 | *r++ = *c++; |
| 148 | chunk = 0; |
| 149 | } |
| 150 | c1 = *str++; |
| 151 | c2 = len > 1 ? *str++ : '\0'; |
| 152 | *r++ = basis_64[c1>>2]; |
| 153 | *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)]; |
| 154 | if (len > 2) { |
| 155 | c3 = *str++; |
| 156 | *r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)]; |
| 157 | *r++ = basis_64[c3 & 0x3F]; |
| 158 | } else if (len == 2) { |
| 159 | *r++ = basis_64[(c2 & 0xF) << 2]; |
| 160 | *r++ = '='; |
| 161 | } else { /* len == 1 */ |
| 162 | *r++ = '='; |
| 163 | *r++ = '='; |
| 164 | } |
| 165 | } |
| 166 | if (rlen) { |
| 167 | /* append eol to the result string */ |
| 168 | const char *c = eol; |
| 169 | const char *e = eol + eollen; |
| 170 | while (c < e) |
| 171 | *r++ = *c++; |
| 172 | } |
| 173 | *r = '\0'; /* every SV in perl should be NUL-terminated */ |
| 174 | #if PERL_REVISION == 5 && PERL_VERSION >= 6 |
| 175 | if (had_utf8) |
| 176 | sv_utf8_upgrade(sv); |
| 177 | #endif |
| 178 | |
| 179 | OUTPUT: |
| 180 | RETVAL |
| 181 | |
| 182 | SV* |
| 183 | decode_base64(sv) |
| 184 | SV* sv |
| 185 | PROTOTYPE: $ |
| 186 | |
| 187 | PREINIT: |
| 188 | STRLEN len; |
| 189 | register unsigned char *str = (unsigned char*)SvPV(sv, len); |
| 190 | unsigned char const* end = str + len; |
| 191 | char *r; |
| 192 | unsigned char c[4]; |
| 193 | |
| 194 | CODE: |
| 195 | { |
| 196 | /* always enough, but might be too much */ |
| 197 | STRLEN rlen = len * 3 / 4; |
| 198 | RETVAL = newSV(rlen ? rlen : 1); |
| 199 | } |
| 200 | SvPOK_on(RETVAL); |
| 201 | r = SvPVX(RETVAL); |
| 202 | |
| 203 | while (str < end) { |
| 204 | int i = 0; |
| 205 | do { |
| 206 | unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)]; |
| 207 | if (uc != INVALID) |
| 208 | c[i++] = uc; |
| 209 | |
| 210 | if (str == end) { |
| 211 | if (i < 4) { |
| 212 | if (i < 2) goto thats_it; |
| 213 | if (i == 2) c[2] = EQ; |
| 214 | c[3] = EQ; |
| 215 | } |
| 216 | break; |
| 217 | } |
| 218 | } while (i < 4); |
| 219 | |
| 220 | if (c[0] == EQ || c[1] == EQ) { |
| 221 | break; |
| 222 | } |
| 223 | /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/ |
| 224 | |
| 225 | *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4); |
| 226 | |
| 227 | if (c[2] == EQ) |
| 228 | break; |
| 229 | *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2); |
| 230 | |
| 231 | if (c[3] == EQ) |
| 232 | break; |
| 233 | *r++ = ((c[2] & 0x03) << 6) | c[3]; |
| 234 | } |
| 235 | |
| 236 | thats_it: |
| 237 | SvCUR_set(RETVAL, r - SvPVX(RETVAL)); |
| 238 | *r = '\0'; |
| 239 | |
| 240 | OUTPUT: |
| 241 | RETVAL |
| 242 | |
| 243 | int |
| 244 | encoded_base64_length(sv,...) |
| 245 | SV* sv |
| 246 | PROTOTYPE: $;$ |
| 247 | |
| 248 | PREINIT: |
| 249 | SSize_t len; /* length of the string */ |
| 250 | STRLEN eollen; /* length of the EOL sequence */ |
| 251 | U32 had_utf8; |
| 252 | |
| 253 | CODE: |
| 254 | #if PERL_REVISION == 5 && PERL_VERSION >= 6 |
| 255 | had_utf8 = SvUTF8(sv); |
| 256 | sv_utf8_downgrade(sv, FALSE); |
| 257 | #endif |
| 258 | len = SvCUR(sv); |
| 259 | #if PERL_REVISION == 5 && PERL_VERSION >= 6 |
| 260 | if (had_utf8) |
| 261 | sv_utf8_upgrade(sv); |
| 262 | #endif |
| 263 | |
| 264 | if (items > 1 && SvOK(ST(1))) { |
| 265 | eollen = SvCUR(ST(1)); |
| 266 | } else { |
| 267 | eollen = 1; |
| 268 | } |
| 269 | |
| 270 | RETVAL = (len+2) / 3 * 4; /* encoded bytes */ |
| 271 | if (RETVAL) { |
| 272 | RETVAL += ((RETVAL-1) / MAX_LINE + 1) * eollen; |
| 273 | } |
| 274 | |
| 275 | OUTPUT: |
| 276 | RETVAL |
| 277 | |
| 278 | int |
| 279 | decoded_base64_length(sv) |
| 280 | SV* sv |
| 281 | PROTOTYPE: $ |
| 282 | |
| 283 | PREINIT: |
| 284 | STRLEN len; |
| 285 | register unsigned char *str = (unsigned char*)SvPV(sv, len); |
| 286 | unsigned char const* end = str + len; |
| 287 | int i = 0; |
| 288 | |
| 289 | CODE: |
| 290 | RETVAL = 0; |
| 291 | while (str < end) { |
| 292 | unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)]; |
| 293 | if (uc == INVALID) |
| 294 | continue; |
| 295 | if (uc == EQ) |
| 296 | break; |
| 297 | if (i++) { |
| 298 | RETVAL++; |
| 299 | if (i == 4) |
| 300 | i = 0; |
| 301 | } |
| 302 | } |
| 303 | |
| 304 | OUTPUT: |
| 305 | RETVAL |
| 306 | |
| 307 | |
| 308 | MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint |
| 309 | |
| 310 | #ifdef EBCDIC |
| 311 | #define qp_isplain(c) ((c) == '\t' || ((!isprint(c) && (c) != '='))) |
| 312 | #else |
| 313 | #define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) != '=')) |
| 314 | #endif |
| 315 | |
| 316 | SV* |
| 317 | encode_qp(sv,...) |
| 318 | SV* sv |
| 319 | PROTOTYPE: $;$$ |
| 320 | |
| 321 | PREINIT: |
| 322 | const char *eol; |
| 323 | STRLEN eol_len; |
| 324 | int binary; |
| 325 | STRLEN sv_len; |
| 326 | STRLEN linelen; |
| 327 | char *beg; |
| 328 | char *end; |
| 329 | char *p; |
| 330 | char *p_beg; |
| 331 | STRLEN p_len; |
| 332 | U32 had_utf8; |
| 333 | |
| 334 | CODE: |
| 335 | #if PERL_REVISION == 5 && PERL_VERSION >= 6 |
| 336 | had_utf8 = SvUTF8(sv); |
| 337 | sv_utf8_downgrade(sv, FALSE); |
| 338 | #endif |
| 339 | /* set up EOL from the second argument if present, default to "\n" */ |
| 340 | if (items > 1 && SvOK(ST(1))) { |
| 341 | eol = SvPV(ST(1), eol_len); |
| 342 | } else { |
| 343 | eol = "\n"; |
| 344 | eol_len = 1; |
| 345 | } |
| 346 | |
| 347 | binary = (items > 2 && SvTRUE(ST(2))); |
| 348 | |
| 349 | beg = SvPV(sv, sv_len); |
| 350 | end = beg + sv_len; |
| 351 | |
| 352 | RETVAL = newSV(sv_len + 1); |
| 353 | sv_setpv(RETVAL, ""); |
| 354 | linelen = 0; |
| 355 | |
| 356 | p = beg; |
| 357 | while (1) { |
| 358 | p_beg = p; |
| 359 | |
| 360 | /* skip past as much plain text as possible */ |
| 361 | while (p < end && qp_isplain(*p)) { |
| 362 | p++; |
| 363 | } |
| 364 | if (p == end || *p == '\n') { |
| 365 | /* whitespace at end of line must be encoded */ |
| 366 | while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' ')) |
| 367 | p--; |
| 368 | } |
| 369 | |
| 370 | p_len = p - p_beg; |
| 371 | if (p_len) { |
| 372 | /* output plain text (with line breaks) */ |
| 373 | if (eol_len) { |
| 374 | while (p_len > MAX_LINE - 1 - linelen) { |
| 375 | STRLEN len = MAX_LINE - 1 - linelen; |
| 376 | sv_catpvn(RETVAL, p_beg, len); |
| 377 | p_beg += len; |
| 378 | p_len -= len; |
| 379 | sv_catpvn(RETVAL, "=", 1); |
| 380 | sv_catpvn(RETVAL, eol, eol_len); |
| 381 | linelen = 0; |
| 382 | } |
| 383 | } |
| 384 | if (p_len) { |
| 385 | sv_catpvn(RETVAL, p_beg, p_len); |
| 386 | linelen += p_len; |
| 387 | } |
| 388 | } |
| 389 | |
| 390 | if (p == end) { |
| 391 | break; |
| 392 | } |
| 393 | else if (*p == '\n' && eol_len && !binary) { |
| 394 | if (linelen == 1 && SvCUR(RETVAL) > eol_len + 1 && (SvEND(RETVAL)-eol_len)[-2] == '=') { |
| 395 | /* fixup useless soft linebreak */ |
| 396 | (SvEND(RETVAL)-eol_len)[-2] = SvEND(RETVAL)[-1]; |
| 397 | SvCUR_set(RETVAL, SvCUR(RETVAL) - 1); |
| 398 | } |
| 399 | else { |
| 400 | sv_catpvn(RETVAL, eol, eol_len); |
| 401 | } |
| 402 | p++; |
| 403 | linelen = 0; |
| 404 | } |
| 405 | else { |
| 406 | /* output escaped char (with line breaks) */ |
| 407 | assert(p < end); |
| 408 | if (eol_len && linelen > MAX_LINE - 4 && !(linelen == MAX_LINE - 3 && p + 1 < end && p[1] == '\n' && !binary)) { |
| 409 | sv_catpvn(RETVAL, "=", 1); |
| 410 | sv_catpvn(RETVAL, eol, eol_len); |
| 411 | linelen = 0; |
| 412 | } |
| 413 | sv_catpvf(RETVAL, "=%02X", (unsigned char)*p); |
| 414 | p++; |
| 415 | linelen += 3; |
| 416 | } |
| 417 | |
| 418 | /* optimize reallocs a bit */ |
| 419 | if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) { |
| 420 | STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg); |
| 421 | SvGROW(RETVAL, expected_len); |
| 422 | } |
| 423 | } |
| 424 | |
| 425 | if (SvCUR(RETVAL) && eol_len && linelen) { |
| 426 | sv_catpvn(RETVAL, "=", 1); |
| 427 | sv_catpvn(RETVAL, eol, eol_len); |
| 428 | } |
| 429 | #if PERL_REVISION == 5 && PERL_VERSION >= 6 |
| 430 | if (had_utf8) |
| 431 | sv_utf8_upgrade(sv); |
| 432 | #endif |
| 433 | |
| 434 | OUTPUT: |
| 435 | RETVAL |
| 436 | |
| 437 | SV* |
| 438 | decode_qp(sv) |
| 439 | SV* sv |
| 440 | PROTOTYPE: $ |
| 441 | |
| 442 | PREINIT: |
| 443 | STRLEN len; |
| 444 | char *str = SvPVbyte(sv, len); |
| 445 | char const* end = str + len; |
| 446 | char *r; |
| 447 | char *whitespace = 0; |
| 448 | |
| 449 | CODE: |
| 450 | RETVAL = newSV(len ? len : 1); |
| 451 | SvPOK_on(RETVAL); |
| 452 | r = SvPVX(RETVAL); |
| 453 | while (str < end) { |
| 454 | if (*str == ' ' || *str == '\t') { |
| 455 | if (!whitespace) |
| 456 | whitespace = str; |
| 457 | str++; |
| 458 | } |
| 459 | else if (*str == '\r' && (str + 1) < end && str[1] == '\n') { |
| 460 | str++; |
| 461 | } |
| 462 | else if (*str == '\n') { |
| 463 | whitespace = 0; |
| 464 | *r++ = *str++; |
| 465 | } |
| 466 | else { |
| 467 | if (whitespace) { |
| 468 | while (whitespace < str) { |
| 469 | *r++ = *whitespace++; |
| 470 | } |
| 471 | whitespace = 0; |
| 472 | } |
| 473 | if (*str == '=') { |
| 474 | if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) { |
| 475 | char buf[3]; |
| 476 | str++; |
| 477 | buf[0] = *str++; |
| 478 | buf[1] = *str++; |
| 479 | buf[2] = '\0'; |
| 480 | *r++ = (char)strtol(buf, 0, 16); |
| 481 | } |
| 482 | else { |
| 483 | /* look for soft line break */ |
| 484 | char *p = str + 1; |
| 485 | while (p < end && (*p == ' ' || *p == '\t')) |
| 486 | p++; |
| 487 | if (p < end && *p == '\n') |
| 488 | str = p + 1; |
| 489 | else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n') |
| 490 | str = p + 2; |
| 491 | else |
| 492 | *r++ = *str++; /* give up */ |
| 493 | } |
| 494 | } |
| 495 | else { |
| 496 | *r++ = *str++; |
| 497 | } |
| 498 | } |
| 499 | } |
| 500 | if (whitespace) { |
| 501 | while (whitespace < str) { |
| 502 | *r++ = *whitespace++; |
| 503 | } |
| 504 | } |
| 505 | *r = '\0'; |
| 506 | SvCUR_set(RETVAL, r - SvPVX(RETVAL)); |
| 507 | |
| 508 | OUTPUT: |
| 509 | RETVAL |
| 510 | |
| 511 | |
| 512 | MODULE = MIME::Base64 PACKAGE = MIME::Base64 |