cpan/MIME-Base64/Base64.xs

   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