[perl5.git] / ext / MIME-Base64 / Base64.xs

/* $Id$

Copyright 1997-2004 Gisle Aas

This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.


The tables and some of the code that used to be here was borrowed from
metamail, which comes with this message:

  Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore)

  Permission to use, copy, modify, and distribute this material
  for any purpose and without fee is hereby granted, provided
  that the above copyright notice and this permission notice
  appear in all copies, and that the name of Bellcore not be
  used in advertising or publicity pertaining to this
  material without the specific, prior written permission
  of an authorized representative of Bellcore.	BELLCORE
  MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY
  OF THIS MATERIAL FOR ANY PURPOSE.  IT IS PROVIDED "AS IS",
  WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.

*/


#ifdef __cplusplus
extern "C" {
#endif
#define PERL_NO_GET_CONTEXT     /* we want efficiency */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif

#ifndef PATCHLEVEL
#    include <patchlevel.h>
#    if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
#        include <could_not_find_Perl_patchlevel.h>
#    endif
#endif

#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
   #define PL_dowarn dowarn
#endif

#ifdef G_WARN_ON
   #define DOWARN (PL_dowarn & G_WARN_ON)
#else
   #define DOWARN PL_dowarn
#endif


#define MAX_LINE  76 /* size of encoded lines */

static const char basis_64[] =
   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";

#define XX      255	/* illegal base64 char */
#define EQ      254	/* padding */
#define INVALID XX

static const unsigned char index_64[256] = {
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63,
    52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX,
    XX, 0, 1, 2,  3, 4, 5, 6,  7, 8, 9,10, 11,12,13,14,
    15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX,
    XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
    41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX,

    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
    XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
};

#ifdef SvPVbyte
#   if PERL_REVISION == 5 && PERL_VERSION < 7
       /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
#       undef SvPVbyte
#       define SvPVbyte(sv, lp) \
          ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
           ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
       static char *
       my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
       {   
           sv_utf8_downgrade(sv,0);
           return SvPV(sv,*lp);
       }
#   endif
#else
#   define SvPVbyte SvPV
#endif

#ifndef isXDIGIT
#   define isXDIGIT isxdigit
#endif

#ifndef NATIVE_TO_ASCII
#   define NATIVE_TO_ASCII(ch) (ch)
#endif

MODULE = MIME::Base64		PACKAGE = MIME::Base64

SV*
encode_base64(sv,...)
	SV* sv
	PROTOTYPE: $;$

	PREINIT:
	char *str;     /* string to encode */
	SSize_t len;   /* length of the string */
	char *eol;     /* the end-of-line sequence to use */
	STRLEN eollen; /* length of the EOL sequence */
	char *r;       /* result string */
	STRLEN rlen;   /* length of result string */
	unsigned char c1, c2, c3;
	int chunk;

	CODE:
#if PERL_REVISION == 5 && PERL_VERSION >= 6
	sv_utf8_downgrade(sv, FALSE);
#endif
	str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
	len = (SSize_t)rlen;

	/* set up EOL from the second argument if present, default to "\n" */
	if (items > 1 && SvOK(ST(1))) {
	    eol = SvPV(ST(1), eollen);
	} else {
	    eol = "\n";
	    eollen = 1;
	}

	/* calculate the length of the result */
	rlen = (len+2) / 3 * 4;	 /* encoded bytes */
	if (rlen) {
	    /* add space for EOL */
	    rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
	}

	/* allocate a result buffer */
	RETVAL = newSV(rlen ? rlen : 1);
	SvPOK_on(RETVAL);	
	SvCUR_set(RETVAL, rlen);
	r = SvPVX(RETVAL);

	/* encode */
	for (chunk=0; len > 0; len -= 3, chunk++) {
	    if (chunk == (MAX_LINE/4)) {
		char *c = eol;
		char *e = eol + eollen;
		while (c < e)
		    *r++ = *c++;
		chunk = 0;
	    }
	    c1 = *str++;
	    c2 = len > 1 ? *str++ : '\0';
	    *r++ = basis_64[c1>>2];
	    *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
	    if (len > 2) {
		c3 = *str++;
		*r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
		*r++ = basis_64[c3 & 0x3F];
	    } else if (len == 2) {
		*r++ = basis_64[(c2 & 0xF) << 2];
		*r++ = '=';
	    } else { /* len == 1 */
		*r++ = '=';
		*r++ = '=';
	    }
	}
	if (rlen) {
	    /* append eol to the result string */
	    char *c = eol;
	    char *e = eol + eollen;
	    while (c < e)
		*r++ = *c++;
	}
	*r = '\0';  /* every SV in perl should be NUL-terminated */

	OUTPUT:
	RETVAL

SV*
decode_base64(sv)
	SV* sv
	PROTOTYPE: $

	PREINIT:
	STRLEN len;
	register unsigned char *str = (unsigned char*)SvPVbyte(sv, len);
	unsigned char const* end = str + len;
	char *r;
	unsigned char c[4];

	CODE:
	{
	    /* always enough, but might be too much */
	    STRLEN rlen = len * 3 / 4;
	    RETVAL = newSV(rlen ? rlen : 1);
	}
        SvPOK_on(RETVAL);
        r = SvPVX(RETVAL);

	while (str < end) {
	    int i = 0;
            do {
		unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
		if (uc != INVALID)
		    c[i++] = uc;

		if (str == end) {
		    if (i < 4) {
			if (i && DOWARN)
			    warn("Premature end of base64 data");
			if (i < 2) goto thats_it;
			if (i == 2) c[2] = EQ;
			c[3] = EQ;
		    }
		    break;
		}
            } while (i < 4);
	
	    if (c[0] == EQ || c[1] == EQ) {
		if (DOWARN) warn("Premature padding of base64 data");
		break;
            }
	    /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/

	    *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);

	    if (c[2] == EQ)
		break;
	    *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2);

	    if (c[3] == EQ)
		break;
	    *r++ = ((c[2] & 0x03) << 6) | c[3];
	}

      thats_it:
	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
	*r = '\0';

	OUTPUT:
	RETVAL


MODULE = MIME::Base64		PACKAGE = MIME::QuotedPrint

#ifdef EBCDIC
#define qp_isplain(c) ((c) == '\t' || ((!isprint(c) && (c) != '=')))
#else
#define qp_isplain(c) ((c) == '\t' || (((c) >= ' ' && (c) <= '~') && (c) != '='))
#endif

SV*
encode_qp(sv,...)
	SV* sv
	PROTOTYPE: $;$$

	PREINIT:
	char *eol;
	STRLEN eol_len;
	int binary;
	STRLEN sv_len;
	STRLEN linelen;
	char *beg;
	char *end;
	char *p;
	char *p_beg;
	STRLEN p_len;

	CODE:
#if PERL_REVISION == 5 && PERL_VERSION >= 6
	sv_utf8_downgrade(sv, FALSE);
#endif
	/* set up EOL from the second argument if present, default to "\n" */
	if (items > 1 && SvOK(ST(1))) {
	    eol = SvPV(ST(1), eol_len);
	} else {
	    eol = "\n";
	    eol_len = 1;
	}

	binary = (items > 2 && SvTRUE(ST(2)));

	beg = SvPV(sv, sv_len);
	end = beg + sv_len;

	RETVAL = newSV(sv_len + 1);
	sv_setpv(RETVAL, "");
	linelen = 0;

	p = beg;
	while (1) {
	    p_beg = p;

	    /* skip past as much plain text as possible */
	    while (p < end && qp_isplain(*p)) {
	        p++;
	    }
	    if (p == end || *p == '\n') {
		/* whitespace at end of line must be encoded */
		while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
		    p--;
	    }

	    p_len = p - p_beg;
	    if (p_len) {
	        /* output plain text (with line breaks) */
	        if (eol_len) {
		    STRLEN max_last_line = (p == end || *p == '\n')
					      ? MAX_LINE         /* .......\n */
					      : ((p + 1) == end || *(p + 1) == '\n')
	                                        ? MAX_LINE - 3   /* ....=XX\n */
	                                        : MAX_LINE - 4;  /* ...=XX=\n */
		    while (p_len + linelen > max_last_line) {
			STRLEN len = MAX_LINE - 1 - linelen;
			if (len > p_len)
			    len = p_len;
			sv_catpvn(RETVAL, p_beg, len);
			p_beg += len;
			p_len -= len;
			sv_catpvn(RETVAL, "=", 1);
			sv_catpvn(RETVAL, eol, eol_len);
		        linelen = 0;
		    }
                }
		if (p_len) {
	            sv_catpvn(RETVAL, p_beg, p_len);
	            linelen += p_len;
		}
	    }

	    if (p == end) {
		break;
            }
	    else if (*p == '\n' && eol_len && !binary) {
	        sv_catpvn(RETVAL, eol, eol_len);
	        p++;
		linelen = 0;
	    }
	    else {
		/* output escaped char (with line breaks) */
	        assert(p < end);
		if (eol_len && linelen > MAX_LINE - 4) {
		    sv_catpvn(RETVAL, "=", 1);
		    sv_catpvn(RETVAL, eol, eol_len);
		    linelen = 0;
		}
	        sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
	        p++;
	        linelen += 3;
	    }

	    /* optimize reallocs a bit */
	    if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
		STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
     		SvGROW(RETVAL, expected_len);
	    }
        }

	if (SvCUR(RETVAL) && eol_len && linelen) {
	    sv_catpvn(RETVAL, "=", 1);
	    sv_catpvn(RETVAL, eol, eol_len);
	}

	OUTPUT:
	RETVAL

SV*
decode_qp(sv)
	SV* sv
	PROTOTYPE: $

        PREINIT:
	STRLEN len;
	char *str = SvPVbyte(sv, len);
	char const* end = str + len;
	char *r;
	char *whitespace = 0;

        CODE:
	RETVAL = newSV(len ? len : 1);
        SvPOK_on(RETVAL);
        r = SvPVX(RETVAL);
	while (str < end) {
	    if (*str == ' ' || *str == '\t') {
		if (!whitespace)
		    whitespace = str;
		str++;
	    }
	    else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
		str++;
	    }
	    else if (*str == '\n') {
		whitespace = 0;
		*r++ = *str++;
	    }
	    else {
		if (whitespace) {
		    while (whitespace < str) {
			*r++ = *whitespace++;
		    }
		    whitespace = 0;
                }
            	if (*str == '=') {
		    if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
	                char buf[3];
                        str++;
	                buf[0] = *str++;
		        buf[1] = *str++;
	                buf[2] = '\0';
		        *r++ = (char)strtol(buf, 0, 16);
	            }
		    else {
		        /* look for soft line break */
		        char *p = str + 1;
		        while (p < end && (*p == ' ' || *p == '\t'))
		            p++;
		        if (p < end && *p == '\n')
		     	    str = p + 1;
		        else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n')
		            str = p + 2;
		        else
		            *r++ = *str++; /* give up */
		    }
		}
		else {
		    *r++ = *str++;
		}
	    }
	}
	if (whitespace) {
	    while (whitespace < str) {
		*r++ = *whitespace++;
	    }
        }
	*r = '\0';
	SvCUR_set(RETVAL, r - SvPVX(RETVAL));

        OUTPUT:
	RETVAL


MODULE = MIME::Base64		PACKAGE = MIME::Base64
Commit	Line	Data
dfed8d37	1	/* $Id$
6fba102d	2
691d66bd	3	Copyright 1997-2004 Gisle Aas
6fba102d JH	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
7d85a32c JH	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",
6fba102d JH	23	WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
	24
	25	*/
	26
	27
	28	#ifdef __cplusplus
	29	extern "C" {
	30	#endif
51ebc328	31	#define PERL_NO_GET_CONTEXT /* we want efficiency */
6fba102d JH	32	#include "EXTERN.h"
	33	#include "perl.h"
	34	#include "XSUB.h"
	35	#ifdef __cplusplus
	36	}
	37	#endif
	38
a3bf621f JH	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
6a63fb82 AMS	46	#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
	47	#define PL_dowarn dowarn
	48	#endif
6fba102d	49
2c634edc GA	50	#ifdef G_WARN_ON
	51	#define DOWARN (PL_dowarn & G_WARN_ON)
	52	#else
	53	#define DOWARN PL_dowarn
	54	#endif
	55
	56
6fba102d JH	57	#define MAX_LINE 76 /* size of encoded lines */
6fba102d JH	58
27da23d5	59	static const char basis_64[] =
6fba102d JH	60	"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
	61
	62	#define XX 255 /* illegal base64 char */
	63	#define EQ 254 /* padding */
	64	#define INVALID XX
	65
27da23d5	66	static const unsigned char index_64[256] = {
6fba102d JH	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
6a63fb82 AMS	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
6fba102d	103
0a362e9d RGS	104	#ifndef isXDIGIT
	105	# define isXDIGIT isxdigit
	106	#endif
	107
6a63fb82 AMS	108	#ifndef NATIVE_TO_ASCII
	109	# define NATIVE_TO_ASCII(ch) (ch)
	110	#endif
6fba102d JH	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:
6a63fb82	130	#if PERL_REVISION == 5 && PERL_VERSION >= 6
6fba102d	131	sv_utf8_downgrade(sv, FALSE);
6a63fb82	132	#endif
6fba102d JH	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++;
8be5f608	167	c2 = len > 1 ? *str++ : '\0';
6fba102d JH	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;
7d85a32c	201	register unsigned char str = (unsigned char)SvPVbyte(sv, len);
6fba102d JH	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 {
7d85a32c	218	unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
6fba102d JH	219	if (uc != INVALID)
	220	c[i++] = uc;
	221
	222	if (str == end) {
	223	if (i < 4) {
2c634edc	224	if (i && DOWARN)
6fba102d JH	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);
7d85a32c	233
6fba102d	234	if (c[0] == EQ \|\| c[1] == EQ) {
2c634edc	235	if (DOWARN) warn("Premature padding of base64 data");
6fba102d JH	236	break;
6fba102d JH	237	}
c6c619a9	238	/* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
6fba102d JH	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
6a63fb82 AMS	257
	258
	259	MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint
	260
cf0d1c66 JH	261	#ifdef EBCDIC
	262	#define qp_isplain(c) ((c) == '\t' \|\| ((!isprint(c) && (c) != '=')))
	263	#else
691d66bd	264	#define qp_isplain(c) ((c) == '\t' \|\| (((c) >= ' ' && (c) <= '~') && (c) != '='))
cf0d1c66	265	#endif
6a63fb82 AMS	266
	267	SV*
	268	encode_qp(sv,...)
	269	SV* sv
9e87bee3	270	PROTOTYPE: $;$$
6a63fb82 AMS	271
	272	PREINIT:
	273	char *eol;
	274	STRLEN eol_len;
9e87bee3	275	int binary;
6a63fb82 AMS	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
9e87bee3 RGS	296	binary = (items > 2 && SvTRUE(ST(2)));
9e87bee3 RGS	297
6a63fb82 AMS	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	}
8be5f608	313	if (p == end \|\| *p == '\n') {
6a63fb82 AMS	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) {
8be5f608	323	STRLEN max_last_line = (p == end \|\| *p == '\n')
6a63fb82	324	? MAX_LINE /* .......\n */
8be5f608	325	: ((p + 1) == end \|\| *(p + 1) == '\n')
6a63fb82 AMS	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
8be5f608 RGS	346	if (p == end) {
	347	break;
	348	}
9e87bee3	349	else if (*p == '\n' && eol_len && !binary) {
6a63fb82 AMS	350	sv_catpvn(RETVAL, eol, eol_len);
	351	p++;
	352	linelen = 0;
	353	}
8be5f608	354	else {
6a63fb82	355	/* output escaped char (with line breaks) */
1b96abaf	356	assert(p < end);
6a63fb82 AMS	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	}
6a63fb82 AMS	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
9e87bee3 RGS	374	if (SvCUR(RETVAL) && eol_len && linelen) {
	375	sv_catpvn(RETVAL, "=", 1);
	376	sv_catpvn(RETVAL, eol, eol_len);
	377	}
	378
6a63fb82 AMS	379	OUTPUT:
	380	RETVAL
	381
	382	SV*
	383	decode_qp(sv)
	384	SV* sv
	385	PROTOTYPE: $
	386
	387	PREINIT:
	388	STRLEN len;
7235ff25	389	char *str = SvPVbyte(sv, len);
6a63fb82 AMS	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	}
ea0e37e4	418	if (*str == '=') {
691d66bd	419	if ((str + 2) < end && isXDIGIT(str[1]) && isXDIGIT(str[2])) {
ea0e37e4 GA	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	}
6a63fb82	439	}
ea0e37e4 GA	440	else {
ea0e37e4 GA	441	r++ = str++;
6a63fb82	442	}
6a63fb82 AMS	443	}
6a63fb82 AMS	444	}
2c634edc GA	445	if (whitespace) {
	446	while (whitespace < str) {
	447	r++ = whitespace++;
	448	}
	449	}
6a63fb82 AMS	450	*r = '\0';
	451	SvCUR_set(RETVAL, r - SvPVX(RETVAL));
	452
	453	OUTPUT:
	454	RETVAL
	455
	456
	457	MODULE = MIME::Base64 PACKAGE = MIME::Base64