From: cjwatson <> Date: Mon, 7 Oct 2002 05:54:48 +0000 (-0800) Subject: [project @ 2002-10-06 22:54:48 by cjwatson] X-Git-Tag: release/2.6.0~1036 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=4a4170e0f4e716ea12c5249721c9283e18159df7;p=debbugs.git [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 6402a60..c3a0bb3 100644 --- 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 d6f9424..e545d30 100644 --- 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 3565cf0..85250b9 100755 --- 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 1e6d606..b15271c 100755 --- 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 2602189..745ad50 100755 --- 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 88a69b2..66a2b5e 100755 --- 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 .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= <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) {