ext/MIME/Base64/Base64.xs

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