1			/*
     2			 * This file was generated automatically by ExtUtils::ParseXS version 2.10 from the
     3			 * contents of Base64.xs. Do not edit this file, edit Base64.xs instead.
     4			 *
     5			 *	ANY CHANGES MADE HERE WILL BE LOST! 
     6			 *
     7			 */
     8			
     9			#line 1 "Base64.xs"
    10			/* $Id: Base64.xs,v 3.4 2004/08/24 16:29:35 gisle Exp $
    11			
    12			Copyright 1997-2004 Gisle Aas
    13			
    14			This library is free software; you can redistribute it and/or
    15			modify it under the same terms as Perl itself.
    16			
    17			
    18			The tables and some of the code that used to be here was borrowed from
    19			metamail, which comes with this message:
    20			
    21			  Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore)
    22			
    23			  Permission to use, copy, modify, and distribute this material
    24			  for any purpose and without fee is hereby granted, provided
    25			  that the above copyright notice and this permission notice
    26			  appear in all copies, and that the name of Bellcore not be
    27			  used in advertising or publicity pertaining to this
    28			  material without the specific, prior written permission
    29			  of an authorized representative of Bellcore.	BELLCORE
    30			  MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY
    31			  OF THIS MATERIAL FOR ANY PURPOSE.  IT IS PROVIDED "AS IS",
    32			  WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
    33			
    34			*/
    35			
    36			
    37			#ifdef __cplusplus
    38			extern "C" {
    39			#endif
    40			#define PERL_NO_GET_CONTEXT     /* we want efficiency */
    41			#include "EXTERN.h"
    42			#include "perl.h"
    43			#include "XSUB.h"
    44			#ifdef __cplusplus
    45			}
    46			#endif
    47			
    48			#ifndef PATCHLEVEL
    49			#    include <patchlevel.h>
    50			#    if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
    51			#        include <could_not_find_Perl_patchlevel.h>
    52			#    endif
    53			#endif
    54			
    55			#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
    56			   #define PL_dowarn dowarn
    57			#endif
    58			
    59			#ifdef G_WARN_ON
    60			   #define DOWARN (PL_dowarn & G_WARN_ON)
    61			#else
    62			   #define DOWARN PL_dowarn
    63			#endif
    64			
    65			
    66			#define MAX_LINE  76 /* size of encoded lines */
    67			
    68			static const char basis_64[] =
    69			   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
    70			
    71			#define XX      255	/* illegal base64 char */
    72			#define EQ      254	/* padding */
    73			#define INVALID XX
    74			
    75			static const unsigned char index_64[256] = {
    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,62, XX,XX,XX,63,
    79			    52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX,
    80			    XX, 0, 1, 2,  3, 4, 5, 6,  7, 8, 9,10, 11,12,13,14,
    81			    15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX,
    82			    XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
    83			    41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX,
    84			
    85			    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    86			    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    87			    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    88			    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    89			    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    90			    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    91			    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    92			    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    93			};
    94			
    95			#ifdef SvPVbyte
    96			#   if PERL_REVISION == 5 && PERL_VERSION < 7
    97			       /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
    98			#       undef SvPVbyte
    99			#       define SvPVbyte(sv, lp) \
   100			          ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
   101			           ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
   102			       static char *
   103			       my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
   104			       {   
   105			           sv_utf8_downgrade(sv,0);
   106			           return SvPV(sv,*lp);
   107			       }
   108			#   endif
   109			#else
   110			#   define SvPVbyte SvPV
   111			#endif
   112			
   113			#ifndef isXDIGIT
   114			#   define isXDIGIT isxdigit
   115			#endif
   116			
   117			#ifndef NATIVE_TO_ASCII
   118			#   define NATIVE_TO_ASCII(ch) (ch)
   119			#endif
   120			
   121			#ifndef PERL_UNUSED_VAR
   122			#  define PERL_UNUSED_VAR(var) if (0) var = var
   123			#endif
   124			
   125			#line 126 "Base64.c"
   126			
   127			XS(XS_MIME__Base64_encode_base64); /* prototype to pass -Wmissing-prototypes */
   128			XS(XS_MIME__Base64_encode_base64)
   129	        2898    {
   130	        2898        dXSARGS;
   131	        2898        if (items < 1)
   132	      ######    	Perl_croak(aTHX_ "Usage: MIME::Base64::encode_base64(sv, ...)");
   133	        2898        PERL_UNUSED_VAR(cv); /* -W */
   134			    {
   135	        2898    	SV*	sv = ST(0);
   136			#line 120 "Base64.xs"
   137				char *str;     /* string to encode */
   138				SSize_t len;   /* length of the string */
   139				char *eol;     /* the end-of-line sequence to use */
   140				STRLEN eollen; /* length of the EOL sequence */
   141				char *r;       /* result string */
   142				STRLEN rlen;   /* length of result string */
   143				unsigned char c1, c2, c3;
   144				int chunk;
   145			
   146			#line 147 "Base64.c"
   147	        2898    	SV *	RETVAL;
   148			#line 130 "Base64.xs"
   149			#if PERL_REVISION == 5 && PERL_VERSION >= 6
   150				sv_utf8_downgrade(sv, FALSE);
   151			#endif
   152				str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
   153				len = (SSize_t)rlen;
   154			
   155				/* set up EOL from the second argument if present, default to "\n" */
   156				if (items > 1 && SvOK(ST(1))) {
   157				    eol = SvPV(ST(1), eollen);
   158				} else {
   159				    eol = "\n";
   160				    eollen = 1;
   161				}
   162			
   163				/* calculate the length of the result */
   164				rlen = (len+2) / 3 * 4;	 /* encoded bytes */
   165				if (rlen) {
   166				    /* add space for EOL */
   167				    rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
   168				}
   169			
   170				/* allocate a result buffer */
   171				RETVAL = newSV(rlen ? rlen : 1);
   172				SvPOK_on(RETVAL);	
   173				SvCUR_set(RETVAL, rlen);
   174				r = SvPVX(RETVAL);
   175			
   176				/* encode */
   177				for (chunk=0; len > 0; len -= 3, chunk++) {
   178				    if (chunk == (MAX_LINE/4)) {
   179					char *c = eol;
   180					char *e = eol + eollen;
   181					while (c < e)
   182					    *r++ = *c++;
   183					chunk = 0;
   184				    }
   185				    c1 = *str++;
   186				    c2 = len > 1 ? *str++ : '\0';
   187				    *r++ = basis_64[c1>>2];
   188				    *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
   189				    if (len > 2) {
   190					c3 = *str++;
   191					*r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
   192					*r++ = basis_64[c3 & 0x3F];
   193				    } else if (len == 2) {
   194					*r++ = basis_64[(c2 & 0xF) << 2];
   195					*r++ = '=';
   196				    } else { /* len == 1 */
   197					*r++ = '=';
   198					*r++ = '=';
   199				    }
   200				}
   201				if (rlen) {
   202				    /* append eol to the result string */
   203				    char *c = eol;
   204				    char *e = eol + eollen;
   205				    while (c < e)
   206					*r++ = *c++;
   207				}
   208				*r = '\0';  /* every SV in perl should be NUL-terminated */
   209			
   210			#line 211 "Base64.c"
   211	        2897    	ST(0) = RETVAL;
   212	        2897    	sv_2mortal(ST(0));
   213			    }
   214	        2897        XSRETURN(1);
   215			}
   216			
   217			
   218			XS(XS_MIME__Base64_decode_base64); /* prototype to pass -Wmissing-prototypes */
   219			XS(XS_MIME__Base64_decode_base64)
   220	        2656    {
   221	        2656        dXSARGS;
   222	        2656        if (items != 1)
   223	      ######    	Perl_croak(aTHX_ "Usage: MIME::Base64::decode_base64(sv)");
   224	        2656        PERL_UNUSED_VAR(cv); /* -W */
   225			    {
   226	        2656    	SV*	sv = ST(0);
   227			#line 200 "Base64.xs"
   228				STRLEN len;
   229				register unsigned char *str = (unsigned char*)SvPVbyte(sv, len);
   230				unsigned char const* end = str + len;
   231				char *r;
   232				unsigned char c[4];
   233			
   234			#line 235 "Base64.c"
   235	        2656    	SV *	RETVAL;
   236			#line 207 "Base64.xs"
   237				{
   238				    /* always enough, but might be too much */
   239				    STRLEN rlen = len * 3 / 4;
   240				    RETVAL = newSV(rlen ? rlen : 1);
   241				}
   242			        SvPOK_on(RETVAL);
   243			        r = SvPVX(RETVAL);
   244			
   245				while (str < end) {
   246				    int i = 0;
   247			            do {
   248					unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
   249					if (uc != INVALID)
   250					    c[i++] = uc;
   251			
   252					if (str == end) {
   253					    if (i < 4) {
   254						if (i && DOWARN)
   255						    warn("Premature end of base64 data");
   256						if (i < 2) goto thats_it;
   257						if (i == 2) c[2] = EQ;
   258						c[3] = EQ;
   259					    }
   260					    break;
   261					}
   262			            } while (i < 4);
   263			
   264				    if (c[0] == EQ || c[1] == EQ) {
   265					if (DOWARN) warn("Premature padding of base64 data");
   266					break;
   267			            }
   268				    /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
   269			
   270				    *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);
   271			
   272				    if (c[2] == EQ)
   273					break;
   274				    *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2);
   275			
   276				    if (c[3] == EQ)
   277					break;
   278				    *r++ = ((c[2] & 0x03) << 6) | c[3];
   279				}
   280			
   281			      thats_it:
   282				SvCUR_set(RETVAL, r - SvPVX(RETVAL));
   283				*r = '\0';
   284			
   285			#line 286 "Base64.c"
   286	        2656    	ST(0) = RETVAL;
   287	        2656    	sv_2mortal(ST(0));
   288			    }
   289	        2656        XSRETURN(1);
   290			}
   291			
   292			#define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) != '='))
   293			
   294			XS(XS_MIME__QuotedPrint_encode_qp); /* prototype to pass -Wmissing-prototypes */
   295			XS(XS_MIME__QuotedPrint_encode_qp)
   296	          46    {
   297	          46        dXSARGS;
   298	          46        if (items < 1)
   299	      ######    	Perl_croak(aTHX_ "Usage: MIME::QuotedPrint::encode_qp(sv, ...)");
   300	          46        PERL_UNUSED_VAR(cv); /* -W */
   301			    {
   302	          46    	SV*	sv = ST(0);
   303			#line 269 "Base64.xs"
   304				char *eol;
   305				STRLEN eol_len;
   306				int binary;
   307				STRLEN sv_len;
   308				STRLEN linelen;
   309				char *beg;
   310				char *end;
   311				char *p;
   312				char *p_beg;
   313				STRLEN p_len;
   314			
   315			#line 316 "Base64.c"
   316	          46    	SV *	RETVAL;
   317			#line 281 "Base64.xs"
   318			#if PERL_REVISION == 5 && PERL_VERSION >= 6
   319				sv_utf8_downgrade(sv, FALSE);
   320			#endif
   321				/* set up EOL from the second argument if present, default to "\n" */
   322				if (items > 1 && SvOK(ST(1))) {
   323				    eol = SvPV(ST(1), eol_len);
   324				} else {
   325				    eol = "\n";
   326				    eol_len = 1;
   327				}
   328			
   329				binary = (items > 2 && SvTRUE(ST(2)));
   330			
   331				beg = SvPV(sv, sv_len);
   332				end = beg + sv_len;
   333			
   334				RETVAL = newSV(sv_len + 1);
   335				sv_setpv(RETVAL, "");
   336				linelen = 0;
   337			
   338				p = beg;
   339				while (1) {
   340				    p_beg = p;
   341			
   342				    /* skip past as much plain text as possible */
   343				    while (p < end && qp_isplain(*p)) {
   344				        p++;
   345				    }
   346				    if (p == end || *p == '\n') {
   347					/* whitespace at end of line must be encoded */
   348					while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
   349					    p--;
   350				    }
   351			
   352				    p_len = p - p_beg;
   353				    if (p_len) {
   354				        /* output plain text (with line breaks) */
   355				        if (eol_len) {
   356					    STRLEN max_last_line = (p == end || *p == '\n')
   357								      ? MAX_LINE         /* .......\n */
   358								      : ((p + 1) == end || *(p + 1) == '\n')
   359				                                        ? MAX_LINE - 3   /* ....=XX\n */
   360				                                        : MAX_LINE - 4;  /* ...=XX=\n */
   361					    while (p_len + linelen > max_last_line) {
   362						STRLEN len = MAX_LINE - 1 - linelen;
   363						if (len > p_len)
   364						    len = p_len;
   365						sv_catpvn(RETVAL, p_beg, len);
   366						p_beg += len;
   367						p_len -= len;
   368						sv_catpvn(RETVAL, "=", 1);
   369						sv_catpvn(RETVAL, eol, eol_len);
   370					        linelen = 0;
   371					    }
   372			                }
   373					if (p_len) {
   374				            sv_catpvn(RETVAL, p_beg, p_len);
   375				            linelen += p_len;
   376					}
   377				    }
   378			
   379				    if (p == end) {
   380					break;
   381			            }
   382				    else if (*p == '\n' && eol_len && !binary) {
   383				        sv_catpvn(RETVAL, eol, eol_len);
   384				        p++;
   385					linelen = 0;
   386				    }
   387				    else {
   388					/* output escaped char (with line breaks) */
   389				        assert(p < end);
   390					if (eol_len && linelen > MAX_LINE - 4) {
   391					    sv_catpvn(RETVAL, "=", 1);
   392					    sv_catpvn(RETVAL, eol, eol_len);
   393					    linelen = 0;
   394					}
   395				        sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
   396				        p++;
   397				        linelen += 3;
   398				    }
   399			
   400				    /* optimize reallocs a bit */
   401				    if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
   402					STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
   403			     		SvGROW(RETVAL, expected_len);
   404				    }
   405			        }
   406			
   407				if (SvCUR(RETVAL) && eol_len && linelen) {
   408				    sv_catpvn(RETVAL, "=", 1);
   409				    sv_catpvn(RETVAL, eol, eol_len);
   410				}
   411			
   412			#line 413 "Base64.c"
   413	          44    	ST(0) = RETVAL;
   414	          44    	sv_2mortal(ST(0));
   415			    }
   416	          44        XSRETURN(1);
   417			}
   418			
   419			
   420			XS(XS_MIME__QuotedPrint_decode_qp); /* prototype to pass -Wmissing-prototypes */
   421			XS(XS_MIME__QuotedPrint_decode_qp)
   422	          51    {
   423	          51        dXSARGS;
   424	          51        if (items != 1)
   425	      ######    	Perl_croak(aTHX_ "Usage: MIME::QuotedPrint::decode_qp(sv)");
   426	          51        PERL_UNUSED_VAR(cv); /* -W */
   427			    {
   428	          51    	SV*	sv = ST(0);
   429			#line 384 "Base64.xs"
   430				STRLEN len;
   431				char *str = SvPVbyte(sv, len);
   432				char const* end = str + len;
   433				char *r;
   434				char *whitespace = 0;
   435			
   436			#line 437 "Base64.c"
   437	          51    	SV *	RETVAL;
   438			#line 391 "Base64.xs"
   439				RETVAL = newSV(len ? len : 1);
   440			        SvPOK_on(RETVAL);
   441			        r = SvPVX(RETVAL);
   442				while (str < end) {
   443				    if (*str == ' ' || *str == '\t') {
   444					if (!whitespace)
   445					    whitespace = str;
   446					str++;
   447				    }
   448				    else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
   449					str++;
   450				    }
   451				    else if (*str == '\n') {
   452					whitespace = 0;
   453					*r++ = *str++;
   454				    }
   455				    else {
   456					if (whitespace) {
   457					    while (whitespace < str) {
   458						*r++ = *whitespace++;
   459					    }
   460					    whitespace = 0;
   461			                }
   462			            	if (*str == '=') {
   463					    if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
   464				                char buf[3];
   465			                        str++;
   466				                buf[0] = *str++;
   467					        buf[1] = *str++;
   468				                buf[2] = '\0';
   469					        *r++ = (char)strtol(buf, 0, 16);
   470				            }
   471					    else {
   472					        /* look for soft line break */
   473					        char *p = str + 1;
   474					        while (p < end && (*p == ' ' || *p == '\t'))
   475					            p++;
   476					        if (p < end && *p == '\n')
   477					     	    str = p + 1;
   478					        else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n')
   479					            str = p + 2;
   480					        else
   481					            *r++ = *str++; /* give up */
   482					    }
   483					}
   484					else {
   485					    *r++ = *str++;
   486					}
   487				    }
   488				}
   489				if (whitespace) {
   490				    while (whitespace < str) {
   491					*r++ = *whitespace++;
   492				    }
   493			        }
   494				*r = '\0';
   495				SvCUR_set(RETVAL, r - SvPVX(RETVAL));
   496			
   497			#line 498 "Base64.c"
   498	          51    	ST(0) = RETVAL;
   499	          51    	sv_2mortal(ST(0));
   500			    }
   501	          51        XSRETURN(1);
   502			}
   503			
   504			#ifdef __cplusplus
   505			extern "C"
   506			#endif
   507			XS(boot_MIME__Base64); /* prototype to pass -Wmissing-prototypes */
   508			XS(boot_MIME__Base64)
   509	          12    {
   510	          12        dXSARGS;
   511	          12        char* file = __FILE__;
   512			
   513	          12        PERL_UNUSED_VAR(cv); /* -W */
   514	          12        PERL_UNUSED_VAR(items); /* -W */
   515	          12        XS_VERSION_BOOTCHECK ;
   516			
   517	          12            newXSproto("MIME::Base64::encode_base64", XS_MIME__Base64_encode_base64, file, "$;$");
   518	          12            newXSproto("MIME::Base64::decode_base64", XS_MIME__Base64_decode_base64, file, "$");
   519	          12            newXSproto("MIME::QuotedPrint::encode_qp", XS_MIME__QuotedPrint_encode_qp, file, "$;$$");
   520	          12            newXSproto("MIME::QuotedPrint::decode_qp", XS_MIME__QuotedPrint_decode_qp, file, "$");
   521	          12        XSRETURN_YES;
   522			}
   523