On Wednesday 06 March 2002 05:28 pm, Matthew Cline wrote:

> I found that this line of my patch to fix the "MIME null block" problem was
> causing an infinite loop sometimes:
>
>       my $boundary = "--$1";

Ugh, that wasn't the only problem.  If, for some reason, the boundary pattern 
doesn't match any of the lines of the body, my algorithm goes past the end of 
the array, getting an undefined values, which makes Perl (my version, 
anyways) go into an infinite loop of spitting out warning messages.  Here's 
my new *new* patch (as an attachment) to take care of it all:

-- 
Visit http://dmoz.org, the world's   | Give a man a match, and he'll be warm
largest human edited web directory.  | for a minute, but set him on fire, and
                                     | he'll be warm for the rest of his life.
[EMAIL PROTECTED]  ICQ: 132152059 |
Index: lib/Mail/SpamAssassin/PerMsgStatus.pm
===================================================================
RCS file: /cvsroot/spamassassin/spamassassin/lib/Mail/SpamAssassin/PerMsgStatus.pm,v
retrieving revision 1.80
diff -u -3 -p -r1.80 PerMsgStatus.pm
--- lib/Mail/SpamAssassin/PerMsgStatus.pm	6 Mar 2002 11:23:35 -0000	1.80
+++ lib/Mail/SpamAssassin/PerMsgStatus.pm	7 Mar 2002 06:24:25 -0000
@@ -403,8 +403,34 @@ sub rewrite_as_spam {
       $rep =~ s/=/=3D/gs;               # quote the = chars
     }
 
-    unshift (@{$lines}, split (/$/, $rep));
-    $lines->[0] =~ s/\n//;
+    if ($self->{msg}->get_header ('Content-Type') =~ /boundary="(.*)"/) {
+      # Deal with MIME "null block".  If this is a multipart MIME mail,
+      # peel off the MIME header for the main part of the message,
+      # stick in the report, then put the MIME header back in front,
+      # so that the report is *after* the MIME header.
+      my $boundary = "--" . quotemeta($1);
+      my @main_part = ();
+
+      if (grep(/^$boundary/, @{$lines})) {
+        # If, for some reason, the boundry marker doesn't appear in the
+        # body of the text, don't bother with the following three lines,
+        # because otherwise @{$lines} will go down to zero size, so
+        # $lines->[0] will be undefined, and Perl (or at least some versions
+        # of it) will go into an infinite loop of throwing warnings.
+        push(@main_part, shift(@{$lines})) while ($lines->[0] !~ /^$boundary/);
+        push(@main_part, shift(@{$lines})) while ($lines->[0] !~ /^$/);
+        push(@main_part, shift(@{$lines}));
+      }
+
+      unshift (@{$lines}, split (/$/, $rep));
+      $lines->[0] =~ s/\n//;
+      unshift (@{$lines}, @main_part);
+    }
+    else {
+      unshift (@{$lines}, split (/$/, $rep));
+      $lines->[0] =~ s/\n//;
+    }
+
     $self->{msg}->replace_body ($lines);
   }
 

Reply via email to