#!/usr/bin/perl
-# $Id: process.in,v 1.109 2006/02/09 22:02:04 don Exp $
-#
-# Usage: process nn
-# Temps: incoming/Pnn
use warnings;
use strict;
use Debbugs::Control qw(append_action_to_log);
use Debbugs::Control::Service qw(valid_control control_line);
use Debbugs::Recipients qw(determine_recipients);
+use Debbugs::Incomming;
use Encode qw(encode_utf8 decode);
=head1 NAME
my %options = (debug => 0,
help => 0,
man => 0,
+ spool => $config{spool_dir},
);
GetOptions(\%options,
'debug|d+','help|h|?','man|m');
+$DEBUG=$options{debug};
+
pod2usage() if $options{help};
pod2usage({verbose=>2}) if $options{man};
+my @USAGE_ERRORS;
-$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;
+if (@ARGV != 1) {
+ push @USAGE_ERRORS,"You must provide exactly one incomming mail message";
}
+pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
-# 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}): $!";
-
-umask(002);
-
-my $intdate = time or die "failed to get time: $!";
-
-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";
-}
-# die here to avoid continuously processing this mail
-if (not exists $baddress{$codeletter}) {
- die "bad codeletter $codeletter";
+my $msg =
+ Debbugs::Incoming->new($ARGV[0]) or
+ die "Unable to start processing message $ARGV[0]";
+
+if ($msg->bug_address eq 'list') { # this message is list administrivia
+ bug_list_forward($msg);
}
-my $baddress = $baddress{$codeletter};
-if ($baddress eq 'list') {
- bug_list_forward($nn) if $codeletter eq 'L';
+my $ph = $msg->pseudoheaders();
+my $new_bug = 0;
+# create the bug if necessary
+if (not defined $msg->bug_num) {
+ # if this message was sent to -submitter, error out
+ if ($msg->bug_address eq 'submitter') {
+ $msg->send_reply({message => 'error',
+ template => 'process_no_bug_number',
+ type => 'nonumnosub',
+ });
+ $msg->finish;
+ exit 0;
+ }
+ if (not defined $ph->{source} and
+ not defined $ph->{package} and
+ not defined $config{default_package}
+ ) {
+ $msg->send_reply({message => 'error',
+ template => 'process_no_package',
+ type => 'nopkgnosub',
+ });
+ $msg->finish;
+ exit 0;
+ }
+ $msg->bug_num(new_bug());
+ $new_bug = 1;
+}
+# load the bug data for this bug
+my ($locks_recv,@data) = lock_read_all_merged_bugs($msg->bug_num);
+if (not $locks_recv or $data[0]->{archived}) {
+ unfilelock() while ($locks_recv--);
+ $msg->send_reply({message=> 'error',
+ template => 'process_unknown_bug_number',
+ type => 'unknown',
+ });
+ $msg->finish();
+}
+# write the received message to the log
+$msg->append_to_log($_->{bug_num}) foreach @data;
+
+# if this is a new bug, add the appropriate new control actions
+if ($new_bug) {
+ # figure out the package
+ my $package = $config{default_package};
+ if (defined $ph->{source} and length $ph->{source}) {
+
+ }
+ unshift @{$ph->{control}}
}
+# perform control actions if necessary
+
+# send the received message to recipients
my $baddressroot= $baddress;
$baddress= "$tryref-$baddress" if defined $tryref;
-my $msg;
-my @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);
-}
-
-
my $tdate = strftime "%a, %d %h %Y %T +0000", gmtime;
my $fwd= "Received: via spool by $baddress\@$gEmailDomain id=$nn\n".
" (code $codeletter".(defined($tryref)?" ref $tryref":'')."); $tdate\n";
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";
- my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
- && !m/^From / && !m/^X-Debbugs-/i;
- $fwd .= $hdr."\n" if $ins;
+ my $ins = !m/^(?:(?:subject|reply-to|return-path|mail-followup-to):
+ |From\s|X-Debbugs-)/xi;
+ $fwd .= encode_utf8($hdr)."\n" if $ins;
# print {$debugfh} ">$_<\n";
if (s/^(\S+):\s*//) {
my $v = lc $1;
# 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*$//;
+ # pluralize tag/usertag
+ $fn = $fn.'s' if $fn =~ /^(?:tag|usertag)$/;
print {$debugfh} ">$fn|$fv|\n";
$fn = lc $fn;
if ($fn =~ /^control$/) {
# set $i to beginning of encoded body data, so we can dump it out
# verbatim later
my $i = 0;
-++$i while $msg[$i] =~ /./;
+++$i while $i <= $#msg and $msg[$i] =~ /./;
$fwd .= join("\n",@msg[$i..$#msg]);
+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;
# remove Re: from the subject line
$subject =~ s/^Re:\s*//i;
-# remove remaining mailing list name markers from the subject line
-$subject =~ s/^\[.*\]\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;
"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",
+ "Content-Type" => 'text/plain; charset="utf-8"',
],message_body_template('mail/process_mark_as_forwarded',
{date => $header{date},
messageid => $header{'message-id'},
"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",
+ "Content-Type" => 'text/plain; charset="utf-8"',
],message_body_template('mail/process_mark_as_done',
{date => $header{date},
messageid => $header{'message-id'},
Subject => "$gBug#$ref closed by $markedby ($header{'subject'})",
"Message-ID" => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
(defined $data->{msgid})?("In-Reply-To" => $data->{msgid}):(),
- References => join(' ',grep {defined $_} ($header{'message-id'},$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",
if (defined $pheader{source}) {
# source packages are identified by the src: prefix
- $data->{package} = 'src:'.$pheader{source};
+ $data->{package} = $pheader{source};
+ $data->{package} =~ s/(^|,\s*)/${1}src:/g;
} elsif (defined $pheader{package}) {
$data->{package} = $pheader{package};
if ($data->{package} =~ /^src:(.+)/) {
request_subject => $header{subject},
request_nn => $nn,
request_replyto => $replyto,
- message => $msg,
+ message => [$msg],
affected_bugs => \%bug_affected,
affected_packages => \%affected_packages,
recipients => \%recipients,
}
}
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";
address_only => 1,
cc => 1,
);
- my $error_text = $errors > 0 ? " (with $errors errors)":'';
+ 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)",
write_log_records(logfh => $logfh,
records => {text => stripbccs($msg),
type => 'recips',
- recips => [@{$recips}],
+ recips => [map {encode_utf8($_)} @{$recips}],
},
);
if (ref($bcc)) {
};
my $hole_var = {'&bugurl' =>
sub{"$_[0]: ".
- 'http://'.$config{cgi_domain}.'/'.
+ $config{cgi_domain}.'/'.
Debbugs::CGI::bug_links(bug=>$_[0],
links_only => 1,
);
unlink("incoming/P$bug_fn") || die "unlinking incoming/P$bug_fn: $!";
exit 0;
}
+
+sub DEBUG {
+ return unless $DEBUG;
+ print STDERR
+ map {defined $_?encode_utf8($_):()} @_;
+}
+sub DEBUG_RAW {
+ return unless $DEBUG;
+ print STDERR @_;
+}
+
+
+__END__
+# Local Variables:
+# indent-tabs-mode: nil
+# cperl-indent-level: 4
+# End:
projects / debbugs.git / blobdiff