scripts/process.in

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