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