scripts/process.in

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