use warnings;
use strict;
-use POSIX qw(strftime);
+use locale;
+use POSIX qw(strftime locale_h);
+setlocale(LC_TIME, "C");
use IO::File;
+use Getopt::Long;
+use Pod::Usage;
use MIME::Parser;
use Debbugs::MIME qw(decode_rfc1522 create_mime_message getmailbody);
-use Debbugs::Mail qw(send_mail_message encode_headers);
-use Debbugs::Packages qw(getpkgsrc);
+use Debbugs::Mail qw(send_mail_message encode_headers get_addresses);
+use Debbugs::Packages qw(getpkgsrc binary_to_source);
use Debbugs::User qw(read_usertags write_usertags);
-use Debbugs::Common qw(:lock get_hashname);
-use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug);
+use Debbugs::Common qw(:lock get_hashname buglog package_maintainer overwritefile make_list);
+use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug new_bug read_bug splitpackages :versions);
-use Debbugs::CGI qw(html_escape bug_url);
+use Debbugs::CGI qw(html_escape bug_links);
-use Debbugs::Log qw(:misc);
+use Debbugs::Log qw(:misc :write);
use Debbugs::Text qw(:templates);
-use Debbugs::Status qw(:versions);
use Debbugs::Config qw(:globals :config);
use Debbugs::Control qw(append_action_to_log);
+use Debbugs::Control::Service qw(valid_control control_line);
+use Debbugs::Recipients qw(determine_recipients);
+use Encode qw(encode_utf8 decode);
-chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
+=head1 NAME
+
+process - Handle e-mails emails sent to bugs
+
+=head1 SYNOPSIS
+
+process nn
+
+ Options:
+ --debug, -d debugging level (Default 0)
+
+=head1 OPTIONS
+
+=over
+
+=item <--debug,-d>
+
+Debugging level (default 0)
+
+=back
+
+=cut
+
+use vars qw($DEBUG);
+
+my %options = (debug => 0,
+ help => 0,
+ man => 0,
+ );
+
+GetOptions(\%options,
+ 'debug|d+','help|h|?','man|m');
+
+pod2usage() if $options{help};
+pod2usage({verbose=>2}) if $options{man};
+
+
+$DEBUG=$options{debug};
+my $debugfh = IO::File->new('/dev/null','w') or
+ die "Unable to open /dev/null for writing; $!";
+if ($DEBUG > 0) {
+ $debugfh = \*STDERR;
+}
+binmode($debugfh,':raw:encoding(UTF-8)');
+
+# these are the valid bug addresses
+my %baddress = (B => 'submit',
+ M => 'maintonly',
+ Q => 'quiet',
+ F => 'forwarded',
+ D => 'done',
+ U => 'submitter',
+ L => 'list',
+ );
+my $valid_codeletters = join('',keys %baddress);
+
+
+chdir($config{spool_dir}) or die "Unable to chdir to spool ($config{spool_dir}): $!";
-#open(DEBUG,"> /tmp/debbugs.debug");
umask(002);
-open DEBUG, ">/dev/null";
my $intdate = time or die "failed to get time: $!";
-$_=shift;
-m/^([BMQFDUL])(\d*)\.\d+$/ or die "bad argument: $_";
-my $codeletter= $1;
-my $tryref= length($2) ? $2 : -1;
-my $nn= $_;
+my ($nn) = @ARGV;
+my ($codeletter,$tryref) =
+ $nn =~ m/^([$valid_codeletters])(\d*)\.\d+$/
+ or die "bad argument: $_";
+$tryref = undef unless length ($tryref) and
+ $tryref > 0;
+
+if (!rename("incoming/G$nn","incoming/P$nn")) {
+ my $error = $!;
+ $error = '' if not defined $error;
+ # this is very fragile, but we should probably die here anyway
+ if ($error =~ m/no such file or directory/i) {
+ exit 0;
+ }
+ die "Unable to rename incoming/G$nn to lock: $error";
+}
-if (!rename("incoming/G$nn","incoming/P$nn"))
-{
- $_=$!.''; m/no such file or directory/i && exit 0;
- die "renaming to lock: $!";
+# die here to avoid continuously processing this mail
+if (not exists $baddress{$codeletter}) {
+ die "bad codeletter $codeletter";
+}
+
+my $baddress = $baddress{$codeletter};
+if ($baddress eq 'list') {
+ bug_list_forward($nn) if $codeletter eq 'L';
}
-my $baddress= 'submit' if $codeletter eq 'B';
-$baddress= 'maintonly' if $codeletter eq 'M';
-$baddress= 'quiet' if $codeletter eq 'Q';
-$baddress= 'forwarded' if $codeletter eq 'F';
-$baddress= 'done' if $codeletter eq 'D';
-$baddress= 'submitter' if $codeletter eq 'U';
-bug_list_forward($nn) if $codeletter eq 'L';
-$baddress || die "bad codeletter $codeletter";
+
my $baddressroot= $baddress;
-$baddress= "$tryref-$baddress" if $tryref>=0;
+$baddress= "$tryref-$baddress" if defined $tryref;
-open(M,"incoming/P$nn");
-my @log=<M>;
-close(M);
+my $msg;
+my @msg;
-my @msg = @log;
-chomp @msg;
+{
+ my $log = IO::File->new("incoming/P$nn",'r') or
+ die "Unable to open 'incoming/P$nn' for reading; $!";
+ local $/;
+ $msg=<$log>;
+ @msg = split /\n/, $msg;
+ close($log);
+}
-print DEBUG "###\n",join("##\n",@msg),"\n###\n";
my $tdate = strftime "%a, %d %h %Y %T +0000", gmtime;
-my $fwd= <<END;
-Received: via spool by $baddress\@$gEmailDomain id=$nn
- (code $codeletter ref $tryref); $tdate
-END
+my $fwd= "Received: via spool by $baddress\@$gEmailDomain id=$nn\n".
+ " (code $codeletter".(defined($tryref)?" ref $tryref":'')."); $tdate\n";
# header and decoded body respectively
my (@headerlines, @bodylines);
our $brokenness = '';
-my $parser = new MIME::Parser;
-mkdir "$gSpoolDir/mime.tmp", 0777;
-$parser->output_under("$gSpoolDir/mime.tmp");
-my $entity = eval { $parser->parse_data(join('',@log)) };
-
-my $i;
-if ($entity and $entity->head->tags) {
- @headerlines = @{$entity->head->header};
- chomp @headerlines;
-
- my $entity_body = getmailbody($entity);
- @bodylines = map {s/\r?\n$//; $_;}
- $entity_body ? $entity_body->as_lines() : ();
-
- # 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, $_;
- }
+my $parser_output = Debbugs::MIME::parse($msg);
- @bodylines = @msg[$i..$#msg];
-}
+@headerlines = @{$parser_output->{header}};
+@bodylines = @{$parser_output->{body}};
my %header;
+my @common_headers;
for my $hdr (@headerlines) {
+ my $orig_hdr = $hdr;
$hdr = decode_rfc1522($hdr);
$_ = $hdr;
s/\n\s/ /g;
- &finish if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
+ finish() 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-/i;
- $fwd .= $hdr."\n" if $ins;
- # print DEBUG ">$_<\n";
+ $fwd .= encode_utf8($hdr)."\n" if $ins;
+ # print {$debugfh} ">$_<\n";
if (s/^(\S+):\s*//) {
my $v = lc $1;
- print DEBUG ">$v=$_<\n";
+ if ($v eq 'x-loop') {
+ push @common_headers, 'X-Loop',$_;
+ }
+ print {$debugfh} ">$v=$_<\n";
$header{$v} = $_;
} else {
- print DEBUG "!>$_<\n";
+ print {$debugfh} "!>$_<\n";
}
}
$header{'message-id'} = '' if not defined $header{'message-id'};
+push @common_headers, 'X-Loop',$gMaintainerEmail;
+
# remove blank lines
shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
#psuedoheaders
my %pheader;
+my @control_bits;
# extract pseudo-headers
for my $phline (@bodylines)
{
+ # Remove BOM markers from UTF-8 strings
+ # Fixes #488554
+ $phline =~ s/\xef\xbb\xbf//g;
+ $phline =~ s/\N{U+FEFF}//g;
last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
my ($fn, $fv) = ($1, $2);
$fv =~ s/\s*$//;
- print DEBUG ">$fn|$fv|\n";
+ print {$debugfh} ">$fn|$fv|\n";
$fn = lc $fn;
- # Don't lc owner or forwarded
- $fv = lc $fv unless $fn =~ /^(?:owner|forwarded|usertags|version|source-version)$/;
- $pheader{$fn} = $fv;
- print DEBUG ">$fn~$fv<\n";
+ if ($fn =~ /^control$/) {
+ push @control_bits,$fv;
+ } else {
+ # Don't lc owner or forwarded
+ $fv = lc $fv unless $fn =~ /^(?:owner|forwarded|usertags|version|source-version)$/;
+ $pheader{$fn} = $fv;
+ }
+ print {$debugfh} ">$fn~$fv<\n";
}
# Allow pseudo headers to set x-debbugs- stuff [#179340]
$header{$key} = $pheader{$key} if not exists $header{$key};
}
+# set $i to beginning of encoded body data, so we can dump it out
+# verbatim later
+my $i = 0;
+++$i while $i <= $#msg and $msg[$i] =~ /./;
$fwd .= join("\n",@msg[$i..$#msg]);
-print DEBUG "***\n$fwd\n***\n";
+binmode($debugfh,':raw');
+print {$debugfh} "***\n$fwd\n***\n";
+binmode($debugfh,':raw:encoding(UTF-8)');
if (defined $header{'resent-from'} && !defined $header{'from'}) {
$header{'from'} = $header{'resent-from'};
}
my $ref=-1;
-$subject =~ s/^Re:\s*//i; $_= $subject."\n";
-if ($tryref < 0 && m/^Bug ?\#(\d+)\D/i) {
- $tryref= $1+0;
+# remove Re: from the subject line
+$subject =~ s/^Re:\s*//i;
+# remove remaining mailing list name markers from the subject line if
+# this appears to be a message that has traversed a mailing list
+if (exists $header{'list-id'} or exists $header{'list-subscribe'} or
+ (exists $header{'precedence'} and defined $header{'precedence'} and
+ $header{'precedence'} eq 'bulk') or
+ exists $header{'mailing-list'} or exists $header{'list-processor-version'}
+ ){
+ # if a mailing list didn't match any of the above, it's probably
+ # so horribly configured that we wouldn't be able to figure it out
+ # anyway.
+ $subject =~ s/^\[.*\]\s*//i;
}
+$_= $subject."\n";
+if (not defined $tryref and m/^Bug ?\#(\d+)\D/i) {
+ $tryref = $1 if $1 > 0;
+}
+my $locks = 0;
my $data;
-if ($tryref >= 0)
-{
- my $bfound;
- ($bfound, $data)= &lockreadbugmerge($tryref);
- if ($bfound) {
- $ref= $tryref;
+if (defined $tryref) {
+ my $locks_recv;
+ ($locks_recv, $data)= &lockreadbugmerge($tryref);
+ $locks += $locks_recv;
+ if ($locks_recv and not $data->{archived}) {
+ $ref= $tryref;
} else {
&sendmessage(create_mime_message(
[From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
References => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
Precedence => 'bulk',
"X-$gProject-PR-Message" => 'error',
- ],message_body_template('process_unknown_bug_number',
+ @common_headers,
+ ],message_body_template('mail/process_unknown_bug_number',
{subject => $subject,
date => $header{date},
baddress => $baddress,
messageid => $header{'message-id'},
},
)),'');
- &appendlog;
- &finish;
+ appendlog($ref,$msg);
+ finish();
}
} else {
&filelock('lock/-1');
$source_package = $pheader{source};
}
elsif (defined $data->{package} or defined $pheader{package}) {
- my $pkg_src = getpkgsrc();
- $source_package = $pkg_src->{defined $data->{package}?$data->{package}:$pheader{package}};
+ $source_package = binary_to_source(binary => $data->{package} // $pheader{package});
}
$source_pr_header = "X-$gProject-PR-Source: $source_package\n"
if defined $source_package and length $source_package;
my $generalcc;
my $set_done;
if ($codeletter eq 'F') { # Forwarded
- (&appendlog,&finish) if defined $data->{forwarded} and length($data->{forwarded});
+ (appendlog($ref,$msg),finish()) if defined $data->{forwarded} and length($data->{forwarded});
$receivedat= "forwarded\@$gEmailDomain";
$markaswhat= 'forwarded';
$set_forwarded= $header{'to'};
push @generalcc, "$gForwardList\@$gListDomain";
$generalcc= "$gForwardList\@$gListDomain";
} else {
- $generalcc='';
+ $generalcc='';
}
} else { # Done
if (defined $data->{done} and length($data->{done}) and
not defined $pheader{'source-version'} and
not defined $pheader{'version'}) {
- &appendlog;
- &finish;
+ appendlog($ref,$msg);
+ finish();
}
$receivedat= "done\@$gEmailDomain";
$markaswhat= 'done';
References => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
Precedence => 'bulk',
"X-$gProject-PR-Message" => 'error',
+ @common_headers,
],message_body_template('mail/process_no_bug_number',
{subject => $subject,
date => $header{date},
messageid => $header{'message-id'},
},
)),'');
- &appendlog;
- &finish;
+ appendlog($ref,$msg);
+ finish();
}
&checkmaintainers;
for $ref (@process) {
if ($ref != $orgref) {
&unfilelock;
+ $locks--;
$data = &lockreadbug($ref)
|| die "huh ? $ref from $orgref out of ".join(' ',@process);
+ $locks++;
}
$data->{done}= $set_done if defined($set_done);
$data->{forwarded}= $set_forwarded if defined($set_forwarded);
# Add bug mailing list to $generalbcc as appropriate
# This array is used to specify bcc in the cases where we're using create_mime_message.
- my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
- my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
+ my @generalbcc = @generalcc;
+ if (defined $config{subscription_domain} and length $config{subscription_domain}) {
+ @generalbcc = (@generalbcc, @addsrcaddrs);
+ }
+ if (defined $config{bug_subscription_domain} and length $config{bug_subscription_domain}) {
+ @generalbcc = (@generalbcc, "bugs=$ref\@$config{bug_subscription_domain}");
+ }
+ my $generalbcc = join(', ', @generalbcc);
$generalbcc =~ s/\s+\n\s+/ /g;
$generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
writebug($ref, $data);
my $hash = get_hashname($ref);
- open(O,"db-h/$hash/$ref.report") || die "read original report: $!";
- my $orig_report= join('',<O>); close(O);
+ my $orig_report_fh = IO::File->new("db-h/$hash/$ref.report") or
+ die "Unable to read original report: $!";
+ my $orig_report;
+ { local $/; $orig_report = <$orig_report_fh>;}
+ close($orig_report_fh) or
+ die "Unable to close original report filehandle: $!";
if ($codeletter eq 'F') {
&htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
&sendmessage(create_mime_message(
- ["X-Loop" => "$gMaintainerEmail",
+ [@common_headers,
From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
To => "$replyto",
Subject => "$gBug#$ref: marked as forwarded ($data->{subject})",
} else {
&htmllog("Reply","sent",$replyto,"You have taken responsibility.");
&sendmessage(create_mime_message(
- ["X-Loop" => "$gMaintainerEmail",
+ [@common_headers,
From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
To => $replyto,
Subject => "$gBug#$ref: marked as done ($data->{subject})",
&htmllog("Notification","sent",$data->{originator},
"$gBug acknowledged by developer.");
&sendmessage(create_mime_message(
- ["X-Loop" => "$gMaintainerEmail",
+ [@common_headers,
From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
To => "$data->{originator}",
Subject => "$gBug#$ref closed by $markedby ($header{'subject'})",
"Message-ID" => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
- "In-Reply-To" => "$data->{msgid}",
- References => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
+ (defined $data->{msgid})?("In-Reply-To" => $data->{msgid}):(),
+ References => join(' ',grep {defined $_} ($header{'message-id'},$data->{msgid},'')),
"X-$gProject-PR-Message" => "they-closed $ref",
- "X-$gProject-PR-Package" => "$data->{package}",
- "X-$gProject-PR-Keywords" => "$data->{keywords}",
+ (defined $data->{package})?("X-$gProject-PR-Package" => $data->{package}):(),
+ (defined $data->{keywords})?("X-$gProject-PR-Keywords" => $data->{keywords}):(),
# Only have a X-$gProject-PR-Source when we know the source package
(defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
"Reply-To" => "$ref\@$gEmailDomain",
),
[join("\n",@msg),$orig_report]),'',undef,1);
}
- &appendlog;
+ appendlog($ref,$msg);
}
- &finish;
+ finish();
}
if ($ref<0) { # new bug report
if ($codeletter eq 'U') { # -submitter
&sendmessage(create_mime_message(
- [From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+ [@common_headers,
+ From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
To => $replyto,
Subject => "Message with no $gBug number cannot be sent to submitter! ($subject)",
'Message-ID' => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
messageid => $header{'message-id'},
},
)),'');
- &appendlog;
- &finish;
+ appendlog($ref,$msg);
+ finish();
}
$data->{found_versions} = [];
$data->{fixed_versions} = [];
if (defined $pheader{source}) {
+ # source packages are identified by the src: prefix
$data->{package} = $pheader{source};
+ $data->{package} =~ s/(^|,\s*)/${1}src:/g;
} elsif (defined $pheader{package}) {
$data->{package} = $pheader{package};
+ if ($data->{package} =~ /^src:(.+)/) {
+ $pheader{source} = $1;
+ }
} elsif (defined $config{default_package}) {
$data->{package} = $config{default_package},
}
my $body = message_body_template('mail/process_no_package',
);
&sendmessage(create_mime_message(
- ["X-Loop" => "$gMaintainerEmail",
+ [@common_headers,
From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
To => $replyto,
Subject => "Message with no Package: tag cannot be processed! ($subject)",
baddress => $baddress,
},
),[join("\n", @msg)]), '',undef,1);
- &appendlog;
- &finish;
+ appendlog($ref,$msg);
+ finish();
}
if (defined $config{default_package}) {
$data->{owner}= $pheader{owner};
}
if (defined($pheader{forwarded})) {
- $data->{'forwarded-to'} = $pheader{forwarded};
+ $data->{forwarded} = $pheader{forwarded};
}
- &filelock("nextnumber.lock");
- 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;
+ $ref = new_bug();
+ $newref = $ref;
my $hash = get_hashname($ref);
- &overwrite("db-h/$hash/$ref.log",'');
$data->{originator} = $replyto;
$data->{date} = $intdate;
$data->{subject} = $subject;
);
}
}
- &overwrite("db-h/$hash/$ref.report",
- join("\n",@msg)."\n");
+ overwritefile("db-h/$hash/$ref.report",
+ map {"$_\n"} @msg);
}
&checkmaintainers;
-print DEBUG "maintainers >".join(' ',@maintaddrs)."<\n";
+print {$debugfh} "maintainers >".join(' ',@maintaddrs)."<\n";
my $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
my $newsubject= $subject; $newsubject =~ s/^$gBug#$ref:*\s*//;
my $xcchdr= $header{ 'x-debbugs-cc' } || '';
if ($xcchdr =~ m/\S/) {
- push(@resentccs,$xcchdr);
+ push(@resentccs,get_addresses($xcchdr));
$resentccexplain.= fill_template('mail/xdebbugscc',
{xcchdr => $xcchdr},
);
}
# Send mail to the per bug list subscription too
-push @bccs, "bugs=$ref\@$gListDomain";
+if (defined $config{bug_subscription_domain} and length $config{bug_subscription_domain}) {
+ push @bccs, "bugs=$ref\@$config{bug_subscription_domain}";
+}
if (defined $pheader{source}) {
# Prefix source versions with the name of the source package. They
$resentcc= "Resent-CC: $resentccval\n";
}
+my $common_headers='';
+{
+ my @tmp = @common_headers;
+ while (my ($key,$value) = splice(@tmp, 0,2)) {
+ $common_headers .= qq($key: $value\n);
+ }
+}
if ($codeletter eq 'U') { # sent to -submitter
&htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
- &sendmessage(<<END,[$data->{originator},@resentccs],[@bccs]);
+ my $enc_msg=<<END;
Subject: $gBug#$ref: $newsubject
Reply-To: $replyto, $ref-quiet\@$gEmailDomain
${orgsender}Resent-To: $data->{originator}
-${resentcc}Resent-Date: $tdate
+${resentcc}${common_headers}Resent-Date: $tdate
Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
Resent-Sender: $gMaintainerEmail
X-$gProject-PR-Message: report $ref
X-$gProject-PR-Package: $data->{package}
X-$gProject-PR-Keywords: $data->{keywords}
-${source_pr_header}$fwd
+${source_pr_header}
END
+ chomp $enc_msg;
+ $enc_msg = encode_utf8($enc_msg).$fwd."\n";
+ &sendmessage($enc_msg,[$data->{originator},@resentccs],[@bccs]);
} elsif ($codeletter eq 'B') { # Sent to submit
my $report_followup = $newref ? 'report' : 'followup';
&htmllog($newref ? "Report" : "Information", "forwarded",
"<code>$gBug#$ref</code>".
(length($data->{package})? "; Package <code>".html_escape($data->{package})."</code>" : '').
".");
- &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
+ my $enc_msg=<<END;
Subject: $gBug#$ref: $newsubject
Reply-To: $replyto, $ref\@$gEmailDomain
Resent-From: $header{'from'}
${orgsender}Resent-To: $gSubmitList\@$gListDomain
-${resentcc}Resent-Date: $tdate
+${resentcc}${common_headers}Resent-Date: $tdate
Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
Resent-Sender: $gMaintainerEmail
X-$gProject-PR-Message: $report_followup $ref
X-$gProject-PR-Package: $data->{package}
X-$gProject-PR-Keywords: $data->{keywords}
-${source_pr_header}$fwd
+${source_pr_header}
END
+ chomp $enc_msg;
+ $enc_msg = encode_utf8($enc_msg).$fwd."\n";
+ &sendmessage($enc_msg,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
} elsif (@resentccs or @bccs) { # Quiet or Maintainer
# D and F done far earlier; B just done - so this must be M or Q
# We preserve whichever it was in the Reply-To (possibly adding
(length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
".");
}
- &sendmessage(<<END,[@resentccs],[@bccs]);
+ my $enc_msg=<<END;
Subject: $gBug#$ref: $newsubject
Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
Resent-From: $header{'from'}
Resent-Date: $tdate
Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
Resent-Sender: $gMaintainerEmail
-X-$gProject-PR-Message: $report_followup $ref
+${common_headers}X-$gProject-PR-Message: $report_followup $ref
X-$gProject-PR-Package: $data->{package}
X-$gProject-PR-Keywords: $data->{keywords}
-${source_pr_header}$fwd
+${source_pr_header}
END
+ chomp $enc_msg;
+ $enc_msg = encode_utf8($enc_msg).$fwd."\n";
+ &sendmessage($enc_msg,[@resentccs],[@bccs]);
}
my $htmlbreak= length($brokenness) ? "<p>\n".html_escape($brokenness)."\n<p>\n" : '';
}
);
&sendmessage(create_mime_message(
- ["X-Loop" => "$gMaintainerEmail",
+ [@common_headers,
From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
To => $replyto,
Subject => $t_h{subject},
],$body,[]), '',undef,1);
}
-&appendlog;
-&finish;
+appendlog($ref,$msg);
+# unlock the locks we have received
+while ($locks--) {unfilelock();}
+
+## handle control messages at this point, immediately before finishing
+my %clonebugs = (-1 => $ref);
+my %bug_affected;
+if (@control_bits) {
+ my $transcript_scalar = '';
+ open my $transcript, ">:scalar:utf8", \$transcript_scalar or
+ die "Unable to create transcript scalar: $!";
+ print {$transcript} "Processing control commands:\n\n";
+ my %affected_packages;
+ my %recipients;
+ # this is the hashref which is passed to all control calls
+ my %limit = ();
+ my $errors = 0;
+ my $unknowns = 0;
+
+ my @common_control_options =
+ (transcript => $transcript,
+ requester => $header{from},
+ request_addr => $baddress.'@'.$config{email_domain},
+ request_msgid => $header{'message-id'},
+ request_subject => $header{subject},
+ request_nn => $nn,
+ request_replyto => $replyto,
+ message => [$msg],
+ affected_bugs => \%bug_affected,
+ affected_packages => \%affected_packages,
+ recipients => \%recipients,
+ limit => \%limit,
+ );
+ if (@gExcludeFromControl and grep {$replyto =~ m/\Q$_\E/} @gExcludeFromControl) {
+ print {$transcript} fill_template('mail/excluded_from_control');
+ print {$transcript} "Stopping processing here.\n\n";
+ } else {
+ for my $control_bit (@control_bits) {
+ $control_bit =~ s/\xef\xbb\xbf//g;
+ next unless $control_bit =~ m/\S/;
+ eval {
+ my $temp = decode("utf8",$control_bit,Encode::FB_CROAK);
+ $control_bit = $temp;
+ };
+ print {$transcript} "> $control_bit\n";
+ next if $control_bit =~ /^\s*\#/;
+ my $action = '';
+ my $ok;
+ if (defined valid_control($control_bit)) {
+ my ($new_errors,$terminate_control) =
+ control_line(line => $control_bit,
+ clonebugs => \%clonebugs,
+ limit => \%limit,
+ common_control_options => \@common_control_options,
+ errors => \$errors,
+ transcript => $transcript,
+ debug => 0,
+ ok => \$ok,
+ replyto => $replyto,
+ );
+ if ($terminate_control) {
+ last;
+ }
+ }
+ else {
+ print {$transcript} "Unknown command or malformed arguments to command.\n\n";
+ $errors++;
+ if (++$unknowns >= 5) {
+ print {$transcript} "Too many unknown commands, stopping here.\n\n";
+ last;
+ }
+ }
+ }
+ }
+ my $temp_transcript = $transcript_scalar;
+ eval{
+ $temp_transcript = decode("utf8",$temp_transcript,Encode::FB_CROAK);
+ };
+ my @maintccs = determine_recipients(recipients => \%recipients,
+ address_only => 1,
+ cc => 1,
+ );
+ my $error_text = $errors > 0 ? " (with $errors error" . ($errors > 1 ? "s" : "") . ")" : "";
+ my $reply =
+ create_mime_message(['X-Loop' => $gMaintainerEmail,
+ From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
+ To => $replyto,
+ @maintccs ? (Cc => join(', ',@maintccs)):(),
+ Subject => "Processed${error_text}: $header{subject}",
+ 'Message-ID' => "<handler.s.$nn.transcript\@$gEmailDomain>",
+ 'In-Reply-To' => $header{'message-id'},
+ References => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
+ Precedence => 'bulk',
+ keys %affected_packages ?("X-${gProject}-PR-Package" => join(' ',keys %affected_packages)):(),
+ keys %affected_packages ?("X-${gProject}-PR-Source" =>
+ join(' ',
+ map {defined $_ ?(ref($_)?@{$_}:$_):()}
+ binary_to_source(binary => [keys %affected_packages],
+ source_only => 1))):(),
+ "X-$gProject-PR-Message" => 'transcript',
+ @common_headers,
+ ],
+ fill_template('mail/message_body',
+ {body => $temp_transcript},
+ ));
+
+ utime(time,time,"db-h");
+
+ send_mail_message(message => $reply,
+ recipients => [exists $header{'x-debbugs-no-ack'}?():$replyto,
+ make_list(values %{{determine_recipients(recipients => \%recipients,
+ address_only => 1,
+ )}}
+ ),
+ ]
+ );
-sub overwrite {
- my ($f,$v) = @_;
- 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: $!";
}
+
+finish();
+
sub appendlog {
- 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";
- die "opening 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): $!";
+ my ($ref,$msg) = @_;
+ my $log_location = buglog($ref);
+ die "Unable to find .log for $ref"
+ if not defined $log_location;
+ my $logfh = IO::File->new(">>$log_location") or
+ die "Unable to open $log_location for appending: $!";
+ write_log_records(logfh => $logfh,
+ records => [{type => 'incoming-recv',
+ text => $msg,
+ }]);
+ close ($logfh) or die "Unable to close $log_location: $!";
}
sub finish {
my $hash = get_hashname($ref);
#save email to the log
- 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") ||
- die "writing db-h/$hash/$ref.log (lo): $!";
- close(AP) || die "closing db-h/$hash/$ref.log (lo): $!";
-
+ my $logfh = IO::File->new(">>db-h/${hash}/${ref}.log") or
+ die "opening db-h/$hash/${ref}.log: $!";
+ write_log_records(logfh => $logfh,
+ records => {text => stripbccs($msg),
+ type => 'recips',
+ recips => [map {encode_utf8($_)} @{$recips}],
+ },
+ );
if (ref($bcc)) {
shift @$recips if $recips->[0] eq '-t';
push @$recips, @$bcc;
my $variables = {config => \%config,
defined($ref)?(ref => $ref):(),
defined($data)?(data => $data):(),
+ refs => [map {exists $clonebugs{$_}?$clonebugs{$_}:$_} keys %bug_affected],
%{$extra_var},
};
my $hole_var = {'&bugurl' =>
sub{"$_[0]: ".
- 'http://'.$config{cgi_domain}.'/'.
+ $config{cgi_domain}.'/'.
Debbugs::CGI::bug_links(bug=>$_[0],
links_only => 1,
);
}
+# this shole routine is *bad*; will be changed to use
+# Debbugs::Recipients and stuff therin in short order.
sub checkmaintainers {
return if $maintainerschecked++;
return if !length($data->{package});
- my %maintainerof;
- open(MAINT,"$gMaintainerFile") || die die "maintainers open: $!";
- while (<MAINT>) {
- m/^\n$/ && next;
- m/^\s*$/ && next;
- 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 die "maintainers.override open: $!";
- while (<MAINT>) {
- m/^\n$/ && next;
- m/^\s*$/ && next;
- 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") || die "pkgsrc open: $!";
- while (<SOURCES>) {
- next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
- ($a,$b)=($1,$2);
- $a =~ y/A-Z/a-z/;
- $pkgsrc{$a} = $b;
- }
- close(SOURCES);
+
my $anymaintfound=0; my $anymaintnotfound=0;
- for my $p (split(m/[ \t?,():]+/,$data->{package})) {
+ for my $p (splitpackages($data->{package})) {
$p =~ y/A-Z/a-z/;
- $p =~ /([a-z0-9.+-]+)/;
+ $p =~ /((?:src:)?[a-z0-9.+-]+)/;
$p = $1;
next unless defined $p;
- if (defined $gSubscriptionDomain) {
- if (defined($pkgsrc{$p})) {
- push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
+ if (defined $config{subscription_domain} and length $config{subscription_domain}) {
+ my @source = binary_to_source(binary => $p,
+ source_only => 1,
+ );
+ if (@source) {
+ push @addsrcaddrs,
+ map {"$_\@$config{subscription_domain}"} @source;
} else {
- push @addsrcaddrs, "$p\@$gSubscriptionDomain";
+ push @addsrcaddrs, "$p\@$config{subscription_domain}";
}
}
- if (defined($maintainerof{$p})) {
- print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
- my $addmaint= $maintainerof{$p};
- push(@maintaddrs,$addmaint) unless
- $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
+ # this is utter hackery until we switch to Debbugs::Recipients
+ my @maints = package_maintainer(binary => $p);
+ if (@maints) {
+ print {$debugfh} "maintainer add >$p|".join(',',@maints)."<\n";
+ my %temp;
+ @temp{@maintaddrs} = @maintaddrs;
+ push(@maintaddrs,
+ grep {$_ ne $replyto and
+ not exists $temp{$_}} @maints);
$anymaintfound++;
} else {
- print DEBUG "maintainer none >$p<\n";
+ print {$debugfh} "maintainer none >$p<\n";
push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
$anymaintnotfound++;
last;
}
if (defined $data->{owner} and length $data->{owner}) {
- print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
+ print {$debugfh} "owner add >$data->{package}|$data->{owner}<\n";
my $addmaint = $data->{owner};
push(@maintaddrs, $addmaint) unless
$addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
my ($bug_fn) = @_;
# Read the bug information and package information for passing to
# the mailing list
+ my $bug_fh = IO::File->new("incoming/P$bug_fn",'r') or
+ die "Unable to open incoming/P$bug_fn $!";
+
+ if (not defined $config{bug_subscription_domain} or not
+ length $config{bug_subscription_domain}) {
+ unlink("incoming/P$bug_fn") or
+ die "unlinking incoming/P$bug_fn: $!";
+ exit 0;
+ }
+
my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
- my ($bfound, $data)= lockreadbugmerge($bug_number);
- my $bug_fh = IO::File->new("incoming/P$bug_fn",'r') or die "Unable to open incoming/P$bug_fn $!";
+ my $data = read_bug(bug => $bug_number);
local $/ = undef;
my $bug_message = <$bug_fh>;
if defined $data;
print STDERR "Tried to loop me with $envelope_from\n"
and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
- print DEBUG $envelope_from,qq(\n);
+ print {$debugfh} $envelope_from,qq(\n);
# If we don't have a bug address, something has gone horribly wrong.
print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
$bug_address =~ s/\@.+//;
- print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
- print DEBUG $header.qq(\n\n).$body;
+ print {$debugfh} "Sending message to bugs=$bug_address\@$config{bug_subscription_domain}\n";
+ print {$debugfh} $header.qq(\n\n).$body;
send_mail_message(message => $header.qq(\n\n).$body,
- recipients => ["bugs=$bug_address\@$gListDomain"],
+ recipients => ["bugs=$bug_address\@$config{bug_subscription_domain}"],
envelope_from => $envelope_from,
encode_headers => 0,
);
projects / debbugs.git / blobdiff