"Fossies" - the Fresh Open Source Software Archive

Member "MIME-Base64-3.16/Base64.xs" (27 Sep 2020, 11793 Bytes) of package /linux/privat/MIME-Base64-3.16.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the latest Fossies "Diffs" side-by-side code changes report for "Base64.xs": 3.15_vs_3.16.

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