scripts/process

   1 #!/usr/bin/perl
   2 # $Id: process.in,v 1.109 2006/02/09 22:02:04 don Exp $
   3 #
   4 # Usage: process nn
   5 # Temps:  incoming/Pnn
   6
   7 use warnings;
   8 use strict;
   9
  10 use POSIX qw(strftime);
  11
  12 use IO::File;
  13
  14 use Getopt::Long;
  15 use Pod::Usage;
  16 use MIME::Parser;
  17 use Debbugs::MIME qw(decode_rfc1522 create_mime_message getmailbody);
  18 use Debbugs::Mail qw(send_mail_message encode_headers get_addresses);
  19 use Debbugs::Packages qw(getpkgsrc binary_to_source);
  20 use Debbugs::User qw(read_usertags write_usertags);
  21 use Debbugs::Common qw(:lock get_hashname buglog package_maintainer overwritefile make_list);
  22 use Debbugs::Status qw(writebug isstrongseverity lockreadbugmerge lockreadbug new_bug read_bug splitpackages  :versions);
  23
  24 use Debbugs::CGI qw(html_escape bug_links);
  25
  26 use Debbugs::Log qw(:misc :write);
  27
  28 use Debbugs::Text qw(:templates);
  29
  30 use Debbugs::Config qw(:globals :config);
  31
  32 use Debbugs::Control qw(append_action_to_log);
  33 use Debbugs::Control::Service qw(valid_control control_line);
  34 use Debbugs::Recipients qw(determine_recipients);
  35 use Encode qw(encode_utf8 decode);
  36
  37 =head1 NAME
  38
  39 process - Handle e-mails emails sent to bugs
  40
  41 =head1 SYNOPSIS
  42
  43 process nn
  44
  45  Options:
  46   --debug, -d debugging level (Default 0)
  47
  48 =head1 OPTIONS
  49
  50 =over
  51
  52 =item <--debug,-d>
  53
  54 Debugging level (default 0)
  55
  56 =back
  57
  58 =cut
  59
  60 use vars qw($DEBUG);
  61
  62 my %options = (debug           => 0,
  63                help            => 0,
  64                man             => 0,
  65               );
  66
  67 GetOptions(\%options,
  68            'debug|d+','help|h|?','man|m');
  69
  70 pod2usage() if $options{help};
  71 pod2usage({verbose=>2}) if $options{man};
  72
  73
  74 $DEBUG=$options{debug};
  75 my $debugfh = IO::File->new('/dev/null','w') or
  76     die "Unable to open /dev/null for writing; $!";
  77 if ($DEBUG > 0) {
  78     $debugfh = \*STDERR;
  79 }
  80
  81 # these are the valid bug addresses
  82 my %baddress = (B => 'submit',
  83                 M => 'maintonly',
  84                 Q => 'quiet',
  85                 F => 'forwarded',
  86                 D => 'done',
  87                 U => 'submitter',
  88                 L => 'list',
  89                );
  90 my $valid_codeletters = join('',keys %baddress);
  91
  92
  93 chdir($config{spool_dir}) or die "Unable to chdir to spool ($config{spool_dir}): $!";
  94
  95 umask(002);
  96
  97 my $intdate = time or die "failed to get time: $!";
  98
  99 my ($nn) = @ARGV;
 100 my ($codeletter,$tryref) =
 101     $nn =~ m/^([$valid_codeletters])(\d*)\.\d+$/
 102     or die "bad argument: $_";
 103 $tryref = undef unless length ($tryref) and
 104     $tryref > 0;
 105
 106 if (!rename("incoming/G$nn","incoming/P$nn"))  {
 107     my $error = $!;
 108     $error = '' if not defined $error;
 109     # this is very fragile, but we should probably die here anyway
 110     if ($error =~ m/no such file or directory/i) {
 111         exit 0;
 112     }
 113     die "Unable to rename incoming/G$nn to lock: $error";
 114 }
 115
 116 # die here to avoid continuously processing this mail
 117 if (not exists $baddress{$codeletter}) {
 118     die "bad codeletter $codeletter";
 119 }
 120
 121 my $baddress = $baddress{$codeletter};
 122 if ($baddress eq 'list') {
 123     bug_list_forward($nn) if $codeletter eq 'L';
 124 }
 125
 126
 127 my $baddressroot= $baddress;
 128 $baddress= "$tryref-$baddress" if defined $tryref;
 129
 130 my $msg;
 131 my @msg;
 132
 133 {
 134     my $log = IO::File->new("incoming/P$nn",'r') or
 135         die "Unable to open 'incoming/P$nn' for reading; $!";
 136     local $/;
 137     $msg=<$log>;
 138     @msg = split /\n/, $msg;
 139     close($log);
 140 }
 141
 142
 143 my $tdate = strftime "%a, %d %h %Y %T +0000", gmtime;
 144 my $fwd= "Received: via spool by $baddress\@$gEmailDomain id=$nn\n".
 145     "          (code $codeletter".(defined($tryref)?" ref $tryref":'')."); $tdate\n";
 146
 147 # header and decoded body respectively
 148 my (@headerlines, @bodylines);
 149
 150 # whether maintainer addresses have been checked
 151 our $maintainerschecked = 0;
 152 #maintainer address for this message
 153 our @maintaddrs;
 154 # other src addresses
 155 our @addsrcaddrs;
 156 our @resentccs;
 157 our @bccs;
 158
 159 my $resentccexplain='';
 160
 161 # whether there's a new reference with this email
 162 our $newref = 0;
 163
 164 our $brokenness = '';
 165
 166 my $parser_output = Debbugs::MIME::parse($msg);
 167
 168 @headerlines = @{$parser_output->{header}};
 169 @bodylines = @{$parser_output->{body}};
 170
 171 my %header;
 172
 173 my @common_headers;
 174 for my $hdr (@headerlines) {
 175     $hdr = decode_rfc1522($hdr);
 176     $_ = $hdr;
 177     s/\n\s/ /g;
 178     finish() if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
 179     my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
 180            && !m/^From / && !m/^X-Debbugs-/i;
 181     $fwd .= $hdr."\n" if $ins;
 182     # print {$debugfh} ">$_<\n";
 183     if (s/^(\S+):\s*//) {
 184         my $v = lc $1;
 185         if ($v eq 'x-loop') {
 186             push @common_headers, 'X-Loop',$_;
 187         }
 188         print {$debugfh} ">$v=$_<\n";
 189         $header{$v} = $_;
 190     } else {
 191         print {$debugfh} "!>$_<\n";
 192     }
 193 }
 194 $header{'message-id'} = '' if not defined $header{'message-id'};
 195
 196 push @common_headers, 'X-Loop',$gMaintainerEmail;
 197
 198 # remove blank lines
 199 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
 200
 201 # Strip off RFC2440-style PGP clearsigning.
 202 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
 203     shift @bodylines while @bodylines and length $bodylines[0];
 204     shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
 205     for my $findsig (0 .. $#bodylines) {
 206         if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
 207             $#bodylines = $findsig - 1;
 208             last;
 209         }
 210     }
 211     map { s/^- // } @bodylines;
 212 }
 213
 214 #psuedoheaders
 215 my %pheader;
 216 my @control_bits;
 217 # extract pseudo-headers
 218 for my $phline (@bodylines)
 219 {
 220     # Remove BOM markers from UTF-8 strings
 221     # Fixes #488554
 222     $phline =~ s/\xef\xbb\xbf//g;
 223     last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
 224     my ($fn, $fv) = ($1, $2);
 225     $fv =~ s/\s*$//;
 226     print {$debugfh} ">$fn|$fv|\n";
 227     $fn = lc $fn;
 228     if ($fn =~ /^control$/) {
 229         push @control_bits,$fv;
 230     } else {
 231         # Don't lc owner or forwarded
 232         $fv = lc $fv unless $fn =~ /^(?:owner|forwarded|usertags|version|source-version)$/;
 233         $pheader{$fn} = $fv;
 234     }
 235     print {$debugfh} ">$fn~$fv<\n";
 236 }
 237
 238 # Allow pseudo headers to set x-debbugs- stuff [#179340]
 239 for my $key (grep /X-Debbugs-.*/i, keys %pheader) {
 240      $header{$key} = $pheader{$key} if not exists $header{$key};
 241 }
 242
 243 # set $i to beginning of encoded body data, so we can dump it out
 244 # verbatim later
 245 my $i = 0;
 246 ++$i while $msg[$i] =~ /./;
 247 $fwd .= join("\n",@msg[$i..$#msg]);
 248
 249 print {$debugfh} "***\n$fwd\n***\n";
 250
 251 if (defined $header{'resent-from'} && !defined $header{'from'}) {
 252     $header{'from'} = $header{'resent-from'};
 253 }
 254 defined($header{'from'}) || die "no From header";
 255
 256 my $replyto = $header{'reply-to'};
 257 $replyto = '' unless defined $replyto;
 258 $replyto =~ s/^ +//;
 259 $replyto =~ s/ +$//;
 260 unless (length $replyto) {
 261     $replyto = $header{'from'};
 262 }
 263
 264 my $subject = '(no subject)';
 265 if (!defined($header{'subject'}))
 266 {
 267         $brokenness.= fill_template('mail/process_broken_subject');
 268
 269 } else {
 270     $subject= $header{'subject'};
 271 }
 272
 273 my $ref=-1;
 274 $subject =~ s/^Re:\s*//i; $_= $subject."\n";
 275 if (not defined $tryref and m/^Bug ?\#(\d+)\D/i) {
 276     $tryref = $1 if $1 > 0;
 277 }
 278 my $data;
 279 if (defined $tryref) {
 280      my $bfound;
 281     ($bfound, $data)= &lockreadbugmerge($tryref);
 282     if ($bfound and not $data->{archived}) {
 283         $ref= $tryref;
 284     } else {
 285         &sendmessage(create_mime_message(
 286           [From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 287            To            => $replyto,
 288            Subject       => "Unknown problem report $gBug#$tryref ($subject)",
 289            'Message-ID'  => "<handler.x.$nn.unknown\@$gEmailDomain>",
 290            'In-Reply-To' => $header{'message-id'},
 291            References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
 292            Precedence    => 'bulk',
 293            "X-$gProject-PR-Message" => 'error',
 294            @common_headers,
 295           ],message_body_template('mail/process_unknown_bug_number',
 296                                   {subject => $subject,
 297                                    date    => $header{date},
 298                                    baddress => $baddress,
 299                                    tryref   => $tryref,
 300                                    messageid => $header{'message-id'},
 301                                   },
 302                                  )),'');
 303         appendlog($ref,$msg);
 304         finish();
 305     }
 306 } else {
 307     &filelock('lock/-1');
 308 }
 309
 310 # Attempt to determine which source package this is
 311 my $source_pr_header = '';
 312 my $source_package = '';
 313 if (defined $pheader{source}) {
 314      $source_package = $pheader{source};
 315 }
 316 elsif (defined $data->{package} or defined $pheader{package}) {
 317      $source_package = binary_to_source(binary => $data->{package} // $pheader{package});
 318 }
 319 $source_pr_header = "X-$gProject-PR-Source: $source_package\n"
 320      if defined $source_package and length $source_package;
 321
 322 # Done and Forwarded Bugs
 323 if ($codeletter eq 'D' || $codeletter eq 'F')
 324 {
 325     if ($replyto =~ m/$gBounceFroms/o ||
 326         $header{'from'} =~ m/$gBounceFroms/o)
 327     {
 328          print STDERR "bounce detected !  Mwaap! Mwaap!";
 329          exit 1;
 330     }
 331     my $markedby= $header{'from'} eq $replyto ? $replyto :
 332                "$header{'from'} (reply to $replyto)";
 333     my @generalcc;
 334     my $receivedat;
 335     my $markaswhat;
 336     my $set_forwarded;
 337     my $generalcc;
 338     my $set_done;
 339     if ($codeletter eq 'F') { # Forwarded
 340         (appendlog($ref,$msg),finish()) if defined $data->{forwarded} and length($data->{forwarded});
 341         $receivedat= "forwarded\@$gEmailDomain";
 342         $markaswhat= 'forwarded';
 343         $set_forwarded= $header{'to'};
 344         # Dissallow forwarded being set to this bug tracking system
 345         if (defined $set_forwarded and $set_forwarded =~ /\Q$gEmailDomain\E/) {
 346              undef $set_forwarded;
 347         }
 348         if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
 349             push @generalcc, "$gForwardList\@$gListDomain";
 350             $generalcc= "$gForwardList\@$gListDomain";
 351         } else {
 352             $generalcc='';
 353         }
 354     } else { # Done
 355         if (defined $data->{done} and length($data->{done}) and
 356                 not defined $pheader{'source-version'} and
 357                 not defined $pheader{'version'}) {
 358             appendlog($ref,$msg);
 359             finish();
 360         }
 361         $receivedat= "done\@$gEmailDomain";
 362         $markaswhat= 'done';
 363         $set_done= $header{'from'};
 364         if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
 365             $generalcc= "$gDoneList\@$gListDomain";
 366             push @generalcc, "$gDoneList\@$gListDomain";
 367         } else {
 368             $generalcc='';
 369         }
 370     }
 371     if (defined $gStrongList and isstrongseverity($data->{severity})) {
 372         $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
 373         push @generalcc,"$gStrongList\@$gListDomain";
 374     }
 375     if ($ref<0) {
 376         &sendmessage(create_mime_message(
 377           [From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 378            To            => $replyto,
 379            Subject       => "Message with no $gBug number ignored by $receivedat ($subject)",
 380            'Message-ID'  => "<handler.x.$nn.warnignore\@$gEmailDomain>",
 381            'In-Reply-To' => $header{'message-id'},
 382            References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
 383            Precedence    => 'bulk',
 384            "X-$gProject-PR-Message" => 'error',
 385            @common_headers,
 386           ],message_body_template('mail/process_no_bug_number',
 387                                   {subject => $subject,
 388                                    date    => $header{date},
 389                                    markaswhat => $markaswhat,
 390                                    receivedat => $receivedat,
 391                                    messageid => $header{'message-id'},
 392                                   },
 393                                  )),'');
 394         appendlog($ref,$msg);
 395         finish();
 396     }
 397
 398     &checkmaintainers;
 399
 400     my @noticecc = grep($_ ne $replyto,@maintaddrs);
 401     my $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
 402     $noticeccval =~ s/\s+\n\s+/ /g;
 403     $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
 404
 405     my @process= ($ref,split(/ /,$data->{mergedwith}));
 406     my $orgref= $ref;
 407
 408     for $ref (@process) {
 409         if ($ref != $orgref) {
 410             &unfilelock;
 411             $data = &lockreadbug($ref)
 412                 || die "huh ? $ref from $orgref out of ".join(' ',@process);
 413         }
 414         $data->{done}= $set_done if defined($set_done);
 415         $data->{forwarded}= $set_forwarded if defined($set_forwarded);
 416         if ($codeletter eq 'D') {
 417             $data->{keywords} = join ' ', grep $_ ne 'pending',
 418                                      split ' ', $data->{keywords};
 419             if (defined $pheader{'source-version'}) {
 420                  if ($pheader{'source-version'} !~ m/^$config{package_version_re}$/) {
 421                       $brokenness .= fill_template('mail/invalid_version',
 422                                                    {version => $pheader{'source-version'}},
 423                                                   );
 424                  }
 425                  else {
 426                       addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
 427                  }
 428             } elsif (defined $pheader{version}) {
 429                  if ($pheader{version} !~ m/^$config{package_version_re}$/) {
 430                       $brokenness .= fill_template('mail/invalid_version',
 431                                                    {version => $pheader{version}},
 432                                                   );
 433                  }
 434                  else {
 435                       addfixedversions($data, $pheader{package}, $pheader{version}, '');
 436                  }
 437             }
 438         }
 439
 440         # Add bug mailing list to $generalbcc as appropriate
 441         # This array is used to specify bcc in the cases where we're using create_mime_message.
 442         my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
 443         my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
 444         $generalbcc =~ s/\s+\n\s+/ /g;
 445         $generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
 446         if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
 447
 448         writebug($ref, $data);
 449
 450         my $hash = get_hashname($ref);
 451         my $orig_report_fh = IO::File->new("db-h/$hash/$ref.report") or
 452             die "Unable to read original report: $!";
 453         my $orig_report;
 454         { local $/; $orig_report = <$orig_report_fh>;}
 455         close($orig_report_fh) or
 456             die "Unable to close original report filehandle: $!";
 457         if ($codeletter eq 'F') {
 458             &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
 459             &sendmessage(create_mime_message(
 460              [@common_headers,
 461               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 462               To            => "$replyto",
 463               Subject       => "$gBug#$ref: marked as forwarded ($data->{subject})",
 464               "Message-ID"  => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
 465               "In-Reply-To" => $header{'message-id'},
 466               References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
 467               Precedence    => 'bulk',
 468               "X-$gProject-PR-Message"  => "forwarded $ref",
 469               "X-$gProject-PR-Package"  => $data->{package},
 470               "X-$gProject-PR-Keywords" => $data->{keywords},
 471               # Only have a X-$gProject-PR-Source when we know the source package
 472               (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
 473              ],message_body_template('mail/process_mark_as_forwarded',
 474                                      {date => $header{date},
 475                                       messageid => $header{'message-id'},
 476                                       data      => $data,
 477                                      },
 478                                     ),
 479              [join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
 480         } else {
 481             &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
 482             &sendmessage(create_mime_message(
 483              [@common_headers,
 484               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 485               To            => $replyto,
 486               Subject       => "$gBug#$ref: marked as done ($data->{subject})",
 487               "Message-ID"  => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
 488               "In-Reply-To" => $header{'message-id'},
 489               References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
 490               Precedence    => 'bulk',
 491               "X-$gProject-PR-Message"  => "closed $ref",
 492               "X-$gProject-PR-Package"  => $data->{package},
 493               "X-$gProject-PR-Keywords" => $data->{keywords},
 494               # Only have a X-$gProject-PR-Source when we know the source package
 495               (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
 496              ],message_body_template('mail/process_mark_as_done',
 497                                      {date => $header{date},
 498                                       messageid => $header{'message-id'},
 499                                       subject   => $header{subject},
 500                                       data      => $data,
 501                                      },
 502                                     ),
 503              [$orig_report,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
 504             &htmllog("Notification","sent",$data->{originator},
 505                 "$gBug acknowledged by developer.");
 506             &sendmessage(create_mime_message(
 507              [@common_headers,
 508               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 509               To            => "$data->{originator}",
 510               Subject       => "$gBug#$ref closed by $markedby ($header{'subject'})",
 511               "Message-ID"  => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
 512               (defined $data->{msgid})?("In-Reply-To" => $data->{msgid}):(),
 513               References    => join(' ',grep {defined $_} ($header{'message-id'},$data->{msgid})),
 514               "X-$gProject-PR-Message"  => "they-closed $ref",
 515               "X-$gProject-PR-Package"  => "$data->{package}",
 516               "X-$gProject-PR-Keywords" => "$data->{keywords}",
 517               # Only have a X-$gProject-PR-Source when we know the source package
 518               (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
 519               "Reply-To"                => "$ref\@$gEmailDomain",
 520               "Content-Type"            => 'text/plain; charset="utf-8"',
 521              ],message_body_template('mail/process_your_bug_done',
 522                                      {data      => $data,
 523                                       markedby  => $markedby,
 524                                       messageid => $header{'message-id'},
 525                                       subject   => $header{subject},
 526                                      },
 527                                     ),
 528              [join("\n",@msg),$orig_report]),'',undef,1);
 529         }
 530         appendlog($ref,$msg);
 531     }
 532     finish();
 533 }
 534
 535 if ($ref<0) { # new bug report
 536     if ($codeletter eq 'U') { # -submitter
 537         &sendmessage(create_mime_message(
 538           [@common_headers,
 539            From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 540            To            => $replyto,
 541            Subject       => "Message with no $gBug number cannot be sent to submitter! ($subject)",
 542            'Message-ID'  => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
 543            'In-Reply-To' => $header{'message-id'},
 544            References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
 545            Precedence    => 'bulk',
 546            "X-$gProject-PR-Message" => 'error',
 547           ],message_body_template('mail/process_no_bug_number',
 548                                   {subject => $subject,
 549                                    date    => $header{date},
 550                                    markaswhat => 'submitter',
 551                                    receivedat => "$baddress\@$gEmailDomain",
 552                                    messageid => $header{'message-id'},
 553                                   },
 554                                  )),'');
 555         appendlog($ref,$msg);
 556         finish();
 557     }
 558
 559     $data->{found_versions} = [];
 560     $data->{fixed_versions} = [];
 561
 562     if (defined $pheader{source}) {
 563         # source packages are identified by the src: prefix
 564         $data->{package} = 'src:'.$pheader{source};
 565     } elsif (defined $pheader{package}) {
 566         $data->{package} = $pheader{package};
 567         if ($data->{package} =~ /^src:(.+)/) {
 568             $pheader{source} = $1;
 569         }
 570     } elsif (defined $config{default_package}) {
 571         $data->{package} = $config{default_package},
 572     }
 573     else {
 574         my $body = message_body_template('mail/process_no_package',
 575                                         );
 576         &sendmessage(create_mime_message(
 577                        [@common_headers,
 578                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 579                         To            => $replyto,
 580                         Subject       => "Message with no Package: tag cannot be processed! ($subject)",
 581                         "Message-ID"  => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
 582                         "In-Reply-To" => $header{'message-id'},
 583                         References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
 584                         Precedence    => 'bulk',
 585                         "X-$gProject-PR-Message" => 'error'
 586                        ],
 587            message_body_template('mail/process_no_package',
 588                                  {date => $header{date},
 589                                   subject => $subject,
 590                                   messageid => $header{'message-id'},
 591                                   baddress => $baddress,
 592                                  },
 593                                 ),[join("\n", @msg)]), '',undef,1);
 594         appendlog($ref,$msg);
 595         finish();
 596     }
 597
 598     if (defined $config{default_package}) {
 599          &checkmaintainers;
 600          # if there are no maintainers for this package, assign it to the default package
 601          if (not @maintaddrs) {
 602               $data->{package} = $config{default_package};
 603               $brokenness.= fill_template('mail/process_default_package_selected',
 604                                           {old_package => $pheader{source} || $pheader{package} || 'No package',
 605                                            new_package => $data->{package},
 606                                           }
 607                                          );
 608               # force the maintainers to be rechecked
 609               $maintainerschecked = 0;
 610               &checkmaintainers;
 611          }
 612     }
 613
 614     $data->{keywords}= '';
 615     if (defined($pheader{'keywords'})) {
 616         $data->{keywords}= $pheader{'keywords'};
 617     } elsif (defined($pheader{'tags'})) {
 618         $data->{keywords}= $pheader{'tags'};
 619     }
 620     if (length($data->{keywords})) {
 621         my @kws;
 622         my %gkws = map { ($_, 1) } @gTags;
 623         foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
 624             push @kws, $kw if (defined $gkws{$kw});
 625         }
 626         $data->{keywords} = join(" ", @kws);
 627     }
 628     $data->{severity}= '';
 629     if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
 630         $data->{severity}= $pheader{'severity'};
 631         $data->{severity}= $pheader{'priority'} unless ($data->{severity});
 632         $data->{severity} =~ s/^\s*(.+)\s*$/$1/;
 633
 634         if (!grep($_ eq $data->{severity}, @gSeverityList, "$gDefaultSeverity")) {
 635             $brokenness.= fill_template('mail/invalid_severity',
 636                                         {severity=>$data->{severity}}
 637                                        );
 638             $data->{severity}= '';
 639         }
 640     }
 641     if (defined($pheader{owner})) {
 642         $data->{owner}= $pheader{owner};
 643     }
 644     if (defined($pheader{forwarded})) {
 645         $data->{forwarded} = $pheader{forwarded};
 646     }
 647     $ref = new_bug();
 648     $newref = $ref;
 649     my $hash = get_hashname($ref);
 650     $data->{originator} = $replyto;
 651     $data->{date} = $intdate;
 652     $data->{subject} = $subject;
 653     $data->{msgid} = $header{'message-id'};
 654     writebug($ref, $data);
 655     # Deal with usertags
 656     if (exists $pheader{usertags}) {
 657          my $user = $replyto;
 658          $user = $pheader{user} if exists $pheader{user};
 659          $user =~ s/,.*//;
 660          $user =~ s/^.*<(.*)>.*$/$1/;
 661          $user =~ s/[(].*[)]//;
 662          $user =~ s/^\s*(\S+)\s+.*$/$1/;
 663          if ($user ne '' and Debbugs::User::is_valid_user($user)) {
 664               $pheader{usertags} =~ s/(?:^\s+|\s+$)//g;
 665               my %user_tags;
 666               read_usertags(\%user_tags,$user);
 667               for my $tag (split /[,\s]+/, $pheader{usertags}) {
 668                    if ($tag =~ /^[a-zA-Z0-9.+\@-]+/) {
 669                         my %bugs_with_tag;
 670                         @bugs_with_tag{@{$user_tags{$tag}||[]}} = (1) x @{$user_tags{$tag}||[]};
 671                         $bugs_with_tag{$ref} = 1;
 672                         $user_tags{$tag} = [keys %bugs_with_tag];
 673                    }
 674               }
 675               write_usertags(\%user_tags,$user);
 676          }
 677          else {
 678               $brokenness .= fill_template('mail/invalid_user',
 679                                            {user => $user}
 680                                           );
 681          }
 682     }
 683     overwritefile("db-h/$hash/$ref.report",
 684                   map {"$_\n"} @msg);
 685 }
 686
 687 &checkmaintainers;
 688
 689 print {$debugfh} "maintainers >".join(' ',@maintaddrs)."<\n";
 690
 691 my $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
 692 my $newsubject= $subject;  $newsubject =~ s/^$gBug#$ref:*\s*//;
 693
 694 my $xcchdr= $header{ 'x-debbugs-cc' } || '';
 695 if ($xcchdr =~ m/\S/) {
 696     push(@resentccs,get_addresses($xcchdr));
 697     $resentccexplain.= fill_template('mail/xdebbugscc',
 698                                      {xcchdr => $xcchdr},
 699                                     );
 700 }
 701
 702 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
 703     push(@resentccs,@maintaddrs);
 704     $resentccexplain.= fill_template('mail/maintainercc',
 705                                      {maintaddrs => \@maintaddrs,
 706                                      },
 707                                     );
 708 }
 709
 710 @bccs = @addsrcaddrs;
 711 if (defined $gStrongList and isstrongseverity($data->{severity})) {
 712     push @bccs, "$gStrongList\@$gListDomain";
 713 }
 714
 715 # Send mail to the per bug list subscription too
 716 push @bccs, "bugs=$ref\@$gListDomain";
 717
 718 if (defined $pheader{source}) {
 719     # Prefix source versions with the name of the source package. They
 720     # appear that way in version trees so that we can deal with binary
 721     # packages moving from one source package to another.
 722     if (defined $pheader{'source-version'}) {
 723          if ($pheader{'source-version'} !~ m/^$config{package_version_re}$/) {
 724               $brokenness .= fill_template('mail/invalid_version',
 725                                            {version => $pheader{'source-version'}},
 726                                           );
 727          }
 728          else {
 729               addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
 730          }
 731     } elsif (defined $pheader{version}) {
 732          if ($pheader{version} !~ m/^$config{package_version_re}$/) {
 733               $brokenness .= fill_template('mail/invalid_version',
 734                                            {version => $pheader{version}},
 735                                           );
 736          }
 737          else {
 738               addfoundversions($data, $pheader{source}, $pheader{version}, '');
 739          }
 740     }
 741     writebug($ref, $data);
 742 } elsif (defined $pheader{package}) {
 743     # TODO: could handle Source-Version: by looking up the source package?
 744      if (defined $pheader{version}) {
 745           if ($pheader{version} !~ m/^$config{package_version_re}$/) {
 746                $brokenness .= fill_template('mail/invalid_version',
 747                                             {version => $pheader{version}},
 748                                            );
 749           }
 750           else {
 751                addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
 752           }
 753      }
 754      writebug($ref, $data);
 755 }
 756
 757 my $veryquiet= $codeletter eq 'Q';
 758 if ($codeletter eq 'M' && !@maintaddrs) {
 759     $veryquiet= 1;
 760     $brokenness.= fill_template('mail/invalid_maintainer',
 761                                 {},
 762                                );
 763 }
 764
 765 my $resentccval.= join(', ',@resentccs);
 766 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
 767 my $resentcc = '';
 768 if (length($resentccval)) {
 769     $resentcc= "Resent-CC: $resentccval\n";
 770 }
 771
 772 my $common_headers='';
 773 {
 774     my @tmp = @common_headers;
 775     while (my ($key,$value) = splice(@tmp, 0,2)) {
 776         $common_headers .= qq($key: $value\n);
 777     }
 778 }
 779 if ($codeletter eq 'U') { # sent to -submitter
 780     &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
 781     my $enc_msg=<<END;
 782 Subject: $gBug#$ref: $newsubject
 783 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
 784 ${orgsender}Resent-To: $data->{originator}
 785 ${resentcc}${common_headers}Resent-Date: $tdate
 786 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 787 Resent-Sender: $gMaintainerEmail
 788 X-$gProject-PR-Message: report $ref
 789 X-$gProject-PR-Package: $data->{package}
 790 X-$gProject-PR-Keywords: $data->{keywords}
 791 ${source_pr_header}
 792 END
 793     chomp $enc_msg;
 794     $enc_msg = encode_utf8($enc_msg).$fwd."\n";
 795     &sendmessage($enc_msg,[$data->{originator},@resentccs],[@bccs]);
 796 } elsif ($codeletter eq 'B') { # Sent to submit
 797     my $report_followup = $newref ? 'report' : 'followup';
 798     &htmllog($newref ? "Report" : "Information", "forwarded",
 799              join(', ',"$gSubmitList\@$gListDomain",@resentccs),
 800              "<code>$gBug#$ref</code>".
 801              (length($data->{package})? "; Package <code>".html_escape($data->{package})."</code>" : '').
 802              ".");
 803     my $enc_msg=<<END;
 804 Subject: $gBug#$ref: $newsubject
 805 Reply-To: $replyto, $ref\@$gEmailDomain
 806 Resent-From: $header{'from'}
 807 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
 808 ${resentcc}${common_headers}Resent-Date: $tdate
 809 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 810 Resent-Sender: $gMaintainerEmail
 811 X-$gProject-PR-Message: $report_followup $ref
 812 X-$gProject-PR-Package: $data->{package}
 813 X-$gProject-PR-Keywords: $data->{keywords}
 814 ${source_pr_header}
 815 END
 816     chomp $enc_msg;
 817     $enc_msg = encode_utf8($enc_msg).$fwd."\n";
 818     &sendmessage($enc_msg,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
 819 } elsif (@resentccs or @bccs) { # Quiet or Maintainer
 820     # D and F done far earlier; B just done - so this must be M or Q
 821     # We preserve whichever it was in the Reply-To (possibly adding
 822     # the $gBug#).
 823     my $report_followup = $newref ? 'report' : 'followup';
 824     if (@resentccs) {
 825         &htmllog($newref ? "Report" : "Information", "forwarded",
 826                  $resentccval,
 827                  "<code>$gBug#$ref</code>".
 828                  (length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
 829                  ".");
 830     } else {
 831         &htmllog($newref ? "Report" : "Information", "stored",
 832                  "",
 833                  "<code>$gBug#$ref</code>".
 834                  (length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
 835                  ".");
 836     }
 837     my $enc_msg=<<END;
 838 Subject: $gBug#$ref: $newsubject
 839 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
 840 Resent-From: $header{'from'}
 841 ${orgsender}Resent-To: $resentccval
 842 Resent-Date: $tdate
 843 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 844 Resent-Sender: $gMaintainerEmail
 845 ${common_headers}X-$gProject-PR-Message: $report_followup $ref
 846 X-$gProject-PR-Package: $data->{package}
 847 X-$gProject-PR-Keywords: $data->{keywords}
 848 ${source_pr_header}
 849 END
 850     chomp $enc_msg;
 851     $enc_msg = encode_utf8($enc_msg).$fwd."\n";
 852     &sendmessage($enc_msg,[@resentccs],[@bccs]);
 853 }
 854
 855 my $htmlbreak= length($brokenness) ? "<p>\n".html_escape($brokenness)."\n<p>\n" : '';
 856 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
 857 if (length($resentccval)) {
 858     $htmlbreak = "  Copy sent to <code>".html_escape($resentccval)."</code>.".
 859         $htmlbreak;
 860 }
 861
 862 # Should we send an ack out?
 863 if (not exists $header{'x-debbugs-no-ack'} and
 864     ($newref or
 865      ($codeletter ne 'U' and
 866       (not defined $header{precedence} or
 867        $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/
 868       )
 869      )
 870     )
 871    ){
 872
 873      # figure out forward explanation
 874      my $forwardexplain = '';
 875      my $thanks = '';
 876      my $extra_vars;
 877      # will contain info and -info in moreinfo messages
 878      my $info = '';
 879      my $infod = '';
 880      # temporary headers
 881      my %t_h;
 882      if ($newref) {
 883           &htmllog("Acknowledgement","sent",$replyto,
 884                    ($veryquiet ?
 885                     "New $gBug report received and filed, but not forwarded." :
 886                     "New $gBug report received and forwarded."). $htmlbreak);
 887           $thanks = fill_template('mail/process_ack_thanks_new');
 888      }
 889      else {
 890           &htmllog("Acknowledgement","sent",$replyto,
 891                    ($veryquiet ? "Extra info received and filed, but not forwarded." :
 892                     $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
 893                     "Extra info received and forwarded to list."). $htmlbreak);
 894           $thanks = fill_template('mail/process_ack_thanks_additional');
 895           $info = 'info';
 896           $infod = '-info';
 897      }
 898      if ($veryquiet) {
 899           $forwardexplain = fill_template('mail/forward_veryquiet',
 900                                          );
 901           # these are the headers that quiet messages override
 902           $t_h{messageid}  = "<handler.$ref.$nn.ack${info}quiet\@$gEmailDomain>";
 903           $t_h{pr_message} = "ack${infod}-quiet $ref";
 904           $t_h{reply_to}   = "$ref-quiet\@$gEmailDomain";
 905           $extra_vars->{refreplyto} = "$ref-quiet\@$gEmailDomain";
 906           $t_h{subject}    = length($info)?
 907                "$gBug#$ref: Info received and FILED only ($subject)":
 908                "$gBug#$ref: Acknowledgement of QUIET report ($subject)";
 909      }
 910      elsif ($codeletter eq 'M') {
 911           $forwardexplain = fill_template('mail/forward_maintonly',
 912                                          );
 913           # these are the headers that maintonly messages override
 914           $t_h{messageid}  = "<handler.$ref.$nn.ack{$info}maintonly\@$gEmailDomain>";
 915           $t_h{pr_message} = "ack${infod}-maintonly $ref";
 916           $t_h{reply_to}   = "$ref-maintonly\@$gEmailDomain";
 917           $extra_vars->{refreplyto} = "$ref-maintonly\@$gEmailDomain";
 918           $t_h{subject}    = length($info)?
 919                "$gBug#$ref: Info received for maintainer only ($subject)":
 920                "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)";
 921      }
 922      else {
 923           $forwardexplain = fill_template('mail/forward_normal',
 924                                          );
 925           $t_h{messageid}  = "<handler.$ref.$nn.ack${info}\@$gEmailDomain>";
 926           $t_h{pr_message} = "ack${infod} $ref";
 927           $t_h{reply_to}   = "$ref\@$gEmailDomain";
 928           $extra_vars->{refreplyto} = "$ref\@$gEmailDomain";
 929           $t_h{subject}    = (defined $info and length($info))?
 930                "$gBug#$ref: Info received ($subject)" :
 931                "$gBug#$ref: Acknowledgement ($subject)";
 932      }
 933      my $body = message_body_template('mail/process_ack',
 934                                       {forwardexplain  => $forwardexplain,
 935                                        resentccexplain => $resentccexplain,
 936                                        thanks          => $thanks,
 937                                        %{$extra_vars}
 938                                       }
 939                                      );
 940      &sendmessage(create_mime_message(
 941                        [@common_headers,
 942                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 943                         To            => $replyto,
 944                         Subject       => $t_h{subject},
 945                         "Message-ID"  => $t_h{messageid},
 946                         "In-Reply-To" => $header{'message-id'},
 947                         References    => $header{'message-id'},
 948                         Precedence    => 'bulk',
 949                         "X-$gProject-PR-Message"  => $t_h{pr_message} || "ack $ref",
 950                         "X-$gProject-PR-Package"  => $data->{package},
 951                         "X-$gProject-PR-Keywords" => $data->{keywords},
 952                         # Only have a X-$gProject-PR-Source when we know the source package
 953                         (defined($source_package) and length($source_package))?("X-$gProject-PR-Source" => $source_package):(),
 954                         "Reply-To"                => $t_h{reply_to} || "$ref\@$gEmailDomain",
 955                        ],$body,[]), '',undef,1);
 956 }
 957
 958 appendlog($ref,$msg);
 959
 960 ## handle control messages at this point, immediately before finishing
 961 my %clonebugs = (-1 => $ref);
 962 my %bug_affected;
 963 if (@control_bits) {
 964     my $transcript_scalar = '';
 965     open my $transcript, ">:scalar:utf8", \$transcript_scalar or
 966         die "Unable to create transcript scalar: $!";
 967     print {$transcript} "Processing control commands:\n\n";
 968     my %affected_packages;
 969     my %recipients;
 970     # this is the hashref which is passed to all control calls
 971     my %limit = ();
 972     my $errors = 0;
 973     my $unknowns = 0;
 974
 975     my @common_control_options =
 976         (transcript        => $transcript,
 977          requester         => $header{from},
 978          request_addr      => $baddress.'@'.$config{email_domain},
 979          request_msgid     => $header{'message-id'},
 980          request_subject   => $header{subject},
 981          request_nn        => $nn,
 982          request_replyto   => $replyto,
 983          message           => $msg,
 984          affected_bugs     => \%bug_affected,
 985          affected_packages => \%affected_packages,
 986          recipients        => \%recipients,
 987          limit             => \%limit,
 988         );
 989     if (@gExcludeFromControl and grep {$replyto =~ m/\Q$_\E/} @gExcludeFromControl) {
 990         print {$transcript} fill_template('mail/excluded_from_control');
 991         print {$transcript} "Stopping processing here.\n\n";
 992     } else {
 993         for my $control_bit (@control_bits) {
 994             $control_bit =~ s/\xef\xbb\xbf//g;
 995             next unless $control_bit =~ m/\S/;
 996             eval {
 997                 my $temp = decode("utf8",$control_bit,Encode::FB_CROAK);
 998                 $control_bit = $temp;
 999             };
1000             print {$transcript} "> $control_bit\n";
1001             next if $control_bit =~ /^\s*\#/;
1002             my $action = '';
1003             my $ok;
1004             if (defined valid_control($control_bit)) {
1005                 my ($new_errors,$terminate_control) =
1006                     control_line(line => $control_bit,
1007                                  clonebugs => \%clonebugs,
1008                                  limit => \%limit,
1009                                  common_control_options => \@common_control_options,
1010                                  errors => \$errors,
1011                                  transcript => $transcript,
1012                                  debug => 0,
1013                                  ok => \$ok,
1014                                 );
1015                 if ($terminate_control) {
1016                     last;
1017                 }
1018             }
1019             else {
1020                 $errors++;
1021                 if (++$unknowns >= 5) {
1022                     print {$transcript} "Too many unknown commands, stopping here.\n\n";
1023                     last;
1024                 }
1025             }
1026         }
1027     }
1028     my $temp_transcript = $transcript_scalar;
1029     eval{
1030         $temp_transcript = decode("utf8",$temp_transcript,Encode::FB_CROAK);
1031     };
1032     my @maintccs = determine_recipients(recipients => \%recipients,
1033                                         address_only => 1,
1034                                         cc => 1,
1035                                        );
1036     my $error_text = $errors > 0 ? " (with $errors errors)":'';
1037     my $reply =
1038         create_mime_message(['X-Loop'      => $gMaintainerEmail,
1039                              From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
1040                              To            => $replyto,
1041                              @maintccs ? (Cc => join(', ',@maintccs)):(),
1042                              Subject       => "Processed${error_text}: $header{subject}",
1043                              'Message-ID'  => "<handler.s.$nn.transcript\@$gEmailDomain>",
1044                              'In-Reply-To' => $header{'message-id'},
1045                              References    => join(' ',grep {defined $_} $header{'message-id'},$data->{msgid}),
1046                              Precedence    => 'bulk',
1047                              keys %affected_packages ?("X-${gProject}-PR-Package" => join(' ',keys %affected_packages)):(),
1048                              keys %affected_packages ?("X-${gProject}-PR-Source" =>
1049                                                        join(' ',
1050                                                             map {defined $_ ?(ref($_)?@{$_}:$_):()}
1051                                                             binary_to_source(binary => [keys %affected_packages],
1052                                                                              source_only => 1))):(),
1053                              "X-$gProject-PR-Message" => 'transcript',
1054                              @common_headers,
1055                             ],
1056                             fill_template('mail/message_body',
1057                                           {body => $temp_transcript},
1058                                          ));
1059
1060     utime(time,time,"db-h");
1061
1062     send_mail_message(message => $reply,
1063                       recipients => [exists $header{'x-debbugs-no-ack'}?():$replyto,
1064                                      make_list(values %{{determine_recipients(recipients => \%recipients,
1065                                                                               address_only => 1,
1066                                                                              )}}
1067                                               ),
1068                                     ]
1069                      );
1070
1071 }
1072
1073
1074 finish();
1075
1076 sub appendlog {
1077     my ($ref,$msg) = @_;
1078     my $log_location = buglog($ref);
1079     die "Unable to find .log for $ref"
1080         if not defined $log_location;
1081     my $logfh = IO::File->new(">>$log_location") or
1082         die "Unable to open $log_location for appending: $!";
1083     write_log_records(logfh => $logfh,
1084                       records => [{type => 'incoming-recv',
1085                                    text => $msg,
1086                                   }]);
1087     close ($logfh) or die "Unable to close $log_location: $!";
1088 }
1089
1090 sub finish {
1091     my ($exit) = @_;
1092     $exit ||= 0;
1093     utime(time,time,"db");
1094     # cleanups are run in an end block now.
1095     #my ($u);
1096     #while ($u= $cleanups[$#cleanups]) { &$u; }
1097     unlink("incoming/P$nn") || die "unlinking incoming/P$nn: $!";
1098     exit $exit;
1099 }
1100
1101 die "wot no exit";
1102
1103 sub htmllog {
1104     my ($whatobj,$whatverb,$where,$desc) = @_;
1105     append_action_to_log(bug => $ref,
1106                          action => "$whatobj $whatverb",
1107                          requester => '',
1108                          request_addr => $where,
1109                          desc         => $desc,
1110                          get_lock     => 0,
1111                         );
1112 }
1113
1114 sub stripbccs {
1115     my $msg = shift;
1116     my $ret = '';
1117     my $bcc = 0;
1118     while ($msg =~ s/(.*\n)//) {
1119         local $_ = $1;
1120         if (/^$/) {
1121             $ret .= $_;
1122             last;
1123         }
1124         if ($bcc) {
1125             # strip continuation lines too
1126             next if /^\s/;
1127             $bcc = 0;
1128         }
1129         if (/^Bcc:/i) {
1130             $bcc = 1;
1131         } else {
1132             $ret .= $_;
1133         }
1134     }
1135     return $ret . $msg;
1136 }
1137
1138 =head2 send_message
1139
1140      send_message($the_message,\@recipients,\@bcc,$do_not_encode)
1141
1142 The first argument is the scalar message, the second argument is the
1143 arrayref of recipients, the third is the arrayref of Bcc:'ed
1144 recipients.
1145
1146 The final argument turns off header encoding and the addition of the
1147 X-Loop header if true, defaults to false.
1148
1149 =cut
1150
1151
1152 sub sendmessage {
1153     my ($msg,$recips,$bcc,$no_encode) = @_;
1154     if (not defined $recips or (!ref($recips) && $recips eq '')
1155         or @$recips == 0) {
1156         $recips = ['-t'];
1157     }
1158     # This is suboptimal. The right solution is to send headers
1159     # separately from the rest of the message and encode them rather
1160     # than doing this.
1161     $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
1162     # The original message received is written out in appendlog, so
1163     # before writing out the other messages we've sent out, we need to
1164     # RFC1522 encode the header.
1165     $msg = encode_headers($msg) unless $no_encode;
1166
1167     my $hash = get_hashname($ref);
1168     #save email to the log
1169     my $logfh = IO::File->new(">>db-h/${hash}/${ref}.log") or
1170         die "opening db-h/$hash/${ref}.log: $!";
1171     write_log_records(logfh => $logfh,
1172                       records => {text => stripbccs($msg),
1173                                   type => 'recips',
1174                                   recips => [@{$recips}],
1175                                  },
1176                      );
1177     if (ref($bcc)) {
1178         shift @$recips if $recips->[0] eq '-t';
1179         push @$recips, @$bcc;
1180     }
1181
1182     send_mail_message(message        => $msg,
1183                       # Because we encode the headers above, we do not want to encode them here
1184                       encode_headers => 0,
1185                       recipients     => $recips);
1186 }
1187
1188 =head2 message_body_template
1189
1190      message_body_template('mail/ack',{ref=>'foo'});
1191
1192 Creates a message body using a template
1193
1194 =cut
1195
1196 sub message_body_template{
1197      my ($template,$extra_var) = @_;
1198      $extra_var ||={};
1199      my $body = fill_template($template,$extra_var);
1200      return fill_template('mail/message_body',
1201                           {%{$extra_var},
1202                            body => $body,
1203                           },
1204                          );
1205 }
1206
1207 =head2 fill_template
1208
1209      fill_template('mail/foo',{foo=>'bar'});
1210
1211 Calls fill_in_template with a default set of variables and any extras
1212 added in.
1213
1214 =cut
1215
1216 sub fill_template{
1217      my ($template,$extra_var) = @_;
1218      $extra_var ||={};
1219      my $variables = {config => \%config,
1220                       defined($ref)?(ref    => $ref):(),
1221                       defined($data)?(data  => $data):(),
1222                       refs => [map {exists $clonebugs{$_}?$clonebugs{$_}:$_} keys %bug_affected],
1223                       %{$extra_var},
1224                      };
1225      my $hole_var = {'&bugurl' =>
1226                      sub{"$_[0]: ".
1227                               'http://'.$config{cgi_domain}.'/'.
1228                                    Debbugs::CGI::bug_links(bug=>$_[0],
1229                                                            links_only => 1,
1230                                                           );
1231                     }
1232                     };
1233      return fill_in_template(template => $template,
1234                              variables => $variables,
1235                              hole_var  => $hole_var,
1236                             );
1237 }
1238
1239
1240 # this shole routine is *bad*; will be changed to use
1241 # Debbugs::Recipients and stuff therin in short order.
1242 sub checkmaintainers {
1243     return if $maintainerschecked++;
1244     return if !length($data->{package});
1245
1246     my $anymaintfound=0; my $anymaintnotfound=0;
1247     for my $p (splitpackages($data->{package})) {
1248         $p =~ y/A-Z/a-z/;
1249         $p =~ /((?:src:)?[a-z0-9.+-]+)/;
1250         $p = $1;
1251         next unless defined $p;
1252         if (defined $gSubscriptionDomain) {
1253             my @source = binary_to_source(binary => $p,
1254                                           source_only => 1,
1255                                          );
1256             if (@source) {
1257                 push @addsrcaddrs,
1258                     map {"$_\@$gSubscriptionDomain"} @source;
1259             } else {
1260                 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1261             }
1262         }
1263         # this is utter hackery until we switch to Debbugs::Recipients
1264         my @maints = package_maintainer(binary => $p);
1265         if (@maints) {
1266             print {$debugfh} "maintainer add >$p|".join(',',@maints)."<\n";
1267             my %temp;
1268             @temp{@maintaddrs} = @maintaddrs;
1269             push(@maintaddrs,
1270                  grep {$_ ne $replyto and
1271                            not exists $temp{$_}} @maints);
1272             $anymaintfound++;
1273         } else {
1274             print {$debugfh} "maintainer none >$p<\n";
1275             push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1276             $anymaintnotfound++;
1277             last;
1278         }
1279     }
1280
1281     if (defined $data->{owner} and length $data->{owner}) {
1282         print {$debugfh} "owner add >$data->{package}|$data->{owner}<\n";
1283         my $addmaint = $data->{owner};
1284         push(@maintaddrs, $addmaint) unless
1285             $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1286     }
1287 }
1288
1289 =head2 bug_list_forward
1290
1291      bug_list_forward($spool_filename) if $codeletter eq 'L';
1292
1293
1294 Given the spool file, will forward a bug to the per bug mailing list
1295 subscription system.
1296
1297 =cut
1298
1299 sub bug_list_forward{
1300      my ($bug_fn) = @_;
1301      # Read the bug information and package information for passing to
1302      # the mailing list
1303      my $bug_fh = IO::File->new("incoming/P$bug_fn",'r') or
1304           die "Unable to open incoming/P$bug_fn $!";
1305
1306      if (not defined $config{bug_subscription_domain} or not
1307          length $config{bug_subscription_domain}) {
1308           unlink("incoming/P$bug_fn") or
1309                die "unlinking incoming/P$bug_fn: $!";
1310           exit 0;
1311      }
1312
1313      my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
1314      my $data = read_bug(bug => $bug_number);
1315
1316      local $/ = undef;
1317      my $bug_message = <$bug_fh>;
1318      my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
1319      my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
1320      if (not defined $envelope_from) {
1321           # Try to use the From: header or something to set it
1322           ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
1323           # Kludgy, and should really be using a full scale header
1324           # parser to do this.
1325           $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
1326      }
1327      my ($header,$body) = split /\n\n/, $bug_message, 2;
1328      # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
1329      $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
1330           qq(X-$gProject-PR-Package: $data->{package}\n).
1331                qq(X-$gProject-PR-Title: $data->{subject})
1332                if defined $data;
1333      print STDERR "Tried to loop me with $envelope_from\n"
1334           and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
1335      print {$debugfh} $envelope_from,qq(\n);
1336      # If we don't have a bug address, something has gone horribly wrong.
1337      print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
1338      $bug_address =~ s/\@.+//;
1339      print {$debugfh} "Sending message to bugs=$bug_address\@$config{bug_subscription_domain}\n";
1340      print {$debugfh} $header.qq(\n\n).$body;
1341      send_mail_message(message        => $header.qq(\n\n).$body,
1342                        recipients     => ["bugs=$bug_address\@$config{bug_subscription_domain}"],
1343                        envelope_from  => $envelope_from,
1344                        encode_headers => 0,
1345                       );
1346      unlink("incoming/P$bug_fn") || die "unlinking incoming/P$bug_fn: $!";
1347      exit 0;
1348 }