| Commit | Line | Data |
|---|
| 6a63fb82 |
1 | /* $Id: Base64.xs,v 1.32 2003/01/05 07:49:07 gisle Exp $ |
| 6fba102d |
2 | |
| 6a63fb82 |
3 | Copyright 1997-2003 Gisle Aas |
| 6fba102d |
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 | |
| 7d85a32c |
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", |
| 6fba102d |
23 | WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. |
| 24 | |
| 25 | */ |
| 26 | |
| 27 | |
| 28 | #ifdef __cplusplus |
| 29 | extern "C" { |
| 30 | #endif |
| 31 | #include "EXTERN.h" |
| 32 | #include "perl.h" |
| 33 | #include "XSUB.h" |
| 34 | #ifdef __cplusplus |
| 35 | } |
| 36 | #endif |
| 37 | |
| a3bf621f |
38 | #ifndef PATCHLEVEL |
| 39 | # include <patchlevel.h> |
| 40 | # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL))) |
| 41 | # include <could_not_find_Perl_patchlevel.h> |
| 42 | # endif |
| 43 | #endif |
| 44 | |
| 6a63fb82 |
45 | #if PATCHLEVEL <= 4 && !defined(PL_dowarn) |
| 46 | #define PL_dowarn dowarn |
| 47 | #endif |
| 6fba102d |
48 | |
| 49 | #define MAX_LINE 76 /* size of encoded lines */ |
| 50 | |
| 51 | static char basis_64[] = |
| 52 | "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; |
| 53 | |
| 54 | #define XX 255 /* illegal base64 char */ |
| 55 | #define EQ 254 /* padding */ |
| 56 | #define INVALID XX |
| 57 | |
| 58 | static unsigned char index_64[256] = { |
| 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,62, XX,XX,XX,63, |
| 62 | 52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX, |
| 63 | XX, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11,12,13,14, |
| 64 | 15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX, |
| 65 | XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40, |
| 66 | 41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX, |
| 67 | |
| 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,XX, XX,XX,XX,XX, |
| 70 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 71 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 72 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 73 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 74 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 75 | XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, |
| 76 | }; |
| 77 | |
| 6a63fb82 |
78 | #ifdef SvPVbyte |
| 79 | # if PERL_REVISION == 5 && PERL_VERSION < 7 |
| 80 | /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ |
| 81 | # undef SvPVbyte |
| 82 | # define SvPVbyte(sv, lp) \ |
| 83 | ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ |
| 84 | ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) |
| 85 | static char * |
| 86 | my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) |
| 87 | { |
| 88 | sv_utf8_downgrade(sv,0); |
| 89 | return SvPV(sv,*lp); |
| 90 | } |
| 91 | # endif |
| 92 | #else |
| 93 | # define SvPVbyte SvPV |
| 94 | #endif |
| 6fba102d |
95 | |
| 6a63fb82 |
96 | #ifndef NATIVE_TO_ASCII |
| 97 | # define NATIVE_TO_ASCII(ch) (ch) |
| 98 | #endif |
| 6fba102d |
99 | |
| 100 | MODULE = MIME::Base64 PACKAGE = MIME::Base64 |
| 101 | |
| 102 | SV* |
| 103 | encode_base64(sv,...) |
| 104 | SV* sv |
| 105 | PROTOTYPE: $;$ |
| 106 | |
| 107 | PREINIT: |
| 108 | char *str; /* string to encode */ |
| 109 | SSize_t len; /* length of the string */ |
| 110 | char *eol; /* the end-of-line sequence to use */ |
| 111 | STRLEN eollen; /* length of the EOL sequence */ |
| 112 | char *r; /* result string */ |
| 113 | STRLEN rlen; /* length of result string */ |
| 114 | unsigned char c1, c2, c3; |
| 115 | int chunk; |
| 116 | |
| 117 | CODE: |
| 6a63fb82 |
118 | #if PERL_REVISION == 5 && PERL_VERSION >= 6 |
| 6fba102d |
119 | sv_utf8_downgrade(sv, FALSE); |
| 6a63fb82 |
120 | #endif |
| 6fba102d |
121 | str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */ |
| 122 | len = (SSize_t)rlen; |
| 123 | |
| 124 | /* set up EOL from the second argument if present, default to "\n" */ |
| 125 | if (items > 1 && SvOK(ST(1))) { |
| 126 | eol = SvPV(ST(1), eollen); |
| 127 | } else { |
| 128 | eol = "\n"; |
| 129 | eollen = 1; |
| 130 | } |
| 131 | |
| 132 | /* calculate the length of the result */ |
| 133 | rlen = (len+2) / 3 * 4; /* encoded bytes */ |
| 134 | if (rlen) { |
| 135 | /* add space for EOL */ |
| 136 | rlen += ((rlen-1) / MAX_LINE + 1) * eollen; |
| 137 | } |
| 138 | |
| 139 | /* allocate a result buffer */ |
| 140 | RETVAL = newSV(rlen ? rlen : 1); |
| 141 | SvPOK_on(RETVAL); |
| 142 | SvCUR_set(RETVAL, rlen); |
| 143 | r = SvPVX(RETVAL); |
| 144 | |
| 145 | /* encode */ |
| 146 | for (chunk=0; len > 0; len -= 3, chunk++) { |
| 147 | if (chunk == (MAX_LINE/4)) { |
| 148 | char *c = eol; |
| 149 | char *e = eol + eollen; |
| 150 | while (c < e) |
| 151 | *r++ = *c++; |
| 152 | chunk = 0; |
| 153 | } |
| 154 | c1 = *str++; |
| 155 | c2 = *str++; |
| 156 | *r++ = basis_64[c1>>2]; |
| 157 | *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)]; |
| 158 | if (len > 2) { |
| 159 | c3 = *str++; |
| 160 | *r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)]; |
| 161 | *r++ = basis_64[c3 & 0x3F]; |
| 162 | } else if (len == 2) { |
| 163 | *r++ = basis_64[(c2 & 0xF) << 2]; |
| 164 | *r++ = '='; |
| 165 | } else { /* len == 1 */ |
| 166 | *r++ = '='; |
| 167 | *r++ = '='; |
| 168 | } |
| 169 | } |
| 170 | if (rlen) { |
| 171 | /* append eol to the result string */ |
| 172 | char *c = eol; |
| 173 | char *e = eol + eollen; |
| 174 | while (c < e) |
| 175 | *r++ = *c++; |
| 176 | } |
| 177 | *r = '\0'; /* every SV in perl should be NUL-terminated */ |
| 178 | |
| 179 | OUTPUT: |
| 180 | RETVAL |
| 181 | |
| 182 | SV* |
| 183 | decode_base64(sv) |
| 184 | SV* sv |
| 185 | PROTOTYPE: $ |
| 186 | |
| 187 | PREINIT: |
| 188 | STRLEN len; |
| 7d85a32c |
189 | register unsigned char *str = (unsigned char*)SvPVbyte(sv, len); |
| 6fba102d |
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 { |
| 7d85a32c |
206 | unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)]; |
| 6fba102d |
207 | if (uc != INVALID) |
| 208 | c[i++] = uc; |
| 209 | |
| 210 | if (str == end) { |
| 211 | if (i < 4) { |
| 212 | if (i && PL_dowarn) |
| 213 | warn("Premature end of base64 data"); |
| 214 | if (i < 2) goto thats_it; |
| 215 | if (i == 2) c[2] = EQ; |
| 216 | c[3] = EQ; |
| 217 | } |
| 218 | break; |
| 219 | } |
| 220 | } while (i < 4); |
| 7d85a32c |
221 | |
| 6fba102d |
222 | if (c[0] == EQ || c[1] == EQ) { |
| 223 | if (PL_dowarn) warn("Premature padding of base64 data"); |
| 224 | break; |
| 225 | } |
| c6c619a9 |
226 | /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/ |
| 6fba102d |
227 | |
| 228 | *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4); |
| 229 | |
| 230 | if (c[2] == EQ) |
| 231 | break; |
| 232 | *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2); |
| 233 | |
| 234 | if (c[3] == EQ) |
| 235 | break; |
| 236 | *r++ = ((c[2] & 0x03) << 6) | c[3]; |
| 237 | } |
| 238 | |
| 239 | thats_it: |
| 240 | SvCUR_set(RETVAL, r - SvPVX(RETVAL)); |
| 241 | *r = '\0'; |
| 242 | |
| 243 | OUTPUT: |
| 244 | RETVAL |
| 6a63fb82 |
245 | |
| 246 | |
| 247 | MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint |
| 248 | |
| 249 | #define qp_isplain(c) ((c) == '\t' || ((c) >= ' ' && (c) <= '~') && (c) != '=') |
| 250 | |
| 251 | SV* |
| 252 | encode_qp(sv,...) |
| 253 | SV* sv |
| 254 | PROTOTYPE: $;$ |
| 255 | |
| 256 | PREINIT: |
| 257 | char *eol; |
| 258 | STRLEN eol_len; |
| 259 | STRLEN sv_len; |
| 260 | STRLEN linelen; |
| 261 | char *beg; |
| 262 | char *end; |
| 263 | char *p; |
| 264 | char *p_beg; |
| 265 | STRLEN p_len; |
| 266 | |
| 267 | CODE: |
| 268 | #if PERL_REVISION == 5 && PERL_VERSION >= 6 |
| 269 | sv_utf8_downgrade(sv, FALSE); |
| 270 | #endif |
| 271 | /* set up EOL from the second argument if present, default to "\n" */ |
| 272 | if (items > 1 && SvOK(ST(1))) { |
| 273 | eol = SvPV(ST(1), eol_len); |
| 274 | } else { |
| 275 | eol = "\n"; |
| 276 | eol_len = 1; |
| 277 | } |
| 278 | |
| 279 | beg = SvPV(sv, sv_len); |
| 280 | end = beg + sv_len; |
| 281 | |
| 282 | RETVAL = newSV(sv_len + 1); |
| 283 | sv_setpv(RETVAL, ""); |
| 284 | linelen = 0; |
| 285 | |
| 286 | p = beg; |
| 287 | while (1) { |
| 288 | p_beg = p; |
| 289 | |
| 290 | /* skip past as much plain text as possible */ |
| 291 | while (p < end && qp_isplain(*p)) { |
| 292 | p++; |
| 293 | } |
| 294 | if (*p == '\n' || p == end) { |
| 295 | /* whitespace at end of line must be encoded */ |
| 296 | while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' ')) |
| 297 | p--; |
| 298 | } |
| 299 | |
| 300 | p_len = p - p_beg; |
| 301 | if (p_len) { |
| 302 | /* output plain text (with line breaks) */ |
| 303 | if (eol_len) { |
| 304 | STRLEN max_last_line = (*p == '\n' || p == end) |
| 305 | ? MAX_LINE /* .......\n */ |
| 306 | : (*(p + 1) == '\n' || (p + 1) == end) |
| 307 | ? MAX_LINE - 3 /* ....=XX\n */ |
| 308 | : MAX_LINE - 4; /* ...=XX=\n */ |
| 309 | while (p_len + linelen > max_last_line) { |
| 310 | STRLEN len = MAX_LINE - 1 - linelen; |
| 311 | if (len > p_len) |
| 312 | len = p_len; |
| 313 | sv_catpvn(RETVAL, p_beg, len); |
| 314 | p_beg += len; |
| 315 | p_len -= len; |
| 316 | sv_catpvn(RETVAL, "=", 1); |
| 317 | sv_catpvn(RETVAL, eol, eol_len); |
| 318 | linelen = 0; |
| 319 | } |
| 320 | } |
| 321 | if (p_len) { |
| 322 | sv_catpvn(RETVAL, p_beg, p_len); |
| 323 | linelen += p_len; |
| 324 | } |
| 325 | } |
| 326 | |
| 327 | if (*p == '\n') { |
| 328 | sv_catpvn(RETVAL, eol, eol_len); |
| 329 | p++; |
| 330 | linelen = 0; |
| 331 | } |
| 332 | else if (p < end) { |
| 333 | /* output escaped char (with line breaks) */ |
| 334 | if (eol_len && linelen > MAX_LINE - 4) { |
| 335 | sv_catpvn(RETVAL, "=", 1); |
| 336 | sv_catpvn(RETVAL, eol, eol_len); |
| 337 | linelen = 0; |
| 338 | } |
| 339 | sv_catpvf(RETVAL, "=%02X", (unsigned char)*p); |
| 340 | p++; |
| 341 | linelen += 3; |
| 342 | } |
| 343 | else { |
| 344 | assert(p == end); |
| 345 | break; |
| 346 | } |
| 347 | |
| 348 | /* optimize reallocs a bit */ |
| 349 | if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) { |
| 350 | STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg); |
| 351 | SvGROW(RETVAL, expected_len); |
| 352 | } |
| 353 | } |
| 354 | |
| 355 | OUTPUT: |
| 356 | RETVAL |
| 357 | |
| 358 | SV* |
| 359 | decode_qp(sv) |
| 360 | SV* sv |
| 361 | PROTOTYPE: $ |
| 362 | |
| 363 | PREINIT: |
| 364 | STRLEN len; |
| 7235ff25 |
365 | char *str = SvPVbyte(sv, len); |
| 6a63fb82 |
366 | char const* end = str + len; |
| 367 | char *r; |
| 368 | char *whitespace = 0; |
| 369 | |
| 370 | CODE: |
| 371 | RETVAL = newSV(len ? len : 1); |
| 372 | SvPOK_on(RETVAL); |
| 373 | r = SvPVX(RETVAL); |
| 374 | while (str < end) { |
| 375 | if (*str == ' ' || *str == '\t') { |
| 376 | if (!whitespace) |
| 377 | whitespace = str; |
| 378 | str++; |
| 379 | } |
| 380 | else if (*str == '\r' && (str + 1) < end && str[1] == '\n') { |
| 381 | str++; |
| 382 | } |
| 383 | else if (*str == '\n') { |
| 384 | whitespace = 0; |
| 385 | *r++ = *str++; |
| 386 | } |
| 387 | else { |
| 388 | if (whitespace) { |
| 389 | while (whitespace < str) { |
| 390 | *r++ = *whitespace++; |
| 391 | } |
| 392 | whitespace = 0; |
| 393 | } |
| 394 | if (*str == '=' && (str + 2) < end && isxdigit(str[1]) && isxdigit(str[2])) { |
| 395 | char buf[3]; |
| 396 | str++; |
| 397 | buf[0] = *str++; |
| 398 | buf[1] = *str++; |
| 399 | buf[2] = '\0'; |
| 400 | *r++ = (char)strtol(buf, 0, 16); |
| 401 | } |
| 402 | else if (*str == '=' && (str + 1) < end && str[1] == '\n') { |
| 403 | str += 2; |
| 404 | } |
| 405 | else if (*str == '=' && (str + 2) < end && str[1] == '\r' && str[2] == '\n') { |
| 406 | str += 3; |
| 407 | } |
| 408 | else { |
| 409 | *r++ = *str++; |
| 410 | } |
| 411 | } |
| 412 | } |
| 413 | *r = '\0'; |
| 414 | SvCUR_set(RETVAL, r - SvPVX(RETVAL)); |
| 415 | |
| 416 | OUTPUT: |
| 417 | RETVAL |
| 418 | |
| 419 | |
| 420 | MODULE = MIME::Base64 PACKAGE = MIME::Base64 |
projects / p5sagit/p5-mst-13.2.git / blame