scripts/process.in

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