1			/* $Id: Base64.xs,v 3.4 2004/08/24 16:29:35 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 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	        2898    	char *str;     /* string to encode */
   121	        2898    	SSize_t len;   /* length of the string */
   122	        2898    	char *eol;     /* the end-of-line sequence to use */
   123	        2898    	STRLEN eollen; /* length of the EOL sequence */
   124	        2898    	char *r;       /* result string */
   125	        2898    	STRLEN rlen;   /* length of result string */
   126	        2898    	unsigned char c1, c2, c3;
   127	        2898    	int chunk;
   128			
   129				CODE:
   130			#if PERL_REVISION == 5 && PERL_VERSION >= 6
   131	        2898    	sv_utf8_downgrade(sv, FALSE);
   132			#endif
   133	        2897    	str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
   134	        2897    	len = (SSize_t)rlen;
   135			
   136				/* set up EOL from the second argument if present, default to "\n" */
   137	        2897    	if (items > 1 && SvOK(ST(1))) {
   138	        2384    	    eol = SvPV(ST(1), eollen);
   139				} else {
   140	         513    	    eol = "\n";
   141	         513    	    eollen = 1;
   142				}
   143			
   144				/* calculate the length of the result */
   145	        2897    	rlen = (len+2) / 3 * 4;	 /* encoded bytes */
   146	        2897    	if (rlen) {
   147				    /* add space for EOL */
   148	        2896    	    rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
   149				}
   150			
   151				/* allocate a result buffer */
   152	        2897    	RETVAL = newSV(rlen ? rlen : 1);
   153	        2897    	SvPOK_on(RETVAL);	
   154	        2897    	SvCUR_set(RETVAL, rlen);
   155	        2897    	r = SvPVX(RETVAL);
   156			
   157				/* encode */
   158	       66996    	for (chunk=0; len > 0; len -= 3, chunk++) {
   159	       64099    	    if (chunk == (MAX_LINE/4)) {
   160	        2760    		char *c = eol;
   161	        2760    		char *e = eol + eollen;
   162	        3668    		while (c < e)
   163	         908    		    *r++ = *c++;
   164	        2760    		chunk = 0;
   165				    }
   166	       64099    	    c1 = *str++;
   167	       64099    	    c2 = len > 1 ? *str++ : '\0';
   168	       64099    	    *r++ = basis_64[c1>>2];
   169	       64099    	    *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
   170	       64099    	    if (len > 2) {
   171	       61470    		c3 = *str++;
   172	       61470    		*r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
   173	       61470    		*r++ = basis_64[c3 & 0x3F];
   174	        2629    	    } else if (len == 2) {
   175	        1419    		*r++ = basis_64[(c2 & 0xF) << 2];
   176	        1419    		*r++ = '=';
   177				    } else { /* len == 1 */
   178	        1210    		*r++ = '=';
   179	        1210    		*r++ = '=';
   180				    }
   181				}
   182	        2897    	if (rlen) {
   183				    /* append eol to the result string */
   184	        2896    	    char *c = eol;
   185	        2896    	    char *e = eol + eollen;
   186	        3409    	    while (c < e)
   187	         513    		*r++ = *c++;
   188				}
   189	        2897    	*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	        2656    	STRLEN len;
   201	        2656    	register unsigned char *str = (unsigned char*)SvPVbyte(sv, len);
   202	        2656    	unsigned char const* end = str + len;
   203	        2656    	char *r;
   204	        2656    	unsigned char c[4];
   205			
   206				CODE:
   207				{
   208				    /* always enough, but might be too much */
   209	        2656    	    STRLEN rlen = len * 3 / 4;
   210	        2656    	    RETVAL = newSV(rlen ? rlen : 1);
   211				}
   212	        2656            SvPOK_on(RETVAL);
   213	        2656            r = SvPVX(RETVAL);
   214			
   215	       53248    	while (str < end) {
   216	       53149    	    int i = 0;
   217	      212784                do {
   218	      212784    		unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
   219	      212784    		if (uc != INVALID)
   220	      212239    		    c[i++] = uc;
   221			
   222	      212784    		if (str == end) {
   223	        2480    		    if (i < 4) {
   224	          93    			if (i && DOWARN)
   225	           2    			    warn("Premature end of base64 data");
   226	          93    			if (i < 2) goto thats_it;
   227	           6    			if (i == 2) c[2] = EQ;
   228	           6    			c[3] = EQ;
   229					    }
   230	           6    		    break;
   231					}
   232	      210304                } while (i < 4);
   233				
   234	       53062    	    if (c[0] == EQ || c[1] == EQ) {
   235	           5    		if (DOWARN) warn("Premature padding of base64 data");
   236	           2    		break;
   237			            }
   238				    /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
   239			
   240	       53057    	    *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);
   241			
   242	       53057    	    if (c[2] == EQ)
   243	        1125    		break;
   244	       51932    	    *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2);
   245			
   246	       51932    	    if (c[3] == EQ)
   247	        1340    		break;
   248	       50592    	    *r++ = ((c[2] & 0x03) << 6) | c[3];
   249				}
   250			
   251			      thats_it:
   252	        2656    	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
   253	        2656    	*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	          46    	char *eol;
   270	          46    	STRLEN eol_len;
   271	          46    	int binary;
   272	          46    	STRLEN sv_len;
   273	          46    	STRLEN linelen;
   274	          46    	char *beg;
   275	          46    	char *end;
   276	          46    	char *p;
   277	          46    	char *p_beg;
   278	          46    	STRLEN p_len;
   279			
   280				CODE:
   281			#if PERL_REVISION == 5 && PERL_VERSION >= 6
   282	          46    	sv_utf8_downgrade(sv, FALSE);
   283			#endif
   284				/* set up EOL from the second argument if present, default to "\n" */
   285	          44    	if (items > 1 && SvOK(ST(1))) {
   286	           2    	    eol = SvPV(ST(1), eol_len);
   287				} else {
   288	          42    	    eol = "\n";
   289	          42    	    eol_len = 1;
   290				}
   291			
   292	          44    	binary = (items > 2 && SvTRUE(ST(2)));
   293			
   294	          44    	beg = SvPV(sv, sv_len);
   295	          44    	end = beg + sv_len;
   296			
   297	          44    	RETVAL = newSV(sv_len + 1);
   298	          44    	sv_setpv(RETVAL, "");
   299	          44    	linelen = 0;
   300			
   301	          44    	p = beg;
   302	        1902    	while (1) {
   303	        1902    	    p_beg = p;
   304			
   305				    /* skip past as much plain text as possible */
   306	        5958    	    while (p < end && qp_isplain(*p)) {
   307	        4056    	        p++;
   308				    }
   309	        1902    	    if (p == end || *p == '\n') {
   310					/* whitespace at end of line must be encoded */
   311	         147    		while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
   312	          40    		    p--;
   313				    }
   314			
   315	        1902    	    p_len = p - p_beg;
   316	        1902    	    if (p_len) {
   317				        /* output plain text (with line breaks) */
   318	          81    	        if (eol_len) {
   319	          80    		    STRLEN max_last_line = (p == end || *p == '\n')
   320								      ? MAX_LINE         /* .......\n */
   321								      : ((p + 1) == end || *(p + 1) == '\n')
   322				                                        ? MAX_LINE - 3   /* ....=XX\n */
   323	          80    	                                        : MAX_LINE - 4;  /* ...=XX=\n */
   324	         121    		    while (p_len + linelen > max_last_line) {
   325	          41    			STRLEN len = MAX_LINE - 1 - linelen;
   326	          41    			if (len > p_len)
   327	           3    			    len = p_len;
   328	          41    			sv_catpvn(RETVAL, p_beg, len);
   329	          41    			p_beg += len;
   330	          41    			p_len -= len;
   331	          41    			sv_catpvn(RETVAL, "=", 1);
   332	          41    			sv_catpvn(RETVAL, eol, eol_len);
   333	          41    		        linelen = 0;
   334					    }
   335			                }
   336	          81    		if (p_len) {
   337	          77    	            sv_catpvn(RETVAL, p_beg, p_len);
   338	          77    	            linelen += p_len;
   339					}
   340				    }
   341			
   342	        1902    	    if (p == end) {
   343	          44    		break;
   344			            }
   345	        1858    	    else if (*p == '\n' && eol_len && !binary) {
   346	          32    	        sv_catpvn(RETVAL, eol, eol_len);
   347	          32    	        p++;
   348	          32    		linelen = 0;
   349				    }
   350				    else {
   351					/* output escaped char (with line breaks) */
   352	        1826    	        assert(p < end);
   353	        1826    		if (eol_len && linelen > MAX_LINE - 4) {
   354	          60    		    sv_catpvn(RETVAL, "=", 1);
   355	          60    		    sv_catpvn(RETVAL, eol, eol_len);
   356	          60    		    linelen = 0;
   357					}
   358	        1826    	        sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
   359	        1826    	        p++;
   360	        1826    	        linelen += 3;
   361				    }
   362			
   363				    /* optimize reallocs a bit */
   364	        1858    	    if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
   365	          14    		STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
   366	          14         		SvGROW(RETVAL, expected_len);
   367				    }
   368			        }
   369			
   370	          44    	if (SvCUR(RETVAL) && eol_len && linelen) {
   371	          26    	    sv_catpvn(RETVAL, "=", 1);
   372	          26    	    sv_catpvn(RETVAL, eol, eol_len);
   373				}
   374			
   375				OUTPUT:
   376				RETVAL
   377			
   378			SV*
   379			decode_qp(sv)
   380				SV* sv
   381				PROTOTYPE: $
   382			
   383			        PREINIT:
   384	          51    	STRLEN len;
   385	          51    	char *str = SvPVbyte(sv, len);
   386	          51    	char const* end = str + len;
   387	          51    	char *r;
   388	          51    	char *whitespace = 0;
   389			
   390			        CODE:
   391	          51    	RETVAL = newSV(len ? len : 1);
   392	          51            SvPOK_on(RETVAL);
   393	          51            r = SvPVX(RETVAL);
   394	        5587    	while (str < end) {
   395	        5536    	    if (*str == ' ' || *str == '\t') {
   396	         148    		if (!whitespace)
   397	         139    		    whitespace = str;
   398	         148    		str++;
   399				    }
   400	        5388    	    else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
   401	           7    		str++;
   402				    }
   403	        5381    	    else if (*str == '\n') {
   404	          46    		whitespace = 0;
   405	          46    		*r++ = *str++;
   406				    }
   407				    else {
   408	        5335    		if (whitespace) {
   409	         269    		    while (whitespace < str) {
   410	         136    			*r++ = *whitespace++;
   411					    }
   412	         133    		    whitespace = 0;
   413			                }
   414	        5335                	if (*str == '=') {
   415	        1786    		    if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
   416	        1662    	                char buf[3];
   417	        1662                            str++;
   418	        1662    	                buf[0] = *str++;
   419	        1662    		        buf[1] = *str++;
   420	        1662    	                buf[2] = '\0';
   421	        1662    		        *r++ = (char)strtol(buf, 0, 16);
   422				            }
   423					    else {
   424					        /* look for soft line break */
   425	         124    		        char *p = str + 1;
   426	         139    		        while (p < end && (*p == ' ' || *p == '\t'))
   427	          15    		            p++;
   428	         124    		        if (p < end && *p == '\n')
   429	         119    		     	    str = p + 1;
   430	           5    		        else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n')
   431	           3    		            str = p + 2;
   432					        else
   433	           2    		            *r++ = *str++; /* give up */
   434					    }
   435					}
   436					else {
   437	        3549    		    *r++ = *str++;
   438					}
   439				    }
   440				}
   441	          51    	if (whitespace) {
   442	           3    	    while (whitespace < str) {
   443	           2    		*r++ = *whitespace++;
   444				    }
   445			        }
   446	          51    	*r = '\0';
   447	          51    	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
   448			
   449			        OUTPUT:
   450				RETVAL
   451			
   452			
   453			MODULE = MIME::Base64		PACKAGE = MIME::Base64