ext/MIME/Base64/Base64.xs

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