Date: Thu, 30 Sep 2004 00:17:26 +0200 (CEST) From: Ralf van der Enden <tremere@cainites.net> To: FreeBSD-gnats-submit@FreeBSD.org Subject: ports/72185: Update to p5-MIME-Tools 5.413 (5.411a breaks amavisd-new) Message-ID: <20040929221726.0A3A61BE@mail.cainites.net> Resent-Message-ID: <200409292220.i8TMKITc021529@freefall.freebsd.org>
next in thread | raw e-mail | index | archive | help
>Number: 72185 >Category: ports >Synopsis: Update to p5-MIME-Tools 5.413 (5.411a breaks amavisd-new) >Confidential: no >Severity: serious >Priority: high >Responsible: freebsd-ports-bugs >State: open >Quarter: >Keywords: >Date-Required: >Class: update >Submitter-Id: current-users >Arrival-Date: Wed Sep 29 22:20:18 GMT 2004 >Closed-Date: >Last-Modified: >Originator: Ralf van der Enden >Release: FreeBSD 5.2.1-RELEASE-p10 i386 >Organization: >Environment: System: FreeBSD lan.cainites.net 5.2.1-RELEASE-p10 FreeBSD 5.2.1-RELEASE-p10 #1: Mon Sep 20 20:43:00 CEST 2004 root@lan.cainites.net:/usr/obj/usr/src/sys/HELLKERNEL i386 >Description: Update to p5-MIME-Tools 5.413 - 5.411a breaks amavisd-new (and possible more ports) - 5.413 contains several bugfixes and includes the patches from 5.411a port) >How-To-Repeat: >Fix: --- p5-MIME-Tools.diff begins here --- diff -ruN p5-MIME-Tools.org/Makefile p5-MIME-Tools/Makefile --- p5-MIME-Tools.org/Makefile Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/Makefile Wed Sep 22 09:56:12 2004 @@ -6,9 +6,8 @@ # PORTNAME= p5-MIME-Tools -PORTVERSION= 5.411a -PORTREVISION= 6 -PORTEPOCH= 2 +PORTVERSION= 5.413 +PORTEPOCH= 3 CATEGORIES= mail perl5 MASTER_SITES= ${MASTER_SITE_PERL_CPAN} MASTER_SITE_SUBDIR= MIME @@ -24,7 +23,7 @@ RUN_DEPENDS= ${BUILD_DEPENDS} PERL_CONFIGURE= YES -WRKSRC= ${WRKDIR}/MIME-tools-5.411 +WRKSRC= ${WRKDIR}/MIME-tools-5.413 MAN3= MIME::Body.3 \ MIME::Decoder.3 \ diff -ruN p5-MIME-Tools.org/distinfo p5-MIME-Tools/distinfo --- p5-MIME-Tools.org/distinfo Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/distinfo Wed Sep 22 09:56:14 2004 @@ -1,2 +1,2 @@ -MD5 (MIME-tools-5.411a.tar.gz) = e7cb1f8e146171103640e3a5516afb1a -SIZE (MIME-tools-5.411a.tar.gz) = 467432 +MD5 (MIME-tools-5.413.tar.gz) = 63dff0743e08984f8938d3a8d4c0c2a8 +SIZE (MIME-tools-5.413.tar.gz) = 350417 diff -ruN p5-MIME-Tools.org/files/patch-7or8bit.diff p5-MIME-Tools/files/patch-7or8bit.diff --- p5-MIME-Tools.org/files/patch-7or8bit.diff Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-7or8bit.diff Thu Jan 1 01:00:00 1970 @@ -1,20 +0,0 @@ ---- 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; - } - - #------------------------------ diff -ruN p5-MIME-Tools.org/files/patch-Benchmark p5-MIME-Tools/files/patch-Benchmark --- p5-MIME-Tools.org/files/patch-Benchmark Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-Benchmark Thu Jan 1 01:00:00 1970 @@ -1,88 +0,0 @@ ---- 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) - diff -ruN p5-MIME-Tools.org/files/patch-Decoder-qpdecode-pdf p5-MIME-Tools/files/patch-Decoder-qpdecode-pdf --- p5-MIME-Tools.org/files/patch-Decoder-qpdecode-pdf Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-Decoder-qpdecode-pdf Thu Jan 1 01:00:00 1970 @@ -1,41 +0,0 @@ ---- 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,37 @@ - # - sub decode_it { - my ($self, $in, $out) = @_; -+ my $init = 0; -+ my $badpdf = 0; - - while (defined($_ = $in->getline)) { -- $out->print(decode_qp($_)); -+ # -+ # Dirty hack to fix QP-Encoded PDFs from MS-Outlook. -+ # -+ # Check if we have a PDF file and if it has been encoded -+ # on Windows. Unix encoded files are fine. If we have -+ # one encoded CR after the PDF init string but are missing -+ # an encoded CR before the newline this means the PDF is broken. -+ # -+ if (!$init) { -+ $init = 1; -+ if ($_ =~ /^%PDF-[0-9\.]+=0D/ && $_ !~ /(?!=0D)\n$/) { -+ $badpdf = 1; -+ } -+ } -+ # -+ # Decode everything with decode_qp() except corrupted PDFs. -+ # -+ if ($badpdf) { -+ my $output = $_; -+ $output =~ s/[ \t]+?(\r?\n)/$1/g; -+ $output =~ s/=\r?\n//g; -+ $output =~ s/(^$|[^\r])\n\Z/$1\r\n/; -+ $output =~ s/=([\da-fA-F]{2})/pack("C", hex($1))/ge; -+ $out->print($output); -+ } else { -+ $out->print(decode_qp($_)); -+ } - } - 1; - } diff -ruN p5-MIME-Tools.org/files/patch-Decoder-qpencode p5-MIME-Tools/files/patch-Decoder-qpencode --- p5-MIME-Tools.org/files/patch-Decoder-qpencode Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-Decoder-qpencode Thu Jan 1 01:00:00 1970 @@ -1,128 +0,0 @@ ---- 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@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"); - } diff -ruN p5-MIME-Tools.org/files/patch-Filer.pm-whitespace p5-MIME-Tools/files/patch-Filer.pm-whitespace --- p5-MIME-Tools.org/files/patch-Filer.pm-whitespace Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-Filer.pm-whitespace Thu Jan 1 01:00:00 1970 @@ -1,23 +0,0 @@ ---- 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"; diff -ruN p5-MIME-Tools.org/files/patch-ParamVal.pm p5-MIME-Tools/files/patch-ParamVal.pm --- p5-MIME-Tools.org/files/patch-ParamVal.pm Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-ParamVal.pm Thu Jan 1 01:00:00 1970 @@ -1,114 +0,0 @@ ---- lib/MIME/Field/ParamVal.pm.orig Sun Nov 5 04:54:49 2000 -+++ lib/MIME/Field/ParamVal.pm Thu Jun 6 10:15:15 2002 -@@ -100,6 +100,9 @@ - # token = 1*<any (ASCII) CHAR except SPACE, CTLs, or tspecials> - # - my $TSPECIAL = '()<>@,;:\</[]?="'; -+ -+#" Fix emacs highlighting... -+ - my $TOKEN = '[^ \x00-\x1f\x80-\xff' . "\Q$TSPECIAL\E" . ']+'; - - # Encoded token: -@@ -108,6 +111,9 @@ - # Pattern to match spaces or comments: - my $SPCZ = '(?:\s|\([^\)]*\))*'; - -+# Pattern to match non-semicolon as fallback for broken MIME -+# produced by some viruses -+my $BADTOKEN = '[^;]+'; - - #------------------------------ - # -@@ -181,10 +187,40 @@ - - =cut - -+sub rfc2231decode { -+ my($val) = @_; -+ my($enc, $lang, $rest); -+ -+ if ($val =~ m/^([^\']*)\'([^\']*)\'(.*)$/) { -+ # SHOULD REALLY DO SOMETHING MORE INTELLIGENT WITH ENCODING!!! -+ $enc = $1; -+ $lang = $2; -+ $rest = $3; -+ $rest = rfc2231percent($rest); -+ } elsif ($val =~ m/^([^\']*)\'([^\']*)$/) { -+ $enc = $1; -+ $rest = $2; -+ $rest = rfc2231percent($rest); -+ } else { -+ $rest = rfc2231percent($val); -+ } -+ return $rest; -+} -+ -+sub rfc2231percent { -+ # Do percent-subsitution -+ my($str) = @_; -+ $str =~ s/%([0-9a-fA-F]{2})/pack("c", hex($1))/ge; -+ return $str; -+} -+ - sub parse_params { - my ($self, $raw) = @_; - my %params = (); -+ my %rfc2231params = (); - my $param; -+ my $val; -+ my $part; - - # Get raw field, and unfold it: - defined($raw) or $raw = ''; -@@ -200,9 +236,47 @@ - $raw =~ m/\G$SPCZ\;$SPCZ/og or last; # skip leading separator - $raw =~ m/\G($PARAMNAME)\s*=\s*/og or last; # give up if not a param - $param = lc($1); -- $raw =~ m/\G(\"([^\"]+)\")|\G($TOKEN)|\G($ENCTOKEN)/g or last; # give up if no value -- my ($qstr, $str, $token, $enctoken) = ($1, $2, $3, $4); -- $params{$param} = defined($qstr) ? $str : (defined($token) ? $token : $enctoken); -+ $raw =~ m/\G(\"([^\"]+)\")|\G($ENCTOKEN)|\G($BADTOKEN)|\G($TOKEN)/g or last; # give up if no value" -+ my ($qstr, $str, $enctoken, $badtoken, $token) = ($1, $2, $3, $4, $5); -+ if (defined($badtoken)) { -+ # Strip leading/trailing whitespace from badtoken -+ $badtoken =~ s/^\s*//; -+ $badtoken =~ s/\s*$//; -+ } -+ $val = defined($qstr) ? $str : -+ (defined($enctoken) ? $enctoken : -+ (defined($badtoken) ? $badtoken : $token)); -+ -+ # Do RFC 2231 processing -+ if ($param =~ /\*/) { -+ my($name, $num); -+ # Pick out the parts of the parameter -+ if ($param =~ m/^([^*]+)\*([^*]+)\*?$/) { -+ # We have param*number* or param*number -+ $name = $1; -+ $num = $2; -+ } else { -+ # Fake a part of zero... not sure how to handle this properly -+ $param =~ s/\*//g; -+ $name = $param; -+ $num = 0; -+ } -+ # Decode the value unless it was a quoted string -+ if (!defined($qstr)) { -+ $val = rfc2231decode($val); -+ } -+ $rfc2231params{$name}{$num} .= $val; -+ } else { -+ # Make a fake "part zero" for non-RFC2231 params -+ $rfc2231params{$param}{"0"} = $val; -+ } -+ } -+ -+ # Extract reconstructed parameters -+ foreach $param (keys %rfc2231params) { -+ foreach $part (sort { $a <=> $b } keys %{$rfc2231params{$param}}) { -+ $params{$param} .= $rfc2231params{$param}{$part}; -+ } - debug " field param <$param> = <$params{$param}>"; - } - diff -ruN p5-MIME-Tools.org/files/patch-Parser-BinHex p5-MIME-Tools/files/patch-Parser-BinHex --- p5-MIME-Tools.org/files/patch-Parser-BinHex Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-Parser-BinHex Thu Jan 1 01:00:00 1970 @@ -1,260 +0,0 @@ ---- /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@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; -+ -+@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; - } - diff -ruN p5-MIME-Tools.org/files/patch-Parser-MaxParts p5-MIME-Tools/files/patch-Parser-MaxParts --- p5-MIME-Tools.org/files/patch-Parser-MaxParts Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-Parser-MaxParts Thu Jan 1 01:00:00 1970 @@ -1,81 +0,0 @@ ---- 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}; - } - - #------------------------------ diff -ruN p5-MIME-Tools.org/files/patch-Parser.pm p5-MIME-Tools/files/patch-Parser.pm --- p5-MIME-Tools.org/files/patch-Parser.pm Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-Parser.pm Thu Jan 1 01:00:00 1970 @@ -1,75 +0,0 @@ ---- lib/MIME/Parser.pm.orig Sun Nov 12 14:55:11 2000 -+++ lib/MIME/Parser.pm Wed Nov 19 18:39:33 2003 -@@ -378,16 +378,17 @@ - =item extract_nested_messages OPTION - - I<Instance method.> --Some MIME messages will contain a part of type C<message/rfc822>: -+Some MIME messages will contain a part of type C<message/rfc822> -+or C<message/partial> or C<message/external-body>: - literally, the text of an embedded mail/news/whatever message. - This option controls whether (and how) we parse that embedded message. - - If the OPTION is false, we treat such a message just as if it were a - C<text/plain> document, without attempting to decode its contents. - --If the OPTION is true (the default), the body of the C<message/rfc822> --part is parsed by this parser, creating an entity object. --What happens then is determined by the actual OPTION: -+If the OPTION is true (the default), the body of the C<message/rfc822> -+or C<message/partial> part is parsed by this parser, creating an -+entity object. What happens then is determined by the actual OPTION: - - =over 4 - -@@ -592,6 +593,7 @@ - # - # I<Instance method.> - # Process and return the next header. -+# Return undef if, instead of a header, the encapsulation boundary is found. - # Fatal exception on failure. - # - sub process_header { -@@ -612,6 +614,10 @@ - foreach (@headlines) { s/[\r\n]+\Z/\n/ } ### fold - - ### How did we do? -+ if ($hdr_rdr->eos_type eq 'DELIM') { -+ $self->whine("bogus part, without CRLF before body"); -+ return; -+ } - ($hdr_rdr->eos_type eq 'DONE') or - $self->error("unexpected end of header\n"); - -@@ -983,7 +989,17 @@ - - ### Parse and add the header: - my $head = $self->process_header($in, $rdr); -- $ent->head($head); -+ if (not defined $head) { -+ $self->debug("bogus empty part"); -+ $head = $self->interface('HEAD_CLASS')->new; -+ $head->mime_type('text/plain; charset=US-ASCII'); -+ $ent->head($head); -+ $ent->bodyhandle($self->new_body_for($head)); -+ $ent->bodyhandle->open("w")->close; -+ $self->results->level(-1); -+ return $ent; -+ } -+ $ent->head($head); - - ### Tweak the content-type based on context from our parent... - ### For example, multipart/digest messages default to type message/rfc822: -@@ -997,8 +1013,10 @@ - if ($type eq 'multipart') { - $self->process_multipart($in, $rdr, $ent); - } -- elsif (("$type/$subtype" eq "message/rfc822") && -- $self->extract_nested_messages) { -+ 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); - } diff -ruN p5-MIME-Tools.org/files/patch-ParserUndef p5-MIME-Tools/files/patch-ParserUndef --- p5-MIME-Tools.org/files/patch-ParserUndef Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-ParserUndef Thu Jan 1 01:00:00 1970 @@ -1,43 +0,0 @@ ---- 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 - diff -ruN p5-MIME-Tools.org/files/patch-Words.pm p5-MIME-Tools/files/patch-Words.pm --- p5-MIME-Tools.org/files/patch-Words.pm Wed Sep 22 09:54:39 2004 +++ p5-MIME-Tools/files/patch-Words.pm Thu Jan 1 01:00:00 1970 @@ -1,11 +0,0 @@ ---- lib/MIME/Words.pm.orig Sat Nov 11 01:45:12 2000 -+++ lib/MIME/Words.pm Thu Jun 6 10:15:15 2002 -@@ -186,7 +186,7 @@ - $@ = ''; ### error-return - - ### Collapse boundaries between adjacent encoded words: -- $encstr =~ s{(\?\=)\r?\n[ \t](\=\?)}{$1$2}gs; -+ $encstr =~ s{(\?\=)\s*(\=\?)}{$1$2}gs; - pos($encstr) = 0; - ### print STDOUT "ENC = [", $encstr, "]\n"; - --- p5-MIME-Tools.diff ends here --- >Release-Note: >Audit-Trail: >Unformatted:
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?20040929221726.0A3A61BE>