debbugs 2.6.0 / usr / lib / debbugs / process

#!/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 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 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 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_links);

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 Debbugs::Control::Service qw(valid_control control_line);
use Debbugs::Recipients qw(determine_recipients);
use Encode qw(encode_utf8 decode);

=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}): $!";

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 $baddress = $baddress{$codeletter};
if ($baddress eq 'list') {
    bug_list_forward($nn) if $codeletter eq 'L';
}


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";

# header and decoded body respectively
my (@headerlines, @bodylines);

# whether maintainer addresses have been checked
our $maintainerschecked = 0;
#maintainer address for this message
our @maintaddrs;
# other src addresses
our @addsrcaddrs;
our @resentccs;
our @bccs;

my $resentccexplain='';

# whether there's a new reference with this email
our $newref = 0;

our $brokenness = '';

my $parser_output = Debbugs::MIME::parse($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";
    my $ins = !m/^(?:(?:subject|reply-to|return-path|
			 mail-followup-to|
			 references):
		 |From\s|X-Debbugs-)/xi;
    $fwd .= encode_utf8($hdr)."\n" if $ins;
    # print {$debugfh} ">$_<\n";
    if (s/^(\S+):\s*//) {
	my $v = lc $1;
	if ($v eq 'x-loop') {
	    push @common_headers, 'X-Loop',$_;
	}
	print {$debugfh} ">$v=$_<\n";
	$header{$v} = $_;
    } else {
	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/;

# Strip off RFC2440-style PGP clearsigning.
if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
    shift @bodylines while @bodylines and length $bodylines[0];
    shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
    for my $findsig (0 .. $#bodylines) {
	if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
	    $#bodylines = $findsig - 1;
	    last;
	}
    }
    map { s/^- // } @bodylines;
}

#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-]+): # psuedoheader
			 (?:\s|\N{U+00A0})* # zero or more spaces, including
                                            # non-breaking space
			 (\S.*)/x; # pseudoheader value
    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$/) {
	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]
for my $key (grep /X-Debbugs-.*/i, keys %pheader) {
     $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]);

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'};
}
defined($header{'from'}) || die "no From header";

my $replyto = $header{'reply-to'};
$replyto = '' unless defined $replyto;
$replyto =~ s/^ +//;
$replyto =~ s/ +$//;
unless (length $replyto) {
    $replyto = $header{'from'};
}

my $subject = '(no subject)';
if (!defined($header{'subject'})) 
{
	$brokenness.= fill_template('mail/process_broken_subject');

} else { 
    $subject= $header{'subject'}; 
}

my $ref=-1;
# 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 (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          =>  qq("$gProject $gBug Tracking System" <$gMaintainerEmail>),
	   To            => $replyto,
	   Subject       => "Unknown problem report $gBug#$tryref ($subject)",
	   'Message-ID'  => "<handler.x.$nn.unknown\@$gEmailDomain>",
	   'In-Reply-To' => $header{'message-id'},
	   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},
				   baddress => $baddress,
				   tryref   => $tryref,
				   messageid => $header{'message-id'},
				  },
				 )),'');
        appendlog($ref,$msg);
        finish();
    }
} else { 
    &filelock('lock/-1'); 
}

# Attempt to determine which source package this is
my $source_pr_header = '';
my $source_package = '';
if (defined $pheader{source}) {
     $source_package = $pheader{source};
}
elsif (defined $data->{package} or defined $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;

# Done and Forwarded Bugs
if ($codeletter eq 'D' || $codeletter eq 'F') 
{
    if ($replyto =~ m/$gBounceFroms/o ||
        $header{'from'} =~ m/$gBounceFroms/o)
    {
	 print STDERR "bounce detected !  Mwaap! Mwaap!";
	 exit 1;
    }
    my $markedby= $header{'from'} eq $replyto ? $replyto :
               "$header{'from'} (reply to $replyto)";
    my @generalcc;
    my $receivedat;
    my $markaswhat;
    my $set_forwarded;
    my $generalcc;
    my $set_done;
    if ($codeletter eq 'F') { # Forwarded
        (appendlog($ref,$msg),finish()) if defined $data->{forwarded} and length($data->{forwarded});
        $receivedat= "forwarded\@$gEmailDomain";
        $markaswhat= 'forwarded';
        $set_forwarded= $header{'to'};
	# Dissallow forwarded being set to this bug tracking system
	if (defined $set_forwarded and $set_forwarded =~ /\Q$gEmailDomain\E/) {
	     undef $set_forwarded;
	}
	if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
	    push @generalcc, "$gForwardList\@$gListDomain";
	    $generalcc= "$gForwardList\@$gListDomain";
	} else { 
	    $generalcc='';
        }
    } else { # Done
        if (defined $data->{done} and length($data->{done}) and
                not defined $pheader{'source-version'} and
                not defined $pheader{'version'}) {
            appendlog($ref,$msg);
            finish();
        }
        $receivedat= "done\@$gEmailDomain";
        $markaswhat= 'done';
        $set_done= $header{'from'};
	if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
            $generalcc= "$gDoneList\@$gListDomain";
	    push @generalcc, "$gDoneList\@$gListDomain";
	} else { 
	    $generalcc=''; 
	}
    }
    if (defined $gStrongList and isstrongseverity($data->{severity})) {
        $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
	push @generalcc,"$gStrongList\@$gListDomain";
    }
    if ($ref<0) {
	&sendmessage(create_mime_message(
          [From          => qq("$gProject $gBug Tracking System" <$gMaintainerEmail>),
	   To            => $replyto,
	   Subject       => "Message with no $gBug number ignored by $receivedat ($subject)",
	   'Message-ID'  => "<handler.x.$nn.warnignore\@$gEmailDomain>",
	   'In-Reply-To' => $header{'message-id'},
	   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},
				   markaswhat => $markaswhat,
				   receivedat => $receivedat,
				   messageid => $header{'message-id'},
				  },
				 )),'');
	appendlog($ref,$msg);
	finish();
    }

    &checkmaintainers;

    my @noticecc = grep($_ ne $replyto,@maintaddrs);
    my $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
    $noticeccval =~ s/\s+\n\s+/ /g; 
    $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;

    my @process= ($ref,split(/ /,$data->{mergedwith}));
    my $orgref= $ref;

    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);
        if ($codeletter eq 'D') {
            $data->{keywords} = join ' ', grep $_ ne 'pending',
                                     split ' ', $data->{keywords};
            if (defined $pheader{'source-version'}) {
		 if ($pheader{'source-version'} !~ m/^$config{package_version_re}$/) {
		      $brokenness .= fill_template('mail/invalid_version',
						   {version => $pheader{'source-version'}},
						  );
		 }
		 else {
		      addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
		 }
	    } elsif (defined $pheader{version}) {
		 if ($pheader{version} !~ m/^$config{package_version_re}$/) {
		      $brokenness .= fill_template('mail/invalid_version',
						   {version => $pheader{version}},
						  );
		 }
		 else {
		      addfixedversions($data, $pheader{package}, $pheader{version}, '');
		 }
	    }
        }

	# 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;
	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);
	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(
	     [@common_headers,
	      From          => qq("$gProject $gBug Tracking System" <$gMaintainerEmail>),
              To            => "$replyto",
              Subject       => "$gBug#$ref: marked as forwarded ($data->{subject})",
              "Message-ID"  => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
              "In-Reply-To" => $header{'message-id'},
              References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
              Precedence    => 'bulk',
              "X-$gProject-PR-Message"  => "forwarded $ref",
              "X-$gProject-PR-Package"  => $data->{package},
              "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'},
				      data      => $data,
				     },
				    ),
	     [join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
        } else {
	    &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
            &sendmessage(create_mime_message(
	     [@common_headers,
	      From          => qq("$gProject $gBug Tracking System" <$gMaintainerEmail>),
              To            => $replyto,
              Subject       => "$gBug#$ref: marked as done ($data->{subject})",
              "Message-ID"  => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
              "In-Reply-To" => $header{'message-id'},
              References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
              Precedence    => 'bulk',
              "X-$gProject-PR-Message"  => "closed $ref",
              "X-$gProject-PR-Package"  => $data->{package},
              "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   => $header{subject},
				      data      => $data,
				     },
				    ),
	     [$orig_report,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
            &htmllog("Notification","sent",$data->{originator},
		"$gBug acknowledged by developer.");
            &sendmessage(create_mime_message(
	     [@common_headers,
	      From          => qq("$gProject $gBug Tracking System" <$gMaintainerEmail>),
              To            => "$data->{originator}",
              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},'')),
              "X-$gProject-PR-Message"  => "they-closed $ref",
              (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",
              "Content-Type"            => 'text/plain; charset="utf-8"',
             ],message_body_template('mail/process_your_bug_done',
				     {data      => $data,
				      markedby  => $markedby,
				      messageid => $header{'message-id'},
				      subject   => $header{subject},
				     },
				    ),
	     [join("\n",@msg),$orig_report]),'',undef,1);
        }
	appendlog($ref,$msg);
    }
    finish();
}

if ($ref<0) { # new bug report
    if ($codeletter eq 'U') { # -submitter
	&sendmessage(create_mime_message(
          [@common_headers,
	   From          => qq("$gProject $gBug Tracking System" <$gMaintainerEmail>),
	   To            => $replyto,
	   Subject       => "Message with no $gBug number cannot be sent to submitter! ($subject)",
	   'Message-ID'  => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
	   'In-Reply-To' => $header{'message-id'},
	   References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
	   Precedence    => 'bulk',
	   "X-$gProject-PR-Message" => 'error',
	  ],message_body_template('mail/process_no_bug_number',
				  {subject => $subject,
				   date    => $header{date},
				   markaswhat => 'submitter',
				   receivedat => "$baddress\@$gEmailDomain",
				   messageid => $header{'message-id'},
				  },
				 )),'');
	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},
    }
    else {
	my $body = message_body_template('mail/process_no_package',
					);
        &sendmessage(create_mime_message(
                       [@common_headers,
			From          => qq("$gProject $gBug Tracking System" <$gMaintainerEmail>),
                        To            => $replyto,
                        Subject       => "Message with no Package: tag cannot be processed! ($subject)",
                        "Message-ID"  => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
                        "In-Reply-To" => $header{'message-id'},
                        References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
                        Precedence    => 'bulk',
                        "X-$gProject-PR-Message" => 'error'
		       ],
	   message_body_template('mail/process_no_package',
				 {date => $header{date},
				  subject => $subject,
				  messageid => $header{'message-id'},
				  baddress => $baddress,
				 },
				),[join("\n", @msg)]), '',undef,1);
	appendlog($ref,$msg);
	finish();
    }

    if (defined $config{default_package}) {
	 &checkmaintainers;
	 # if there are no maintainers for this package, assign it to the default package
	 if (not @maintaddrs) {
	      $data->{package} = $config{default_package};
	      $brokenness.= fill_template('mail/process_default_package_selected',
					  {old_package => $pheader{source} || $pheader{package} || 'No package',
					   new_package => $data->{package},
					  }
					 );
	      # force the maintainers to be rechecked
	      $maintainerschecked = 0;
	      &checkmaintainers;
	 }
    }

    $data->{keywords}= '';
    if (defined($pheader{'keywords'})) {
        $data->{keywords}= $pheader{'keywords'};
    } elsif (defined($pheader{'tags'})) {
        $data->{keywords}= $pheader{'tags'};
    }
    if (length($data->{keywords})) {
        my @kws;
        my %gkws = map { ($_, 1) } @gTags;
        foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
            push @kws, $kw if (defined $gkws{$kw});
        }
        $data->{keywords} = join(" ", @kws);
    }
    $data->{severity}= '';
    if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
 	$data->{severity}= $pheader{'severity'};
	$data->{severity}= $pheader{'priority'} unless ($data->{severity});
	$data->{severity} =~ s/^\s*(.+)\s*$/$1/;

	if (!grep($_ eq $data->{severity}, @gSeverityList, "$gDefaultSeverity")) {
            $brokenness.= fill_template('mail/invalid_severity',
					{severity=>$data->{severity}}
				       );
            $data->{severity}= '';
        }
    }
    if (defined($pheader{owner})) {
        $data->{owner}= $pheader{owner};
    }
    if (defined($pheader{forwarded})) {
	$data->{forwarded} = $pheader{forwarded};
    }
    $ref = new_bug();
    $newref = $ref;
    my $hash = get_hashname($ref);
    $data->{originator} = $replyto;
    $data->{date} = $intdate;
    $data->{subject} = $subject;
    $data->{msgid} = $header{'message-id'};
    writebug($ref, $data);
    # Deal with usertags
    if (exists $pheader{usertags}) {
	 my $user = $replyto;
	 $user = $pheader{user} if exists $pheader{user};
	 $user =~ s/,.*//;
	 $user =~ s/^.*<(.*)>.*$/$1/;
	 $user =~ s/[(].*[)]//;
	 $user =~ s/^\s*(\S+)\s+.*$/$1/;
	 if ($user ne '' and Debbugs::User::is_valid_user($user)) {
	      $pheader{usertags} =~ s/(?:^\s+|\s+$)//g;
	      my %user_tags;
	      read_usertags(\%user_tags,$user);
	      for my $tag (split /[,\s]+/, $pheader{usertags}) {
		   if ($tag =~ /^[a-zA-Z0-9.+\@-]+/) {
			my %bugs_with_tag; 
			@bugs_with_tag{@{$user_tags{$tag}||[]}} = (1) x @{$user_tags{$tag}||[]};
			$bugs_with_tag{$ref} = 1;
			$user_tags{$tag} = [keys %bugs_with_tag];
		   }
	      }
	      write_usertags(\%user_tags,$user);
	 }
	 else {
	      $brokenness .= fill_template('mail/invalid_user',
					   {user => $user}
					  );
	 }
    }
    overwritefile("db-h/$hash/$ref.report",
		  map {"$_\n"} @msg);
}

&checkmaintainers;

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,get_addresses($xcchdr));
    $resentccexplain.= fill_template('mail/xdebbugscc',
				     {xcchdr => $xcchdr},
				    );
}

if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
    push(@resentccs,@maintaddrs);
    $resentccexplain.= fill_template('mail/maintainercc',
				     {maintaddrs => \@maintaddrs,
				     },
				    );
}

@bccs = @addsrcaddrs;
if (defined $gStrongList and isstrongseverity($data->{severity})) {
    push @bccs, "$gStrongList\@$gListDomain";
}

# Send mail to the per bug list subscription too
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
    # appear that way in version trees so that we can deal with binary
    # packages moving from one source package to another.
    if (defined $pheader{'source-version'}) {
	 if ($pheader{'source-version'} !~ m/^$config{package_version_re}$/) {
	      $brokenness .= fill_template('mail/invalid_version',
					   {version => $pheader{'source-version'}},
					  );
	 }
	 else {
	      addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
	 }
    } elsif (defined $pheader{version}) {
	 if ($pheader{version} !~ m/^$config{package_version_re}$/) {
	      $brokenness .= fill_template('mail/invalid_version',
					   {version => $pheader{version}},
					  );
	 }
	 else {
	      addfoundversions($data, $pheader{source}, $pheader{version}, '');
	 }
    }
    writebug($ref, $data);
} elsif (defined $pheader{package}) {
    # TODO: could handle Source-Version: by looking up the source package?
     if (defined $pheader{version}) {
	  if ($pheader{version} !~ m/^$config{package_version_re}$/) {
	       $brokenness .= fill_template('mail/invalid_version',
					    {version => $pheader{version}},
					   );
	  }
	  else {
	       addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
	  }
     }
     writebug($ref, $data);
}

my $veryquiet= $codeletter eq 'Q';
if ($codeletter eq 'M' && !@maintaddrs) {
    $veryquiet= 1;
    $brokenness.= fill_template('mail/invalid_maintainer',
				{},
			       );
}

my $resentccval.= join(', ',@resentccs);
$resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
my $resentcc = '';
if (length($resentccval)) { 
    $resentcc= "Resent-CC: $resentccval\n"; 
}

my $referencesval = join(' ',grep {defined $_} $header{'references'},$data->{msgid});
my $references = '';
if (!$newref && length($referencesval)) {
    $references = "References: $referencesval\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.");
    my $enc_msg=<<END;
Subject: $gBug#$ref: $newsubject
Reply-To: $replyto, $ref-quiet\@$gEmailDomain
${orgsender}Resent-To: $data->{originator}
${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}
${references}${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",
             join(', ',"$gSubmitList\@$gListDomain",@resentccs),
             "<code>$gBug#$ref</code>".
             (length($data->{package})? "; Package <code>".html_escape($data->{package})."</code>" : '').
             ".");
    my $enc_msg=<<END;
Subject: $gBug#$ref: $newsubject
Reply-To: $replyto, $ref\@$gEmailDomain
Resent-From: $header{'from'}
${orgsender}Resent-To: $gSubmitList\@$gListDomain
${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}
${references}${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
    # the $gBug#).
    my $report_followup = $newref ? 'report' : 'followup';
    if (@resentccs) {
        &htmllog($newref ? "Report" : "Information", "forwarded",
                 $resentccval,
                 "<code>$gBug#$ref</code>".
                 (length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
                 ".");
    } else {
        &htmllog($newref ? "Report" : "Information", "stored",
                 "",
                 "<code>$gBug#$ref</code>".
                 (length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
                 ".");
    }
    my $enc_msg=<<END;
Subject: $gBug#$ref: $newsubject
Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
Resent-From: $header{'from'}
${orgsender}Resent-To: $resentccval
Resent-Date: $tdate
Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
Resent-Sender: $gMaintainerEmail
${common_headers}X-$gProject-PR-Message: $report_followup $ref
X-$gProject-PR-Package: $data->{package}
X-$gProject-PR-Keywords: $data->{keywords}
${references}${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" : '';
$htmlbreak =~ s/\n\n/\n<P>\n\n/g;
if (length($resentccval)) {
    $htmlbreak = "  Copy sent to <code>".html_escape($resentccval)."</code>.".
        $htmlbreak;
}

# Should we send an ack out?
if (not exists $header{'x-debbugs-no-ack'} and
    ($newref or
     ($codeletter ne 'U' and
      (not defined $header{precedence} or
       $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/
      )
     )
    )
   ){

     # figure out forward explanation
     my $forwardexplain = '';
     my $thanks = '';
     my $extra_vars;
     # will contain info and -info in moreinfo messages
     my $info = '';
     my $infod = '';
     # temporary headers
     my %t_h;
     if ($newref) {
	  &htmllog("Acknowledgement","sent",$replyto,
		   ($veryquiet ?
		    "New $gBug report received and filed, but not forwarded." :
		    "New $gBug report received and forwarded."). $htmlbreak);
	  $thanks = fill_template('mail/process_ack_thanks_new');
     }
     else {
	  &htmllog("Acknowledgement","sent",$replyto,
		   ($veryquiet ? "Extra info received and filed, but not forwarded." :
		    $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
		    "Extra info received and forwarded to list."). $htmlbreak);
	  $thanks = fill_template('mail/process_ack_thanks_additional');
	  $info = 'info';
	  $infod = '-info';
     }
     if ($veryquiet) {
	  $forwardexplain = fill_template('mail/forward_veryquiet',
					 );
	  # these are the headers that quiet messages override
	  $t_h{messageid}  = "<handler.$ref.$nn.ack${info}quiet\@$gEmailDomain>";
	  $t_h{pr_message} = "ack${infod}-quiet $ref";
	  $t_h{reply_to}   = "$ref-quiet\@$gEmailDomain";
	  $extra_vars->{refreplyto} = "$ref-quiet\@$gEmailDomain";
	  $t_h{subject}    = length($info)?
	       "$gBug#$ref: Info received and FILED only ($subject)":
	       "$gBug#$ref: Acknowledgement of QUIET report ($subject)";
     }
     elsif ($codeletter eq 'M') {
	  $forwardexplain = fill_template('mail/forward_maintonly',
					 );
	  # these are the headers that maintonly messages override
	  $t_h{messageid}  = "<handler.$ref.$nn.ack{$info}maintonly\@$gEmailDomain>";
	  $t_h{pr_message} = "ack${infod}-maintonly $ref";
	  $t_h{reply_to}   = "$ref-maintonly\@$gEmailDomain";
	  $extra_vars->{refreplyto} = "$ref-maintonly\@$gEmailDomain";
	  $t_h{subject}    = length($info)?
	       "$gBug#$ref: Info received for maintainer only ($subject)":
	       "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)";
     }
     else {
	  $forwardexplain = fill_template('mail/forward_normal',
					 );
	  $t_h{messageid}  = "<handler.$ref.$nn.ack${info}\@$gEmailDomain>";
	  $t_h{pr_message} = "ack${infod} $ref";
	  $t_h{reply_to}   = "$ref\@$gEmailDomain";
	  $extra_vars->{refreplyto} = "$ref\@$gEmailDomain";
	  $t_h{subject}    = (defined $info and length($info))?
	       "$gBug#$ref: Info received ($subject)" :
	       "$gBug#$ref: Acknowledgement ($subject)";
     }
     my $body = message_body_template('mail/process_ack',
				      {forwardexplain  => $forwardexplain,
				       resentccexplain => $resentccexplain,
				       thanks          => $thanks,
				       %{$extra_vars}
				      }
				     );
     &sendmessage(create_mime_message(
		       [@common_headers,
			From          => qq("$gProject $gBug Tracking System" <$gMaintainerEmail>),
			To            => $replyto,
			Subject       => $t_h{subject},
			"Message-ID"  => $t_h{messageid},
			"In-Reply-To" => $header{'message-id'},
                        References    => $header{'message-id'},
                        Precedence    => 'bulk',
			"X-$gProject-PR-Message"  => $t_h{pr_message} || "ack $ref",
			"X-$gProject-PR-Package"  => $data->{package},
			"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"                => $t_h{reply_to} || "$ref\@$gEmailDomain",
		       ],$body,[]), '',undef,1);
}

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          => qq("$gProject $gBug Tracking System" <$gMaintainerEmail>),
			     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,
									     )}}
					      ),
				    ]
		     );

}


finish();

sub appendlog {
    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 ($exit) = @_;
    $exit ||= 0;
    utime(time,time,"db");
    # cleanups are run in an end block now.
    #my ($u);
    #while ($u= $cleanups[$#cleanups]) { &$u; }
    unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
    exit $exit;
}

die "wot no exit";

sub htmllog {
    my ($whatobj,$whatverb,$where,$desc) = @_;
    append_action_to_log(bug => $ref,
			 action => "$whatobj $whatverb",
			 requester => '',
			 request_addr => $where,
			 desc         => $desc,
			 get_lock     => 0,
			);
}

sub stripbccs {
    my $msg = shift;
    my $ret = '';
    my $bcc = 0;
    while ($msg =~ s/(.*\n)//) {
	local $_ = $1;
	if (/^$/) {
	    $ret .= $_;
	    last;
	}
	if ($bcc) {
	    # strip continuation lines too
	    next if /^\s/;
	    $bcc = 0;
	}
	if (/^Bcc:/i) {
	    $bcc = 1;
	} else {
	    $ret .= $_;
	}
    }
    return $ret . $msg;
}

=head2 send_message

     send_message($the_message,\@recipients,\@bcc,$do_not_encode)

The first argument is the scalar message, the second argument is the
arrayref of recipients, the third is the arrayref of Bcc:'ed
recipients.

The final argument turns off header encoding and the addition of the
X-Loop header if true, defaults to false.

=cut


sub sendmessage {
    my ($msg,$recips,$bcc,$no_encode) = @_;
    if (not defined $recips or (!ref($recips) && $recips eq '')
	or @$recips == 0) {
	$recips = ['-t'];
    }
    # This is suboptimal. The right solution is to send headers
    # separately from the rest of the message and encode them rather
    # than doing this.
    $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
    # The original message received is written out in appendlog, so
    # before writing out the other messages we've sent out, we need to
    # RFC1522 encode the header.
    $msg = encode_headers($msg) unless $no_encode;

    my $hash = get_hashname($ref);
    #save email to the log
    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;
    }

    send_mail_message(message        => $msg,
		      # Because we encode the headers above, we do not want to encode them here
		      encode_headers => 0,
		      recipients     => $recips);
}

=head2 message_body_template

     message_body_template('mail/ack',{ref=>'foo'});

Creates a message body using a template

=cut

sub message_body_template{
     my ($template,$extra_var) = @_;
     $extra_var ||={};
     my $body = fill_template($template,$extra_var);
     return fill_template('mail/message_body',
			  {%{$extra_var},
			   body => $body,
			  },
			 );
}

=head2 fill_template

     fill_template('mail/foo',{foo=>'bar'});

Calls fill_in_template with a default set of variables and any extras
added in.

=cut

sub fill_template{
     my ($template,$extra_var) = @_;
     $extra_var ||={};
     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]: ".
			      $config{cgi_domain}.'/'.
				   Debbugs::CGI::bug_links(bug=>$_[0],
							   links_only => 1,
							  );
		    }
		    };
     return fill_in_template(template => $template,
			     variables => $variables,
			     hole_var  => $hole_var,
			    );
}


# 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 $anymaintfound=0; my $anymaintnotfound=0;
    for my $p (splitpackages($data->{package})) {
        $p =~ y/A-Z/a-z/;
	$p =~ /((?:src:)?[a-z0-9.+-]+)/;
	$p = $1;
	next unless defined $p;
        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\@$config{subscription_domain}";
	    }
	}
	# 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 {$debugfh} "maintainer none >$p<\n";
	    push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
            $anymaintnotfound++;
            last;
        }
    }

    if (defined $data->{owner} and length $data->{owner}) {
        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);
    }
}

=head2 bug_list_forward

     bug_list_forward($spool_filename) if $codeletter eq 'L';


Given the spool file, will forward a bug to the per bug mailing list
subscription system.

=cut

sub bug_list_forward{
     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 $data = read_bug(bug => $bug_number);

     local $/ = undef;
     my $bug_message = <$bug_fh>;
     my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
     my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
     if (not defined $envelope_from) {
	  # Try to use the From: header or something to set it 
          ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
	  # Kludgy, and should really be using a full scale header
	  # parser to do this.
	  $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
     }
     my ($header,$body) = split /\n\n/, $bug_message, 2;
     # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
     $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
	  qq(X-$gProject-PR-Package: $data->{package}\n).
	       qq(X-$gProject-PR-Title: $data->{subject})
	       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 {$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 {$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,
		       encode_headers => 0,
		      );
     unlink("incoming/P$bug_fn") || die "unlinking incoming/P$bug_fn: $!";
     exit 0;
}