ext/MIME/Base64/Base64.xs

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