summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
Diffstat (limited to 'ext')
-rw-r--r--ext/MIME/Base64/Base64.pm202
-rw-r--r--ext/MIME/Base64/Base64.xs218
-rw-r--r--ext/MIME/Base64/Changes132
-rw-r--r--ext/MIME/Base64/Makefile.PL8
-rw-r--r--ext/MIME/Base64/QuotedPrint.pm115
5 files changed, 675 insertions, 0 deletions
diff --git a/ext/MIME/Base64/Base64.pm b/ext/MIME/Base64/Base64.pm
new file mode 100644
index 0000000000..af13589b37
--- /dev/null
+++ b/ext/MIME/Base64/Base64.pm
@@ -0,0 +1,202 @@
+#
+# $Id: Base64.pm,v 2.16 2001/02/24 06:28:10 gisle Exp $
+
+package MIME::Base64;
+
+=head1 NAME
+
+MIME::Base64 - Encoding and decoding of base64 strings
+
+=head1 SYNOPSIS
+
+ use MIME::Base64;
+
+ $encoded = encode_base64('Aladdin:open sesame');
+ $decoded = decode_base64($encoded);
+
+=head1 DESCRIPTION
+
+This module provides functions to encode and decode strings into the
+Base64 encoding specified in RFC 2045 - I<MIME (Multipurpose Internet
+Mail Extensions)>. The Base64 encoding is designed to represent
+arbitrary sequences of octets in a form that need not be humanly
+readable. A 65-character subset ([A-Za-z0-9+/=]) of US-ASCII is used,
+enabling 6 bits to be represented per printable character.
+
+The following functions are provided:
+
+=over 4
+
+=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
+ending sequence to use (it is optional and defaults to C<"\n">). The
+returned encoded string is broken into lines of no more than 76
+characters each and it will end with $eol unless it is empty. Pass an
+empty string as second argument if you do not want the encoded string
+broken into lines.
+
+=item decode_base64($str)
+
+Decode a base64 string by calling the decode_base64() function. This
+function takes a single argument which is the string to decode and
+returns the decoded data.
+
+Any character not part of the 65-character base64 subset set is
+silently ignored. Characters occuring after a '=' padding character
+are never decoded.
+
+If the length of the string to decode (after ignoring
+non-base64 chars) is not a multiple of 4 or padding occurs too ealy,
+then a warning is generated if perl is running under C<-w>.
+
+=back
+
+If you prefer not to import these routines into your namespace you can
+call them as:
+
+ use MIME::Base64 ();
+ $encoded = MIME::Base64::encode($decoded);
+ $decoded = MIME::Base64::decode($encoded);
+
+=head1 DIAGNOSTICS
+
+The following warnings might be generated if perl is invoked with the
+C<-w> switch:
+
+=over 4
+
+=item Premature end of base64 data
+
+The number of characters to decode is not a multiple of 4. Legal
+base64 data should be padded with one or two "=" characters to make
+its length a multiple of 4. The decoded result will anyway be as if
+the padding was there.
+
+=item Premature padding of base64 data
+
+The '=' padding character occurs as the first or second character
+in a base64 quartet.
+
+=back
+
+=head1 EXAMPLES
+
+If you want to encode a large file, you should encode it in chunks
+that are a multiple of 57 bytes. This ensures that the base64 lines
+line up and that you do not end up with padding in the middle. 57
+bytes of data fills one complete base64 line (76 == 57*4/3):
+
+ use MIME::Base64 qw(encode_base64);
+
+ open(FILE, "/var/log/wtmp") or die "$!";
+ while (read(FILE, $buf, 60*57)) {
+ print encode_base64($buf);
+ }
+
+or if you know you have enough memory
+
+ use MIME::Base64 qw(encode_base64);
+ local($/) = undef; # slurp
+ print encode_base64(<STDIN>);
+
+The same approach as a command line:
+
+ perl -MMIME::Base64 -0777 -ne 'print encode_base64($_)' <file
+
+Decoding does not need slurp mode if all the lines contains a multiple
+of 4 base64 chars:
+
+ perl -MMIME::Base64 -ne 'print decode_base64($_)' <file
+
+=head1 COPYRIGHT
+
+Copyright 1995-1999, 2001 Gisle Aas.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+Distantly based on LWP::Base64 written by Martijn Koster
+<m.koster@nexor.co.uk> and Joerg Reichelt <j.reichelt@nexor.co.uk> and
+code posted to comp.lang.perl <3pd2lp$6gf@wsinti07.win.tue.nl> by Hans
+Mulder <hansm@wsinti07.win.tue.nl>
+
+The XS implementation use code from metamail. Copyright 1991 Bell
+Communications Research, Inc. (Bellcore)
+
+=cut
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION $OLD_CODE);
+
+require Exporter;
+require DynaLoader;
+@ISA = qw(Exporter DynaLoader);
+@EXPORT = qw(encode_base64 decode_base64);
+
+$VERSION = '2.13';
+
+eval { bootstrap MIME::Base64 $VERSION; };
+if ($@) {
+ # can't bootstrap XS implementation, use perl implementation
+ *encode_base64 = \&old_encode_base64;
+ *decode_base64 = \&old_decode_base64;
+
+ $OLD_CODE = $@;
+ #warn $@ if $^W;
+}
+
+# Historically this module has been implemented as pure perl code.
+# The XS implementation runs about 20 times faster, but the Perl
+# code might be more portable, so it is still here.
+
+use integer;
+
+sub old_encode_base64 ($;$)
+{
+ my $res = "";
+ my $eol = $_[1];
+ $eol = "\n" unless defined $eol;
+ pos($_[0]) = 0; # ensure start at the beginning
+
+ $res = join '', map( pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
+
+ $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs
+ # fix padding at the end
+ my $padding = (3 - length($_[0]) % 3) % 3;
+ $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
+ # break encoded string into lines of no more than 76 characters each
+ if (length $eol) {
+ $res =~ s/(.{1,76})/$1$eol/g;
+ }
+ return $res;
+}
+
+
+sub old_decode_base64 ($)
+{
+ local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
+
+ my $str = shift;
+ $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
+ if (length($str) % 4) {
+ require Carp;
+ Carp::carp("Length of base64 data not a multiple of 4")
+ }
+ $str =~ s/=+$//; # remove padding
+ $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
+
+ return join'', map( unpack("u", chr(32 + length($_)*3/4) . $_),
+ $str =~ /(.{1,60})/gs);
+}
+
+# Set up aliases so that these functions also can be called as
+#
+# MIME::Base64::encode();
+# MIME::Base64::decode();
+
+*encode = \&encode_base64;
+*decode = \&decode_base64;
+
+1;
diff --git a/ext/MIME/Base64/Base64.xs b/ext/MIME/Base64/Base64.xs
new file mode 100644
index 0000000000..118d170823
--- /dev/null
+++ b/ext/MIME/Base64/Base64.xs
@@ -0,0 +1,218 @@
+/* $Id: Base64.xs,v 1.18 2001/02/24 06:27:01 gisle Exp $
+
+Copyright 1997-1999,2001 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
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef __cplusplus
+}
+#endif
+
+#include "patchlevel.h"
+#if PATCHLEVEL <= 4 && !defined(PL_dowarn)
+ #define PL_dowarn dowarn
+#endif
+
+#define MAX_LINE 76 /* size of encoded lines */
+
+static char basis_64[] =
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
+
+#define XX 255 /* illegal base64 char */
+#define EQ 254 /* padding */
+#define INVALID XX
+
+static 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,
+};
+
+
+
+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:
+#ifdef sv_utf8_downgrade
+ 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 = *str++;
+ *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*)SvPV(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[*str++];
+ if (uc != INVALID)
+ c[i++] = uc;
+
+ if (str == end) {
+ if (i < 4) {
+ if (i && PL_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 (PL_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
diff --git a/ext/MIME/Base64/Changes b/ext/MIME/Base64/Changes
new file mode 100644
index 0000000000..10cd3ce6ba
--- /dev/null
+++ b/ext/MIME/Base64/Changes
@@ -0,0 +1,132 @@
+2001-02-23 Gisle Aas <gisle@ActiveState.com>
+
+ Release 2.12
+
+ Speed up pure perl base64 encoder/decoder by using join/map instead
+ of while loop. Contributed by Arno Beckmann <arno@gmx.de>
+
+ Doc update contributed by Jerrad Pierce <belg4mit@CALLOWAY.MIT.EDU>
+
+ Downgrade UTF8 strings before starting to encode.
+
+
+
+1999-02-27 Gisle Aas <gisle@aas.no>
+
+ Release 2.11
+
+ Fixed bogus "Premature end of base64 data" warning. Bug spotted
+ by Dwayne Jacques Fontenot.
+
+ Workaround for Redhat shipping trial releases of perl.
+
+
+
+1998-12-18 Gisle Aas <aas@sn.no>
+
+ Release 2.10
+
+ A tweak that should make compilation with some old perl5.00[23]
+ perls better.
+
+ A cast that make some compilers more happy.
+
+
+
+1998-11-13 Gisle Aas <aas@sn.no>
+
+ Release 2.09
+
+ The 2.08 release did not compile with perl5.005_53, because
+ all simple globals now need to be prefixed with "PL_".
+
+
+
+1998-10-22 Gisle Aas <aas@sn.no>
+
+ Release 2.08
+
+ Found another tweak to speed up decode_base64() with another 3%.
+
+ Improved MIME::Base64 documentation a little.
+
+
+
+1998-10-21 Gisle Aas <aas@sn.no>
+
+ Release 2.07
+
+ Faster and smarter C implementation of the decode_base64()
+ function. The new decode_base64() was 25% faster when tested
+ on Linux, i586, gcc -O2.
+
+
+
+1998-07-15 Gisle Aas <aas@sn.no>
+
+ Release 2.06
+
+ The decode_base64() implemented in pure perl will only carp
+ (not croak) if length of data to decode is not a multiple 4. This
+ actually made 'make test' fail after 'rm Base64.xs'.
+
+
+
+1998-01-27 Gisle Aas <aas@sn.no>
+
+ Release 2.05
+
+ The decode_base64() would previously allocate a too short buffer for the
+ result string when the trailing "==" padding was missing in the string to
+ be decoded.
+
+ The encode_base64() now allocate one byte less space in the result
+ strings returned.
+
+
+
+1997-12-02 Gisle Aas <aas@sn.no>
+
+ Release 2.04
+
+ Documentation expanded a bit.
+
+
+
+1997-07-10 Gisle Aas <aas@sn.no>
+
+ Release 2.03
+
+ Decode_base64() doesn't croak on premature ended data any more.
+ A warning is generated instead if running under -w.
+
+
+
+1997-06-27 Gisle Aas <aas@sn.no>
+
+ Release 2.02
+
+ QuotedPrint fix by Roderick Schertler <roderick@argon.org>:
+
+ - Long lines were not broken unless they're at the beginning
+ of the text
+
+ - Lines near but not over 76 chars were broken when they
+ shouldn't be
+
+
+
+1997-06-13 Gisle Aas <aas@sn.no>
+
+ Release 2.01
+
+ Base64.xs: Avoid type convertion warnings with some compilers
+
+ Minor documentation updates
+
+
+
+1997-04-24 Gisle Aas <aas@sn.no>
+
+ Release 2.00, based on libwww-perl-5.08.
+
diff --git a/ext/MIME/Base64/Makefile.PL b/ext/MIME/Base64/Makefile.PL
new file mode 100644
index 0000000000..f5b4cb9fe5
--- /dev/null
+++ b/ext/MIME/Base64/Makefile.PL
@@ -0,0 +1,8 @@
+require 5.002;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'MIME::Base64',
+ VERSION_FROM => 'Base64.pm',
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+);
diff --git a/ext/MIME/Base64/QuotedPrint.pm b/ext/MIME/Base64/QuotedPrint.pm
new file mode 100644
index 0000000000..ccdee2bbfa
--- /dev/null
+++ b/ext/MIME/Base64/QuotedPrint.pm
@@ -0,0 +1,115 @@
+#
+# $Id: QuotedPrint.pm,v 2.3 1997/12/02 10:24:27 aas Exp $
+
+package MIME::QuotedPrint;
+
+=head1 NAME
+
+MIME::QuotedPrint - Encoding and decoding of quoted-printable strings
+
+=head1 SYNOPSIS
+
+ use MIME::QuotedPrint;
+
+ $encoded = encode_qp($decoded);
+ $decoded = decode_qp($encoded);
+
+=head1 DESCRIPTION
+
+This module provides functions to encode and decode strings into the
+Quoted-Printable encoding specified in RFC 2045 - I<MIME (Multipurpose
+Internet Mail Extensions)>. The Quoted-Printable encoding is intended
+to represent data that largely consists of bytes that correspond to
+printable characters in the ASCII character set. Non-printable
+characters (as defined by english americans) are represented by a
+triplet consisting of the character "=" followed by two hexadecimal
+digits.
+
+The following functions are provided:
+
+=over 4
+
+=item encode_qp($str)
+
+This function will return an encoded version of the string given as
+argument.
+
+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)).
+
+=item decode_qp($str);
+
+This function will return the plain text version of the string given
+as argument.
+
+=back
+
+
+If you prefer not to import these routines into your namespace you can
+call them as:
+
+ use MIME::QuotedPrint ();
+ $encoded = MIME::QuotedPrint::encode($decoded);
+ $decoded = MIME::QuotedPrint::decode($encoded);
+
+=head1 COPYRIGHT
+
+Copyright 1995-1997 Gisle Aas.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use vars qw(@ISA @EXPORT $VERSION);
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(encode_qp decode_qp);
+
+$VERSION = sprintf("%d.%02d", q$Revision: 2.3 $ =~ /(\d+)\.(\d+)/);
+
+
+sub encode_qp ($)
+{
+ my $res = shift;
+ $res =~ s/([^ \t\n!-<>-~])/sprintf("=%02X", ord($1))/eg; # rule #2,#3
+ $res =~ s/([ \t]+)$/
+ join('', map { sprintf("=%02X", ord($_)) }
+ split('', $1)
+ )/egm; # rule #3 (encode whitespace at eol)
+
+ # 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"
+ while $res =~ s/(.*?^[^\n]{73} (?:
+ [^=\n]{2} (?! [^=\n]{0,1} $) # 75 not followed by .?\n
+ |[^=\n] (?! [^=\n]{0,2} $) # 74 not followed by .?.?\n
+ | (?! [^=\n]{0,3} $) # 73 not followed by .?.?.?\n
+ ))//xsm;
+
+ "$brokenlines$res";
+}
+
+
+sub 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/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
+ $res;
+}
+
+# Set up aliases so that these functions also can be called as
+#
+# MIME::QuotedPrint::encode();
+# MIME::QuotedPrint::decode();
+
+*encode = \&encode_qp;
+*decode = \&decode_qp;
+
+1;
View Lorry Controller Status