diff options
Diffstat (limited to 'ext/MIME/Base64')
| -rw-r--r-- | ext/MIME/Base64/Base64.pm | 11 | ||||
| -rw-r--r-- | ext/MIME/Base64/Base64.xs | 206 | ||||
| -rw-r--r-- | ext/MIME/Base64/Changes | 48 | ||||
| -rw-r--r-- | ext/MIME/Base64/Makefile.PL | 2 | ||||
| -rw-r--r-- | ext/MIME/Base64/QuotedPrint.pm | 37 | ||||
| -rwxr-xr-x | ext/MIME/Base64/decode-base64 | 8 | ||||
| -rwxr-xr-x | ext/MIME/Base64/decode-qp | 8 | ||||
| -rwxr-xr-x | ext/MIME/Base64/encode-base64 | 13 | ||||
| -rwxr-xr-x | ext/MIME/Base64/encode-qp | 8 | ||||
| -rw-r--r-- | ext/MIME/Base64/t/base64.t | 18 | ||||
| -rw-r--r-- | ext/MIME/Base64/t/quoted-print.t | 38 |
11 files changed, 354 insertions, 43 deletions
diff --git a/ext/MIME/Base64/Base64.pm b/ext/MIME/Base64/Base64.pm index 67034189d6..378adf5981 100644 --- a/ext/MIME/Base64/Base64.pm +++ b/ext/MIME/Base64/Base64.pm @@ -1,5 +1,5 @@ # -# $Id: Base64.pm,v 2.19 2002/12/28 06:32:37 gisle Exp $ +# $Id: Base64.pm,v 2.25 2003/01/05 08:01:33 gisle Exp $ package MIME::Base64; @@ -27,7 +27,9 @@ The following functions are provided: =over 4 -=item encode_base64($str, [$eol]) +=item encode_base64($str) + +=item encode_base64($str, $eol); Encode data by calling the encode_base64() function. The first argument is the string to encode. The second argument is the line @@ -112,7 +114,7 @@ of 4 base64 chars: =head1 COPYRIGHT -Copyright 1995-1999, 2001 Gisle Aas. +Copyright 1995-1999, 2001-2003 Gisle Aas. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -135,7 +137,7 @@ require DynaLoader; @ISA = qw(Exporter DynaLoader); @EXPORT = qw(encode_base64 decode_base64); -$VERSION = '2.13'; +$VERSION = '2.16'; eval { bootstrap MIME::Base64 $VERSION; }; if ($@) { @@ -187,6 +189,7 @@ sub old_decode_base64 ($) } $str =~ s/=+$//; # remove padding $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format + return "" unless length $str; ## I guess this could be written as #return unpack("u", join('', map( chr(32 + length($_)*3/4) . $_, diff --git a/ext/MIME/Base64/Base64.xs b/ext/MIME/Base64/Base64.xs index 664907948b..e421836203 100644 --- a/ext/MIME/Base64/Base64.xs +++ b/ext/MIME/Base64/Base64.xs @@ -1,6 +1,6 @@ -/* +/* $Id: Base64.xs,v 1.32 2003/01/05 07:49:07 gisle Exp $ -Copyright 1997-1999,2001 Gisle Aas +Copyright 1997-2003 Gisle Aas This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -35,6 +35,10 @@ extern "C" { } #endif +#include "patchlevel.h" +#if PATCHLEVEL <= 4 && !defined(PL_dowarn) + #define PL_dowarn dowarn +#endif #define MAX_LINE 76 /* size of encoded lines */ @@ -65,7 +69,27 @@ static unsigned char index_64[256] = { 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 NATIVE_TO_ASCII +# define NATIVE_TO_ASCII(ch) (ch) +#endif MODULE = MIME::Base64 PACKAGE = MIME::Base64 @@ -85,7 +109,9 @@ encode_base64(sv,...) 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; @@ -210,3 +236,179 @@ decode_base64(sv) OUTPUT: RETVAL + + +MODULE = MIME::Base64 PACKAGE = MIME::QuotedPrint + +#define qp_isplain(c) ((c) == '\t' || ((c) >= ' ' && (c) <= '~') && (c) != '=') + +SV* +encode_qp(sv,...) + SV* sv + PROTOTYPE: $;$ + + PREINIT: + char *eol; + STRLEN eol_len; + 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; + } + + 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 == '\n' || p == end) { + /* 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 == '\n' || p == end) + ? MAX_LINE /* .......\n */ + : (*(p + 1) == '\n' || (p + 1) == end) + ? 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 == '\n') { + sv_catpvn(RETVAL, eol, eol_len); + p++; + linelen = 0; + } + else if (p < end) { + /* output escaped char (with line breaks) */ + 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; + } + else { + assert(p == end); + break; + } + + /* 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); + } + } + + OUTPUT: + RETVAL + +SV* +decode_qp(sv) + SV* sv + PROTOTYPE: $ + + PREINIT: + STRLEN len; + char *str = (unsigned char*)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 == '=' && (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 if (*str == '=' && (str + 1) < end && str[1] == '\n') { + str += 2; + } + else if (*str == '=' && (str + 2) < end && str[1] == '\r' && str[2] == '\n') { + str += 3; + } + else { + *r++ = *str++; + } + } + } + *r = '\0'; + SvCUR_set(RETVAL, r - SvPVX(RETVAL)); + + OUTPUT: + RETVAL + + +MODULE = MIME::Base64 PACKAGE = MIME::Base64 diff --git a/ext/MIME/Base64/Changes b/ext/MIME/Base64/Changes index a462317632..fab3cca66e 100644 --- a/ext/MIME/Base64/Changes +++ b/ext/MIME/Base64/Changes @@ -1,4 +1,50 @@ -2002-02-27 Gisle Aas <gisle@ActiveState.com> +2003-01-05 Gisle Aas <gisle@ActiveState.com> + + Release 2.16 + + Fixed the encode_qp() line breaking code. It sometimes + made lines longer than 76 chars and it could even get into + an infinite loop on certain inputs. + + + +2003-01-03 Gisle Aas <gisle@ActiveState.com> + + Release 2.15 + + Fixed the XS based decode_qp() for strings where a =XX + sequence was followed by digits. + + Faster encode_qp() for long strings with lots of chars + that need escaping. + + The old_decode_base64() function introduced in 2.13 + was returning undef for empty input on olders perls. + This problem has been fixed. + + + +2003-01-01 Gisle Aas <gisle@ActiveState.com> + + Release 2.14 + + MIME::QuotedPrint functions now also implemented using XS + which make them faster. 2-3 times faster when encoding line by + line and as much as 200 times faster on long binary input. There + is probably some breakage on non-ASCII systems from this. + + The encode_qp() function now takes an $eol argument in the + same way as encode_base64() does. + + Slight change in behaviour: the decode_qp() function now turns + \r\n terminated lines into \n terminated lines. This makes is + more likely that encode_qp(decode_qp()) round-trip properly. + + Included {en,de}code-{base64,qp} utility scripts. + + + +2002-12-27 Gisle Aas <gisle@ActiveState.com> Release 2.13 diff --git a/ext/MIME/Base64/Makefile.PL b/ext/MIME/Base64/Makefile.PL index da37853cc7..93e30806ec 100644 --- a/ext/MIME/Base64/Makefile.PL +++ b/ext/MIME/Base64/Makefile.PL @@ -3,7 +3,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'MIME::Base64', - MAN3PODS => {}, # Pods will be built by installman. VERSION_FROM => 'Base64.pm', + EXE_FILES => [qw(encode-base64 decode-base64 encode-qp decode-qp)], dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, ); diff --git a/ext/MIME/Base64/QuotedPrint.pm b/ext/MIME/Base64/QuotedPrint.pm index c2d4cbf7d4..778cdab0df 100644 --- a/ext/MIME/Base64/QuotedPrint.pm +++ b/ext/MIME/Base64/QuotedPrint.pm @@ -1,5 +1,5 @@ # -# $Id: QuotedPrint.pm,v 2.4 2002/12/28 05:50:05 gisle Exp $ +# $Id: QuotedPrint.pm,v 2.11 2003/01/05 08:01:33 gisle Exp $ package MIME::QuotedPrint; @@ -31,17 +31,16 @@ The following functions are provided: =item encode_qp($str) -This function will return an encoded version of the string given as -argument. +=item encode_qp($str, $eol) -Note that encode_qp() does not change newlines C<"\n"> to the CRLF -sequence even though this might be considered the right thing to do -(RFC 2045 (Q-P Rule #4)). +This function will return an encoded version of the string given as +argument. The second argument is the line ending sequence to use (it +is optional and defaults to C<"\n">). =item decode_qp($str); This function will return the plain text version of the string given -as argument. +as argument. Lines with be "\n" terminated. =back @@ -55,7 +54,7 @@ call them as: =head1 COPYRIGHT -Copyright 1995-1997 Gisle Aas. +Copyright 1995-1997,2002-2003 Gisle Aas. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -74,9 +73,15 @@ require Exporter; use Carp qw(croak); -$VERSION = sprintf("%d.%02d", q$Revision: 2.4 $ =~ /(\d+)\.(\d+)/); +$VERSION = "2.16"; -sub encode_qp ($) +use MIME::Base64; # try to load XS version of encode_qp +unless (defined &encode_qp) { + *encode_qp = \&old_encode_qp; + *decode_qp = \&old_decode_qp; +} + +sub old_encode_qp ($;$) { my $res = shift; if ($] >= 5.006) { @@ -87,6 +92,9 @@ sub encode_qp ($) } } + my $eol = shift; + $eol = "\n" unless defined($eol) || length($eol); + # Do not mention ranges such as $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg; # since that will not even compile on an EBCDIC machine (where ord('!') > ord('<')). if (ord('A') == 193) { # EBCDIC style machine @@ -123,7 +131,7 @@ sub encode_qp ($) # rule #5 (lines must be shorter than 76 chars, but we are not allowed # to break =XX escapes. This makes things complicated :-( ) my $brokenlines = ""; - $brokenlines .= "$1=\n" + $brokenlines .= "$1=$eol" while $res =~ s/(.*?^[^\n]{73} (?: [^=\n]{2} (?! [^=\n]{0,1} $) # 75 not followed by .?\n |[^=\n] (?! [^=\n]{0,2} $) # 74 not followed by .?.?\n @@ -134,11 +142,12 @@ sub encode_qp ($) } -sub decode_qp ($) +sub old_decode_qp ($) { my $res = shift; - $res =~ s/[ \t]+?(\r?\n)/$1/g; # rule #3 (trailing space must be deleted) - $res =~ s/=\r?\n//g; # rule #5 (soft line breaks) + $res =~ s/\r\n/\n/g; # normalize newlines + $res =~ s/[ \t]+\n/\n/g; # rule #3 (trailing space must be deleted) + $res =~ s/=\n//g; # rule #5 (soft line breaks) if (ord('A') == 193) { # EBCDIC style machine if (ord('[') == 173) { $res =~ s/=([\da-fA-F]{2})/Encode::encode('cp1047',Encode::decode('iso-8859-1',pack("C", hex($1))))/ge; diff --git a/ext/MIME/Base64/decode-base64 b/ext/MIME/Base64/decode-base64 new file mode 100755 index 0000000000..5c13c244dc --- /dev/null +++ b/ext/MIME/Base64/decode-base64 @@ -0,0 +1,8 @@ +#!/usr/bin/perl + +use MIME::Base64 qw(decode_base64); + +while (<>) { + print decode_base64($_); +} + diff --git a/ext/MIME/Base64/decode-qp b/ext/MIME/Base64/decode-qp new file mode 100755 index 0000000000..6b9663ca5a --- /dev/null +++ b/ext/MIME/Base64/decode-qp @@ -0,0 +1,8 @@ +#!/usr/bin/perl + +use MIME::QuotedPrint qw(decode_qp); + +while (<>) { + print decode_qp($_); +} + diff --git a/ext/MIME/Base64/encode-base64 b/ext/MIME/Base64/encode-base64 new file mode 100755 index 0000000000..0ee70f87e3 --- /dev/null +++ b/ext/MIME/Base64/encode-base64 @@ -0,0 +1,13 @@ +#!/usr/bin/perl + +use MIME::Base64 qw(encode_base64); + +my $buf = ""; +while (<>) { + $buf .= $_; + if (length($buf) >= 57) { + print encode_base64(substr($buf, 0, int(length($buf) / 57) * 57, "")); + } +} + +print encode_base64($buf); diff --git a/ext/MIME/Base64/encode-qp b/ext/MIME/Base64/encode-qp new file mode 100755 index 0000000000..7ceed3ecd7 --- /dev/null +++ b/ext/MIME/Base64/encode-qp @@ -0,0 +1,8 @@ +#!/usr/bin/perl + +use MIME::QuotedPrint qw(encode_qp); + +while (<>) { + print encode_qp($_); +} + diff --git a/ext/MIME/Base64/t/base64.t b/ext/MIME/Base64/t/base64.t index 08bdea003b..b398131981 100644 --- a/ext/MIME/Base64/t/base64.t +++ b/ext/MIME/Base64/t/base64.t @@ -337,15 +337,15 @@ sub encodeTest } if (ord('A') != 193) { # perl versions broken on EBCDIC - # Try the old Perl versions too - if ($encoded ne MIME::Base64::old_encode_base64($plain, '')) { - print "old_encode_base64 give different result.\n"; - print "not "; - } - if ($plain ne MIME::Base64::old_decode_base64($encoded)) { - print "old_decode_base64 give different result.\n"; - print "not "; - } + # Try the old Perl versions too + if ($encoded ne MIME::Base64::old_encode_base64($plain, '')) { + print "old_encode_base64 give different result.\n"; + print "not "; + } + if ($plain ne MIME::Base64::old_decode_base64($encoded)) { + print "old_decode_base64 give different result.\n"; + print "not "; + } } print "ok $testno\n"; diff --git a/ext/MIME/Base64/t/quoted-print.t b/ext/MIME/Base64/t/quoted-print.t index 395958ee21..66427246e1 100644 --- a/ext/MIME/Base64/t/quoted-print.t +++ b/ext/MIME/Base64/t/quoted-print.t @@ -25,8 +25,8 @@ $x70 = "x" x 70; ["test \ntest\n\t \t \n" => "test=20=20\ntest\n=09=20=09=20\n"], # "=" is special an should be decoded - ["=\n" => "=3D\n"], - ["\0\xff" => "=00=FF"], + ["=30\n" => "=3D30\n"], + ["\0\xff0" => "=00=FF0"], # Very long lines should be broken (not more than 76 chars ["The Quoted-Printable encoding is intended to represent data that largly consists of octets that correspond to printable characters in the ASCII character set." => @@ -57,20 +57,34 @@ y. -- H. L. Mencken"], ["$x70!234" => "$x70!234"], ["$x70!2345" => "$x70!2345"], ["$x70!23456" => "$x70!23456"], + ["$x70!234567" => "$x70!2345=\n67"], + ["$x70!23456=" => "$x70!2345=\n6=3D"], ["$x70!23\n" => "$x70!23\n"], ["$x70!234\n" => "$x70!234\n"], ["$x70!2345\n" => "$x70!2345\n"], ["$x70!23456\n" => "$x70!23456\n"], + ["$x70!234567\n" => "$x70!2345=\n67\n"], + ["$x70!23456=\n" => "$x70!2345=\n6=3D\n"], # Not allowed to break =XX escapes using soft line break - ["$x70===xxxx" => "$x70=3D=\n=3D=3Dxxxx"], - ["$x70!===xxx" => "$x70!=3D=\n=3D=3Dxxx"], - ["$x70!!===xx" => "$x70!!=3D=\n=3D=3Dxx"], - ["$x70!!!===x" => "$x70!!!=\n=3D=3D=3Dx"], - # ^ - # 70123456| - # max - # line width + ["$x70===xxxxx" => "$x70=3D=\n=3D=3Dxxxxx"], + ["$x70!===xxxx" => "$x70!=3D=\n=3D=3Dxxxx"], + ["$x70!2===xxx" => "$x70!2=3D=\n=3D=3Dxxx"], + ["$x70!23===xx" => "$x70!23=\n=3D=3D=3Dxx"], + ["$x70!234===x" => "$x70!234=\n=3D=3D=3Dx"], + ["$x70!2=\n" => "$x70!2=3D\n"], + ["$x70!23=\n" => "$x70!23=\n=3D\n"], + ["$x70!234=\n" => "$x70!234=\n=3D\n"], + ["$x70!2345=\n" => "$x70!2345=\n=3D\n"], + ["$x70!23456=\n" => "$x70!2345=\n6=3D\n"], + # ^ + # 70123456| + # max + # line width + + # some extra special cases we have had problems with + ["$x70!2=x=x" => "$x70!2=3D=\nx=3Dx"], + ["$x70!2345$x70!2345$x70!23456\n", "$x70!2345=\n$x70!2345=\n$x70!23456\n"], ); $notests = @tests + 3; @@ -110,8 +124,8 @@ $testno++; print "ok $testno\n"; # Same test but with "\r\n" terminated lines print "not " unless decode_qp("foo \r\n\r\nfoo =\r\n\r\nfoo=20\r\n\r\n") eq - "foo\r\n\r\nfoo \r\nfoo \r\n\r\n"; + "foo\n\nfoo \nfoo \n\n"; $testno++; print "ok $testno\n"; -print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || $@ !~ /^The Quoted-Printable encoding is only defined for bytes/); +print "not " if $] >= 5.006 && (eval 'encode_qp("XXX \x{100}")' || !$@); $testno++; print "ok $testno\n"; |