ext/MIME/Base64/Base64.xs

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