[project @ 2002-10-06 22:54:48 by cjwatson]

Implement MIME support in process and service.

diff --git a/debian/changelog b/debian/changelog
index 6402a60379c46700a4630daef3656f8d4d11955d..c3a0bb3519451ee4546486178525a50fae5dc4f2 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -66,6 +66,8 @@ debbugs (2.4) experimental; urgency=low
   * Fix viewing archived bugs by source package, closes: #121082, #146484.
     [Colin]
   * Depends: libmailtools-perl rather than mailtools, closes: #113028.
+  * Add MIME support to process and service, and depend on libmime-perl as a
+    result, closes: #36813. [Colin]
   * Fix a few typos, closes: #146745, #152751.
   * Various other things, not worth mentioning here.
 

diff --git a/debian/control b/debian/control
index d6f9424cc1d898511dc17fec27c1d65505c456f0..e545d309fd41120ac965d43ba65d7d0ce553276a 100644 (file)
--- a/debian/control
+++ b/debian/control
@@ -8,7 +8,7 @@ Build-Depends: debhelper
 
 Package: debbugs
 Architecture: all
-Depends: perl5 | perl, exim | mail-transport-agent, libmailtools-perl, ed
+Depends: perl5 | perl, exim | mail-transport-agent, libmailtools-perl, ed, libmime-perl
 Recommends: httpd, links | lynx
 Description: The bug tracking system based on the active Debian BTS
  Debian has a bug tracking system which files details of bugs reported by

diff --git a/scripts/errorlib.in b/scripts/errorlib.in
index 3565cf0a1b54955e5a9e6fa22a6e8cd15542c677..85250b995c71ddf40441c9da7f833a57d0cad463 100755 (executable)
--- a/scripts/errorlib.in
+++ b/scripts/errorlib.in
@@ -1,5 +1,5 @@
 # -*- perl -*-
-# $Id: errorlib.in,v 1.6 2002/01/06 10:46:24 ajt Exp $
+# $Id: errorlib.in,v 1.7 2002/10/06 22:54:48 cjwatson Exp $
 
 sub F_SETLK { 6; } sub F_WRLCK{ 1; }
 $flockstruct= 'sslll'; # And there ought to be something for this too.
@@ -151,6 +151,29 @@ sub appendfile {
        close(AP) || &quit("closing $file (appendfile): $!");
 }
 
+sub getmailbody {
+       my $entity = shift;
+       my $type = $entity->effective_type;
+       if ($type eq 'text/plain' or
+           ($type =~ m#text/# and $type ne 'text/html')) {
+               return $entity->bodyhandle;
+       } elsif ($type eq 'multipart/alternative') {
+               # RFC 2046 says we should use the last part we recognize.
+               for my $part (reverse $entity->parts) {
+                       my $ret = getmailbody($part);
+                       return $ret if $ret;
+               }
+       } else {
+               # For other multipart types, we just pretend they're
+               # multipart/mixed and run through in order.
+               for my $part ($entity->parts) {
+                       my $ret = getmailbody($part);
+                       return $ret if $ret;
+               }
+       }
+       return undef;
+}
+
 
 @severities= @gSeverityList;
 @showseverities= @severities;

diff --git a/scripts/process.in b/scripts/process.in
index 1e6d6062904c8bb23d0e3fb5830c6ace928ef3dc..b15271cc180bdb8a0d4fd9e3ce5f20d0f193d1e5 100755 (executable)
--- a/scripts/process.in
+++ b/scripts/process.in
@@ -1,10 +1,12 @@
 #!/usr/bin/perl
-# $Id: process.in,v 1.48 2002/09/25 16:19:08 doogie Exp $
+# $Id: process.in,v 1.49 2002/10/06 22:54:48 cjwatson Exp $
 #
 # Usage: process nn
 # Temps:  incoming/Pnn
 
 use Mail::Address;
+use MIME::Parser;
+
 $config_path = '/org/bugs.debian.org/etc';
 $lib_path = '/org/bugs.debian.org/scripts';
 
@@ -12,7 +14,7 @@ require "$config_path/config";
 require "$lib_path/errorlib";
 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
 
-chdir( "$gSpoolDir" ) || die 'chdir spool: $!\n';
+chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
 
 #open(DEBUG,"> /tmp/debbugs.debug");
 umask(002);
@@ -46,7 +48,7 @@ open(M,"incoming/P$nn");
 close(M);
 
 @msg=@log;
-grep(s/\n+$//,@msg);
+chomp @msg;
 
 print DEBUG "###\n",join("##\n",@msg),"\n###\n";
 
@@ -56,57 +58,72 @@ Received: via spool by $baddress\@$gEmailDomain id=$nn
           (code $codeletter ref $tryref); $tdate
 END
 
-# Process the message's mail headers
-for ($i=0; $i<=$#msg; $i++) {
-    $_ = $msg[$i];
-    last unless length($_);
-    &quit("looping detected") if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
-    $ins= !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
-       && !m/^From / && !m/^X-Debbugs-CC:/i && !m/^received:/i;
-    $fwd .= $_."\n" if $ins;
-    while ($msg[$i+1] =~ m/^\s/) {
-        $i++;
-        $fwd .= $msg[$i]."\n" if $ins;
-        $_ .= ' '.$msg[$i];
+# header and decoded body respectively
+my (@headerlines, @bodylines);
+
+my $parser = new MIME::Parser;
+mkdir "$gSpoolDir/mime.tmp", 0777;
+$parser->output_under("$gSpoolDir/mime.tmp");
+my $entity = eval { $parser->parse_data(join('',@log)) };
+
+if ($entity and $entity->head->tags) {
+    @headerlines = @{$entity->head->header};
+    chomp @headerlines;
+
+    my $entity_body = getmailbody($entity);
+    @bodylines = $entity_body ? $entity_body->as_lines() : ();
+    chomp @bodylines;
+
+    # set $i to beginning of encoded body data, so we can dump it out
+    # verbatim later
+    $i = 0;
+    ++$i while $msg[$i] =~ /./;
+} else {
+    # Legacy pre-MIME code, kept around in case MIME::Parser fails.
+    for ($i = 0; $i <= $#msg; $i++) {
+       $_ = $msg[$i];
+       last unless length($_);
+       while ($msg[$i+1] =~ m/^\s/) {
+           $i++;
+           $_ .= "\n".$msg[$i];
+       }
+       push @headerlines, $_;
     }
+
+    @bodylines = @msg[$i..$#msg];
+}
+
+for my $hdr (@headerlines) {
+    $_ = $hdr;
+    s/\n\s/ /g;
+    &quit("looping detected")
+       if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
+    my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
+           && !m/^From / && !m/^X-Debbugs-CC:/i && !m/^received:/i;
+    $fwd .= $hdr."\n" if $ins;
 # print DEBUG ">$_<\n";
     if (s/^(\S+):\s*//) {
-        $v= $1; $v =~ y/A-Z/a-z/;
-               print DEBUG ">$v=$_<\n";
-        $header{$v}= $_;
+       my $v = lc $1;
+       print DEBUG ">$v=$_<\n";
+       $header{$v} = $_;
     } else {
        print DEBUG "!>$_<\n";
     }
 }
 
-#remove blank lines
-while ($i <= $#msg && !length($msg[$i])) { $fwd .= "\n"; $i++; }
-
-#skips the "this is mime" message and any blank space after it
-if ( $msg[$i] =~ /^This is a multi-part message in MIME format./ )
-{
-       while ( $i <= $#msg && length( $msg[$i] ) ) { $fwd .= $msg[$i] . "\n"; $i++; }
-       while ( $i <= $#msg && !length( $msg[$i] ) ) { $fwd .= "\n"; $i++; }
-}
-#if the lines starts with -- or is nothing but blank space...
-#skip to the next blank line(s) then skip past the blank line(s)
-if ( $msg[$i] =~ /^--/ || $msg[$i] =~ /^\s*$/ )
-{
-       while ( $i <= $#msg && length( $msg[$i] ) ) { $fwd .= $msg[$i] . "\n"; $i++; }
-       while ( $i <= $#msg && !length( $msg[$i] ) ) { $fwd .= "\n"; $i++; }
-}              
+# remove blank lines
+shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
 
-while (defined ($msg[$i] ) )
+# extract pseudo-headers
+for my $phline (@bodylines)
 {
-       last if ( $msg[$i] !~ m/^([\w]+):\s*(\S.*)/ );
-       $i++;
-       $fn = $1; $fv = $2;
-       print DEBUG ">$fn|$'|\n";
-    $fwd .= $fn.': '.$fv."\n";
-    $fn =~ y/A-Z/a-z/;
-    $fv =~ y/A-Z/a-z/;
-    $pheader{$fn}= $fv;
-       print DEBUG ">$fn~$fv<\n";
+    last if $phline !~ m/^([\w]+):\s*(\S.*)/;
+    my ($fn, $fv) = ($1, $2);
+    print DEBUG ">$fn|$fv|\n";
+    $fn = lc $fn;
+    $fv = lc $fv;
+    $pheader{$fn} = $fv;
+    print DEBUG ">$fn~$fv<\n";
 }
 
 

diff --git a/scripts/processall.in b/scripts/processall.in
index 2602189533924f817af2fd78f4a252314426dd43..745ad50232edc3532ef9db4771ac9616cb4cdfbb 100755 (executable)
--- a/scripts/processall.in
+++ b/scripts/processall.in
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: processall.in,v 1.7 2001/08/16 07:20:18 doogie Exp $
+# $Id: processall.in,v 1.8 2002/10/06 22:54:48 cjwatson Exp $
 #
 # Usage: processall
 #
@@ -15,6 +15,8 @@ require "$config_path/config";
 require "$lib_path/errorlib";
 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
 
+use File::Path;
+
 chdir( "$gSpoolDir" ) || die 'chdir spool: $!\n';
 push( @INC, "$lib_path" );
 
@@ -64,6 +66,7 @@ for (;;) {
         print(STDERR "$id: process failed ($status $!) - now in [PG]$id\n") || die $!;
     }
     print(STDOUT " done\n") || die $!;
+    rmtree("$gSpoolDir/mime.tmp",0,1);
     $ndone++;
 }
 &unfilelock;

diff --git a/scripts/service.in b/scripts/service.in
index 88a69b2cb2c43b4074e03ba0c1f82e21aa848048..66a2b5e0c668318af84efa4a58d53b04b6232902 100755 (executable)
--- a/scripts/service.in
+++ b/scripts/service.in
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: service.in,v 1.53 2002/10/06 20:05:49 cjwatson Exp $
+# $Id: service.in,v 1.54 2002/10/06 22:54:48 cjwatson Exp $
 # ^ more or less ^
 #
 # Usage: service <code>.nn
@@ -7,6 +7,7 @@
 
 use Mail::Address;
 use File::Copy;
+use MIME::Parser;
 
 $config_path = '/org/bugs.debian.org/etc';
 $lib_path = '/org/bugs.debian.org/scripts';
@@ -36,34 +37,57 @@ open(M,"incoming/P$nn");
 @msg=@log;
 close(M);
 
-grep((s/\n$//,s/\s+$//),@msg);
+chomp @msg;
 
 print "###\n",join("##\n",@msg),"\n###\n" if $debug;
 
-chop($tdate= `date -u '+%a, %d %h %Y %T GMT'`);
-$fwd= <<END;
-Received: via spool for service; $tdate
-END
+my $parser = new MIME::Parser;
+mkdir "$gSpoolDir/mime.tmp", 0777;
+$parser->output_under("$gSpoolDir/mime.tmp");
+my $entity = eval { $parser->parse_data(join('',@log)) };
+
+# header and decoded body respectively
+my (@headerlines, @bodylines);
 
-for ($i=0; $i<=$#msg; $i++) {
-     $_ = $msg[$i];
-    last unless length($_);
-    $fwd .= $_."\n";
-    while ($msg[$i+1] =~ m/^\s/) {
-       $i++;
-        $fwd .= $msg[$i]."\n" if $ins; # Huh ? Where is ins set ?
-        $_ .= ' '.$msg[$i];
+if ($entity and $entity->head->tags) {
+    @headerlines = @{$entity->head->header};
+    chomp @headerlines;
+
+    my $entity_body = getmailbody($entity);
+    @bodylines = $entity_body ? $entity_body->as_lines() : ();
+    chomp @bodylines;
+} else {
+    # Legacy pre-MIME code, kept around in case MIME::Parser fails.
+    my $i;
+    for ($i = 0; $i <= $#msg; $i++) {
+       $_ = $msg[$i];
+       last unless length($_);
+       while ($msg[$i+1] =~ m/^\s/) {
+           $i++;
+           $_ .= "\n".$msg[$i];
+       }
+       push @headerlines, $_;
     }
+
+    @bodylines = @msg[$i..$#msg];
+}
+
+for (@headerlines) {
+    s/\n\s/ /g;
     print ">$_<\n" if $debug;
     if (s/^(\S+):\s*//) {
-       $v= $1; $v =~ y/A-Z/a-z/;
+       my $v = lc $1;
        print ">$v=$_<\n" if $debug;
-        $header{$v}= $_;
+       $header{$v} = $_;
     } else {
-       print "!>$_<\n" if $debug; 
+       print "!>$_<\n" if $debug;
     }
 }
 
+grep(s/\s+$//,@bodylines);
+
+print "***\n",join("\n",@bodylines),"\n***\n" if $debug;
+
 if (defined $header{'resent-from'} && !defined $header{'from'}) {
     $header{'from'} = $header{'resent-from'};
 }
@@ -90,9 +114,6 @@ $mergelowstate= 'idle';
 $midix=0;    
 $extras="";
 
-#strip blank line(s) after header
-while ( $i <= $#msg && !length( $msg[$i] ) ) { $fwd .= "\n"; $i++; }
-
 my $quickabort = 0;
 
 my $fuckheads = "(" . join("|", @gFuckheads) . ")";
@@ -101,24 +122,10 @@ if (@gFuckheads and $replyto =~ m/$fuckheads/) {
        $quickabort = 1;
 }
 
-#strip, if exists, mime header
-if ( $msg[$i] =~ /^This is a multi-part message in MIME format./ ) {
-    while ( $i <= $#msg && length( $msg[$i] ) ) {
-        $fwd .= $msg[$i] . "\n"; $i++; 
-    }
-    while ( $i <= $#msg && !length( $msg[$i] ) ) {
-        $fwd .= "\n"; $i++; 
-    }
-}
-if ( $msg[$i] =~ /^--/ || $msg[$i] =~ /^\s*$/ ) {
-    while ( $i <= $#msg && length( $msg[$i] ) ) { $fwd .= $msg[$i]; $i++; }
-    while ( $i <= $#msg && !length( $msg[$i] ) ) { $fwd .= "\n"; $i++; }
-}      
-
 my %clonebugs = ();
 my @bcc = ();
 
-for ($procline=$i; $procline<=$#msg; $procline++) {
+for ($procline=0; $procline<=$#bodylines; $procline++) {
     $state eq 'idle' || print "$state ?\n";
     $lowstate eq 'idle' || print "$lowstate ?\n";
     $mergelowstate eq 'idle' || print "$mergelowstate ?\n";
@@ -126,7 +133,7 @@ for ($procline=$i; $procline<=$#msg; $procline++) {
          &transcript("Stopping processing here.\n\n");
         last;
     }
-    $_= $msg[$procline]; s/\s+$//;
+    $_= $bodylines[$procline]; s/\s+$//;
     next unless m/\S/; next if m/^\s*\#/;
     &transcript("> $_\n");
     $action= '';
@@ -598,7 +605,7 @@ END
         }
     }
 }
-if ($procline>$#msg) {
+if ($procline>$#bodylines) {
     &transcript(">\nEnd of message, stopping processing here.\n\n");
 }
 if (!$ok && !quickabort) {