MIME-Tools 5.411a fixes (will be part of MIME-Tools 5.412)
Martin Blapp
mb at imp.ch
Tue Aug 31 11:16:51 PDT 2004
Hi all,
If it is ok I plan to commit the following changes to MIME-Tools. These are
all needed fixes to get p5-MIME-Tools working properly together with
MIMEDefang/Mailscanner/Amavis.
They have been reviewed and discussed by Julian Field (the mailscanner
lead developer) and David F. Skoll <dfs at roaringpenguin.com> (the MIMEDefang
lead developer). Gisle Aas (developer of p5-Base64) has also helped us
a lot.
This port is unmaintained in CPAN since almost 2 years now and we need
to do something. Hopefully there will be soon MIME-Tools 5.412 (but that
will be after the ports freeze.
I'm running these fixes here on a heavily used server and they fix
all known problems (binary corruption, memleaks etc) with MIME-Tools 5411.
Unfortunatly MIME-Tools 6.002 contains some regressions and nobody uses
it currently.
Martin
patch-7or8bit.diff
------------------
Correct "7_bit", "7-bit", and "7 bit" to
"7bit"; likewise for "8bit".
Taken from MIME-Tools 6.002
patch-Benchmark
---------------
Parser memory leak fixed. The closure-based task/benchmark mechanisms created
for 5.5 were leaking references like crazy. That's been stopped.
Taken from MIME-Tools 6.002
patch-Parser-BinHex
-------------------
Add BinHex support.
Submitted by: Julian Field <mailscanner at ecs.soton.ac.uk>
patch-Decoder-qpdecode
----------------------
Fix the problem with corrupted PDF-files with a modified patch which treats
encoded PDF-Files differently and decodes these file adding a carriage return.
patch-Decoder-qpencode
----------------------
Fix encoding corruption. rt.cpan.org: Bug #7457
encode_qp() since version 3.02 takes up 3 args. Third arg is a flag indicating
binarymode. Since the flag meaning is inverted comparing to the MIME::Base64 patch
suggested originally, the corresponding MIME-tools patch needs to be modified
also.
Submitted by: ak2 at smr.ru
patch-Filer.pm-whitespace
-------------------------
Remove whitspaces from exorcise_filename() and make evil_filename()
recognize path or special characters.
Submitted by: Julian Field <mailscanner at ecs.soton.ac.uk>
Martin Blapp <mbr at freebsd.org>
patch-Parser-MaxParts
---------------------
Limits the number of MIME parts we will parse.
Normally, instances of this class parse a message to the bitter end.
Messages with many MIME parts can cause excessive memory consumption.
If you invoke this method, parsing will abort with a die() if a message
contains more than NUM parts.
Submitted by: David F. Skoll <dfs at roaringpenguin.com>
patch-ParserUndef
-----------------
Return undef or the parsed MIME::Entity in parse_data().
Submitted by: David F. Skoll <dfs at roaringpenguin.com>
Index: Makefile
===================================================================
RCS file: /home/pcvs/ports/mail/p5-MIME-Tools/Makefile,v
retrieving revision 1.27
diff -u -r1.27 Makefile
--- Makefile 19 Nov 2003 10:00:45 -0000 1.27
+++ Makefile 31 Aug 2004 18:06:53 -0000
@@ -7,8 +7,8 @@
PORTNAME= p5-MIME-Tools
PORTVERSION= 5.411a
-PORTREVISION= 3
-PORTEPOCH= 1
+PORTREVISION= 4
+PORTEPOCH= 2
CATEGORIES= mail perl5
MASTER_SITES= ${MASTER_SITE_PERL_CPAN}
MASTER_SITE_SUBDIR= MIME
@@ -18,7 +18,9 @@
COMMENT= A set of perl5 modules for MIME
BUILD_DEPENDS= ${SITE_PERL}/Mail/Header.pm:${PORTSDIR}/mail/p5-Mail-Tools \
- ${SITE_PERL}/IO/Wrap.pm:${PORTSDIR}/devel/p5-IO-stringy
+ ${SITE_PERL}/IO/Wrap.pm:${PORTSDIR}/devel/p5-IO-stringy \
+ ${SITE_PERL}/Convert/BinHex.pm:${PORTSDIR}/converters/p5-Convert-BinHex \
+ ${SITE_PERL}/${PERL_ARCH}/MIME/Base64.pm:${PORTSDIR}/converters/p5-MIME-Base64
RUN_DEPENDS= ${BUILD_DEPENDS}
PERL_CONFIGURE= YES
@@ -48,9 +50,6 @@
.include <bsd.port.pre.mk>
-.if ${PERL_LEVEL} < 500800
-BUILD_DEPENDS+= ${SITE_PERL}/${PERL_ARCH}/MIME/Base64.pm:${PORTSDIR}/converters/p5-MIME-Base64
-.endif
post-patch:
@${RM} -f ${WRKSRC}/lib/MIME/Field/ParamVal.pm.orig \
Index: files/patch-7or8bit.diff
===================================================================
RCS file: files/patch-7or8bit.diff
diff -N files/patch-7or8bit.diff
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-7or8bit.diff 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,20 @@
+--- lib/MIME/Head.pm.orig Sat Nov 4 20:54:46 2000
++++ lib/MIME/Head.pm Wed Aug 25 11:12:25 2004
+@@ -685,11 +685,16 @@
+ This is the default value -- that is, "Content-Transfer-Encoding: 7BIT"
+ is assumed if the Content-Transfer-Encoding header field is not present.
+
++I do one other form of fixup: "7_bit", "7-bit", and "7 bit" are
++corrected to "7bit"; likewise for "8bit".
++
+ =cut
+
+ sub mime_encoding {
+ my $self = shift;
+- lc($self->mime_attr('content-transfer-encoding') || '7bit');
++ my $enc = lc($self->mime_attr('content-transfer-encoding') || '7bit');
++ $enc =~ s{^([78])[ _-]bit\Z}{$1bit};
++ $enc;
+ }
+
+ #------------------------------
Index: files/patch-Benchmark
===================================================================
RCS file: files/patch-Benchmark
diff -N files/patch-Benchmark
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Benchmark 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,88 @@
+--- lib/MIME/Parser.pm.orig Wed Aug 25 11:19:44 2004
++++ lib/MIME/Parser.pm Wed Aug 25 11:23:39 2004
+@@ -582,10 +582,7 @@
+ my ($self, $in, $rdr, $out) = @_;
+
+ ### Parse:
+- my $bm = benchmark {
+- $rdr->read_chunk($in, $out);
+- };
+- $self->debug("t bound: $bm");
++ $rdr->read_chunk($in, $out);
+ 1;
+ }
+
+@@ -828,11 +825,8 @@
+
+ ### Decode and save the body (using the decoder):
+ my $DECODED = $body->open("w") || die "$ME: body not opened: $!\n";
+- my $bm = benchmark {
+- eval { $decoder->decode($ENCODED, $DECODED); };
+- $@ and $self->error($@);
+- };
+- $self->debug("t decode: $bm");
++ eval { $decoder->decode($ENCODED, $DECODED); };
++ $@ and $self->error($@);
+ $DECODED->close;
+
+ ### Success! Remember where we put stuff:
+@@ -1134,11 +1128,8 @@
+ my $entity;
+ local $/ = "\n"; ### just to be safe
+
+- my $bm = benchmark {
+- $self->init_parse;
+- ($entity) = $self->process_part($in, undef); ### parse!
+- };
+- $self->debug("t parse: $bm");
++ $self->init_parse;
++ ($entity) = $self->process_part($in, undef); ### parse!
+
+ $entity;
+ }
+--- lib/MIME/Tools.pm.orig Wed Aug 25 10:47:32 2004
++++ lib/MIME/Tools.pm Wed Aug 25 10:50:41 2004
+@@ -24,7 +24,7 @@
+ 'config' => [qw(%CONFIG)],
+ 'msgs' => [qw(usage debug whine error)],
+ 'msgtypes'=> [qw($M_DEBUG $M_WARNING $M_ERROR)],
+- 'utils' => [qw(benchmark catfile shellquote textual_type tmpopen )],
++ 'utils' => [qw(catfile shellquote textual_type tmpopen )],
+ );
+ Exporter::export_ok_tags('config', 'msgs', 'msgtypes', 'utils');
+
+@@ -153,26 +153,6 @@
+
+ #------------------------------
+ #
+-# benchmark CODE
+-#
+-# Private benchmarking utility.
+-#
+-sub benchmark(&) {
+- my ($code) = @_;
+- if (1) {
+- my $t0 = new Benchmark;
+- &$code;
+- my $t1 = new Benchmark;
+- return timestr(timediff($t1, $t0));
+- }
+- else {
+- &$code;
+- return "";
+- }
+-}
+-
+-#------------------------------
+-#
+ # catfile DIR, FILE
+ #
+ # Directory/file concatenation.
+@@ -1394,7 +1374,6 @@
+ Newlines in the void
+
+ Started using Benchmark for benchmarking.
+-
+
+ =item Version 5.205 (2000/06/06)
+
Index: files/patch-Decoder-qpdecode
===================================================================
RCS file: files/patch-Decoder-qpdecode
diff -N files/patch-Decoder-qpdecode
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Decoder-qpdecode 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,30 @@
+--- lib/MIME/Decoder/QuotedPrint.pm.orig Tue Aug 31 17:02:43 2004
++++ lib/MIME/Decoder/QuotedPrint.pm Tue Aug 31 17:02:38 2004
+@@ -85,9 +85,26 @@
+ #
+ sub decode_it {
+ my ($self, $in, $out) = @_;
++ my $init = 0;
++ my $havepdf = 0;
+
+ while (defined($_ = $in->getline)) {
+- $out->print(decode_qp($_));
++ if (!$init) {
++ if ($_ =~ /^%PDF/) {
++ $init = 1;
++ $havepdf = 1;
++ }
++ }
++ if ($havepdf) {
++ my $output = $_;
++ $output =~ s/[ \t]+?(\r?\n)/$1/g; # rule #3 (trailing space must be deleted)
++ $output =~ s/=\r?\n//g; # rule #5 (soft line breaks)
++ $output =~ s/(^|[^\r])\n\Z/$1\r\n/; # JKF rule to replace trailing \n with \r\n
++ $output =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
++ $out->print($output);
++ } else {
++ $out->print(decode_qp($_));
++ }
+ }
+ 1;
+ }
Index: files/patch-Decoder-qpencode
===================================================================
RCS file: files/patch-Decoder-qpencode
diff -N files/patch-Decoder-qpencode
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Decoder-qpencode 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,128 @@
+--- lib/MIME/Decoder/QuotedPrint.pm.orig Wed Aug 25 11:46:45 2004
++++ lib/MIME/Decoder/QuotedPrint.pm Wed Aug 25 11:48:27 2004
+@@ -54,7 +54,7 @@
+
+ use vars qw(@ISA $VERSION);
+ use MIME::Decoder;
+-use MIME::QuotedPrint 2.03;
++use MIME::QuotedPrint 3.03;
+
+ @ISA = qw(MIME::Decoder);
+
+@@ -63,7 +63,7 @@
+
+ #------------------------------
+ #
+-# encode_qp_really STRING
++# encode_qp_really STRING TEXTUAL_TYPE_FLAG
+ #
+ # Encode QP, and then follow guideline 8 from RFC 2049 (thanks to Denis
+ # N. Antonioli) whereby we make things a little safer for the transport
+@@ -71,7 +71,7 @@
+ # grow beyond 76 characters!
+ #
+ sub encode_qp_really {
+- my $enc = encode_qp($_[0]);
++ my $enc = encode_qp(shift, undef, not shift);
+ if (length($enc) < 74) {
+ $enc =~ s/^\.$/=2E/g; # force encoding of /^\.$/
+ $enc =~ s/^From /=46rom /g; # force encoding of /^From /
+@@ -97,10 +97,10 @@
+ # encode_it IN, OUT
+ #
+ sub encode_it {
+- my ($self, $in, $out) = @_;
++ my ($self, $in, $out, $textual_type) = @_;
+
+ while (defined($_ = $in->getline)) {
+- $out->print(encode_qp_really($_));
++ $out->print(encode_qp_really($_, $textual_type));
+ }
+ 1;
+ }
+--- lib/MIME/Decoder.pm.orig Wed Aug 25 11:49:42 2004
++++ lib/MIME/Decoder.pm Wed Aug 25 11:50:26 2004
+@@ -248,14 +248,14 @@
+ =cut
+
+ sub encode {
+- my ($self, $in, $out) = @_;
++ my ($self, $in, $out, $textual_type) = @_;
+
+ ### Coerce old-style filehandles to legit objects, and do it!
+ $in = wraphandle($in);
+ $out = wraphandle($out);
+
+ ### Invoke back-end method to do the work:
+- $self->encode_it($in, $out) ||
++ $self->encode_it($in, $out, $self->encoding eq 'quoted-printable' ? ($textual_type) : ()) ||
+ die "$ME: ".$self->encoding." encoding failed\n";
+ }
+
+--- lib/MIME/Entity.pm.orig Wed Aug 25 11:50:54 2004
++++ lib/MIME/Entity.pm Wed Aug 25 11:51:25 2004
+@@ -1853,7 +1853,7 @@
+
+ ### Output the body:
+ my $IO = $self->open("r") || die "open body: $!";
+- $decoder->encode($IO, $out) || return error "encoding failed";
++ $decoder->encode($IO, $out, textual_type($self->head->mime_type) ? 1 : 0) || die "encoding failed\n";
+ $IO->close;
+ 1;
+ }
+--- lib/MIME/Decoder/QuotedPrint.pm.orig Thu Aug 26 12:28:37 2004
++++ lib/MIME/Decoder/QuotedPrint.pm Thu Aug 26 12:28:26 2004
+@@ -73,7 +73,7 @@
+ sub encode_qp_really {
+ my $enc = encode_qp(shift, undef, not shift);
+ if (length($enc) < 74) {
+- $enc =~ s/^\.$/=2E/g; # force encoding of /^\.$/
++ $enc =~ s/^\.\n/=2E\n/g; # force encoding of /^\.$/
+ $enc =~ s/^From /=46rom /g; # force encoding of /^From /
+ }
+ $enc;
+--- t/Misc.t.orig Sun May 21 07:15:26 2000
++++ t/Misc.t Thu Aug 26 12:34:27 2004
+@@ -6,7 +6,7 @@
+
+ # Create checker:
+ my $T = typical ExtUtils::TBone;
+-$T->begin(7);
++$T->begin(12);
+
+ #------------------------------
+ # Bug 971008 from Michael W. Normandin <michael.normandin at csfb.com>:
+@@ -67,13 +67,29 @@
+ # $res =~ s/\./=2E/go;
+ # $res =~ s/From /=46rom /go;
+ # at the start of encode_qp_really in MIME::Decoder::QuotedPrint?
++#
++# Textual mode.
++{
++ use MIME::Decoder::QuotedPrint;
++ my $pair;
++ foreach $pair (["From me", "=46rom me=\n"],
++ [".", ".=\n"], # soft line-break
++ [".\n", "=2E\n"], # line-break
++ [" From you", " From you=\n"]) {
++ my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0], 1);
++ $T->ok_eq($out, $pair->[1],
++ "bug 970725-DNA: QP use of RFC2049 guideline 8");
++ }
++}
++# Binary mode
+ {
+ use MIME::Decoder::QuotedPrint;
+ my $pair;
+- foreach $pair (["From me", "=46rom me"],
+- [".", "=2E"],
+- [" From you", " From you"]) {
+- my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0]);
++ foreach $pair (["From me", "=46rom me=\n"],
++ [".", ".=\n"], # soft line-break
++ [".\n", ".=0A=\n"], # line-break
++ [" From you", " From you=\n"]) {
++ my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0], 0);
+ $T->ok_eq($out, $pair->[1],
+ "bug 970725-DNA: QP use of RFC2049 guideline 8");
+ }
Index: files/patch-Filer.pm-whitespace
===================================================================
RCS file: files/patch-Filer.pm-whitespace
diff -N files/patch-Filer.pm-whitespace
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Filer.pm-whitespace 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,23 @@
+--- lib/MIME/Parser/Filer.pm Thu Nov 23 06:04:03 2000
++++ lib/MIME/Parser/Filer.pm Thu Aug 26 00:42:18 2004
+@@ -357,8 +357,9 @@
+ $self->debug("is this evil? '$name'");
+
+ return 1 if (!defined($name) or ($name eq '')); ### empty
++ return 1 if ($name =~ m{(^\s)|(\s+\Z)}); ### leading/trailing whitespace
+ return 1 if ($name =~ m{^\.+\Z}); ### dots
+- return 1 if ($name =~ tr{\\/:[]}{}); ### path characters
++ return 1 if ($name =~ /((?:[\[\]\\\/\<\>\|\?\*\:\"]|\p{IsCntrl}))/); ### path or special characters
+ return 1 if ($self->{MPF_MaxName} and
+ (length($name) > $self->{MPF_MaxName}));
+
+@@ -402,6 +403,9 @@
+ my ($root, $ext) = (($last =~ /^(.*)\.([^\.]+)\Z/)
+ ? ($1, $2)
+ : ($last, ''));
++ ### Delete leading and trailing whitespace
++ $root =~ s/^\s+//;
++ $ext =~ s/\s+$//;
+ $root = substr($root, 0, ($self->{MPF_TrimRoot} || 14));
+ $ext = substr($ext, 0, ($self->{MPF_TrimExt} || 3));
+ $ext =~ /^\w+$/ or $ext = "dat";
Index: files/patch-Parser-BinHex
===================================================================
RCS file: files/patch-Parser-BinHex
diff -N files/patch-Parser-BinHex
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Parser-BinHex 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,260 @@
+--- /dev/null Sun Aug 1 22:44:02 2004
++++ lib/MIME/Decoder/BinHex.pm Sun Aug 1 22:43:12 2004
+@@ -0,0 +1,182 @@
++package MIME::Decoder::BinHex;
++
++
++=head1 NAME
++
++MIME::Decoder::BinHex - decode a "binhex" stream
++
++
++=head1 SYNOPSIS
++
++A generic decoder object; see L<MIME::Decoder> for usage.
++
++Also supports a preamble() method to recover text before
++the binhexed portion of the stream.
++
++
++=head1 DESCRIPTION
++
++A MIME::Decoder subclass for a nonstandard encoding whereby
++data are binhex-encoded. Common non-standard MIME encodings for this:
++
++ x-uu
++ x-uuencode
++
++
++=head1 AUTHOR
++
++Julian Field (F<mailscanner at ecs.soton.ac.uk>).
++
++All rights reserved. This program is free software; you can redistribute
++it and/or modify it under the same terms as Perl itself.
++
++=head1 VERSION
++
++$Revision: 1.1 $ $Date: 2004/08/01 20:46:17 $
++
++=cut
++
++
++require 5.002;
++use vars qw(@ISA $VERSION);
++use MIME::Decoder;
++use MIME::Tools qw(whine);
++use Convert::BinHex;
++
++ at ISA = qw(MIME::Decoder);
++
++# The package version, both in 1.23 style *and* usable by MakeMaker:
++$VERSION = substr q$Revision: 1.1 $, 10;
++
++
++#------------------------------
++#
++# decode_it IN, OUT
++#
++sub decode_it {
++ my ($self, $in, $out) = @_;
++ my ($mode, $file);
++ my (@preamble, @data);
++ local $_;
++ my $H2B = Convert::BinHex->hex2bin;
++ #my $H2B = Convert::BinHex->open($in);
++ my $line;
++
++ $self->{MDU_Preamble} = \@preamble;
++ $self->{MDU_Mode} = '600';
++ $self->{MDU_File} = undef;
++
++ ### Find beginning...
++ $MailScanner::BinHex::Inline = 1;
++ if ($MailScanner::BinHex::Inline) {
++ while (defined($_ = $in->getline)) {
++ #print STDERR "Line is \"$_\"\n";
++ if (/^\(This file must be converted/) {
++ $_ = $in->getline;
++ last if /^:/;
++ }
++ push @preamble, $_;
++ }
++ die("binhex decoding: fell off end of file\n") if !defined($_);
++ } else {
++ while (defined($_ = $in->getline)) {
++ # Found the header? So start decoding it
++ last if /^:/;
++ push @preamble, $_;
++ }
++ ## hit eof!
++ die("binhex decoding: no This file must be... found\n") if !defined($_);
++ }
++
++ ### Decode:
++ # Don't rely on the comment always being there
++ #$self->whine(":H2B is $H2B\n");
++ #$self->whine("Header is " . $H2B->read_header . "\n");
++ #@data = $H2B->read_data;
++ #$out->print(@data);
++ #print STDERR "End of binhex stream\n";
++ #return 1;
++ #if (/^:/) {
++ my $data;
++ $data = $H2B->next($_); # or whine("Next error is $@ $!\n");
++ #print STDERR "Data line 1 is length \"" . length($data) . "\" \"$data\"\n";
++ my $len = unpack("C", $data);
++ while ($len > length($data)+21 && defined($line = $in->getline)) {
++ $data .= $H2B->next($line);
++ }
++ $data = substr($data, 22+$len);
++ $out->print($data);
++ #}
++ while (defined($_ = $in->getline)) {
++ $line = $_;
++ $data = $H2B->next($line);
++ #print STDERR "Data is length " . length($data) . " \"$data\"\n";
++ $out->print($data);
++ #chomp $line;
++ #print STDERR "Line is length " . length($line) . " \"$line\"\n";
++ #print STDERR "Line matches end\n" if $line =~ /:$/;
++ last if $line =~ /:$/;
++ }
++ #print STDERR "Broken out of loop\n";
++ #print STDERR "file incomplete, no end found\n" if !defined($_); # eof
++ 1;
++}
++
++#------------------------------
++#
++# encode_it IN, OUT
++#
++sub encode_it {
++ my ($self, $in, $out) = @_;
++ my $line;
++ my $buf = '';
++
++ my $fname = (($self->head &&
++ $self->head->mime_attr('content-disposition.filename')) ||
++ '');
++ my $B2H = Convert::BinHex->bin2hex;
++ $out->print("(This file must be converted with BinHex 4.0)\n");
++ #while (defined($line = <$in>)) {
++ while ($in->read($buf, 1000)) {
++ $out->print($B2H->next($buf));
++ }
++ $out->print($B2H->done);
++ 1;
++}
++
++#------------------------------
++#
++# last_preamble
++#
++# Return the last preamble as ref to array of lines.
++# Gets reset by decode_it().
++#
++sub last_preamble {
++ my $self = shift;
++ return $self->{MDU_Preamble} || [];
++}
++
++#------------------------------
++#
++# last_mode
++#
++# Return the last mode.
++# Gets reset to undef by decode_it().
++#
++sub last_mode {
++ shift->{MDU_Mode};
++}
++
++#------------------------------
++#
++# last_filename
++#
++# Return the last filename.
++# Gets reset by decode_it().
++#
++sub last_filename {
++ shift->{MDU_File} || undef; #[];
++}
++
++#------------------------------
++1;
+--- lib/MIME/Decoder.pm.orig Sun Aug 1 22:44:50 2004
++++ lib/MIME/Decoder.pm Sun Aug 1 22:45:10 2004
+@@ -111,6 +111,7 @@
+ 'quoted-printable' => 'MIME::Decoder::QuotedPrint',
+
+ ### Non-standard...
++ 'binhex' => 'MIME::Decoder::BinHex',
+ 'x-uu' => 'MIME::Decoder::UU',
+ 'x-uuencode' => 'MIME::Decoder::UU',
+
+--- lib/MIME/Parser.pm Tue Aug 31 18:54:05 2004
++++ lib/MIME/Parser.pm Tue Aug 31 18:53:33 2004
+@@ -799,10 +802,11 @@
+ $self->debug("extract uuencode? ", $self->extract_uuencode);
+ $self->debug("encoding? ", $encoding);
+ $self->debug("effective type? ", $ent->effective_type);
++
+ if ($self->extract_uuencode and
+ ($encoding =~ /^(7bit|8bit|binary)\Z/) and
+- ($ent->effective_type =~ m{^text/plain\Z})) {
+-
++ ($ent->effective_type =~
++ m{^(?:text/plain|application/mac-binhex40|application/mac-binhex)\Z})) {
+ ### Hunt for it:
+ my $uu_ent = eval { $self->hunt_for_uuencode($ENCODED, $ent) };
+ if ($uu_ent) { ### snark
+@@ -842,14 +844,21 @@
+ #
+ sub hunt_for_uuencode {
+ my ($self, $ENCODED, $ent) = @_;
+- my $good;
++ my ($good, $jkfis);
+ local $_;
+ $self->debug("sniffing around for UUENCODE");
+
+ ### Heuristic:
+ $ENCODED->seek(0,0);
+ while (defined($_ = $ENCODED->getline)) {
+- last if ($good = /^begin [0-7]{3}/);
++ if ($good = /^begin [0-7]{3}/) {
++ $jkfis = 'uu';
++ last;
++ }
++ if ($good = /^\(This file must be converted with/i) {
++ $jkfis = 'binhex';
++ last;
++ }
+ }
+ $good or do { $self->debug("no one made the cut"); return 0 };
+
+@@ -860,7 +869,9 @@
+
+ ### Made the first cut; on to the real stuff:
+ $ENCODED->seek(0,0);
+- my $decoder = MIME::Decoder->new('x-uuencode');
++ my $decoder = MIME::Decoder->new(($jkfis eq 'uu')?'x-uuencode'
++ :'binhex');
++ $self->whine("Found a $jkfis attachment");
+ my $pre;
+ while (1) {
+ my @bin_data;
+@@ -910,12 +921,11 @@
+
+ ### Did we get anything?
+ @parts or return undef;
+-
+ ### Set the parts and a nice preamble:
+ $top_ent->parts(\@parts);
+ $top_ent->preamble
+ (["The following is a multipart MIME message which was extracted\n",
+- "from a uuencoded message.\n"]);
++ "from a $jkfis-encoded message.\n"]);
+ $top_ent;
+ }
+
Index: files/patch-Parser-MaxParts
===================================================================
RCS file: files/patch-Parser-MaxParts
diff -N files/patch-Parser-MaxParts
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Parser-MaxParts 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,81 @@
+--- lib/MIME/Parser.pm.orig Tue Aug 31 18:54:05 2004
++++ lib/MIME/Parser.pm Tue Aug 31 18:53:33 2004
+@@ -250,6 +250,7 @@
+ $self->{MP5_IgnoreErrors} = 1;
+ $self->{MP5_UseInnerFiles} = 0;
+ $self->{MP5_UUDecode} = 0;
++ $self->{MP5_MaxParts} = -1;
+
+ $self->interface(ENTITY_CLASS => 'MIME::Entity');
+ $self->interface(HEAD_CLASS => 'MIME::Head');
+@@ -277,6 +278,7 @@
+ $self->{MP5_Filer}->results($self->{MP5_Results});
+ $self->{MP5_Filer}->init_parse();
+ $self->{MP5_Filer}->purgeable([]); ### just to be safe
++ $self->{MP5_NumParts} = 0;
+ 1;
+ }
+
+@@ -969,11 +980,19 @@
+ # Retype => retype this part to the given content-type
+ #
+ # Return the entity.
+-# Fatal exception on failure.
++# Fatal exception on failure. Returns undef if message to complex
+ #
+ sub process_part {
+ my ($self, $in, $rdr, %p) = @_;
+
++ if ($self->{MP5_MaxParts} > 0) {
++ $self->{MP5_NumParts}++;
++ if ($self->{MP5_NumParts} > $self->{MP5_MaxParts}) {
++ # Return UNDEF if msg too complex
++ return undef;
++ }
++ }
++
+ $rdr ||= MIME::Parser::Reader->new;
+ #debug "process_part";
+ $self->results->level(+1);
+@@ -1094,6 +1112,8 @@
+
+ Returns the parsed MIME::Entity on success.
+ Throws exception on failure.
++If the message contained too many
++parts (as set by I<max_parts>), returns undef.
+
+ =cut
+
+@@ -1351,6 +1371,32 @@
+ my $self = shift;
+ &MIME::Tools::whine("evil_filename deprecated in MIME::Parser");
+ $self->filer->evil_filename(@_);
++}
++
++#------------------------------
++
++=item max_parts NUM
++
++I<Instance method.>
++Limits the number of MIME parts we will parse.
++
++Normally, instances of this class parse a message to the bitter end.
++Messages with many MIME parts can cause excessive memory consumption.
++If you invoke this method, parsing will abort with a die() if a message
++contains more than NUM parts.
++
++If NUM is set to -1 (the default), then no maximum limit is enforced.
++
++With no argument, returns the current setting as an integer
++
++=cut
++
++sub max_parts {
++ my($self, $num) = @_;
++ if (@_ > 1) {
++ $self->{MP5_MaxParts} = $num;
++ }
++ return $self->{MP5_MaxParts};
+ }
+
+ #------------------------------
Index: files/patch-ParserUndef
===================================================================
RCS file: files/patch-ParserUndef
diff -N files/patch-ParserUndef
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-ParserUndef 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,43 @@
+--- lib/MIME/Parser.pm Tue Aug 31 18:54:05 2004
++++ lib/MIME/Parser.pm Tue Aug 31 18:53:33 2004
+@@ -708,6 +710,7 @@
+
+ ### Parse the next part, and add it to the entity...
+ my $part = $self->process_part($in, $part_rdr, Retype=>$retype);
++ return undef unless defined($part);
+ $ent->add_part($part);
+
+ ### ...and look at how we finished up:
+@@ -944,6 +954,7 @@
+
+ ### Parse the message:
+ my $msg = $self->process_part($in, $rdr);
++ return undef unless defined($msg);
+
+ ### How to handle nested messages?
+ if ($self->extract_nested_messages eq 'REPLACE') {
+@@ -1005,14 +1024,14 @@
+
+ ### Handle, according to the MIME type:
+ if ($type eq 'multipart') {
+- $self->process_multipart($in, $rdr, $ent);
++ return undef unless defined($self->process_multipart($in, $rdr, $ent));
+ }
+ elsif (("$type/$subtype" eq "message/rfc822" ||
+ "$type/$subtype" eq "message/external-body" ||
+ ("$type/$subtype" eq "message/partial" && $head->mime_attr("content-type.number") == 1)) &&
+ $self->extract_nested_messages) {
+ $self->debug("attempting to process a nested message");
+- $self->process_message($in, $rdr, $ent);
++ return undef unless defined($self->process_message($in, $rdr, $ent));
+ }
+ else {
+ $self->process_singlepart($in, $rdr, $ent);
+@@ -1080,7 +1080,6 @@
+ =back
+
+ Returns the parsed MIME::Entity on success.
+-Throws exception on failure.
+
+ =cut
+
-------------- next part --------------
Index: Makefile
===================================================================
RCS file: /home/pcvs/ports/mail/p5-MIME-Tools/Makefile,v
retrieving revision 1.27
diff -u -r1.27 Makefile
--- Makefile 19 Nov 2003 10:00:45 -0000 1.27
+++ Makefile 31 Aug 2004 18:06:53 -0000
@@ -7,8 +7,8 @@
PORTNAME= p5-MIME-Tools
PORTVERSION= 5.411a
-PORTREVISION= 3
-PORTEPOCH= 1
+PORTREVISION= 4
+PORTEPOCH= 2
CATEGORIES= mail perl5
MASTER_SITES= ${MASTER_SITE_PERL_CPAN}
MASTER_SITE_SUBDIR= MIME
@@ -18,7 +18,9 @@
COMMENT= A set of perl5 modules for MIME
BUILD_DEPENDS= ${SITE_PERL}/Mail/Header.pm:${PORTSDIR}/mail/p5-Mail-Tools \
- ${SITE_PERL}/IO/Wrap.pm:${PORTSDIR}/devel/p5-IO-stringy
+ ${SITE_PERL}/IO/Wrap.pm:${PORTSDIR}/devel/p5-IO-stringy \
+ ${SITE_PERL}/Convert/BinHex.pm:${PORTSDIR}/converters/p5-Convert-BinHex \
+ ${SITE_PERL}/${PERL_ARCH}/MIME/Base64.pm:${PORTSDIR}/converters/p5-MIME-Base64
RUN_DEPENDS= ${BUILD_DEPENDS}
PERL_CONFIGURE= YES
@@ -48,9 +50,6 @@
.include <bsd.port.pre.mk>
-.if ${PERL_LEVEL} < 500800
-BUILD_DEPENDS+= ${SITE_PERL}/${PERL_ARCH}/MIME/Base64.pm:${PORTSDIR}/converters/p5-MIME-Base64
-.endif
post-patch:
@${RM} -f ${WRKSRC}/lib/MIME/Field/ParamVal.pm.orig \
Index: files/patch-7or8bit.diff
===================================================================
RCS file: files/patch-7or8bit.diff
diff -N files/patch-7or8bit.diff
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-7or8bit.diff 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,20 @@
+--- lib/MIME/Head.pm.orig Sat Nov 4 20:54:46 2000
++++ lib/MIME/Head.pm Wed Aug 25 11:12:25 2004
+@@ -685,11 +685,16 @@
+ This is the default value -- that is, "Content-Transfer-Encoding: 7BIT"
+ is assumed if the Content-Transfer-Encoding header field is not present.
+
++I do one other form of fixup: "7_bit", "7-bit", and "7 bit" are
++corrected to "7bit"; likewise for "8bit".
++
+ =cut
+
+ sub mime_encoding {
+ my $self = shift;
+- lc($self->mime_attr('content-transfer-encoding') || '7bit');
++ my $enc = lc($self->mime_attr('content-transfer-encoding') || '7bit');
++ $enc =~ s{^([78])[ _-]bit\Z}{$1bit};
++ $enc;
+ }
+
+ #------------------------------
Index: files/patch-Benchmark
===================================================================
RCS file: files/patch-Benchmark
diff -N files/patch-Benchmark
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Benchmark 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,88 @@
+--- lib/MIME/Parser.pm.orig Wed Aug 25 11:19:44 2004
++++ lib/MIME/Parser.pm Wed Aug 25 11:23:39 2004
+@@ -582,10 +582,7 @@
+ my ($self, $in, $rdr, $out) = @_;
+
+ ### Parse:
+- my $bm = benchmark {
+- $rdr->read_chunk($in, $out);
+- };
+- $self->debug("t bound: $bm");
++ $rdr->read_chunk($in, $out);
+ 1;
+ }
+
+@@ -828,11 +825,8 @@
+
+ ### Decode and save the body (using the decoder):
+ my $DECODED = $body->open("w") || die "$ME: body not opened: $!\n";
+- my $bm = benchmark {
+- eval { $decoder->decode($ENCODED, $DECODED); };
+- $@ and $self->error($@);
+- };
+- $self->debug("t decode: $bm");
++ eval { $decoder->decode($ENCODED, $DECODED); };
++ $@ and $self->error($@);
+ $DECODED->close;
+
+ ### Success! Remember where we put stuff:
+@@ -1134,11 +1128,8 @@
+ my $entity;
+ local $/ = "\n"; ### just to be safe
+
+- my $bm = benchmark {
+- $self->init_parse;
+- ($entity) = $self->process_part($in, undef); ### parse!
+- };
+- $self->debug("t parse: $bm");
++ $self->init_parse;
++ ($entity) = $self->process_part($in, undef); ### parse!
+
+ $entity;
+ }
+--- lib/MIME/Tools.pm.orig Wed Aug 25 10:47:32 2004
++++ lib/MIME/Tools.pm Wed Aug 25 10:50:41 2004
+@@ -24,7 +24,7 @@
+ 'config' => [qw(%CONFIG)],
+ 'msgs' => [qw(usage debug whine error)],
+ 'msgtypes'=> [qw($M_DEBUG $M_WARNING $M_ERROR)],
+- 'utils' => [qw(benchmark catfile shellquote textual_type tmpopen )],
++ 'utils' => [qw(catfile shellquote textual_type tmpopen )],
+ );
+ Exporter::export_ok_tags('config', 'msgs', 'msgtypes', 'utils');
+
+@@ -153,26 +153,6 @@
+
+ #------------------------------
+ #
+-# benchmark CODE
+-#
+-# Private benchmarking utility.
+-#
+-sub benchmark(&) {
+- my ($code) = @_;
+- if (1) {
+- my $t0 = new Benchmark;
+- &$code;
+- my $t1 = new Benchmark;
+- return timestr(timediff($t1, $t0));
+- }
+- else {
+- &$code;
+- return "";
+- }
+-}
+-
+-#------------------------------
+-#
+ # catfile DIR, FILE
+ #
+ # Directory/file concatenation.
+@@ -1394,7 +1374,6 @@
+ Newlines in the void
+
+ Started using Benchmark for benchmarking.
+-
+
+ =item Version 5.205 (2000/06/06)
+
Index: files/patch-Decoder-qpdecode
===================================================================
RCS file: files/patch-Decoder-qpdecode
diff -N files/patch-Decoder-qpdecode
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Decoder-qpdecode 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,30 @@
+--- lib/MIME/Decoder/QuotedPrint.pm.orig Tue Aug 31 17:02:43 2004
++++ lib/MIME/Decoder/QuotedPrint.pm Tue Aug 31 17:02:38 2004
+@@ -85,9 +85,26 @@
+ #
+ sub decode_it {
+ my ($self, $in, $out) = @_;
++ my $init = 0;
++ my $havepdf = 0;
+
+ while (defined($_ = $in->getline)) {
+- $out->print(decode_qp($_));
++ if (!$init) {
++ if ($_ =~ /^%PDF/) {
++ $init = 1;
++ $havepdf = 1;
++ }
++ }
++ if ($havepdf) {
++ my $output = $_;
++ $output =~ s/[ \t]+?(\r?\n)/$1/g; # rule #3 (trailing space must be deleted)
++ $output =~ s/=\r?\n//g; # rule #5 (soft line breaks)
++ $output =~ s/(^|[^\r])\n\Z/$1\r\n/; # JKF rule to replace trailing \n with \r\n
++ $output =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge;
++ $out->print($output);
++ } else {
++ $out->print(decode_qp($_));
++ }
+ }
+ 1;
+ }
Index: files/patch-Decoder-qpencode
===================================================================
RCS file: files/patch-Decoder-qpencode
diff -N files/patch-Decoder-qpencode
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Decoder-qpencode 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,128 @@
+--- lib/MIME/Decoder/QuotedPrint.pm.orig Wed Aug 25 11:46:45 2004
++++ lib/MIME/Decoder/QuotedPrint.pm Wed Aug 25 11:48:27 2004
+@@ -54,7 +54,7 @@
+
+ use vars qw(@ISA $VERSION);
+ use MIME::Decoder;
+-use MIME::QuotedPrint 2.03;
++use MIME::QuotedPrint 3.03;
+
+ @ISA = qw(MIME::Decoder);
+
+@@ -63,7 +63,7 @@
+
+ #------------------------------
+ #
+-# encode_qp_really STRING
++# encode_qp_really STRING TEXTUAL_TYPE_FLAG
+ #
+ # Encode QP, and then follow guideline 8 from RFC 2049 (thanks to Denis
+ # N. Antonioli) whereby we make things a little safer for the transport
+@@ -71,7 +71,7 @@
+ # grow beyond 76 characters!
+ #
+ sub encode_qp_really {
+- my $enc = encode_qp($_[0]);
++ my $enc = encode_qp(shift, undef, not shift);
+ if (length($enc) < 74) {
+ $enc =~ s/^\.$/=2E/g; # force encoding of /^\.$/
+ $enc =~ s/^From /=46rom /g; # force encoding of /^From /
+@@ -97,10 +97,10 @@
+ # encode_it IN, OUT
+ #
+ sub encode_it {
+- my ($self, $in, $out) = @_;
++ my ($self, $in, $out, $textual_type) = @_;
+
+ while (defined($_ = $in->getline)) {
+- $out->print(encode_qp_really($_));
++ $out->print(encode_qp_really($_, $textual_type));
+ }
+ 1;
+ }
+--- lib/MIME/Decoder.pm.orig Wed Aug 25 11:49:42 2004
++++ lib/MIME/Decoder.pm Wed Aug 25 11:50:26 2004
+@@ -248,14 +248,14 @@
+ =cut
+
+ sub encode {
+- my ($self, $in, $out) = @_;
++ my ($self, $in, $out, $textual_type) = @_;
+
+ ### Coerce old-style filehandles to legit objects, and do it!
+ $in = wraphandle($in);
+ $out = wraphandle($out);
+
+ ### Invoke back-end method to do the work:
+- $self->encode_it($in, $out) ||
++ $self->encode_it($in, $out, $self->encoding eq 'quoted-printable' ? ($textual_type) : ()) ||
+ die "$ME: ".$self->encoding." encoding failed\n";
+ }
+
+--- lib/MIME/Entity.pm.orig Wed Aug 25 11:50:54 2004
++++ lib/MIME/Entity.pm Wed Aug 25 11:51:25 2004
+@@ -1853,7 +1853,7 @@
+
+ ### Output the body:
+ my $IO = $self->open("r") || die "open body: $!";
+- $decoder->encode($IO, $out) || return error "encoding failed";
++ $decoder->encode($IO, $out, textual_type($self->head->mime_type) ? 1 : 0) || die "encoding failed\n";
+ $IO->close;
+ 1;
+ }
+--- lib/MIME/Decoder/QuotedPrint.pm.orig Thu Aug 26 12:28:37 2004
++++ lib/MIME/Decoder/QuotedPrint.pm Thu Aug 26 12:28:26 2004
+@@ -73,7 +73,7 @@
+ sub encode_qp_really {
+ my $enc = encode_qp(shift, undef, not shift);
+ if (length($enc) < 74) {
+- $enc =~ s/^\.$/=2E/g; # force encoding of /^\.$/
++ $enc =~ s/^\.\n/=2E\n/g; # force encoding of /^\.$/
+ $enc =~ s/^From /=46rom /g; # force encoding of /^From /
+ }
+ $enc;
+--- t/Misc.t.orig Sun May 21 07:15:26 2000
++++ t/Misc.t Thu Aug 26 12:34:27 2004
+@@ -6,7 +6,7 @@
+
+ # Create checker:
+ my $T = typical ExtUtils::TBone;
+-$T->begin(7);
++$T->begin(12);
+
+ #------------------------------
+ # Bug 971008 from Michael W. Normandin <michael.normandin at csfb.com>:
+@@ -67,13 +67,29 @@
+ # $res =~ s/\./=2E/go;
+ # $res =~ s/From /=46rom /go;
+ # at the start of encode_qp_really in MIME::Decoder::QuotedPrint?
++#
++# Textual mode.
++{
++ use MIME::Decoder::QuotedPrint;
++ my $pair;
++ foreach $pair (["From me", "=46rom me=\n"],
++ [".", ".=\n"], # soft line-break
++ [".\n", "=2E\n"], # line-break
++ [" From you", " From you=\n"]) {
++ my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0], 1);
++ $T->ok_eq($out, $pair->[1],
++ "bug 970725-DNA: QP use of RFC2049 guideline 8");
++ }
++}
++# Binary mode
+ {
+ use MIME::Decoder::QuotedPrint;
+ my $pair;
+- foreach $pair (["From me", "=46rom me"],
+- [".", "=2E"],
+- [" From you", " From you"]) {
+- my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0]);
++ foreach $pair (["From me", "=46rom me=\n"],
++ [".", ".=\n"], # soft line-break
++ [".\n", ".=0A=\n"], # line-break
++ [" From you", " From you=\n"]) {
++ my $out = MIME::Decoder::QuotedPrint::encode_qp_really($pair->[0], 0);
+ $T->ok_eq($out, $pair->[1],
+ "bug 970725-DNA: QP use of RFC2049 guideline 8");
+ }
Index: files/patch-Filer.pm-whitespace
===================================================================
RCS file: files/patch-Filer.pm-whitespace
diff -N files/patch-Filer.pm-whitespace
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Filer.pm-whitespace 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,23 @@
+--- lib/MIME/Parser/Filer.pm Thu Nov 23 06:04:03 2000
++++ lib/MIME/Parser/Filer.pm Thu Aug 26 00:42:18 2004
+@@ -357,8 +357,9 @@
+ $self->debug("is this evil? '$name'");
+
+ return 1 if (!defined($name) or ($name eq '')); ### empty
++ return 1 if ($name =~ m{(^\s)|(\s+\Z)}); ### leading/trailing whitespace
+ return 1 if ($name =~ m{^\.+\Z}); ### dots
+- return 1 if ($name =~ tr{\\/:[]}{}); ### path characters
++ return 1 if ($name =~ /((?:[\[\]\\\/\<\>\|\?\*\:\"]|\p{IsCntrl}))/); ### path or special characters
+ return 1 if ($self->{MPF_MaxName} and
+ (length($name) > $self->{MPF_MaxName}));
+
+@@ -402,6 +403,9 @@
+ my ($root, $ext) = (($last =~ /^(.*)\.([^\.]+)\Z/)
+ ? ($1, $2)
+ : ($last, ''));
++ ### Delete leading and trailing whitespace
++ $root =~ s/^\s+//;
++ $ext =~ s/\s+$//;
+ $root = substr($root, 0, ($self->{MPF_TrimRoot} || 14));
+ $ext = substr($ext, 0, ($self->{MPF_TrimExt} || 3));
+ $ext =~ /^\w+$/ or $ext = "dat";
Index: files/patch-Parser-BinHex
===================================================================
RCS file: files/patch-Parser-BinHex
diff -N files/patch-Parser-BinHex
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Parser-BinHex 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,260 @@
+--- /dev/null Sun Aug 1 22:44:02 2004
++++ lib/MIME/Decoder/BinHex.pm Sun Aug 1 22:43:12 2004
+@@ -0,0 +1,182 @@
++package MIME::Decoder::BinHex;
++
++
++=head1 NAME
++
++MIME::Decoder::BinHex - decode a "binhex" stream
++
++
++=head1 SYNOPSIS
++
++A generic decoder object; see L<MIME::Decoder> for usage.
++
++Also supports a preamble() method to recover text before
++the binhexed portion of the stream.
++
++
++=head1 DESCRIPTION
++
++A MIME::Decoder subclass for a nonstandard encoding whereby
++data are binhex-encoded. Common non-standard MIME encodings for this:
++
++ x-uu
++ x-uuencode
++
++
++=head1 AUTHOR
++
++Julian Field (F<mailscanner at ecs.soton.ac.uk>).
++
++All rights reserved. This program is free software; you can redistribute
++it and/or modify it under the same terms as Perl itself.
++
++=head1 VERSION
++
++$Revision: 1.1 $ $Date: 2004/08/01 20:46:17 $
++
++=cut
++
++
++require 5.002;
++use vars qw(@ISA $VERSION);
++use MIME::Decoder;
++use MIME::Tools qw(whine);
++use Convert::BinHex;
++
++ at ISA = qw(MIME::Decoder);
++
++# The package version, both in 1.23 style *and* usable by MakeMaker:
++$VERSION = substr q$Revision: 1.1 $, 10;
++
++
++#------------------------------
++#
++# decode_it IN, OUT
++#
++sub decode_it {
++ my ($self, $in, $out) = @_;
++ my ($mode, $file);
++ my (@preamble, @data);
++ local $_;
++ my $H2B = Convert::BinHex->hex2bin;
++ #my $H2B = Convert::BinHex->open($in);
++ my $line;
++
++ $self->{MDU_Preamble} = \@preamble;
++ $self->{MDU_Mode} = '600';
++ $self->{MDU_File} = undef;
++
++ ### Find beginning...
++ $MailScanner::BinHex::Inline = 1;
++ if ($MailScanner::BinHex::Inline) {
++ while (defined($_ = $in->getline)) {
++ #print STDERR "Line is \"$_\"\n";
++ if (/^\(This file must be converted/) {
++ $_ = $in->getline;
++ last if /^:/;
++ }
++ push @preamble, $_;
++ }
++ die("binhex decoding: fell off end of file\n") if !defined($_);
++ } else {
++ while (defined($_ = $in->getline)) {
++ # Found the header? So start decoding it
++ last if /^:/;
++ push @preamble, $_;
++ }
++ ## hit eof!
++ die("binhex decoding: no This file must be... found\n") if !defined($_);
++ }
++
++ ### Decode:
++ # Don't rely on the comment always being there
++ #$self->whine(":H2B is $H2B\n");
++ #$self->whine("Header is " . $H2B->read_header . "\n");
++ #@data = $H2B->read_data;
++ #$out->print(@data);
++ #print STDERR "End of binhex stream\n";
++ #return 1;
++ #if (/^:/) {
++ my $data;
++ $data = $H2B->next($_); # or whine("Next error is $@ $!\n");
++ #print STDERR "Data line 1 is length \"" . length($data) . "\" \"$data\"\n";
++ my $len = unpack("C", $data);
++ while ($len > length($data)+21 && defined($line = $in->getline)) {
++ $data .= $H2B->next($line);
++ }
++ $data = substr($data, 22+$len);
++ $out->print($data);
++ #}
++ while (defined($_ = $in->getline)) {
++ $line = $_;
++ $data = $H2B->next($line);
++ #print STDERR "Data is length " . length($data) . " \"$data\"\n";
++ $out->print($data);
++ #chomp $line;
++ #print STDERR "Line is length " . length($line) . " \"$line\"\n";
++ #print STDERR "Line matches end\n" if $line =~ /:$/;
++ last if $line =~ /:$/;
++ }
++ #print STDERR "Broken out of loop\n";
++ #print STDERR "file incomplete, no end found\n" if !defined($_); # eof
++ 1;
++}
++
++#------------------------------
++#
++# encode_it IN, OUT
++#
++sub encode_it {
++ my ($self, $in, $out) = @_;
++ my $line;
++ my $buf = '';
++
++ my $fname = (($self->head &&
++ $self->head->mime_attr('content-disposition.filename')) ||
++ '');
++ my $B2H = Convert::BinHex->bin2hex;
++ $out->print("(This file must be converted with BinHex 4.0)\n");
++ #while (defined($line = <$in>)) {
++ while ($in->read($buf, 1000)) {
++ $out->print($B2H->next($buf));
++ }
++ $out->print($B2H->done);
++ 1;
++}
++
++#------------------------------
++#
++# last_preamble
++#
++# Return the last preamble as ref to array of lines.
++# Gets reset by decode_it().
++#
++sub last_preamble {
++ my $self = shift;
++ return $self->{MDU_Preamble} || [];
++}
++
++#------------------------------
++#
++# last_mode
++#
++# Return the last mode.
++# Gets reset to undef by decode_it().
++#
++sub last_mode {
++ shift->{MDU_Mode};
++}
++
++#------------------------------
++#
++# last_filename
++#
++# Return the last filename.
++# Gets reset by decode_it().
++#
++sub last_filename {
++ shift->{MDU_File} || undef; #[];
++}
++
++#------------------------------
++1;
+--- lib/MIME/Decoder.pm.orig Sun Aug 1 22:44:50 2004
++++ lib/MIME/Decoder.pm Sun Aug 1 22:45:10 2004
+@@ -111,6 +111,7 @@
+ 'quoted-printable' => 'MIME::Decoder::QuotedPrint',
+
+ ### Non-standard...
++ 'binhex' => 'MIME::Decoder::BinHex',
+ 'x-uu' => 'MIME::Decoder::UU',
+ 'x-uuencode' => 'MIME::Decoder::UU',
+
+--- lib/MIME/Parser.pm Tue Aug 31 18:54:05 2004
++++ lib/MIME/Parser.pm Tue Aug 31 18:53:33 2004
+@@ -799,10 +802,11 @@
+ $self->debug("extract uuencode? ", $self->extract_uuencode);
+ $self->debug("encoding? ", $encoding);
+ $self->debug("effective type? ", $ent->effective_type);
++
+ if ($self->extract_uuencode and
+ ($encoding =~ /^(7bit|8bit|binary)\Z/) and
+- ($ent->effective_type =~ m{^text/plain\Z})) {
+-
++ ($ent->effective_type =~
++ m{^(?:text/plain|application/mac-binhex40|application/mac-binhex)\Z})) {
+ ### Hunt for it:
+ my $uu_ent = eval { $self->hunt_for_uuencode($ENCODED, $ent) };
+ if ($uu_ent) { ### snark
+@@ -842,14 +844,21 @@
+ #
+ sub hunt_for_uuencode {
+ my ($self, $ENCODED, $ent) = @_;
+- my $good;
++ my ($good, $jkfis);
+ local $_;
+ $self->debug("sniffing around for UUENCODE");
+
+ ### Heuristic:
+ $ENCODED->seek(0,0);
+ while (defined($_ = $ENCODED->getline)) {
+- last if ($good = /^begin [0-7]{3}/);
++ if ($good = /^begin [0-7]{3}/) {
++ $jkfis = 'uu';
++ last;
++ }
++ if ($good = /^\(This file must be converted with/i) {
++ $jkfis = 'binhex';
++ last;
++ }
+ }
+ $good or do { $self->debug("no one made the cut"); return 0 };
+
+@@ -860,7 +869,9 @@
+
+ ### Made the first cut; on to the real stuff:
+ $ENCODED->seek(0,0);
+- my $decoder = MIME::Decoder->new('x-uuencode');
++ my $decoder = MIME::Decoder->new(($jkfis eq 'uu')?'x-uuencode'
++ :'binhex');
++ $self->whine("Found a $jkfis attachment");
+ my $pre;
+ while (1) {
+ my @bin_data;
+@@ -910,12 +921,11 @@
+
+ ### Did we get anything?
+ @parts or return undef;
+-
+ ### Set the parts and a nice preamble:
+ $top_ent->parts(\@parts);
+ $top_ent->preamble
+ (["The following is a multipart MIME message which was extracted\n",
+- "from a uuencoded message.\n"]);
++ "from a $jkfis-encoded message.\n"]);
+ $top_ent;
+ }
+
Index: files/patch-Parser-MaxParts
===================================================================
RCS file: files/patch-Parser-MaxParts
diff -N files/patch-Parser-MaxParts
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-Parser-MaxParts 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,81 @@
+--- lib/MIME/Parser.pm.orig Tue Aug 31 18:54:05 2004
++++ lib/MIME/Parser.pm Tue Aug 31 18:53:33 2004
+@@ -250,6 +250,7 @@
+ $self->{MP5_IgnoreErrors} = 1;
+ $self->{MP5_UseInnerFiles} = 0;
+ $self->{MP5_UUDecode} = 0;
++ $self->{MP5_MaxParts} = -1;
+
+ $self->interface(ENTITY_CLASS => 'MIME::Entity');
+ $self->interface(HEAD_CLASS => 'MIME::Head');
+@@ -277,6 +278,7 @@
+ $self->{MP5_Filer}->results($self->{MP5_Results});
+ $self->{MP5_Filer}->init_parse();
+ $self->{MP5_Filer}->purgeable([]); ### just to be safe
++ $self->{MP5_NumParts} = 0;
+ 1;
+ }
+
+@@ -969,11 +980,19 @@
+ # Retype => retype this part to the given content-type
+ #
+ # Return the entity.
+-# Fatal exception on failure.
++# Fatal exception on failure. Returns undef if message to complex
+ #
+ sub process_part {
+ my ($self, $in, $rdr, %p) = @_;
+
++ if ($self->{MP5_MaxParts} > 0) {
++ $self->{MP5_NumParts}++;
++ if ($self->{MP5_NumParts} > $self->{MP5_MaxParts}) {
++ # Return UNDEF if msg too complex
++ return undef;
++ }
++ }
++
+ $rdr ||= MIME::Parser::Reader->new;
+ #debug "process_part";
+ $self->results->level(+1);
+@@ -1094,6 +1112,8 @@
+
+ Returns the parsed MIME::Entity on success.
+ Throws exception on failure.
++If the message contained too many
++parts (as set by I<max_parts>), returns undef.
+
+ =cut
+
+@@ -1351,6 +1371,32 @@
+ my $self = shift;
+ &MIME::Tools::whine("evil_filename deprecated in MIME::Parser");
+ $self->filer->evil_filename(@_);
++}
++
++#------------------------------
++
++=item max_parts NUM
++
++I<Instance method.>
++Limits the number of MIME parts we will parse.
++
++Normally, instances of this class parse a message to the bitter end.
++Messages with many MIME parts can cause excessive memory consumption.
++If you invoke this method, parsing will abort with a die() if a message
++contains more than NUM parts.
++
++If NUM is set to -1 (the default), then no maximum limit is enforced.
++
++With no argument, returns the current setting as an integer
++
++=cut
++
++sub max_parts {
++ my($self, $num) = @_;
++ if (@_ > 1) {
++ $self->{MP5_MaxParts} = $num;
++ }
++ return $self->{MP5_MaxParts};
+ }
+
+ #------------------------------
Index: files/patch-ParserUndef
===================================================================
RCS file: files/patch-ParserUndef
diff -N files/patch-ParserUndef
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ files/patch-ParserUndef 31 Aug 2004 18:06:53 -0000
@@ -0,0 +1,43 @@
+--- lib/MIME/Parser.pm Tue Aug 31 18:54:05 2004
++++ lib/MIME/Parser.pm Tue Aug 31 18:53:33 2004
+@@ -708,6 +710,7 @@
+
+ ### Parse the next part, and add it to the entity...
+ my $part = $self->process_part($in, $part_rdr, Retype=>$retype);
++ return undef unless defined($part);
+ $ent->add_part($part);
+
+ ### ...and look at how we finished up:
+@@ -944,6 +954,7 @@
+
+ ### Parse the message:
+ my $msg = $self->process_part($in, $rdr);
++ return undef unless defined($msg);
+
+ ### How to handle nested messages?
+ if ($self->extract_nested_messages eq 'REPLACE') {
+@@ -1005,14 +1024,14 @@
+
+ ### Handle, according to the MIME type:
+ if ($type eq 'multipart') {
+- $self->process_multipart($in, $rdr, $ent);
++ return undef unless defined($self->process_multipart($in, $rdr, $ent));
+ }
+ elsif (("$type/$subtype" eq "message/rfc822" ||
+ "$type/$subtype" eq "message/external-body" ||
+ ("$type/$subtype" eq "message/partial" && $head->mime_attr("content-type.number") == 1)) &&
+ $self->extract_nested_messages) {
+ $self->debug("attempting to process a nested message");
+- $self->process_message($in, $rdr, $ent);
++ return undef unless defined($self->process_message($in, $rdr, $ent));
+ }
+ else {
+ $self->process_singlepart($in, $rdr, $ent);
+@@ -1080,7 +1080,6 @@
+ =back
+
+ Returns the parsed MIME::Entity on success.
+-Throws exception on failure.
+
+ =cut
+
More information about the freebsd-ports
mailing list