scripts/process.in

   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 POSIX qw(strftime tzset);
   8 $ENV{"TZ"} = 'UTC';
   9 tzset();
  10
  11 use MIME::Parser;
  12 use Debbugs::MIME qw(decode_rfc1522 create_mime_message);
  13 use Debbugs::Mail qw(send_mail_message encode_headers);
  14
  15 $config_path = '/etc/debbugs';
  16 $lib_path = '/usr/lib/debbugs';
  17
  18 require "$config_path/config";
  19 require "$lib_path/errorlib";
  20 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
  21
  22 chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
  23
  24 #open(DEBUG,"> /tmp/debbugs.debug");
  25 umask(002);
  26 open DEBUG, ">/dev/null";
  27
  28 defined( $intdate= time ) || &quit( "failed to get time: $!" );
  29
  30 $_=shift;
  31 m/^([BMQFDUL])(\d*)\.\d+$/ || &quit("bad argument");
  32 $codeletter= $1;
  33 $tryref= length($2) ? $2+0 : -1;
  34 $nn= $_;
  35
  36 if (!rename("incoming/G$nn","incoming/P$nn"))
  37 {
  38     $_=$!.'';  m/no such file or directory/i && exit 0;
  39     &quit("renaming to lock: $!");
  40 }
  41
  42 $baddress= 'submit' if $codeletter eq 'B';
  43 $baddress= 'maintonly' if $codeletter eq 'M';
  44 $baddress= 'quiet' if $codeletter eq 'Q';
  45 $baddress= 'forwarded' if $codeletter eq 'F';
  46 $baddress= 'done' if $codeletter eq 'D';
  47 $baddress= 'submitter' if $codeletter eq 'U';
  48 bug_list_forward($nn) if $codeletter eq 'L';
  49 $baddress || &quit("bad codeletter $codeletter");
  50 $baddressroot= $baddress;
  51 $baddress= "$tryref-$baddress" if $tryref>=0;
  52
  53 open(M,"incoming/P$nn");
  54 @log=<M>;
  55 close(M);
  56
  57 @msg=@log;
  58 chomp @msg;
  59
  60 print DEBUG "###\n",join("##\n",@msg),"\n###\n";
  61
  62 $tdate = strftime "%a, %d %h %Y %T UTC", localtime;
  63 $fwd= <<END;
  64 Received: via spool by $baddress\@$gEmailDomain id=$nn
  65           (code $codeletter ref $tryref); $tdate
  66 END
  67
  68 # header and decoded body respectively
  69 my (@headerlines, @bodylines);
  70
  71 my $parser = new MIME::Parser;
  72 mkdir "$gSpoolDir/mime.tmp", 0777;
  73 $parser->output_under("$gSpoolDir/mime.tmp");
  74 my $entity = eval { $parser->parse_data(join('',@log)) };
  75
  76 if ($entity and $entity->head->tags) {
  77     @headerlines = @{$entity->head->header};
  78     chomp @headerlines;
  79
  80     my $entity_body = getmailbody($entity);
  81     @bodylines = $entity_body ? $entity_body->as_lines() : ();
  82     chomp @bodylines;
  83
  84     # set $i to beginning of encoded body data, so we can dump it out
  85     # verbatim later
  86     $i = 0;
  87     ++$i while $msg[$i] =~ /./;
  88 } else {
  89     # Legacy pre-MIME code, kept around in case MIME::Parser fails.
  90     for ($i = 0; $i <= $#msg; $i++) {
  91         $_ = $msg[$i];
  92         last unless length($_);
  93         while ($msg[$i+1] =~ m/^\s/) {
  94             $i++;
  95             $_ .= "\n".$msg[$i];
  96         }
  97         push @headerlines, $_;
  98     }
  99
 100     @bodylines = @msg[$i..$#msg];
 101 }
 102
 103 my %header;
 104
 105 for my $hdr (@headerlines) {
 106     $hdr = decode_rfc1522($hdr);
 107     $_ = $hdr;
 108     s/\n\s/ /g;
 109     &finish if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
 110     my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
 111            && !m/^From / && !m/^X-Debbugs-/i;
 112     $fwd .= $hdr."\n" if $ins;
 113     # print DEBUG ">$_<\n";
 114     if (s/^(\S+):\s*//) {
 115         my $v = lc $1;
 116         print DEBUG ">$v=$_<\n";
 117         $header{$v} = $_;
 118     } else {
 119         print DEBUG "!>$_<\n";
 120     }
 121 }
 122
 123 # remove blank lines
 124 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
 125
 126 # Strip off RFC2440-style PGP clearsigning.
 127 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
 128     shift @bodylines while @bodylines and length $bodylines[0];
 129     shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
 130     for my $findsig (0 .. $#bodylines) {
 131         if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
 132             $#bodylines = $findsig - 1;
 133             last;
 134         }
 135     }
 136     map { s/^- // } @bodylines;
 137 }
 138
 139 # extract pseudo-headers
 140 for my $phline (@bodylines)
 141 {
 142     last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
 143     my ($fn, $fv) = ($1, $2);
 144     $fv =~ s/\s*$//;
 145     print DEBUG ">$fn|$fv|\n";
 146     $fn = lc $fn;
 147     $fv = lc $fv;
 148     $pheader{$fn} = $fv;
 149     print DEBUG ">$fn~$fv<\n";
 150 }
 151
 152 # Allow pseudo headers to set x-debbugs- stuff [#179340]
 153 for my $key (grep /X-Debbugs-.*/i, keys %pheader) {
 154      $header{$key} = $pheader{$key} if not exists $header{$key};
 155 }
 156
 157 $fwd .= join("\n",@msg[$i..$#msg]);
 158
 159 print DEBUG "***\n$fwd\n***\n";
 160
 161 if (defined $header{'resent-from'} && !defined $header{'from'}) {
 162     $header{'from'} = $header{'resent-from'};
 163 }
 164 defined($header{'from'}) || &quit("no From header");
 165
 166 $replyto = $header{'reply-to'};
 167 $replyto = '' unless defined $replyto;
 168 $replyto =~ s/^ +//;
 169 $replyto =~ s/ +$//;
 170 unless (length $replyto) {
 171     $replyto = $header{'from'};
 172 }
 173
 174 $_= $replyto;
 175 $_= "$2 <$1>" if m/^([^\<\> \t\n\(\)]+) \(([^\(\)\<\>]+)\)$/;
 176 $replytocompare= $_;
 177 print DEBUG "replytocompare >$replytocompare<\n";
 178
 179 if (!defined($header{'subject'}))
 180 {
 181         $brokenness.= <<END;
 182
 183 Your message did not contain a Subject field. They are recommended and
 184 useful because the title of a $gBug is determined using this field.
 185 Please remember to include a Subject field in your messages in future.
 186 END
 187
 188 # RFC822 actually lists it as an `optional-field'.
 189
 190     $subject= '(no subject)';
 191 } else {
 192     $subject= $header{'subject'};
 193 }
 194
 195 $ref=-1;
 196 $subject =~ s/^Re:\s*//i; $_= $subject."\n";
 197 if ($tryref < 0 && m/^Bug ?\#(\d+)\D/i) {
 198     $tryref= $1+0;
 199 }
 200
 201 if ($tryref >= 0)
 202 {
 203     ($bfound, $data)= &lockreadbugmerge($tryref);
 204     if ($bfound) {
 205         $ref= $tryref;
 206     } else {
 207         &htmllog("Reply","sent", $replyto,"Unknown problem report number <code>$tryref</code>.");
 208         my $archivenote = '';
 209         if ($gRemoveAge) {
 210             $archivenote = <<END;
 211 This may be because that $gBug report has been resolved for more than $gRemoveAge
 212 days, and the record of it has been archived and made read-only, or
 213 because you mistyped the $gBug report number.
 214
 215 END
 216         }
 217         &sendmessage(<<END, '');
 218 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 219 To: $replyto
 220 Subject: Unknown problem report $gBug#$tryref ($subject)
 221 Message-ID: <handler.x.$nn.unknown\@$gEmailDomain>
 222 In-Reply-To: $header{'message-id'}
 223 References: $header{'message-id'} $data->{msgid}
 224 Precedence: bulk
 225 X-$gProject-PR-Message: error
 226
 227 You sent a message to the $gBug tracking system which gave (in the
 228 Subject line or encoded into the recipient at $gEmailDomain),
 229 the number of a nonexistent $gBug report (#$tryref).
 230
 231 ${archivenote}Your message was dated $header{'date'} and was sent to
 232 $baddress\@$gEmailDomain.  It had
 233 Message-ID $header{'message-id'}
 234 and Subject $subject.
 235
 236 It has been filed (under junk) but otherwise ignored.
 237
 238 Please consult your records to find the correct $gBug report number, or
 239 contact me, the system administrator, for assistance.
 240
 241 $gMaintainer
 242 (administrator, $gProject $gBugs database)
 243
 244 (NB: If you are a system administrator and have no idea what I am
 245 talking about this indicates a serious mail system misconfiguration
 246 somewhere.  Please contact me immediately.)
 247
 248 END
 249         &appendlog;
 250         &finish;
 251     }
 252 } else {
 253     &filelock('lock/-1');
 254 }
 255
 256 if ($codeletter eq 'D' || $codeletter eq 'F')
 257 {
 258     if ($replyto =~ m/$gBounceFroms/o ||
 259         $header{'from'} =~ m/$gBounceFroms/o)
 260     {
 261         &quit("bounce detected !  Mwaap! Mwaap!");
 262     }
 263     $markedby= $header{'from'} eq $replyto ? $replyto :
 264                "$header{'from'} (reply to $replyto)";
 265     my @generalcc;
 266     if ($codeletter eq 'F') {
 267         (&appendlog,&finish) if length($data->{forwarded});
 268         $receivedat= "forwarded\@$gEmailDomain";
 269         $markaswhat= 'forwarded';
 270         $set_forwarded= $header{'to'};
 271         if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
 272             push @generalcc, "$gForwardList\@$gListDomain";
 273             $generalcc= "$gForwardList\@$gListDomain";
 274         } else {
 275             $generalcc='';
 276         }
 277     } else {
 278         if (length($data->{done}) and
 279                 not defined $pheader{'source-version'} and
 280                 not defined $pheader{'version'}) {
 281             &appendlog;
 282             &finish;
 283         }
 284         $receivedat= "done\@$gEmailDomain";
 285         $markaswhat= 'done';
 286         $set_done= $header{'from'};
 287         if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
 288             $generalcc= "$gDoneList\@$gListDomain";
 289             push @generalcc, "$gDoneList\@$gListDomain";
 290         } else {
 291             $generalcc='';
 292         }
 293     }
 294     if (defined $gStrongList and isstrongseverity($data->{severity})) {
 295         $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
 296         push @generalcc,"$gStrongList\@$gListDomain";
 297     }
 298     if ($ref<0) {
 299         &htmllog("Warning","sent",$replyto,"Message ignored.");
 300         &sendmessage(<<END, '');
 301 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 302 To: $replyto
 303 Subject: Message with no $gBug number ignored by $receivedat
 304          ($subject)
 305 Message-ID: <header.x.$nn.warnignore\@$gEmailDomain>
 306 In-Reply-To: $header{'message-id'}
 307 References: $header{'message-id'} $data->{msgid}
 308 Precedence: bulk
 309 X-$gProject-PR-Message: error
 310
 311 You sent a message to the $gProject $gBug tracking system old-style
 312 unified mark as $markaswhat address ($receivedat),
 313 without a recognisable $gBug number in the Subject.
 314 Your message has been filed under junk but otherwise ignored.
 315
 316 If you don't know what I'm talking about then probably either:
 317
 318 (a) you unwittingly sent a message to done\@$gEmailDomain
 319 because you replied to all recipients of the message a developer used
 320 to mark a $gBug as done and you modified the Subject.  In this case,
 321 please do not be alarmed.  To avoid confusion do not do it again, but
 322 there is no need to apologise or mail anyone asking for an explanation.
 323
 324 (b) you are a system administrator, reading this because the $gBug
 325 tracking system is responding to a misdirected bounce message.  In this
 326 case there is a serious mail system misconfiguration somewhere - please
 327 contact me immediately.
 328
 329 Your message was dated $header{'date'} and had
 330 message-id $header{'message-id'}
 331 and subject $subject.
 332
 333 If you need any assistance or explanation please contact me.
 334
 335 $gMaintainer
 336 (administrator, $gProject $gBugs database)
 337
 338 END
 339         &appendlog;
 340         &finish;
 341     }
 342
 343     &checkmaintainers;
 344
 345     my @noticecc = grep($_ ne $replyto,@maintaddrs);
 346     $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
 347     $noticeccval =~ s/\s+\n\s+/ /g;
 348     $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
 349     if (length($noticeccval)) { $noticecc= "Cc: $noticeccval\n"; }
 350
 351     @process= ($ref,split(/ /,$data->{mergedwith}));
 352     $orgref= $ref;
 353
 354     for $ref (@process) {
 355         if ($ref != $orgref) {
 356             &unfilelock;
 357             $data = &lockreadbug($ref)
 358                 || die "huh ? $ref from $orgref out of @process";
 359         }
 360         $data->{done}= $set_done if defined($set_done);
 361         $data->{forwarded}= $set_forwarded if defined($set_forwarded);
 362         if ($codeletter eq 'D') {
 363             $data->{keywords} = join ' ', grep $_ ne 'pending',
 364                                      split ' ', $data->{keywords};
 365             if (defined $pheader{'source-version'}) {
 366                 addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
 367             } elsif (defined $pheader{version}) {
 368                 addfixedversions($data, $pheader{package}, $pheader{version}, 'binary');
 369             }
 370         }
 371
 372         # Add bug mailing list to $generalbcc as appropriate
 373         # This array is used to specify bcc in the cases where we're using create_mime_message.
 374         my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
 375         my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
 376         $generalbcc =~ s/\s+\n\s+/ /g;
 377         $generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
 378         if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
 379
 380         writebug($ref, $data);
 381
 382         my $hash = get_hashname($ref);
 383         open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!");
 384         $x= join('',<O>); close(O);
 385         if ($codeletter eq 'F') {
 386             &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
 387             &sendmessage(create_mime_message(
 388              ["X-Loop"      => "$gMaintainerEmail",
 389               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 390               To            => "$replyto",
 391               Subject       => "$gBug#$ref: marked as forwarded ($data->{subject})",
 392               "Message-ID"  => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
 393               "In-Reply-To" => $header{'message-id'},
 394               References    => "$header{'message-id'} $data->{msgid}",
 395               Precedence    => 'bulk',
 396               "X-$gProject-PR-Message"  => "forwarded $ref",
 397               "X-$gProject-PR-Package"  => $data->{package},
 398               "X-$gProject-PR-Keywords" => $data->{keywords}
 399              ],<<END ,[join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
 400 Your message dated $header{'date'}
 401 with message-id $header{'message-id'}
 402 has caused the $gProject $gBug report #$ref,
 403 regarding $data->{subject}
 404 to be marked as having been forwarded to the upstream software
 405 author(s) $data->{forwarded}.
 406
 407 (NB: If you are a system administrator and have no idea what I am
 408 talking about this indicates a serious mail system misconfiguration
 409 somewhere.  Please contact me immediately.)
 410
 411 $gMaintainer
 412 (administrator, $gProject $gBugs database)
 413
 414 END
 415
 416         } else {
 417             &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
 418             &sendmessage(create_mime_message(
 419              ["X-Loop"      => "$gMaintainerEmail",
 420               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 421               To            => $replyto,
 422               Subject       => "$gBug#$ref: marked as done ($data->{subject})",
 423               "Message-ID"  => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
 424               "In-Reply-To" => $header{'message-id'},
 425               References    => "$header{'message-id'} $data->{msgid}",
 426               Precedence    => 'bulk',
 427               "X-$gProject-PR-Message"  => "closed $ref",
 428               "X-$gProject-PR-Package"  => $data->{package},
 429               "X-$gProject-PR-Keywords" => $data->{keywords}
 430              ],<<END ,[$x,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
 431 Your message dated $header{'date'}
 432 with message-id $header{'message-id'}
 433 and subject line $subject
 434 has caused the attached $gBug report to be marked as done.
 435
 436 This means that you claim that the problem has been dealt with.
 437 If this is not the case it is now your responsibility to reopen the
 438 $gBug report if necessary, and/or fix the problem forthwith.
 439
 440 (NB: If you are a system administrator and have no idea what I am
 441 talking about this indicates a serious mail system misconfiguration
 442 somewhere.  Please contact me immediately.)
 443
 444 $gMaintainer
 445 (administrator, $gProject $gBugs database)
 446
 447 END
 448             &htmllog("Notification","sent",$data->{originator},
 449                 "$gBug acknowledged by developer.");
 450             &sendmessage(create_mime_message(
 451              ["X-Loop"      => "$gMaintainerEmail",
 452               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 453               To            => "$data->{originator}",
 454               Subject       => "$gBug#$ref closed by $markedby ($header{'subject'})",
 455               "Message-ID"  => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
 456               "In-Reply-To" => "$data->{msgid}",
 457               References    => "$header{'message-id'} $data->{msgid}",
 458               "X-$gProject-PR-Message"  => "they-closed $ref",
 459               "X-$gProject-PR-Package"  => "$data->{package}",
 460               "X-$gProject-PR-Keywords" => "$data->{keywords}",
 461               "Reply-To"                => "$ref\@$gEmailDomain",
 462               "Content-Type"            => 'text/plain; charset="utf-8"',
 463              ],<<END ,[join("\n",@msg)]),'',undef,1);
 464 This is an automatic notification regarding your $gBug report
 465 #$ref: $data->{subject},
 466 which was filed against the $data->{package} package.
 467
 468 It has been closed by $markedby.
 469
 470 Their explanation is attached below.  If this explanation is
 471 unsatisfactory and you have not received a better one in a separate
 472 message then please contact $markedby by replying
 473 to this email.
 474
 475 $gMaintainer
 476 (administrator, $gProject $gBugs database)
 477
 478 END
 479         }
 480         &appendlog;
 481     }
 482     &finish;
 483 }
 484
 485 if ($ref<0) {
 486     if ($codeletter eq 'U') {
 487         &htmllog("Warning","sent",$replyto,"Message not forwarded.");
 488         &sendmessage(<<END, '');
 489 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 490 To: $replyto
 491 Subject: Message with no $gBug number cannot be sent to submitter !
 492          ($subject)
 493 Message-ID: <handler.x.$nn.nonumnosub\@$gEmailDomain>
 494 In-Reply-To: $header{'message-id'}
 495 References: $header{'message-id'} $data->{msgid}
 496 Precedence: bulk
 497 X-$gProject-PR-Message: error
 498
 499 You sent a message to the $gProject $gBug tracking system's $gBug
 500 report submitter address $baddress\@$gEmailDomain, without a
 501 recognisable $gBug number in the Subject.  Your message has been filed
 502 under junk but otherwise ignored.
 503
 504 If you don't know what I'm talking about then probably either:
 505
 506 (a) you unwittingly sent a message to $baddress\@$gEmailDomain
 507 because you replied to all recipients of the message a developer sent
 508 to a $gBug\'s submitter and you modified the Subject.  In this case,
 509 please do not be alarmed.  To avoid confusion do not do it again, but
 510 there is no need to apologise or mail anyone asking for an
 511 explanation.
 512
 513 (b) you are a system administrator, reading this because the $gBug
 514 tracking system is responding to a misdirected bounce message.  In this
 515 case there is a serious mail system misconfiguration somewhere - please
 516 contact me immediately.
 517
 518 Your message was dated $header{'date'} and had
 519 message-id $header{'message-id'}
 520 and subject $subject.
 521
 522 If you need any assistance or explanation please contact me.
 523
 524 $gMaintainer
 525 (administrator, $gProject $gBugs database)
 526
 527 END
 528         &appendlog;
 529         &finish;
 530     }
 531
 532     $data->{found_versions} = [];
 533     $data->{fixed_versions} = [];
 534
 535     if (defined $pheader{source}) {
 536         $data->{package} = $pheader{source};
 537     } elsif (defined $pheader{package}) {
 538         $data->{package} = $pheader{package};
 539     } else {
 540         &htmllog("Warning","sent",$replyto,"Message not forwarded.");
 541         &sendmessage(create_mime_message(
 542                        ["X-Loop"      => "$gMaintainerEmail",
 543                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 544                         To            => $replyto,
 545                         Subject       => "Message with no Package: tag cannot be processed! ($subject)",
 546                         "Message-ID"  => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
 547                         "In-Reply-To" => $header{'message-id'},
 548                         References    => "$header{'message-id'} $data->{msgid}",
 549                         Precedence    => 'bulk',
 550                         "X-$gProject-PR-Message" => 'error'
 551                        ],<<END,[join("\n", @msg)]), '',undef,1);
 552
 553 Your message didn't have a Package: line at the start (in the
 554 pseudo-header following the real mail header), or didn't have a
 555 pseudo-header at all.  Your message has been filed under junk but
 556 otherwise ignored.
 557
 558 This makes it much harder for us to categorise and deal with your
 559 problem report. Please _resubmit_ your report to $baddress\@$gEmailDomain
 560 and tell us which package the report is on. For help, check out
 561 http://$gWebDomain/Reporting$gHTMLSuffix.
 562
 563 Your message was dated $header{'date'} and had
 564 message-id $header{'message-id'}
 565 and subject $subject.
 566 The complete text of it is attached to this message.
 567
 568 If you need any assistance or explanation please contact me.
 569
 570 $gMaintainer
 571 (administrator, $gProject $gBugs database)
 572
 573 END
 574         &appendlog;
 575         &finish;
 576     }
 577
 578     $data->{keywords}= '';
 579     if (defined($pheader{'keywords'})) {
 580         $data->{keywords}= $pheader{'keywords'};
 581     } elsif (defined($pheader{'tags'})) {
 582         $data->{keywords}= $pheader{'tags'};
 583     }
 584     if (length($data->{keywords})) {
 585         my @kws;
 586         my %gkws = map { ($_, 1) } @gTags;
 587         foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
 588             push @kws, $kw if (defined $gkws{$kw});
 589         }
 590         $data->{keywords} = join(" ", @kws);
 591     }
 592     $data->{severity}= '';
 593     if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
 594         $data->{severity}= $pheader{'severity'};
 595         $data->{severity}= $pheader{'priority'} unless ($data->{severity});
 596         $data->{severity} =~ s/^\s*(.+)\s*$/$1/;
 597
 598         if (!grep($_ eq $data->{severity}, @severities, "$gDefaultSeverity")) {
 599             $brokenness.= <<END;
 600
 601 Your message specified a Severity: in the pseudo-header, but
 602 the severity value $data->{severity} was not recognised.
 603 The default severity $gDefaultSeverity is being used instead.
 604 The recognised values are: $gShowSeverities.
 605 END
 606 # if we use @gSeverityList array in the above line, perl -c gives:
 607 # In string, @gSeverityList now must be written as \@gSeverityList at
 608 #          process line 452, near "$gDefaultSeverity is being used instead.
 609             $data->{severity}= '';
 610         }
 611     }
 612     if (defined($pheader{owner})) {
 613         $data->{owner}= $pheader{owner};
 614     }
 615     if (defined($pheader{forwarded})) {
 616         $data->{'forwarded-to'} = $pheader{forwarded};
 617     }
 618     &filelock("nextnumber.lock");
 619     open(N,"nextnumber") || &quit("nextnumber: read: $!");
 620     $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
 621     $ref= $v+0;  $v += 1;  $newref=1;
 622     &overwrite('nextnumber', "$v\n");
 623     &unfilelock;
 624     my $hash = get_hashname($ref);
 625     &overwrite("db-h/$hash/$ref.log",'');
 626     $data->{originator} = $replyto;
 627     $data->{date} = $intdate;
 628     $data->{subject} = $subject;
 629     $data->{msgid} = $header{'message-id'};
 630     writebug($ref, $data);
 631     &overwrite("db-h/$hash/$ref.report",
 632                join("\n",@msg)."\n");
 633 }
 634
 635 &checkmaintainers;
 636
 637 print DEBUG "maintainers >@maintaddrs<\n";
 638
 639 $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
 640 $newsubject= $subject;  $newsubject =~ s/^$gBug#$ref:*\s*//;
 641
 642 $xcchdr= $header{ 'x-debbugs-cc' };
 643 if ($xcchdr =~ m/\S/) {
 644     push(@resentccs,$xcchdr);
 645     $resentccexplain.= <<END;
 646
 647 As you requested using X-Debbugs-CC, your message was also forwarded to
 648    $xcchdr
 649 (after having been given a $gBug report number, if it did not have one).
 650 END
 651 }
 652
 653 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
 654     push(@resentccs,@maintaddrs);
 655     $resentccexplain.= <<END." ".join("\n ",@maintaddrs)."\n";
 656
 657 Your message has been sent to the package maintainer(s):
 658 END
 659 }
 660
 661 @bccs = @addsrcaddrs;
 662 if (defined $gStrongList and isstrongseverity($data->{severity})) {
 663     push @bccs, "$gStrongList\@$gListDomain";
 664 }
 665
 666 # Send mail to the per bug list subscription too
 667 push @bccs, "bugs=$ref\@$gListDomain";
 668
 669 if (defined $pheader{source}) {
 670     # Prefix source versions with the name of the source package. They
 671     # appear that way in version trees so that we can deal with binary
 672     # packages moving from one source package to another.
 673     if (defined $pheader{'source-version'}) {
 674         addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
 675     } elsif (defined $pheader{version}) {
 676         addfoundversions($data, $pheader{source}, $pheader{version}, '');
 677     }
 678     writebug($ref, $data);
 679 } elsif (defined $pheader{package}) {
 680     # TODO: could handle Source-Version: by looking up the source package?
 681     addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
 682     writebug($ref, $data);
 683 }
 684
 685 $veryquiet= $codeletter eq 'Q';
 686 if ($codeletter eq 'M' && !@maintaddrs) {
 687     $veryquiet= 1;
 688     $brokenness.= <<END;
 689
 690 You requested that the message be sent to the package maintainer(s)
 691 but either the $gBug report is not associated with any package (probably
 692 because of a missing Package pseudo-header field in the original $gBug
 693 report), or the package(s) specified do not have any maintainer(s).
 694
 695 Your message has *not* been sent to any package maintainers; it has
 696 merely been filed in the $gBug tracking system.  If you require assistance
 697 please contact $gMaintainerEmail quoting the $gBug number $ref.
 698 END
 699 }
 700
 701 $resentccval.= join(', ',@resentccs);
 702 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
 703 if (length($resentccval)) {
 704     $resentcc= "Resent-CC: $resentccval\n";
 705 }
 706
 707 if ($codeletter eq 'U') {
 708     &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
 709     &sendmessage(<<END,[$data->{originator},@resentccs],[@bccs]);
 710 Subject: $gBug#$ref: $newsubject
 711 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
 712 ${orgsender}Resent-To: $data->{originator}
 713 ${resentcc}Resent-Date: $tdate
 714 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 715 Resent-Sender: $gMaintainerEmail
 716 X-$gProject-PR-Message: report $ref
 717 X-$gProject-PR-Package: $data->{package}
 718 X-$gProject-PR-Keywords: $data->{keywords}
 719 $fwd
 720 END
 721 } elsif ($codeletter eq 'B') {
 722     &htmllog($newref ? "Report" : "Information", "forwarded",
 723              join(', ',"$gSubmitList\@$gListDomain",@resentccs),
 724              "<code>$gBug#$ref</code>".
 725              (length($data->{package})? "; Package <code>".&sani($data->{package})."</code>" : '').
 726              ".");
 727     &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
 728 Subject: $gBug#$ref: $newsubject
 729 Reply-To: $replyto, $ref\@$gEmailDomain
 730 Resent-From: $header{'from'}
 731 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
 732 ${resentcc}Resent-Date: $tdate
 733 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 734 Resent-Sender: $gMaintainerEmail
 735 X-$gProject-PR-Message: report $ref
 736 X-$gProject-PR-Package: $data->{package}
 737 X-$gProject-PR-Keywords: $data->{keywords}
 738 $fwd
 739 END
 740 } elsif (@resentccs or @bccs) {
 741     # D and F done far earlier; B just done - so this must be M or Q
 742     # We preserve whichever it was in the Reply-To (possibly adding
 743     # the $gBug#).
 744     if (@resentccs) {
 745         &htmllog($newref ? "Report" : "Information", "forwarded",
 746                  $resentccval,
 747                  "<code>$gBug#$ref</code>".
 748                  (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
 749                  ".");
 750     } else {
 751         &htmllog($newref ? "Report" : "Information", "stored",
 752                  "",
 753                  "<code>$gBug#$ref</code>".
 754                  (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
 755                  ".");
 756     }
 757     &sendmessage(<<END,[@resentccs],[@bccs]);
 758 Subject: $gBug#$ref: $newsubject
 759 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
 760 Resent-From: $header{'from'}
 761 ${orgsender}Resent-To: $resentccval
 762 Resent-Date: $tdate
 763 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 764 Resent-Sender: $gMaintainerEmail
 765 X-$gProject-PR-Message: report $ref
 766 X-$gProject-PR-Package: $data->{package}
 767 X-$gProject-PR-Keywords: $data->{keywords}
 768 $fwd
 769 END
 770 }
 771
 772 $htmlbreak= length($brokenness) ? "<p>\n".&sani($brokenness)."\n<p>\n" : '';
 773 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
 774 if (length($resentccval)) {
 775     $htmlbreak = "  Copy sent to <code>".&sani($resentccval)."</code>.".
 776         $htmlbreak;
 777 }
 778 unless (exists $header{'x-debbugs-no-ack'}) {
 779     if ($newref) {
 780         &htmllog("Acknowledgement","sent",$replyto,
 781                  ($veryquiet ?
 782                   "New $gBug report received and filed, but not forwarded." :
 783                   "New $gBug report received and forwarded."). $htmlbreak);
 784         if ($veryquiet) {
 785              &sendmessage(create_mime_message(
 786                        ["X-Loop"      => "$gMaintainerEmail",
 787                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 788                         To            => $replyto,
 789                         Subject       => "$gBug#$ref: Acknowledgement of QUIET report ($subject)",
 790                         "Message-ID"  => "<handler.$ref.$nn.ackquiet\@$gEmailDomain>",
 791                         "In-Reply-To" => $header{'message-id'},
 792                         References    => $header{'message-id'},
 793                         Precedence    => 'bulk',
 794                         "X-$gProject-PR-Message"  => "ack-quiet $ref",
 795                         "X-$gProject-PR-Package"  => $data->{package},
 796                         "X-$gProject-PR-Keywords" => $data->{keywords},
 797                         "Reply-To"                => "$ref-quiet\@$gEmailDomain",
 798                        ],<<END,[join("\n", @msg)]), '',undef,1);
 799 Thank you for the problem report you have sent regarding $gProject.
 800 This is an automatically generated reply, to let you know your message
 801 has been received.  It has not been forwarded to the package maintainers
 802 or other interested parties; you should ensure that the developers are
 803 aware of the problem you have entered into the system - preferably
 804 quoting the $gBug reference number, #$ref.
 805 $resentccexplain
 806 If you wish to submit further information on your problem, please send it
 807 to $ref-$baddressroot\@$gEmailDomain (and *not*
 808 to $baddress\@$gEmailDomain).
 809
 810 Please do not reply to the address at the top of this message,
 811 unless you wish to report a problem with the $gBug-tracking system.
 812 $brokenness
 813 $gMaintainer
 814 (administrator, $gProject $gBugs database)
 815 END
 816         }
 817         elsif ($codeletter eq 'M') {
 818              &sendmessage(create_mime_message(
 819                        ["X-Loop"      => "$gMaintainerEmail",
 820                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 821                         To            => $replyto,
 822                         Subject       => "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)",
 823                         "Message-ID"  => "<handler.$ref.$nn.ackmaint\@$gEmailDomain>",
 824                         "In-Reply-To" => $header{'message-id'},
 825                         References    => $header{'message-id'},
 826                         Precedence    => 'bulk',
 827                         "X-$gProject-PR-Message" => "ack-maintonly $ref",
 828                         "X-$gProject-PR-Package"  => $data->{package},
 829                         "X-$gProject-PR-Keywords" => $data->{keywords},
 830                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
 831                        ],<<END,[]), '',undef,1);
 832 Thank you for the problem report you have sent regarding $gProject.
 833 This is an automatically generated reply, to let you know your message has
 834 been received.  It is being forwarded to the package maintainers (but not
 835 other interested parties, as you requested) for their attention; they will
 836 reply in due course.
 837 $resentccexplain
 838 If you wish to submit further information on your problem, please send
 839 it to $ref-$baddressroot\@$gEmailDomain (and *not*
 840 to $baddress\@$gEmailDomain).
 841
 842 Please do not reply to the address at the top of this message,
 843 unless you wish to report a problem with the $gBug-tracking system.
 844 $brokenness
 845 $gMaintainer
 846 (administrator, $gProject $gBugs database)
 847 END
 848                    }
 849         else {
 850              &sendmessage(create_mime_message(
 851                        ["X-Loop"      => "$gMaintainerEmail",
 852                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 853                         To            => $replyto,
 854                         Subject       => "$gBug#$ref: Acknowledgement ($subject)",
 855                         "Message-ID"  => "<handler.$ref.$nn.ack\@$gEmailDomain>",
 856                         "In-Reply-To" => $header{'message-id'},
 857                         References    => $header{'message-id'},
 858                         Precedence    => 'bulk',
 859                         "X-$gProject-PR-Message"  => "ack $ref",
 860                         "X-$gProject-PR-Package"  => $data->{package},
 861                         "X-$gProject-PR-Keywords" => $data->{keywords},
 862                         "Reply-To"                => "$ref\@$gEmailDomain",
 863                        ],<<END,[]), '',undef,1);
 864 Thank you for the problem report you have sent regarding $gProject.
 865 This is an automatically generated reply, to let you know your message has
 866 been received.  It is being forwarded to the package maintainers and other
 867 interested parties for their attention; they will reply in due course.
 868 $resentccexplain
 869 If you wish to submit further information on your problem, please send
 870 it to $ref\@$gEmailDomain (and *not* to
 871 $baddress\@$gEmailDomain).
 872
 873 Please do not reply to the address at the top of this message,
 874 unless you wish to report a problem with the $gBug-tracking system.
 875 $brokenness
 876 $gMaintainer
 877 (administrator, $gProject $gBugs database)
 878 END
 879                    }
 880     } elsif ($codeletter ne 'U' and
 881              $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/ and
 882              # Workaround for gcc mail loops; bugzilla should do Precedence:
 883              # instead. Deliberately not in CVS. - cjwatson
 884              not exists $header{'x-bugzilla-reason'}) {
 885         &htmllog("Acknowledgement","sent",$replyto,
 886                  ($veryquiet ? "Extra info received and filed, but not forwarded." :
 887                   $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
 888                   "Extra info received and forwarded to list."). $htmlbreak);
 889         if ($veryquiet) {
 890              &sendmessage(create_mime_message(
 891                        ["X-Loop"      => "$gMaintainerEmail",
 892                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 893                         To            => $replyto,
 894                         Subject       => "$gBug#$ref: Info received and FILED only (was $subject)",
 895                         "Message-ID"  => "<handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>",
 896                         "In-Reply-To" => $header{'message-id'},
 897                         References    => $header{'message-id'},
 898                         Precedence    => 'bulk',
 899                         "X-$gProject-PR-Message" => "ack-info-quiet $ref",
 900                         "X-$gProject-PR-Package"  => $data->{package},
 901                         "X-$gProject-PR-Keywords" => $data->{keywords},
 902                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
 903                        ],<<END,[]), '',undef,1);
 904 Thank you for the additional information you have supplied regarding
 905 this problem report.  It has NOT been forwarded to the package
 906 maintainers, but will accompany the original report in the $gBug
 907 tracking system.  Please ensure that you yourself have sent a copy of
 908 the additional information to any relevant developers or mailing lists.
 909 $resentccexplain
 910 If you wish to continue to submit further information on your problem,
 911 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 912
 913 Please do not reply to the address at the top of this message,
 914 unless you wish to report a problem with the $gBug-tracking system.
 915 $brokenness
 916 $gMaintainer
 917 (administrator, $gProject $gBugs database)
 918 END
 919                  }
 920         elsif ($codeletter eq 'M') {
 921              &sendmessage(create_mime_message(
 922                        ["X-Loop"      => "$gMaintainerEmail",
 923                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 924                         To            => $replyto,
 925                         Subject       => "$gBug#$ref: Info received for maintainer only (was $subject)",
 926                         "Message-ID"  => "<handler.$ref.$nn.ackinfomaint\@$gEmailDomain>",
 927                         "In-Reply-To" => $header{'message-id'},
 928                         References    => "$header{'message-id'} $data->{msgid}",
 929                         Precedence    => 'bulk',
 930                         "X-$gProject-PR-Message" => "ack-info-maintonly $ref",
 931                         "X-$gProject-PR-Package"  => $data->{package},
 932                         "X-$gProject-PR-Keywords" => $data->{keywords},
 933                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
 934                        ],<<END,[]), '',undef,1);
 935 Thank you for the additional information you have supplied regarding
 936 this problem report.  It has been forwarded to the package maintainer(s)
 937 (but not to other interested parties) to accompany the original report.
 938 $resentccexplain
 939 If you wish to continue to submit further information on your problem,
 940 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 941
 942 Please do not reply to the address at the top of this message,
 943 unless you wish to report a problem with the $gBug-tracking system.
 944 $brokenness
 945 $gMaintainer
 946 (administrator, $gProject $gBugs database)
 947 END
 948                    }
 949         else {
 950              &sendmessage(create_mime_message(
 951                        ["X-Loop"      => "$gMaintainerEmail",
 952                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 953                         To            => $replyto,
 954                         Subject       => "$gBug#$ref: Info received ($subject)",
 955                         "Message-ID"  => "<handler.$ref.$nn.ackinfo\@$gEmailDomain>",
 956                         "In-Reply-To" => $header{'message-id'},
 957                         References    => "$header{'message-id'} $data->{msgid}",
 958                         Precedence    => 'bulk',
 959                         "X-$gProject-PR-Message"  => "ack-info $ref",
 960                         "X-$gProject-PR-Package"  => $data->{package},
 961                         "X-$gProject-PR-Keywords" => $data->{keywords},
 962                         "Reply-To"                => "$ref\@$gEmailDomain",
 963                        ],<<END,[]), '',undef,1);
 964 Thank you for the additional information you have supplied regarding
 965 this problem report.  It has been forwarded to the package maintainer(s)
 966 and to other interested parties to accompany the original report.
 967 $resentccexplain
 968 If you wish to continue to submit further information on your problem,
 969 please send it to $ref\@$gEmailDomain, as before.
 970
 971 Please do not reply to the address at the top of this message,
 972 unless you wish to report a problem with the $gBug-tracking system.
 973 $brokenness
 974 $gMaintainer
 975 (administrator, $gProject $gBugs database)
 976 END
 977
 978                    }
 979    }
 980 }
 981
 982 &appendlog;
 983 &finish;
 984
 985 sub overwrite {
 986     local ($f,$v) = @_;
 987     open(NEW,">$f.new") || &quit("$f.new: create: $!");
 988     print(NEW "$v") || &quit("$f.new: write: $!");
 989     close(NEW) || &quit("$f.new: close: $!");
 990     rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
 991 }
 992
 993 sub appendlog {
 994     my $hash = get_hashname($ref);
 995     if (!open(AP,">>db-h/$hash/$ref.log")) {
 996         print DEBUG "failed open log<\n";
 997         print DEBUG "failed open log err $!<\n";
 998         &quit("opening db-h/$hash/$ref.log (li): $!");
 999     }
1000     print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
1001     close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
1002 }
1003
1004 sub finish {
1005     utime(time,time,"db");
1006     local ($u);
1007     while ($u= $cleanups[$#cleanups]) { &$u; }
1008     unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1009     exit $_[0];
1010 }
1011
1012 &quit("wot no exit");
1013
1014 sub chldhandle { $chldexit = 'yes'; }
1015
1016 sub htmllog {
1017     local ($whatobj,$whatverb,$where,$desc) = @_;
1018     my $hash = get_hashname($ref);
1019     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
1020     print(AP
1021           "\6\n".
1022           "<strong>$whatobj $whatverb</strong>".
1023           ($where eq '' ? "" : " to <code>".&sani($where)."</code>").
1024           ":<br>\n". $desc.
1025           "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
1026     close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
1027 }
1028
1029 sub stripbccs {
1030     my $msg = shift;
1031     my $ret = '';
1032     my $bcc = 0;
1033     while ($msg =~ s/(.*\n)//) {
1034         local $_ = $1;
1035         if (/^$/) {
1036             $ret .= $_;
1037             last;
1038         }
1039         if ($bcc) {
1040             # strip continuation lines too
1041             next if /^\s/;
1042             $bcc = 0;
1043         }
1044         if (/^Bcc:/i) {
1045             $bcc = 1;
1046         } else {
1047             $ret .= $_;
1048         }
1049     }
1050     return $ret . $msg;
1051 }
1052
1053 =head2 send_message
1054
1055      send_message($the_message,\@recipients,\@bcc,$do_not_encode)
1056
1057 The first argument is the scalar message, the second argument is the
1058 arrayref of recipients, the third is the arrayref of Bcc:'ed
1059 recipients.
1060
1061 The final argument turns off header encoding and the addition of the
1062 X-Loop header if true, defaults to false.
1063
1064 =cut
1065
1066
1067 sub sendmessage {
1068     my ($msg,$recips,$bcc,$no_encode) = @_;
1069     if (not defined $recips or (!ref($recips) && $recips eq '')
1070         or @$recips == 0) {
1071         $recips = ['-t'];
1072     }
1073     # This is suboptimal. The right solution is to send headers
1074     # separately from the rest of the message and encode them rather
1075     # than doing this.
1076     $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
1077     # The original message received is written out in appendlog, so
1078     # before writing out the other messages we've sent out, we need to
1079     # RFC1522 encode the header.
1080     $msg = encode_headers($msg) unless $no_encode;
1081
1082     my $hash = get_hashname($ref);
1083     #save email to the log
1084     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
1085     print(AP "\2\n",join("\4",@$recips),"\n\5\n",
1086           @{escapelog(stripbccs($msg))},"\n\3\n") ||
1087         &quit("writing db-h/$hash/$ref.log (lo): $!");
1088     close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
1089
1090     if (ref($bcc)) {
1091         shift @$recips if $recips->[0] eq '-t';
1092         push @$recips, @$bcc;
1093     }
1094
1095     send_mail_message(message        => $msg,
1096                       # Because we encode the headers above, we do not want to encode them here
1097                       encode_headers => 0,
1098                       recipients     => $recips);
1099 }
1100
1101 sub checkmaintainers {
1102     return if $maintainerschecked++;
1103     return if !length($data->{package});
1104     open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1105     while (<MAINT>) {
1106         m/^\n$/ && next;
1107         m/^\s*$/ && next;
1108         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1109         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1110         # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1111         $maintainerof{$a}= $2;
1112     }
1113     close(MAINT);
1114     open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1115     while (<MAINT>) {
1116         m/^\n$/ && next;
1117         m/^\s*$/ && next;
1118         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1119         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1120         # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1121         $maintainerof{$a}= $2;
1122     }
1123     close(MAINT);
1124     open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
1125     while (<SOURCES>) {
1126         next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1127         ($a,$b)=($1,$2);
1128         $a =~ y/A-Z/a-z/;
1129         $pkgsrc{$a} = $b;
1130     }
1131     close(SOURCES);
1132     $anymaintfound=0; $anymaintnotfound=0;
1133     for $p (split(m/[ \t?,():]+/,$data->{package})) {
1134         $p =~ y/A-Z/a-z/;
1135         $p =~ /([a-z0-9.+-]+)/;
1136         $p = $1;
1137         next unless defined $p;
1138         if (defined $gSubscriptionDomain) {
1139             if (defined($pkgsrc{$p})) {
1140                 push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
1141             } else {
1142                 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1143             }
1144         }
1145         if (defined($maintainerof{$p})) {
1146             print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
1147             $addmaint= $maintainerof{$p};
1148             push(@maintaddrs,$addmaint) unless
1149                 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
1150             $anymaintfound++;
1151         } else {
1152             print DEBUG "maintainer none >$p<\n";
1153             push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1154             $anymaintnotfound++;
1155             last;
1156         }
1157     }
1158
1159     if (length $data->{owner}) {
1160         print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
1161         $addmaint = $data->{owner};
1162         push(@maintaddrs, $addmaint) unless
1163             $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1164     }
1165 }
1166
1167 =head2 bug_list_forward
1168
1169      bug_list_forward($spool_filename) if $codeletter eq 'L';
1170
1171
1172 Given the spool file, will forward a bug to the per bug mailing list
1173 subscription system.
1174
1175 =cut
1176
1177 sub bug_list_forward{
1178      my ($bug_fn) = @_;
1179      # Read the bug information and package information for passing to
1180      # the mailing list
1181      my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
1182      my ($bfound, $data)= lockreadbugmerge($bug_number);
1183      my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!";
1184
1185      local $/ = undef;
1186      my $bug_message = <$bug_fh>;
1187      my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
1188      my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
1189      if (not defined $envelope_from) {
1190           # Try to use the From: header or something to set it
1191           ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
1192           # Kludgy, and should really be using a full scale header
1193           # parser to do this.
1194           $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
1195      }
1196      my ($header,$body) = split /\n\n/, $bug_message, 2;
1197      # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
1198      $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
1199           qq(X-$gProject-PR-Package: $data->{package}\n).
1200                qq(X-$gProject-PR-Title: $data->{subject})
1201                if defined $data;
1202      print STDERR "Tried to loop me with $envelope_from\n"
1203           and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
1204      print DEBUG $envelope_from,qq(\n);
1205      # If we don't have a bug address, something has gone horribly wrong.
1206      print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
1207      $bug_address =~ s/\@.+//;
1208      print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
1209      print DEBUG $header.qq(\n\n).$body;
1210      send_mail_message(message        => $header.qq(\n\n).$body,
1211                        recipients     => ["bugs=$bug_address\@$gListDomain"],
1212                        envelope_from  => $envelope_from,
1213                        encode_headers => 0,
1214                       );
1215      unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");
1216      exit 0;
1217 }