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 get_addresses);
-use Debbugs::Packages qw(getpkgsrc);
+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 read_bug :versions);
+use Debbugs::Common qw(:lock get_hashname buglog package_maintainer overwritefile);
+use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug new_bug read_bug splitpackages :versions);
use Debbugs::CGI qw(html_escape bug_url);
-use Debbugs::Log qw(:misc);
+use Debbugs::Log qw(:misc :write);
use Debbugs::Text qw(:templates);
use Debbugs::Config qw(:globals :config);
use Debbugs::Control qw(append_action_to_log);
+use Encode qw(encode_utf8);
-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;
+}
+
+# these are the valid bug addresses
+my %baddress = (B => 'submit',
+ M => 'maintonly',
+ Q => 'quiet',
+ F => 'forwarded',
+ D => 'done',
+ S => '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) {
$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";
+ # 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)
{
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 $msg[$i] =~ /./;
$fwd .= join("\n",@msg[$i..$#msg]);
-print DEBUG "***\n$fwd\n***\n";
+print {$debugfh} "***\n$fwd\n***\n";
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;
+if (not defined $tryref and m/^Bug ?\#(\d+)\D/i) {
+ $tryref = $1 if $1 > 0;
}
my $data;
-if ($tryref >= 0)
-{
+if (defined $tryref) {
my $bfound;
($bfound, $data)= &lockreadbugmerge($tryref);
if ($bfound and not $data->{archived}) {
References => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
Precedence => 'bulk',
"X-$gProject-PR-Message" => 'error',
+ @common_headers,
],message_body_template('mail/process_unknown_bug_number',
{subject => $subject,
date => $header{date},
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;
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'})",
),
[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->{package} = 'src:'.$pheader{source};
} 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*//;
$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;
-
-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: $!";
-}
+appendlog($ref,$msg);
+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 => [@{$recips}],
+ },
+ );
if (ref($bcc)) {
shift @$recips if $recips->[0] eq '-t';
push @$recips, @$bcc;
}
+# 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";
+ my @source = binary_to_source(binary => $p,
+ source_only => 1,
+ );
+ if (@source) {
+ push @addsrcaddrs,
+ map {"$_\@$gSubscriptionDomain"} @source;
} else {
push @addsrcaddrs, "$p\@$gSubscriptionDomain";
}
}
- 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);
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\@$config{bug_subscription_domain}\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\@$config{bug_subscription_domain}"],
envelope_from => $envelope_from,
projects / debbugs.git / blobdiff