scripts/process.in

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