cpan/MIME-Base64/Base64.xs

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