scripts/process.in

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