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