scripts/process.in

   1 #!/usr/bin/perl
   2 # $Id: process.in,v 1.100 2005/07/30 03:22:36 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 = 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
 151 $fwd .= join("\n",@msg[$i..$#msg]);
 152
 153 print DEBUG "***\n$fwd\n***\n";
 154
 155 if (defined $header{'resent-from'} && !defined $header{'from'}) {
 156     $header{'from'} = $header{'resent-from'};
 157 }
 158 defined($header{'from'}) || &quit("no From header");
 159
 160 $replyto = $header{'reply-to'};
 161 $replyto = '' unless defined $replyto;
 162 $replyto =~ s/^ +//;
 163 $replyto =~ s/ +$//;
 164 unless (length $replyto) {
 165     $replyto = $header{'from'};
 166 }
 167
 168 $_= $replyto;
 169 $_= "$2 <$1>" if m/^([^\<\> \t\n\(\)]+) \(([^\(\)\<\>]+)\)$/;
 170 $replytocompare= $_;
 171 print DEBUG "replytocompare >$replytocompare<\n";
 172
 173 if (!defined($header{'subject'}))
 174 {
 175         $brokenness.= <<END;
 176
 177 Your message did not contain a Subject field. They are recommended and
 178 useful because the title of a $gBug is determined using this field.
 179 Please remember to include a Subject field in your messages in future.
 180 END
 181
 182 # RFC822 actually lists it as an `optional-field'.
 183
 184     $subject= '(no subject)';
 185 } else {
 186     $subject= $header{'subject'};
 187 }
 188
 189 $ref=-1;
 190 $subject =~ s/^Re:\s*//i; $_= $subject."\n";
 191 if ($tryref < 0 && m/^Bug ?\#(\d+)\D/i) {
 192     $tryref= $1+0;
 193 }
 194
 195 if ($tryref >= 0)
 196 {
 197     ($bfound, $data)= &lockreadbugmerge($tryref);
 198     if ($bfound) {
 199         $ref= $tryref;
 200     } else {
 201         &htmllog("Reply","sent", $replyto,"Unknown problem report number <code>$tryref</code>.");
 202         my $archivenote = '';
 203         if ($gRemoveAge) {
 204             $archivenote = <<END;
 205 This may be because that $gBug report has been resolved for more than $gRemoveAge
 206 days, and the record of it has been archived and made read-only, or
 207 because you mistyped the $gBug report number.
 208
 209 END
 210         }
 211         &sendmessage(<<END, '');
 212 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 213 To: $replyto
 214 Subject: Unknown problem report $gBug#$tryref ($subject)
 215 Message-ID: <handler.x.$nn.unknown\@$gEmailDomain>
 216 In-Reply-To: $header{'message-id'}
 217 References: $header{'message-id'} $data->{msgid}
 218 Precedence: bulk
 219 X-$gProject-PR-Message: error
 220
 221 You sent a message to the $gBug tracking system which gave (in the
 222 Subject line or encoded into the recipient at $gEmailDomain),
 223 the number of a nonexistent $gBug report (#$tryref).
 224
 225 ${archivenote}Your message was dated $header{'date'} and was sent to
 226 $baddress\@$gEmailDomain.  It had
 227 Message-ID $header{'message-id'}
 228 and Subject $subject.
 229
 230 It has been filed (under junk) but otherwise ignored.
 231
 232 Please consult your records to find the correct $gBug report number, or
 233 contact me, the system administrator, for assistance.
 234
 235 $gMaintainer
 236 (administrator, $gProject $gBugs database)
 237
 238 (NB: If you are a system administrator and have no idea what I am
 239 talking about this indicates a serious mail system misconfiguration
 240 somewhere.  Please contact me immediately.)
 241
 242 END
 243         &appendlog;
 244         &finish;
 245     }
 246 } else {
 247     &filelock('lock/-1');
 248 }
 249
 250 if ($codeletter eq 'D' || $codeletter eq 'F')
 251 {
 252     if ($replyto =~ m/$gBounceFroms/o ||
 253         $header{'from'} =~ m/$gBounceFroms/o)
 254     {
 255         &quit("bounce detected !  Mwaap! Mwaap!");
 256     }
 257     $markedby= $header{'from'} eq $replyto ? $replyto :
 258                "$header{'from'} (reply to $replyto)";
 259     if ($codeletter eq 'F') {
 260         (&appendlog,&finish) if length($data->{forwarded});
 261         $receivedat= "forwarded\@$gEmailDomain";
 262         $markaswhat= 'forwarded';
 263         $set_forwarded= $header{'to'};
 264         if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
 265             $generalcc= "$gForwardList\@$gListDomain";
 266         } else {
 267             $generalcc='';
 268         }
 269     } else {
 270         if (length($data->{done}) and
 271                 not defined $pheader{'source-version'} and
 272                 not defined $pheader{'version'}) {
 273             &appendlog;
 274             &finish;
 275         }
 276         $receivedat= "done\@$gEmailDomain";
 277         $markaswhat= 'done';
 278         $set_done= $header{'from'};
 279         if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
 280             $generalcc= "$gDoneList\@$gListDomain";
 281         } else {
 282             $generalcc='';
 283         }
 284     }
 285     if (defined $gStrongList and isstrongseverity($data->{severity})) {
 286         $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
 287     }
 288     if ($ref<0) {
 289         &htmllog("Warning","sent",$replyto,"Message ignored.");
 290         &sendmessage(<<END, '');
 291 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 292 To: $replyto
 293 Subject: Message with no $gBug number ignored by $receivedat
 294          ($subject)
 295 Message-ID: <header.x.$nn.warnignore\@$gEmailDomain>
 296 In-Reply-To: $header{'message-id'}
 297 References: $header{'message-id'} $data->{msgid}
 298 Precedence: bulk
 299 X-$gProject-PR-Message: error
 300
 301 You sent a message to the $gProject $gBug tracking system old-style
 302 unified mark as $markaswhat address ($receivedat),
 303 without a recognisable $gBug number in the Subject.
 304 Your message has been filed under junk but otherwise ignored.
 305
 306 If you don't know what I'm talking about then probably either:
 307
 308 (a) you unwittingly sent a message to done\@$gEmailDomain
 309 because you replied to all recipients of the message a developer used
 310 to mark a $gBug as done and you modified the Subject.  In this case,
 311 please do not be alarmed.  To avoid confusion do not do it again, but
 312 there is no need to apologise or mail anyone asking for an explanation.
 313
 314 (b) you are a system administrator, reading this because the $gBug
 315 tracking system is responding to a misdirected bounce message.  In this
 316 case there is a serious mail system misconfiguration somewhere - please
 317 contact me immediately.
 318
 319 Your message was dated $header{'date'} and had
 320 message-id $header{'message-id'}
 321 and subject $subject.
 322
 323 If you need any assistance or explanation please contact me.
 324
 325 $gMaintainer
 326 (administrator, $gProject $gBugs database)
 327
 328 END
 329         &appendlog;
 330         &finish;
 331     }
 332
 333     &checkmaintainers;
 334
 335     # Add bug mailing lists as appropriate
 336     my @bug_mailing_lists;
 337     push @bug_mailing_lists, map {"bugs=$_\@$gListDomain"} ($ref, split (/ /, $data->{mergedwith}));
 338
 339     $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
 340     $noticeccval =~ s/\s+\n\s+/ /g;
 341     $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
 342
 343     $generalcc = join(', ', $generalcc, @addsrcaddrs, @bug_mailing_lists);
 344     $generalcc =~ s/\s+\n\s+/ /g;
 345     $generalcc =~ s/^\s+/ /; $generalcc =~ s/\s+$//;
 346
 347     if (length($noticeccval)) { $noticecc= "Cc: $noticeccval\n"; }
 348     if (length($generalcc)) { $noticecc.= "Bcc: $generalcc\n"; }
 349
 350     @process= ($ref,split(/ /,$data->{mergedwith}));
 351     $orgref= $ref;
 352
 353     for $ref (@process) {
 354         if ($ref != $orgref) {
 355             &unfilelock;
 356             $data = &lockreadbug($ref)
 357                 || die "huh ? $ref from $orgref out of @process";
 358         }
 359         $data->{done}= $set_done if defined($set_done);
 360         $data->{forwarded}= $set_forwarded if defined($set_forwarded);
 361         if ($codeletter eq 'D') {
 362             $data->{keywords} = join ' ', grep $_ ne 'pending',
 363                                      split ' ', $data->{keywords};
 364             if (defined $pheader{'source-version'}) {
 365                 addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
 366             } elsif (defined $pheader{version}) {
 367                 addfixedversions($data, $pheader{package}, $pheader{version}, 'binary');
 368             }
 369         }
 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}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}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     &filelock("nextnumber.lock");
 603     open(N,"nextnumber") || &quit("nextnumber: read: $!");
 604     $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
 605     $ref= $v+0;  $v += 1;  $newref=1;
 606     &overwrite('nextnumber', "$v\n");
 607     &unfilelock;
 608     my $hash = get_hashname($ref);
 609     &overwrite("db-h/$hash/$ref.log",'');
 610     $data->{originator} = $replyto;
 611     $data->{date} = $intdate;
 612     $data->{subject} = $subject;
 613     $data->{msgid} = $header{'message-id'};
 614     writebug($ref, $data);
 615     &overwrite("db-h/$hash/$ref.report",
 616                join("\n",@msg)."\n");
 617 }
 618
 619 &checkmaintainers;
 620
 621 print DEBUG "maintainers >@maintaddrs<\n";
 622
 623 $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
 624 $newsubject= $subject;  $newsubject =~ s/^$gBug#$ref:*\s*//;
 625
 626 $xcchdr= $header{ 'x-debbugs-cc' };
 627 if ($xcchdr =~ m/\S/) {
 628     push(@resentccs,$xcchdr);
 629     $resentccexplain.= <<END;
 630
 631 As you requested using X-Debbugs-CC, your message was also forwarded to
 632    $xcchdr
 633 (after having been given a $gBug report number, if it did not have one).
 634 END
 635 }
 636
 637 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
 638     push(@resentccs,@maintaddrs);
 639     $resentccexplain.= <<END." ".join("\n ",@maintaddrs)."\n";
 640
 641 Your message has been sent to the package maintainer(s):
 642 END
 643 }
 644
 645 @bccs = @addsrcaddrs;
 646 if (defined $gStrongList and isstrongseverity($data->{severity})) {
 647     push @bccs, "$gStrongList\@$gListDomain";
 648 }
 649
 650 # Send mail to the per bug list subscription too
 651 push @bccs, "bugs=$ref\@$gListDomain";
 652
 653 if (defined $pheader{source}) {
 654     # Prefix source versions with the name of the source package. They
 655     # appear that way in version trees so that we can deal with binary
 656     # packages moving from one source package to another.
 657     if (defined $pheader{'source-version'}) {
 658         addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
 659     } elsif (defined $pheader{version}) {
 660         addfoundversions($data, $pheader{source}, $pheader{version}, '');
 661     }
 662     writebug($ref, $data);
 663 } elsif (defined $pheader{package}) {
 664     # TODO: could handle Source-Version: by looking up the source package?
 665     addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
 666     writebug($ref, $data);
 667 }
 668
 669 $veryquiet= $codeletter eq 'Q';
 670 if ($codeletter eq 'M' && !@maintaddrs) {
 671     $veryquiet= 1;
 672     $brokenness.= <<END;
 673
 674 You requested that the message be sent to the package maintainer(s)
 675 but either the $gBug report is not associated with any package (probably
 676 because of a missing Package pseudo-header field in the original $gBug
 677 report), or the package(s) specified do not have any maintainer(s).
 678
 679 Your message has *not* been sent to any package maintainers; it has
 680 merely been filed in the $gBug tracking system.  If you require assistance
 681 please contact $gMaintainerEmail quoting the $gBug number $ref.
 682 END
 683 }
 684
 685 $resentccval.= join(', ',@resentccs);
 686 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
 687 if (length($resentccval)) {
 688     $resentcc= "Resent-CC: $resentccval\n";
 689 }
 690
 691 if ($codeletter eq 'U') {
 692     &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
 693     &sendmessage(<<END,[$data->{originator},@resentccs],[@bccs]);
 694 Subject: $gBug#$ref: $newsubject
 695 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
 696 ${orgsender}Resent-To: $data->{originator}
 697 ${resentcc}Resent-Date: $tdate
 698 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 699 Resent-Sender: $gMaintainerEmail
 700 X-$gProject-PR-Message: report $ref
 701 X-$gProject-PR-Package: $data->{package}
 702 X-$gProject-PR-Keywords: $data->{keywords}
 703 $fwd
 704 END
 705 } elsif ($codeletter eq 'B') {
 706     &htmllog($newref ? "Report" : "Information", "forwarded",
 707              join(', ',"$gSubmitList\@$gListDomain",@resentccs),
 708              "<code>$gBug#$ref</code>".
 709              (length($data->{package})? "; Package <code>".&sani($data->{package})."</code>" : '').
 710              ".");
 711     &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
 712 Subject: $gBug#$ref: $newsubject
 713 Reply-To: $replyto, $ref\@$gEmailDomain
 714 Resent-From: $header{'from'}
 715 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
 716 ${resentcc}Resent-Date: $tdate
 717 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 718 Resent-Sender: $gMaintainerEmail
 719 X-$gProject-PR-Message: report $ref
 720 X-$gProject-PR-Package: $data->{package}
 721 X-$gProject-PR-Keywords: $data->{keywords}
 722 $fwd
 723 END
 724 } elsif (@resentccs or @bccs) {
 725     # D and F done far earlier; B just done - so this must be M or Q
 726     # We preserve whichever it was in the Reply-To (possibly adding
 727     # the $gBug#).
 728     if (@resentccs) {
 729         &htmllog($newref ? "Report" : "Information", "forwarded",
 730                  $resentccval,
 731                  "<code>$gBug#$ref</code>".
 732                  (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
 733                  ".");
 734     } else {
 735         &htmllog($newref ? "Report" : "Information", "stored",
 736                  "",
 737                  "<code>$gBug#$ref</code>".
 738                  (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
 739                  ".");
 740     }
 741     &sendmessage(<<END,[@resentccs],[@bccs]);
 742 Subject: $gBug#$ref: $newsubject
 743 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
 744 Resent-From: $header{'from'}
 745 ${orgsender}Resent-To: $resentccval
 746 Resent-Date: $tdate
 747 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 748 Resent-Sender: $gMaintainerEmail
 749 X-$gProject-PR-Message: report $ref
 750 X-$gProject-PR-Package: $data->{package}
 751 X-$gProject-PR-Keywords: $data->{keywords}
 752 $fwd
 753 END
 754 }
 755
 756 $htmlbreak= length($brokenness) ? "<p>\n".&sani($brokenness)."\n<p>\n" : '';
 757 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
 758 if (length($resentccval)) {
 759     $htmlbreak = "  Copy sent to <code>".&sani($resentccval)."</code>.".
 760         $htmlbreak;
 761 }
 762 unless (exists $header{'x-debbugs-no-ack'}) {
 763     if ($newref) {
 764         &htmllog("Acknowledgement","sent",$replyto,
 765                  ($veryquiet ?
 766                   "New $gBug report received and filed, but not forwarded." :
 767                   "New $gBug report received and forwarded."). $htmlbreak);
 768         &sendmessage($veryquiet ? <<END : $codeletter eq 'M' ? <<END : <<END,'');
 769 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 770 To: $replyto
 771 Subject: $gBug#$ref: Acknowledgement of QUIET report
 772          ($subject)
 773 Message-ID: <handler.$ref.$nn.ackquiet\@$gEmailDomain>
 774 In-Reply-To: $header{'message-id'}
 775 References: $header{'message-id'}
 776 Precedence: bulk
 777 X-$gProject-PR-Message: ack-quiet $ref
 778 X-$gProject-PR-Package: $data->{package}
 779 X-$gProject-PR-Keywords: $data->{keywords}
 780 Reply-To: $ref-quiet\@$gEmailDomain
 781
 782 Thank you for the problem report you have sent regarding $gProject.
 783 This is an automatically generated reply, to let you know your message
 784 has been received.  It has not been forwarded to the package maintainers
 785 or other interested parties; you should ensure that the developers are
 786 aware of the problem you have entered into the system - preferably
 787 quoting the $gBug reference number, #$ref.
 788 $resentccexplain
 789 If you wish to submit further information on your problem, please send it
 790 to $ref-$baddressroot\@$gEmailDomain (and *not*
 791 to $baddress\@$gEmailDomain).
 792
 793 Please do not reply to the address at the top of this message,
 794 unless you wish to report a problem with the $gBug-tracking system.
 795 $brokenness
 796 $gMaintainer
 797 (administrator, $gProject $gBugs database)
 798 END
 799 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 800 To: $replyto
 801 Subject: $gBug#$ref: Acknowledgement of maintainer-only report
 802          ($subject)
 803 Message-ID: <handler.$ref.$nn.ackmaint\@$gEmailDomain>
 804 In-Reply-To: $header{'message-id'}
 805 References: $header{'message-id'}
 806 Precedence: bulk
 807 X-$gProject-PR-Message: ack-maintonly $ref
 808 X-$gProject-PR-Package: $data->{package}
 809 X-$gProject-PR-Keywords: $data->{keywords}
 810 Reply-To: $ref-maintonly\@$gEmailDomain
 811
 812 Thank you for the problem report you have sent regarding $gProject.
 813 This is an automatically generated reply, to let you know your message has
 814 been received.  It is being forwarded to the package maintainers (but not
 815 other interested parties, as you requested) for their attention; they will
 816 reply in due course.
 817 $resentccexplain
 818 If you wish to submit further information on your problem, please send
 819 it to $ref-$baddressroot\@$gEmailDomain (and *not*
 820 to $baddress\@$gEmailDomain).
 821
 822 Please do not reply to the address at the top of this message,
 823 unless you wish to report a problem with the $gBug-tracking system.
 824 $brokenness
 825 $gMaintainer
 826 (administrator, $gProject $gBugs database)
 827 END
 828 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 829 To: $replyto
 830 Subject: $gBug#$ref: Acknowledgement ($subject)
 831 Message-ID: <handler.$ref.$nn.ack\@$gEmailDomain>
 832 In-Reply-To: $header{'message-id'}
 833 References: $header{'message-id'}
 834 Precedence: bulk
 835 X-$gProject-PR-Message: ack $ref
 836 X-$gProject-PR-Package: $data->{package}
 837 X-$gProject-PR-Keywords: $data->{keywords}
 838 Reply-To: $ref\@$gEmailDomain
 839
 840 Thank you for the problem report you have sent regarding $gProject.
 841 This is an automatically generated reply, to let you know your message has
 842 been received.  It is being forwarded to the package maintainers and other
 843 interested parties for their attention; they will reply in due course.
 844 $resentccexplain
 845 If you wish to submit further information on your problem, please send
 846 it to $ref\@$gEmailDomain (and *not* to
 847 $baddress\@$gEmailDomain).
 848
 849 Please do not reply to the address at the top of this message,
 850 unless you wish to report a problem with the $gBug-tracking system.
 851 $brokenness
 852 $gMaintainer
 853 (administrator, $gProject $gBugs database)
 854 END
 855     } elsif ($codeletter ne 'U' and
 856              $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/) {
 857         &htmllog("Acknowledgement","sent",$replyto,
 858                  ($veryquiet ? "Extra info received and filed, but not forwarded." :
 859                   $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
 860                   "Extra info received and forwarded to list."). $htmlbreak);
 861         &sendmessage($veryquiet ? <<END : $codeletter eq 'M' ? <<END : <<END,'');
 862 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 863 To: $replyto
 864 Subject: $gBug#$ref: Info received and FILED only
 865          (was $subject)
 866 Message-ID: <handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>
 867 In-Reply-To: $header{'message-id'}
 868 References: $header{'message-id'}
 869 Precedence: bulk
 870 X-$gProject-PR-Message: ack-info-quiet $ref
 871 X-$gProject-PR-Package: $data->{package}
 872 X-$gProject-PR-Keywords: $data->{keywords}
 873 Reply-To: $ref-quiet\@$gEmailDomain
 874
 875 Thank you for the additional information you have supplied regarding
 876 this problem report.  It has NOT been forwarded to the package
 877 maintainers, but will accompany the original report in the $gBug
 878 tracking system.  Please ensure that you yourself have sent a copy of
 879 the additional information to any relevant developers or mailing lists.
 880 $resentccexplain
 881 If you wish to continue to submit further information on your problem,
 882 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 883
 884 Please do not reply to the address at the top of this message,
 885 unless you wish to report a problem with the $gBug-tracking system.
 886 $brokenness
 887 $gMaintainer
 888 (administrator, $gProject $gBugs database)
 889 END
 890 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 891 To: $replyto
 892 Subject: $gBug#$ref: Info received for maintainer only
 893          (was $subject)
 894 Message-ID: <handler.$ref.$nn.ackinfomaint\@$gEmailDomain>
 895 In-Reply-To: $header{'message-id'}
 896 References: $header{'message-id'}
 897 Precedence: bulk
 898 X-$gProject-PR-Message: ack-info-maintonly $ref
 899 X-$gProject-PR-Package: $data->{package}
 900 X-$gProject-PR-Keywords: $data->{keywords}
 901 Reply-To: $ref-maintonly\@$gEmailDomain
 902
 903 Thank you for the additional information you have supplied regarding
 904 this problem report.  It has been forwarded to the package maintainer(s)
 905 (but not to other interested parties) to accompany the original report.
 906 $resentccexplain
 907 If you wish to continue to submit further information on your problem,
 908 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 909
 910 Please do not reply to the address at the top of this message,
 911 unless you wish to report a problem with the $gBug-tracking system.
 912 $brokenness
 913 $gMaintainer
 914 (administrator, $gProject $gBugs database)
 915 END
 916 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 917 To: $replyto
 918 Subject: $gBug#$ref: Info received (was $subject)
 919 Message-ID: <handler.$ref.$nn.ackinfo\@$gEmailDomain>
 920 In-Reply-To: $header{'message-id'}
 921 References: $header{'message-id'}
 922 Precedence: bulk
 923 X-$gProject-PR-Message: ack-info $ref
 924 X-$gProject-PR-Package: $data->{package}
 925 X-$gProject-PR-Keywords: $data->{keywords}
 926
 927 Thank you for the additional information you have supplied regarding
 928 this problem report.  It has been forwarded to the package maintainer(s)
 929 and to other interested parties to accompany the original report.
 930 $resentccexplain
 931 If you wish to continue to submit further information on your problem,
 932 please send it to $ref\@$gEmailDomain, as before.
 933
 934 Please do not reply to the address at the top of this message,
 935 unless you wish to report a problem with the $gBug-tracking system.
 936 $brokenness
 937 $gMaintainer
 938 (administrator, $gProject $gBugs database)
 939 END
 940 # Reply-To: in previous ack disabled by doogie due to mail loops.
 941 # Are these still a concern?
 942 # Reply-To: $ref\@$gEmailDomain
 943     }
 944 }
 945
 946 &appendlog;
 947 &finish;
 948
 949 sub overwrite {
 950     local ($f,$v) = @_;
 951     open(NEW,">$f.new") || &quit("$f.new: create: $!");
 952     print(NEW "$v") || &quit("$f.new: write: $!");
 953     close(NEW) || &quit("$f.new: close: $!");
 954     rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
 955 }
 956
 957 sub appendlog {
 958     my $hash = get_hashname($ref);
 959     if (!open(AP,">>db-h/$hash/$ref.log")) {
 960         print DEBUG "failed open log<\n";
 961         print DEBUG "failed open log err $!<\n";
 962         &quit("opening db-h/$hash/$ref.log (li): $!");
 963     }
 964     print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
 965     close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
 966 }
 967
 968 sub finish {
 969     utime(time,time,"db");
 970     local ($u);
 971     while ($u= $cleanups[$#cleanups]) { &$u; }
 972     unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
 973     exit $_[0];
 974 }
 975
 976 &quit("wot no exit");
 977
 978 sub chldhandle { $chldexit = 'yes'; }
 979
 980 sub htmllog {
 981     local ($whatobj,$whatverb,$where,$desc) = @_;
 982     my $hash = get_hashname($ref);
 983     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
 984     print(AP
 985           "\6\n".
 986           "<strong>$whatobj $whatverb</strong>".
 987           ($where eq '' ? "" : " to <code>".&sani($where)."</code>").
 988           ":<br>\n". $desc.
 989           "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
 990     close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
 991 }
 992
 993 sub stripbccs {
 994     my $msg = shift;
 995     my $ret = '';
 996     my $bcc = 0;
 997     while ($msg =~ s/(.*\n)//) {
 998         local $_ = $1;
 999         if (/^$/) {
1000             $ret .= $_;
1001             last;
1002         }
1003         if ($bcc) {
1004             # strip continuation lines too
1005             next if /^\s/;
1006             $bcc = 0;
1007         }
1008         if (/^Bcc:/i) {
1009             $bcc = 1;
1010         } else {
1011             $ret .= $_;
1012         }
1013     }
1014     return $ret . $msg;
1015 }
1016
1017 sub sendmessage {
1018     local ($msg,$recips,$bcc) = @_;
1019     if ((!ref($recips) && $recips eq '') || @$recips == 0) {
1020         $recips = ['-t'];
1021     }
1022     $msg = "X-Loop: $gMaintainerEmail\n" . $msg;
1023     # The original message received is written out in appendlog, so
1024     # before writing out the other messages we've sent out, we need to
1025     # RFC1522 encode the header.
1026     my ($header,$body) = split /\n\n/, $msg, 2;
1027     $header = encode_rfc1522($header);
1028     $msg = $header . qq(\n\n). $body;
1029
1030     my $hash = get_hashname($ref);
1031     #save email to the log
1032     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
1033     print(AP "\2\n",join("\4",@$recips),"\n\5\n",
1034           @{escapelog(stripbccs($msg))},"\n\3\n") ||
1035         &quit("writing db-h/$hash/$ref.log (lo): $!");
1036     close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
1037
1038     if (ref($bcc)) {
1039         shift @$recips if $recips->[0] eq '-t';
1040         push @$recips, @$bcc;
1041     }
1042
1043     send_mail_message($msg,$recips);
1044 }
1045
1046 sub checkmaintainers {
1047     return if $maintainerschecked++;
1048     return if !length($data->{package});
1049     open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1050     while (<MAINT>) {
1051         m/^\n$/ && next;
1052         m/^\s*$/ && next;
1053         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1054         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1055         $maintainerof{$1}= $2;
1056     }
1057     close(MAINT);
1058     open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1059     while (<MAINT>) {
1060         m/^\n$/ && next;
1061         m/^\s*$/ && next;
1062         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1063         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1064         $maintainerof{$1}= $2;
1065     }
1066     close(MAINT);
1067     open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
1068     while (<SOURCES>) {
1069         next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1070         ($a,$b)=($1,$2);
1071         $a =~ y/A-Z/a-z/;
1072         $pkgsrc{$a} = $b;
1073     }
1074     close(SOURCES);
1075     $anymaintfound=0; $anymaintnotfound=0;
1076     for $p (split(m/[ \t?,():]+/,$data->{package})) {
1077         $p =~ y/A-Z/a-z/;
1078         $p =~ /([a-z0-9.+-]+)/;
1079         $p = $1;
1080         next unless defined $p;
1081         if (defined $gSubscriptionDomain) {
1082             if (defined($pkgsrc{$p})) {
1083                 push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
1084             } else {
1085                 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1086             }
1087         }
1088         if (defined($maintainerof{$p})) {
1089             print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
1090             $addmaint= $maintainerof{$p};
1091             push(@maintaddrs,$addmaint) unless
1092                 ($addmaint eq $replyto and $codeletter ne 'M') ||
1093                      grep($_ eq $addmaint, @maintaddrs);
1094             $anymaintfound++;
1095         } else {
1096             print DEBUG "maintainer none >$p<\n";
1097             push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1098             $anymaintnotfound++;
1099             last;
1100         }
1101     }
1102
1103     if (length $data->{owner}) {
1104         print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
1105         $addmaint = $data->{owner};
1106         push(@maintaddrs, $addmaint) unless
1107             $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1108     }
1109 }
1110
1111 =head2 send_mail_message
1112
1113      send_mail_message($message,[@recipients],$envelope_from)
1114
1115 Sends a mail message out to a set of recepients with envelope sender
1116 $envelope_from; if $envelope_from is not set, defaults to
1117 $gMaintainerEmail.
1118
1119 =cut
1120
1121 sub send_mail_message{
1122      my ($message,$recipients,$envelope_from) = @_;
1123
1124      # Default to $gMaintainerEmail
1125      $envelope_from ||= $gMaintainerEmail;
1126
1127      print DEBUG "sending mail to ".join(', ',@$recipients)." with -f $envelope_from";
1128      local $_ = '';
1129      $SIG{'CHLD'}='chldhandle';
1130      #print DEBUG "mailing sigchild set up<\n";
1131      our $chldexit = 'no';
1132      our $c= open(U,"-|");
1133      #print DEBUG "mailing opened pipe fork<\n";
1134      defined($c) || die $!;
1135      #print DEBUG "mailing opened pipe fork ok $c<\n";
1136      if (!$c) { # ie, we are in the child process
1137           #print DEBUG "mailing child<\n";
1138           unless (open(STDERR,">&STDOUT")) {
1139                #print DEBUG "mailing child opened stderr<\n";
1140                print STDOUT "redirect stderr: $!\n";
1141                #print DEBUG "mailing child opened stderr fail<\n";
1142                exit 1;
1143                #print DEBUG "mailing child opened stderr fail exit !?<\n";
1144           }
1145           #print DEBUG "mailing child opened stderr ok<\n";
1146           $c= open(D,"|-");
1147           #print DEBUG "mailing child forked again<\n";
1148           defined($c) || die $!;
1149           #print DEBUG "mailing child forked again ok $c<\n";
1150           if (!$c) { # ie, we are the child process
1151                #print DEBUG "mailing grandchild<\n";
1152                exec '/usr/lib/sendmail', (defined $envelope_from?'-f'.$envelope_from:''),'-odq','-oem','-oi',
1153                     @{$recipients};
1154                #print DEBUG "mailing grandchild exec failed<\n";
1155                die $!;
1156                #print DEBUG "mailing grandchild died !?<\n";
1157           }
1158           #print DEBUG "mailing child not grandchild<\n";
1159           print(D $message) || die $!;
1160           #print DEBUG "mailing child printed msg<\n";
1161           close(D);
1162           #print DEBUG "mailing child closed pipe<\n";
1163           die "\n*** command returned exit status $?\n" if $?;
1164           #print DEBUG "mailing child exit status ok<\n";
1165           exit 0;
1166           #print DEBUG "mailing child exited ?!<\n";
1167      }
1168      #print DEBUG "mailing parent<\n";
1169      $results='';
1170      #print DEBUG "mailing parent results emptied<\n";
1171      while( $chldexit eq 'no' ) { $results.= $_; }
1172      #print DEBUG "mailing parent results read >$results<\n";
1173      close(U);
1174      #print DEBUG "mailing parent results closed<\n";
1175      $results.= "\n*** child returned exit status $?\n" if $?;
1176      #print DEBUG "mailing parent exit status ok<\n";
1177      $SIG{'CHLD'}='DEFAULT';
1178      #print DEBUG "mailing parent sigchild default<\n";
1179      if (length($results)) { &quit("running sendmail: $results"); }
1180      #print DEBUG "mailing parent results ok<\n";
1181
1182
1183 }
1184
1185 =head2 bug_list_forward
1186
1187      bug_list_forward($spool_filename) if $codeletter eq 'L';
1188
1189
1190 Given the spool file, will forward a bug to the per bug mailing list
1191 subscription system.
1192
1193 =cut
1194
1195 sub bug_list_forward{
1196      my ($bug_fn) = @_;
1197      # Read the bug information and package information for passing to
1198      # the mailing list
1199      my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
1200      my ($bfound, $data)= lockreadbugmerge($bug_number);
1201      my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!";
1202
1203      local $/ = undef;
1204      my $bug_message = <$bug_fh>;
1205      my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
1206      my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
1207      if (not defined $envelope_from) {
1208           # Try to use the From: header or something to set it
1209           ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
1210           # Kludgy, and should really be using a full scale header
1211           # parser to do this.
1212           $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
1213      }
1214      my ($header,$body) = split /\n\n/, $bug_message, 2;
1215      # Add X-$gProject-PR-Message: list bug_number and package name headers
1216      if (defined $data and $bfound) {
1217           $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
1218                qq(X-$gProject-PR-Package: $data->{package}\n).
1219                     qq(X-$gProject-PR-Title: $data->{subject});
1220      }
1221      else {
1222           $header .= qq(\nX-$gProject-PR-Message: list inactivebug);
1223      }
1224      print STDERR "Tried to loop me with $envelope_from\n"
1225           and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
1226      print DEBUG $envelope_from,qq(\n);
1227      # If we don't have a bug address, something has gone horribly wrong.
1228      print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
1229      $bug_address =~ s/\@.+//;
1230      print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
1231      print DEBUG $header.qq(\n\n).$body;
1232      send_mail_message($header.qq(\n\n).$body,
1233                        ["bugs=$bug_address\@$gListDomain"],
1234                        $envelope_from,
1235                       );
1236      unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");
1237      exit 0;
1238 }