[patch] patch-roaring-pengiun

patch-roaring-pengiun (text/plain), 9.08 KB, created by Brett Simpson on 2004-01-08 12:05:43 UTC

diff --unified --recursive --new-file MIME-tools-5.411/lib/MIME/Field/ParamVal.pm MIME-tools-5.411.patched/lib/MIME/Field/ParamVal.pm
--- MIME-tools-5.411/lib/MIME/Field/ParamVal.pm	2000-11-04 14:54:49.000000000 -0500
+++ MIME-tools-5.411.patched/lib/MIME/Field/ParamVal.pm	2004-01-08 14:41:22.000000000 -0500
@@ -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,41 @@
 
 =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 +237,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 --unified --recursive --new-file MIME-tools-5.411/lib/MIME/Parser.pm MIME-tools-5.411.patched/lib/MIME/Parser.pm
--- MIME-tools-5.411/lib/MIME/Parser.pm	2000-11-12 00:55:11.000000000 -0500
+++ MIME-tools-5.411.patched/lib/MIME/Parser.pm	2004-01-08 14:52:17.000000000 -0500
@@ -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;
 }
 
@@ -378,7 +380,8 @@
 =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>:
 literally, the text of an embedded mail/news/whatever message.  
 This option controls whether (and how) we parse that embedded message.
 
@@ -386,8 +389,8 @@
 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:
+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
 
@@ -705,6 +708,9 @@
 	
 	### 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 +950,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') {
@@ -969,11 +976,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);
@@ -995,12 +1010,13 @@
 
     ### 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") && 
-	   $self->extract_nested_messages) {
+    elsif (("$type/$subtype" eq "message/rfc822" ||
+           ("$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);
@@ -1047,7 +1063,6 @@
 =back
 
 Returns the parsed MIME::Entity on success.  
-Throws exception on failure.
 
 =cut
 
@@ -1086,7 +1101,8 @@
 (which minimally implements getline() and read()).
 
 Returns the parsed MIME::Entity on success.  
-Throws exception on failure.
+Throws exception on failure.  If the message contained too many
+parts (as set by I<max_parts>), returns undef.
 
 =cut
 
@@ -1098,7 +1114,7 @@
 
     my $bm = benchmark {
 	$self->init_parse;
-	($entity) = $self->process_part($in, undef);  ### parse!
+	$entity = $self->process_part($in, undef);  ### parse!
     };
     $self->debug("t parse: $bm");
 
@@ -1346,6 +1362,33 @@
 
 #------------------------------
 
+=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};
+}
+
+#------------------------------
+
+
 =item output_to_core YESNO
 
 I<Instance method.>
diff --unified --recursive --new-file MIME-tools-5.411/lib/MIME/Words.pm MIME-tools-5.411.patched/lib/MIME/Words.pm
--- MIME-tools-5.411/lib/MIME/Words.pm	2000-11-10 11:45:12.000000000 -0500
+++ MIME-tools-5.411.patched/lib/MIME/Words.pm	2004-01-08 14:53:12.000000000 -0500
@@ -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";