#!/usr/bin/perl
-# $Id: process.in,v 1.23 2001/03/18 04:11:07 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: $!" );
&quit("renaming to lock: $!");
}
-$baddress= 'bugs' if $codeletter eq 'B';
+$baddress= 'submit' if $codeletter eq 'B';
$baddress= 'maintonly' if $codeletter eq 'M';
$baddress= 'quiet' if $codeletter eq 'Q';
$baddress= 'forwarded' if $codeletter eq 'F';
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;
- $pfullheader{$fn}= $2.$3;
- 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";
}
print DEBUG "***\n$fwd\n***\n";
+if (defined $header{'resent-from'} && !defined $header{'from'}) {
+ $header{'from'} = $header{'resent-from'};
+}
defined($header{'from'}) || &quit("no From header");
$replyto= defined($header{'reply-to'}) ? $header{'reply-to'} : $header{'from'};
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'}; }
}
$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.");
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,
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)
} else { $s_package= $pheader{'package'}; }
$s_keywords= '';
if (defined($pheader{'keywords'})) {
- $s_keywords= $pfullheader{'keywords'};
+ $s_keywords= $pheader{'keywords'};
} elsif (defined($pheader{'tags'})) {
- $s_keywords= $pfullheader{'tags'};
+ $s_keywords= $pheader{'tags'};
}
if (length($s_keywords)) {
my @kws;
- my %gkws = map { (%_, 1) } @gTags;
+ my %gkws = map { ($_, 1) } @gTags;
foreach my $kw (sort split(/[,\s]+/, lc($s_keywords))) {
push @kws, $kw if (defined $gkws{$kw});
}
$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");
- &overwrite("db/$ref.report",
+ &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-h/$hash/$ref.report",
join("\n",@msg)."\n");
}
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/) {
END
}
+push(@resentccs, @addsrcaddrs);
+
$veryquiet= $codeletter eq 'Q';
if ($codeletter eq 'M' && !@maintaddrs) {
$veryquiet= 1;
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
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
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
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
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
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
}
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 {
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 {
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";
- exec '/usr/lib/sendmail','-f'."$gMaintainerEmail",'-odi','-oem','-oi',get_addresses(@recips);
- #print DEBUG "mailing grandchild exec failed<\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";
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 {
while (<MAINT>) {
m/^\n$/ && next;
m/^\s*$/ && next;
- m/^(\S+)\s+(\S.*\S)\n$/ || &quit("maintainers bogus \`$_'");
+ m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
$a= $1; $b= $2; $a =~ y/A-Z/a-z/;
$maintainerof{$1}= $2;
}
close(MAINT);
+ open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
+ while (<MAINT>) {
+ m/^\n$/ && next;
+ m/^\s*$/ && next;
+ m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
+ $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
+ $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};
$anymaintfound++;
} else {
print DEBUG "maintainer none >$p<\n";
+ push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
$anymaintnotfound++;
last;
}
projects / debbugs.git / blobdiff