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 #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_ register 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         register 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         register 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