X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=scripts%2Fprocess.in;h=b15271cc180bdb8a0d4fd9e3ce5f20d0f193d1e5;hb=4a4170e0f4e716ea12c5249721c9283e18159df7;hp=8aff7c27632acf19b69c3a543c3d5d2b486d90a1;hpb=3d63bd7ac3b7b59ae390af8915e2b3c28c89be6c;p=debbugs.git

diff --git a/scripts/process.in b/scripts/process.in
index 8aff7c2..b15271c 100755
--- a/scripts/process.in
+++ b/scripts/process.in
@@ -1,15 +1,23 @@
 #!/usr/bin/perl
-# $Id: process.in,v 1.33 2001/08/16 07:06:16 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;
-require( '/etc/debbugs/config' );
-require( '/usr/lib/debbugs/errorlib' );
-chdir( "$gSpoolDir" ) || die 'chdir spool: $!\n';
+use MIME::Parser;
+
+$config_path = '/org/bugs.debian.org/etc';
+$lib_path = '/org/bugs.debian.org/scripts';
+
+require "$config_path/config";
+require "$lib_path/errorlib";
+$ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
+
+chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
 
 #open(DEBUG,"> /tmp/debbugs.debug");
+umask(002);
 open DEBUG, ">/dev/null";
 
 defined( $intdate= time ) || &quit( "failed to get time: $!" );
@@ -40,68 +48,82 @@ open(M,"incoming/P$nn");
 close(M);
 
 @msg=@log;
-grep(s/\n+$//,@msg);
+chomp @msg;
 
 print DEBUG "###\n",join("##\n",@msg),"\n###\n";
 
 chop($tdate= `date -u '+%a, %d %h %Y %T GMT'`);
 $fwd= <<END;
-X-Loop: $gMaintainerEmail
 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";
 }
 
 
@@ -121,14 +143,16 @@ $replytocompare= $_;
 print DEBUG "replytocompare >$replytocompare<\n";
     
 if (!defined($header{'subject'})) 
-{	$brokenness.= <<END;
+{
+	$brokenness.= <<END;
 
-Your message did not contain a Subject field.  This is broken, I am
-afraid - the Subject: line is a Required Header according to RFC822.
+Your message did not contain a Subject field. They are recommended and
+useful because the title of a $gBug is determined using this field.
 Please remember to include a Subject field in your messages in future.
-If you did so the fact that it got lost probably indicates a poorly
-configured mail system at your site or an intervening one.
 END
+
+# RFC822 actually lists it as an `optional-field'.
+
     $subject= '(no subject)';
 } else { $subject= $header{'subject'}; }
 
@@ -261,13 +285,14 @@ END
 		}
         $s_done= $set_done if defined($set_done);
         $s_forwarded= $set_forwarded if defined($set_forwarded);
-		&overwrite("db/$ref.status",
+	my $hash = get_hashname($ref);
+		&overwrite("db-h/$hash/$ref.status",
         	   "$s_originator\n$s_date\n$s_subject\n$s_msgid\n".
                    "$s_package\n$s_keywords\n$s_done\n$s_forwarded\n$s_mergedwith\n$s_severity\n");
 		&bughook('change',$ref,
         	   "$s_originator\n$s_date\n$s_subject\n$s_msgid\n".
                    "$s_package\n$s_keywords\n$s_done\n$s_forwarded\n$s_mergedwith\n$s_severity\n");
-        open(O,"db/$ref.report") || &quit("read original report: $!");
+        open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!");
         $x= join('',<O>); close(O);
         if ($codeletter eq 'F') 
 		{ 	&htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
@@ -334,6 +359,7 @@ Message-ID: <handler.$ref.$nn.notifdone\@$gEmailDomain>
 In-Reply-To: $s_msgid
 References: $header{'message-id'} $s_msgid
 X-$gProject-PR-Message: they-closed $ref
+Reply-To: $ref\@$gEmailDomain
 
 This is an automatic notification regarding your $gBug report
 #$ref: $s_subject,
@@ -344,8 +370,7 @@ $markedby.
 
 Their explanation is attached below.  If this explanation is
 unsatisfactory and you have not received a better one in a separate
-message then please contact the developer directly, or email
-$ref\@$gEmailDomain or me.
+message then please contact the developer, by replying to this email.
 
 $gMaintainer
 (administrator, $gProject $gBugs database)
@@ -475,14 +500,15 @@ END
     $ref= $v+0;  $v += 1;  $newref=1;
     &overwrite('nextnumber', "$v\n");
     &unfilelock;
-    &overwrite("db/$ref.log",'');
-    &overwrite("db/$ref.status",
+    my $hash = get_hashname($ref);
+    &overwrite("db-h/$hash/$ref.log",'');
+    &overwrite("db-h/$hash/$ref.status",
                "$replyto\n$intdate\n$subject\n$header{'message-id'}\n".
                "$s_package\n$s_keywords\n\n\n\n$s_severity\n");
 	&bughook('new',$ref,
                "$replyto\n$intdate\n$subject\n$header{'message-id'}\n".
                "$s_package\n$s_keywords\n\n\n\n$s_severity\n");
-    &overwrite("db/$ref.report",
+    &overwrite("db-h/$hash/$ref.report",
                join("\n",@msg)."\n");
 }
 
@@ -490,8 +516,8 @@ END
 
 print DEBUG "maintainers >@maintaddrs<\n";
 
-$orgsender= defined($header{'sender'}) ? "Orignal-Sender: $header{'sender'}\n" : '';
-$newsubject= $subject;  $newsubject =~ s/^$gBug#$ref\W*\s*//;
+$orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
+$newsubject= $subject;  $newsubject =~ s/^$gBug#$ref:*\s*//;
 
 $xcchdr= $header{ 'x-debbugs-cc' };
 if ($xcchdr =~ m/\S/) {
@@ -512,6 +538,8 @@ Your message has been sent to the package maintainer(s):
 END
 }
 
+push(@resentccs, @addsrcaddrs);
+
 $veryquiet= $codeletter eq 'Q';
 if ($codeletter eq 'M' && !@maintaddrs) {
     $veryquiet= 1;
@@ -610,6 +638,7 @@ Message-ID: <handler.$ref.$nn.ackquiet\@$gEmailDomain>
 In-Reply-To: $header{'message-id'}
 References: $header{'message-id'}
 X-$gProject-PR-Message: ack-quiet $ref
+Reply-To: $ref-quiet\@$gEmailDomain
 
 Thank you for the problem report you have sent regarding $gProject.
 This is an automatically generated reply, to let you know your message
@@ -636,6 +665,7 @@ Message-ID: <handler.$ref.$nn.ackmaint\@$gEmailDomain>
 In-Reply-To: $header{'message-id'}
 References: $header{'message-id'}
 X-$gProject-PR-Message: ack-maintonly $ref
+Reply-To: $ref-maintonly\@$gEmailDomain
 
 Thank you for the problem report you have sent regarding $gProject.
 This is an automatically generated reply, to let you know your message has
@@ -659,6 +689,7 @@ Message-ID: <handler.$ref.$nn.ack\@$gEmailDomain>
 In-Reply-To: $header{'message-id'}
 References: $header{'message-id'}
 X-$gProject-PR-Message: ack $ref
+Reply-To: $ref\@$gEmailDomain
 
 Thank you for the problem report you have sent regarding $gProject.
 This is an automatically generated reply, to let you know your message has
@@ -689,6 +720,7 @@ Message-ID: <handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>
 In-Reply-To: $header{'message-id'}
 References: $header{'message-id'}
 X-$gProject-PR-Message: ack-info-quiet $ref
+Reply-To: $ref-quiet\@$gEmailDomain
 
 Thank you for the additional information you have supplied regarding
 this problem report.  It has NOT been forwarded to the developers, but
@@ -712,7 +744,8 @@ Subject: $gBug#$ref: Info received for maintainer only
 Message-ID: <handler.$ref.$nn.ackinfomaint\@$gEmailDomain>
 In-Reply-To: $header{'message-id'}
 References: $header{'message-id'}
-X-$gProject-PR-Message: ack-info $ref
+X-$gProject-PR-Message: ack-info-maintonly $ref
+Reply-To: $ref-maintonly\@$gEmailDomain
 
 Thank you for the additional information you have supplied regarding
 this problem report.  It has been forwarded to the developer(s) (but
@@ -733,7 +766,8 @@ Subject: $gBug#$ref: Info received (was $subject)
 Message-ID: <handler.$ref.$nn.ackinfo\@$gEmailDomain>
 In-Reply-To: $header{'message-id'}
 References: $header{'message-id'}
-X-$gProject-PR-Message: ack-info-maintonly $ref
+X-$gProject-PR-Message: ack-info $ref
+Disabled-Doogie-Reply-To: $ref\@$gEmailDomain
 
 Thank you for the additional information you have supplied regarding
 this problem report.  It has been forwarded to the developer(s) and
@@ -762,13 +796,14 @@ sub overwrite {
 }
 
 sub appendlog {
-    if (!open(AP,">>db/$ref.log")) {
+    my $hash = get_hashname($ref);
+    if (!open(AP,">>db-h/$hash/$ref.log")) {
         print DEBUG "failed open log<\n";
         print DEBUG "failed open log err $!<\n";
-        &quit("opening db/$ref.log (li): $!");
+        &quit("opening db-h/$hash/$ref.log (li): $!");
     }
-    print(AP "\7\n",@log,"\n\3\n") || &quit("writing db/$ref.log (li): $!");
-    close(AP) || &quit("closing db/$ref.log (li): $!");
+    print(AP "\7\n",@log,"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
+    close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
 }
 
 sub finish {
@@ -785,13 +820,14 @@ sub chldhandle { $chldexit = 'yes'; }
 
 sub htmllog {
     local ($whatobj,$whatverb,$where,$desc) = @_;
-    open(AP,">>db/$ref.log") || &quit("opening db/$ref.log (lh): $!");
+    my $hash = get_hashname($ref);
+    open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
     print(AP
           "\6\n".
           "<strong>$whatobj $whatverb</strong> to <code>".&sani($where).
           "</code>:<br>\n". $desc.
-          "\n\3\n") || &quit("writing db/$ref.log (lh): $!");
-    close(AP) || &quit("closing db/$ref.log (lh): $!");
+          "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
+    close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
 }    
 
 sub get_addresses {
@@ -800,78 +836,79 @@ sub get_addresses {
    		map { Mail::Address->parse($_) } @_;
 }
 
-
 sub sendmessage {
     local ($msg,@recips) = @_;
     if ($recips[0] eq '' && $#recips == 0) { @recips= ('-t'); }
+    $msg = "X-Loop: $gMaintainerEmail\n" . $msg;
 
-	#save email to the log
-    open(AP,">>db/$ref.log") || &quit("opening db/$ref.log (lo): $!");
+    my $hash = get_hashname($ref);
+    #save email to the log
+    open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
     print(AP "\2\n",join("\4",@recips),"\n\5\n$msg\n\3\n") ||
-        &quit("writing db/$ref.log (lo): $!");
-    close(AP) || &quit("closing db/$ref.log (lo): $!");
+        &quit("writing db-h/$hash/$ref.log (lo): $!");
+    close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
     
-	#if debbuging.. save email to a log
-#	open AP, ">>debug";
-#	print AP join( '|', @recips )."\n>>";
-#	print AP get_addresses( @recips );
-#	print AP "<<\n".$msg;
-#	print AP "\n--------------------------------------------------------\n";
-#	close AP;
-
-	#start mailing
-	$_ = '';
+#if debbuging.. save email to a log
+#    open AP, ">>debug";
+#    print AP join( '|', @recips )."\n>>";
+#    print AP get_addresses( @recips );
+#    print AP "<<\n".$msg;
+#    print AP "\n--------------------------------------------------------\n";
+#    close AP;
+
+    #start mailing
+    $_ = '';
     $SIG{'CHLD'}='chldhandle';
-	#print DEBUG "mailing sigchild set up<\n";
-	$chldexit = 'no';
+    #print DEBUG "mailing sigchild set up<\n";
+    $chldexit = 'no';
     $c= open(U,"-|");
-	#print DEBUG "mailing opened pipe fork<\n";
+    #print DEBUG "mailing opened pipe fork<\n";
     defined($c) || die $!;
-	#print DEBUG "mailing opened pipe fork ok $c<\n";
+    #print DEBUG "mailing opened pipe fork ok $c<\n";
     if (!$c) { # ie, we are in the child process
-		#print DEBUG "mailing child<\n";
+	#print DEBUG "mailing child<\n";
         unless (open(STDERR,">&STDOUT")) {
-			#print DEBUG "mailing child opened stderr<\n";
+	    #print DEBUG "mailing child opened stderr<\n";
             print STDOUT "redirect stderr: $!\n";
-			#print DEBUG "mailing child opened stderr fail<\n";
+	    #print DEBUG "mailing child opened stderr fail<\n";
             exit 1;
-			#print DEBUG "mailing child opened stderr fail exit !?<\n";
+	    #print DEBUG "mailing child opened stderr fail exit !?<\n";
         }
-		#print DEBUG "mailing child opened stderr ok<\n";
+	#print DEBUG "mailing child opened stderr ok<\n";
         $c= open(D,"|-");
-		#print DEBUG "mailing child forked again<\n";
+	#print DEBUG "mailing child forked again<\n";
         defined($c) || die $!;
-		#print DEBUG "mailing child forked again ok $c<\n";
+	#print DEBUG "mailing child forked again ok $c<\n";
         if (!$c) { # ie, we are the child process
-			#print DEBUG "mailing grandchild<\n";
+	    #print DEBUG "mailing grandchild<\n";
             exec '/usr/lib/sendmail','-f'."$gMaintainerEmail",'-odq','-oem','-oi',get_addresses(@recips);
-			#print DEBUG "mailing grandchild exec failed<\n";
+	    #print DEBUG "mailing grandchild exec failed<\n";
             die $!;
-			#print DEBUG "mailing grandchild died !?<\n";
+	    #print DEBUG "mailing grandchild died !?<\n";
         }
-		#print DEBUG "mailing child not grandchild<\n";
+	#print DEBUG "mailing child not grandchild<\n";
         print(D $msg) || die $!;
-		#print DEBUG "mailing child printed msg<\n";
+	#print DEBUG "mailing child printed msg<\n";
         close(D);
-		#print DEBUG "mailing child closed pipe<\n";
+	#print DEBUG "mailing child closed pipe<\n";
         die "\n*** command returned exit status $?\n" if $?;
-		#print DEBUG "mailing child exit status ok<\n";
+	#print DEBUG "mailing child exit status ok<\n";
         exit 0;
-		#print DEBUG "mailing child exited ?!<\n";
+	#print DEBUG "mailing child exited ?!<\n";
     }
-	#print DEBUG "mailing parent<\n";
+    #print DEBUG "mailing parent<\n";
     $results='';
-	#print DEBUG "mailing parent results emptied<\n";
+    #print DEBUG "mailing parent results emptied<\n";
     while( $chldexit eq 'no' ) { $results.= $_; }
-	#print DEBUG "mailing parent results read >$results<\n";
+    #print DEBUG "mailing parent results read >$results<\n";
     close(U);
-	#print DEBUG "mailing parent results closed<\n";
+    #print DEBUG "mailing parent results closed<\n";
     $results.= "\n*** child returned exit status $?\n" if $?;
-	#print DEBUG "mailing parent exit status ok<\n";
+    #print DEBUG "mailing parent exit status ok<\n";
     $SIG{'CHLD'}='DEFAULT';
-	#print DEBUG "mailing parent sigchild default<\n";
+    #print DEBUG "mailing parent sigchild default<\n";
     if (length($results)) { &quit("running sendmail: $results"); }
-	#print DEBUG "mailing parent results ok<\n";
+    #print DEBUG "mailing parent results ok<\n";
 }
 
 sub checkmaintainers {
@@ -895,9 +932,22 @@ sub checkmaintainers {
         $maintainerof{$1}= $2;
     }
     close(MAINT);
+    open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
+    while (<SOURCES>) {
+        next unless m/^(\S+)\s+(\S.*\S)\s*$/;
+	($a,$b)=($1,$2);
+	$a =~ y/A-Z/a-z/;
+	$pkgsrc{$a} = $b;
+    }
+    close(SOURCES);
     $anymaintfound=0; $anymaintnotfound=0;
     for $p (split(m/[ \t?,()]+/,$s_package)) {
         $p =~ y/A-Z/a-z/;
+	if (defined($pkgsrc{$p})) {
+	    push @addsrcaddrs, "$pkgsrc{$p}\@packages.qa.debian.org";
+	} else {
+	    push @addsrcaddrs, "$p\@packages.qa.debian.org";
+	}
         if (defined($maintainerof{$p})) {
 print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
             $addmaint= $maintainerof{$p};