ext/MIME/Base64/Base64.xs

   1 /* $Id: Base64.xs,v 3.2 2004/03/29 11:35:13 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 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 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         STRLEN sv_len;
 272         STRLEN linelen;
 273         char *beg;
 274         char *end;
 275         char *p;
 276         char *p_beg;
 277         STRLEN p_len;
 278
 279         CODE:
 280 #if PERL_REVISION == 5 && PERL_VERSION >= 6
 281         sv_utf8_downgrade(sv, FALSE);
 282 #endif
 283         /* set up EOL from the second argument if present, default to "\n" */
 284         if (items > 1 && SvOK(ST(1))) {
 285             eol = SvPV(ST(1), eol_len);
 286         } else {
 287             eol = "\n";
 288             eol_len = 1;
 289         }
 290
 291         beg = SvPV(sv, sv_len);
 292         end = beg + sv_len;
 293
 294         RETVAL = newSV(sv_len + 1);
 295         sv_setpv(RETVAL, "");
 296         linelen = 0;
 297
 298         p = beg;
 299         while (1) {
 300             p_beg = p;
 301
 302             /* skip past as much plain text as possible */
 303             while (p < end && qp_isplain(*p)) {
 304                 p++;
 305             }
 306             if (p == end || *p == '\n') {
 307                 /* whitespace at end of line must be encoded */
 308                 while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
 309                     p--;
 310             }
 311
 312             p_len = p - p_beg;
 313             if (p_len) {
 314                 /* output plain text (with line breaks) */
 315                 if (eol_len) {
 316                     STRLEN max_last_line = (p == end || *p == '\n')
 317                                               ? MAX_LINE         /* .......\n */
 318                                               : ((p + 1) == end || *(p + 1) == '\n')
 319                                                 ? MAX_LINE - 3   /* ....=XX\n */
 320                                                 : MAX_LINE - 4;  /* ...=XX=\n */
 321                     while (p_len + linelen > max_last_line) {
 322                         STRLEN len = MAX_LINE - 1 - linelen;
 323                         if (len > p_len)
 324                             len = p_len;
 325                         sv_catpvn(RETVAL, p_beg, len);
 326                         p_beg += len;
 327                         p_len -= len;
 328                         sv_catpvn(RETVAL, "=", 1);
 329                         sv_catpvn(RETVAL, eol, eol_len);
 330                         linelen = 0;
 331                     }
 332                 }
 333                 if (p_len) {
 334                     sv_catpvn(RETVAL, p_beg, p_len);
 335                     linelen += p_len;
 336                 }
 337             }
 338
 339             if (p == end) {
 340                 break;
 341             }
 342             else if (*p == '\n' && eol_len) {
 343                 sv_catpvn(RETVAL, eol, eol_len);
 344                 p++;
 345                 linelen = 0;
 346             }
 347             else {
 348                 /* output escaped char (with line breaks) */
 349                 assert(p < end);
 350                 if (eol_len && linelen > MAX_LINE - 4) {
 351                     sv_catpvn(RETVAL, "=", 1);
 352                     sv_catpvn(RETVAL, eol, eol_len);
 353                     linelen = 0;
 354                 }
 355                 sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
 356                 p++;
 357                 linelen += 3;
 358             }
 359
 360             /* optimize reallocs a bit */
 361             if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
 362                 STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
 363                 SvGROW(RETVAL, expected_len);
 364             }
 365         }
 366
 367         OUTPUT:
 368         RETVAL
 369
 370 SV*
 371 decode_qp(sv)
 372         SV* sv
 373         PROTOTYPE: $
 374
 375         PREINIT:
 376         STRLEN len;
 377         char *str = SvPVbyte(sv, len);
 378         char const* end = str + len;
 379         char *r;
 380         char *whitespace = 0;
 381
 382         CODE:
 383         RETVAL = newSV(len ? len : 1);
 384         SvPOK_on(RETVAL);
 385         r = SvPVX(RETVAL);
 386         while (str < end) {
 387             if (*str == ' ' || *str == '\t') {
 388                 if (!whitespace)
 389                     whitespace = str;
 390                 str++;
 391             }
 392             else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
 393                 str++;
 394             }
 395             else if (*str == '\n') {
 396                 whitespace = 0;
 397                 *r++ = *str++;
 398             }
 399             else {
 400                 if (whitespace) {
 401                     while (whitespace < str) {
 402                         *r++ = *whitespace++;
 403                     }
 404                     whitespace = 0;
 405                 }
 406                 if (*str == '=') {
 407                     if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
 408                         char buf[3];
 409                         str++;
 410                         buf[0] = *str++;
 411                         buf[1] = *str++;
 412                         buf[2] = '\0';
 413                         *r++ = (char)strtol(buf, 0, 16);
 414                     }
 415                     else {
 416                         /* look for soft line break */
 417                         char *p = str + 1;
 418                         while (p < end && (*p == ' ' || *p == '\t'))
 419                             p++;
 420                         if (p < end && *p == '\n')
 421                             str = p + 1;
 422                         else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n')
 423                             str = p + 2;
 424                         else
 425                             *r++ = *str++; /* give up */
 426                     }
 427                 }
 428                 else {
 429                     *r++ = *str++;
 430                 }
 431             }
 432         }
 433         if (whitespace) {
 434             while (whitespace < str) {
 435                 *r++ = *whitespace++;
 436             }
 437         }
 438         *r = '\0';
 439         SvCUR_set(RETVAL, r - SvPVX(RETVAL));
 440
 441         OUTPUT:
 442         RETVAL
 443
 444
 445 MODULE = MIME::Base64           PACKAGE = MIME::Base64