use Debbugs::Status qw(:versions);
use Debbugs::Config qw(:globals :config);
+use Debbugs::Control qw(append_action_to_log);
+
chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
#open(DEBUG,"> /tmp/debbugs.debug");
umask(002);
open DEBUG, ">/dev/null";
-my $intdate = time or quit("failed to get time: $!");
+my $intdate = time or die "failed to get time: $!";
$_=shift;
-m/^([BMQFDUL])(\d*)\.\d+$/ or quit("bad argument: $_");
+m/^([BMQFDUL])(\d*)\.\d+$/ or die "bad argument: $_";
my $codeletter= $1;
my $tryref= length($2) ? $2 : -1;
my $nn= $_;
if (!rename("incoming/G$nn","incoming/P$nn"))
{
$_=$!.''; m/no such file or directory/i && exit 0;
- &quit("renaming to lock: $!");
+ die "renaming to lock: $!";
}
my $baddress= 'submit' if $codeletter eq 'B';
$baddress= 'done' if $codeletter eq 'D';
$baddress= 'submitter' if $codeletter eq 'U';
bug_list_forward($nn) if $codeletter eq 'L';
-$baddress || &quit("bad codeletter $codeletter");
+$baddress || die "bad codeletter $codeletter";
my $baddressroot= $baddress;
$baddress= "$tryref-$baddress" if $tryref>=0;
if (defined $header{'resent-from'} && !defined $header{'from'}) {
$header{'from'} = $header{'resent-from'};
}
-defined($header{'from'}) || &quit("no From header");
+defined($header{'from'}) || die "no From header";
my $replyto = $header{'reply-to'};
$replyto = '' unless defined $replyto;
if ($bfound) {
$ref= $tryref;
} else {
- &htmllog("Reply","sent", $replyto,"Unknown problem report number <code>$tryref</code>.");
&sendmessage(create_mime_message(
[From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
To => $replyto,
push @generalcc,"$gStrongList\@$gListDomain";
}
if ($ref<0) {
- &htmllog("Warning","sent",$replyto,"Message ignored.");
&sendmessage(create_mime_message(
[From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
To => $replyto,
writebug($ref, $data);
my $hash = get_hashname($ref);
- open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!");
+ open(O,"db-h/$hash/$ref.report") || die "read original report: $!";
my $orig_report= join('',<O>); close(O);
if ($codeletter eq 'F') {
&htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
if ($ref<0) { # new bug report
if ($codeletter eq 'U') { # -submitter
- &htmllog("Warning","sent",$replyto,"Message not forwarded.");
&sendmessage(create_mime_message(
[From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
To => $replyto,
$data->{package} = $config{default_package},
}
else {
- &htmllog("Warning","sent",$replyto,"Message not forwarded.");
my $body = message_body_template('mail/process_no_package',
);
&sendmessage(create_mime_message(
$data->{'forwarded-to'} = $pheader{forwarded};
}
&filelock("nextnumber.lock");
- open(N,"nextnumber") || &quit("nextnumber: read: $!");
- my $nextnumber=<N>; $nextnumber =~ s/\n$// || &quit("nextnumber bad format");
+ open(N,"nextnumber") || die "nextnumber: read: $!";
+ my $nextnumber=<N>; $nextnumber =~ s/\n$// || die "nextnumber bad format";
$ref= $nextnumber+0; $nextnumber += 1; $newref=1;
&overwrite('nextnumber', "$nextnumber\n");
&unfilelock;
sub overwrite {
my ($f,$v) = @_;
- open(NEW,">$f.new") || &quit("$f.new: create: $!");
- print(NEW "$v") || &quit("$f.new: write: $!");
- close(NEW) || &quit("$f.new: close: $!");
- rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
+ open(NEW,">$f.new") || die "$f.new: create: $!";
+ print(NEW "$v") || die "$f.new: write: $!";
+ close(NEW) || die "$f.new: close: $!";
+ rename("$f.new","$f") || die "rename $f.new to $f: $!";
}
sub appendlog {
if (!open(AP,">>db-h/$hash/$ref.log")) {
print DEBUG "failed open log<\n";
print DEBUG "failed open log err $!<\n";
- &quit("opening db-h/$hash/$ref.log (li): $!");
+ die "opening db-h/$hash/$ref.log (li): $!";
}
- print(AP "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
- close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
+ print(AP "\7\n",escape_log(@log),"\n\3\n") || die "writing db-h/$hash/$ref.log (li): $!";
+ close(AP) || die "closing db-h/$hash/$ref.log (li): $!";
}
sub finish {
# cleanups are run in an end block now.
#my ($u);
#while ($u= $cleanups[$#cleanups]) { &$u; }
- unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
+ unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
exit $exit;
}
-&quit("wot no exit");
+die "wot no exit";
sub htmllog {
my ($whatobj,$whatverb,$where,$desc) = @_;
- 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>".
- ($where eq '' ? "" : " to <code>".html_escape($where)."</code>").
- ":<br>\n". $desc.
- "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
- close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
-}
+ append_action_to_log(bug => $ref,
+ action => "$whatobj $whatverb",
+ requester => '',
+ request_addr => $where,
+ desc => $desc,
+ get_lock => 0,
+ );
+}
sub stripbccs {
my $msg = shift;
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): $!");
+ open(AP,">>db-h/$hash/$ref.log") || die "opening db-h/$hash/$ref.log (lo): $!";
print(AP "\2\n",join("\4",@$recips),"\n\5\n",
escape_log(stripbccs($msg)),"\n\3\n") ||
- &quit("writing db-h/$hash/$ref.log (lo): $!");
- close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
+ die "writing db-h/$hash/$ref.log (lo): $!";
+ close(AP) || die "closing db-h/$hash/$ref.log (lo): $!";
if (ref($bcc)) {
shift @$recips if $recips->[0] eq '-t';
my $hole_var = {'&bugurl' =>
sub{"$_[0]: ".
'http://'.$config{cgi_domain}.'/'.
- Debbugs::CGI::bug_url($_[0]);
+ Debbugs::CGI::bug_links(bug=>$_[0],
+ links_only => 1,
+ );
}
};
return fill_in_template(template => $template,
return if $maintainerschecked++;
return if !length($data->{package});
my %maintainerof;
- open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
+ open(MAINT,"$gMaintainerFile") || die die "maintainers open: $!";
while (<MAINT>) {
m/^\n$/ && next;
m/^\s*$/ && next;
- m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
+ m/^(\S+)\s+(\S.*\S)\s*\n$/ || die "maintainers bogus \`$_'";
$a= $1; $b= $2; $a =~ y/A-Z/a-z/;
# use the package which is normalized to lower case; we do this because we lc the pseudo headers.
$maintainerof{$a}= $2;
}
close(MAINT);
- open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
+ open(MAINT,"$gMaintainerFileOverride") || die die "maintainers.override open: $!";
while (<MAINT>) {
m/^\n$/ && next;
m/^\s*$/ && next;
- m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
+ m/^(\S+)\s+(\S.*\S)\s*\n$/ || die "maintainers.override bogus \`$_'";
$a= $1; $b= $2; $a =~ y/A-Z/a-z/;
# use the package which is normalized to lower case; we do this because we lc the pseudo headers.
$maintainerof{$a}= $2;
}
close(MAINT);
my %pkgsrc;
- open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
+ open(SOURCES,"$gPackageSource") || die "pkgsrc open: $!";
while (<SOURCES>) {
next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
($a,$b)=($1,$2);
envelope_from => $envelope_from,
encode_headers => 0,
);
- unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");
+ unlink("incoming/P$bug_fn") || die "unlinking incoming/P$bug_fn: $!";
exit 0;
}