scripts/process.in

   1 #!/usr/bin/perl
   2 # $Id: process.in,v 1.88 2005/01/02 19:08:12 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     if (defined($pheader{owner})) {
 588         $data->{owner}= $pheader{owner};
 589     }
 590     &filelock("nextnumber.lock");
 591     open(N,"nextnumber") || &quit("nextnumber: read: $!");
 592     $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
 593     $ref= $v+0;  $v += 1;  $newref=1;
 594     &overwrite('nextnumber', "$v\n");
 595     &unfilelock;
 596     my $hash = get_hashname($ref);
 597     &overwrite("db-h/$hash/$ref.log",'');
 598     $data->{originator} = $replyto;
 599     $data->{date} = $intdate;
 600     $data->{subject} = $subject;
 601     $data->{msgid} = $header{'message-id'};
 602     writebug($ref, $data);
 603     &overwrite("db-h/$hash/$ref.report",
 604                join("\n",@msg)."\n");
 605 }
 606
 607 &checkmaintainers;
 608
 609 print DEBUG "maintainers >@maintaddrs<\n";
 610
 611 $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
 612 $newsubject= $subject;  $newsubject =~ s/^$gBug#$ref:*\s*//;
 613
 614 $xcchdr= $header{ 'x-debbugs-cc' };
 615 if ($xcchdr =~ m/\S/) {
 616     push(@resentccs,$xcchdr);
 617     $resentccexplain.= <<END;
 618
 619 As you requested using X-Debbugs-CC, your message was also forwarded to
 620    $xcchdr
 621 (after having been given a $gBug report number, if it did not have one).
 622 END
 623 }
 624
 625 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
 626     push(@resentccs,@maintaddrs);
 627     $resentccexplain.= <<END." ".join("\n ",@maintaddrs)."\n";
 628
 629 Your message has been sent to the package maintainer(s):
 630 END
 631 }
 632
 633 @bccs = @addsrcaddrs;
 634 if (defined $gStrongList and isstrongseverity($data->{severity})) {
 635     push @bccs, "$gStrongList\@$gListDomain";
 636 }
 637
 638 $veryquiet= $codeletter eq 'Q';
 639 if ($codeletter eq 'M' && !@maintaddrs) {
 640     $veryquiet= 1;
 641     $brokenness.= <<END;
 642
 643 You requested that the message be sent to the package maintainer(s)
 644 but either the $gBug report is not associated with any package (probably
 645 because of a missing Package pseudo-header field in the original $gBug
 646 report), or the package(s) specified do not have any maintainer(s).
 647
 648 Your message has *not* been sent to any package maintainers; it has
 649 merely been filed in the $gBug tracking system.  If you require assistance
 650 please contact $gMaintainerEmail quoting the $gBug number $ref.
 651 END
 652 }
 653
 654 $resentccval.= join(', ',@resentccs);
 655 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
 656 if (length($resentccval)) {
 657     $resentcc= "Resent-CC: $resentccval\n";
 658 }
 659
 660 if ($codeletter eq 'U') {
 661     &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
 662     &sendmessage(<<END,[$data->{originator},@resentccs],[@bccs]);
 663 Subject: $gBug#$ref: $newsubject
 664 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
 665 ${orgsender}Resent-To: $data->{originator}
 666 ${resentcc}Resent-Date: $tdate
 667 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 668 Resent-Sender: $gMaintainerEmail
 669 X-$gProject-PR-Message: report $ref
 670 X-$gProject-PR-Package: $data->{package}
 671 X-$gProject-PR-Keywords: $data->{keywords}
 672 $fwd
 673 END
 674 } elsif ($codeletter eq 'B') {
 675     &htmllog($newref ? "Report" : "Information", "forwarded",
 676              join(', ',"$gSubmitList\@$gListDomain",@resentccs),
 677              "<code>$gBug#$ref</code>".
 678              (length($data->{package})? "; Package <code>".&sani($data->{package})."</code>" : '').
 679              ".");
 680     &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
 681 Subject: $gBug#$ref: $newsubject
 682 Reply-To: $replyto, $ref\@$gEmailDomain
 683 Resent-From: $header{'from'}
 684 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
 685 ${resentcc}Resent-Date: $tdate
 686 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 687 Resent-Sender: $gMaintainerEmail
 688 X-$gProject-PR-Message: report $ref
 689 X-$gProject-PR-Package: $data->{package}
 690 X-$gProject-PR-Keywords: $data->{keywords}
 691 $fwd
 692 END
 693 } elsif (@resentccs or @bccs) {
 694     # D and F done far earlier; B just done - so this must be M or Q
 695     # We preserve whichever it was in the Reply-To (possibly adding
 696     # the $gBug#).
 697     if (@resentccs) {
 698         &htmllog($newref ? "Report" : "Information", "forwarded",
 699                  $resentccval,
 700                  "<code>$gBug#$ref</code>".
 701                  (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
 702                  ".");
 703     } else {
 704         &htmllog($newref ? "Report" : "Information", "stored",
 705                  "",
 706                  "<code>$gBug#$ref</code>".
 707                  (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
 708                  ".");
 709     }
 710     &sendmessage(<<END,[@resentccs],[@bccs]);
 711 Subject: $gBug#$ref: $newsubject
 712 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
 713 Resent-From: $header{'from'}
 714 ${orgsender}Resent-To: $resentccval
 715 Resent-Date: $tdate
 716 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 717 Resent-Sender: $gMaintainerEmail
 718 X-$gProject-PR-Message: report $ref
 719 X-$gProject-PR-Package: $data->{package}
 720 X-$gProject-PR-Keywords: $data->{keywords}
 721 $fwd
 722 END
 723 }
 724
 725 $htmlbreak= length($brokenness) ? "<p>\n".&sani($brokenness)."\n<p>\n" : '';
 726 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
 727 if (length($resentccval)) {
 728     $htmlbreak = "  Copy sent to <code>".&sani($resentccval)."</code>.".
 729         $htmlbreak;
 730 }
 731 unless (exists $header{'x-debbugs-no-ack'}) {
 732     if ($newref) {
 733         &htmllog("Acknowledgement","sent",$replyto,
 734                  ($veryquiet ?
 735                   "New $gBug report received and filed, but not forwarded." :
 736                   "New $gBug report received and forwarded."). $htmlbreak);
 737         &sendmessage($veryquiet ? <<END : $codeletter eq 'M' ? <<END : <<END,'');
 738 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 739 To: $replyto
 740 Subject: $gBug#$ref: Acknowledgement of QUIET report
 741          ($subject)
 742 Message-ID: <handler.$ref.$nn.ackquiet\@$gEmailDomain>
 743 In-Reply-To: $header{'message-id'}
 744 References: $header{'message-id'}
 745 Precedence: bulk
 746 X-$gProject-PR-Message: ack-quiet $ref
 747 X-$gProject-PR-Package: $data->{package}
 748 X-$gProject-PR-Keywords: $data->{keywords}
 749 Reply-To: $ref-quiet\@$gEmailDomain
 750
 751 Thank you for the problem report you have sent regarding $gProject.
 752 This is an automatically generated reply, to let you know your message
 753 has been received.  It has not been forwarded to the package maintainers
 754 or other interested parties; you should ensure that the developers are
 755 aware of the problem you have entered into the system - preferably
 756 quoting the $gBug reference number, #$ref.
 757 $resentccexplain
 758 If you wish to submit further information on your problem, please send it
 759 to $ref-$baddressroot\@$gEmailDomain (and *not*
 760 to $baddress\@$gEmailDomain).
 761
 762 Please do not reply to the address at the top of this message,
 763 unless you wish to report a problem with the $gBug-tracking system.
 764 $brokenness
 765 $gMaintainer
 766 (administrator, $gProject $gBugs database)
 767 END
 768 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 769 To: $replyto
 770 Subject: $gBug#$ref: Acknowledgement of maintainer-only report
 771          ($subject)
 772 Message-ID: <handler.$ref.$nn.ackmaint\@$gEmailDomain>
 773 In-Reply-To: $header{'message-id'}
 774 References: $header{'message-id'}
 775 Precedence: bulk
 776 X-$gProject-PR-Message: ack-maintonly $ref
 777 X-$gProject-PR-Package: $data->{package}
 778 X-$gProject-PR-Keywords: $data->{keywords}
 779 Reply-To: $ref-maintonly\@$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 package maintainers (but not
 784 other interested parties, as you requested) for their attention; they will
 785 reply in due course.
 786 $resentccexplain
 787 If you wish to submit further information on your problem, please send
 788 it to $ref-$baddressroot\@$gEmailDomain (and *not*
 789 to $baddress\@$gEmailDomain).
 790
 791 Please do not reply to the address at the top of this message,
 792 unless you wish to report a problem with the $gBug-tracking system.
 793 $brokenness
 794 $gMaintainer
 795 (administrator, $gProject $gBugs database)
 796 END
 797 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 798 To: $replyto
 799 Subject: $gBug#$ref: Acknowledgement ($subject)
 800 Message-ID: <handler.$ref.$nn.ack\@$gEmailDomain>
 801 In-Reply-To: $header{'message-id'}
 802 References: $header{'message-id'}
 803 Precedence: bulk
 804 X-$gProject-PR-Message: ack $ref
 805 X-$gProject-PR-Package: $data->{package}
 806 X-$gProject-PR-Keywords: $data->{keywords}
 807 Reply-To: $ref\@$gEmailDomain
 808
 809 Thank you for the problem report you have sent regarding $gProject.
 810 This is an automatically generated reply, to let you know your message has
 811 been received.  It is being forwarded to the package maintainers and other
 812 interested parties for their attention; they will reply in due course.
 813 $resentccexplain
 814 If you wish to submit further information on your problem, please send
 815 it to $ref\@$gEmailDomain (and *not* to
 816 $baddress\@$gEmailDomain).
 817
 818 Please do not reply to the address at the top of this message,
 819 unless you wish to report a problem with the $gBug-tracking system.
 820 $brokenness
 821 $gMaintainer
 822 (administrator, $gProject $gBugs database)
 823 END
 824     } elsif ($codeletter ne 'U' and
 825              $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/) {
 826         &htmllog("Acknowledgement","sent",$replyto,
 827                  ($veryquiet ? "Extra info received and filed, but not forwarded." :
 828                   $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
 829                   "Extra info received and forwarded to list."). $htmlbreak);
 830         &sendmessage($veryquiet ? <<END : $codeletter eq 'M' ? <<END : <<END,'');
 831 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 832 To: $replyto
 833 Subject: $gBug#$ref: Info received and FILED only
 834          (was $subject)
 835 Message-ID: <handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>
 836 In-Reply-To: $header{'message-id'}
 837 References: $header{'message-id'}
 838 Precedence: bulk
 839 X-$gProject-PR-Message: ack-info-quiet $ref
 840 X-$gProject-PR-Package: $data->{package}
 841 X-$gProject-PR-Keywords: $data->{keywords}
 842 Reply-To: $ref-quiet\@$gEmailDomain
 843
 844 Thank you for the additional information you have supplied regarding
 845 this problem report.  It has NOT been forwarded to the package
 846 maintainers, but will accompany the original report in the $gBug
 847 tracking system.  Please ensure that you yourself have sent a copy of
 848 the additional information to any relevant developers or mailing lists.
 849 $resentccexplain
 850 If you wish to continue to submit further information on your problem,
 851 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 852
 853 Please do not reply to the address at the top of this message,
 854 unless you wish to report a problem with the $gBug-tracking system.
 855 $brokenness
 856 $gMaintainer
 857 (administrator, $gProject $gBugs database)
 858 END
 859 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 860 To: $replyto
 861 Subject: $gBug#$ref: Info received for maintainer only
 862          (was $subject)
 863 Message-ID: <handler.$ref.$nn.ackinfomaint\@$gEmailDomain>
 864 In-Reply-To: $header{'message-id'}
 865 References: $header{'message-id'}
 866 Precedence: bulk
 867 X-$gProject-PR-Message: ack-info-maintonly $ref
 868 X-$gProject-PR-Package: $data->{package}
 869 X-$gProject-PR-Keywords: $data->{keywords}
 870 Reply-To: $ref-maintonly\@$gEmailDomain
 871
 872 Thank you for the additional information you have supplied regarding
 873 this problem report.  It has been forwarded to the package maintainer(s)
 874 (but not to other interested parties) to accompany the original report.
 875 $resentccexplain
 876 If you wish to continue to submit further information on your problem,
 877 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 878
 879 Please do not reply to the address at the top of this message,
 880 unless you wish to report a problem with the $gBug-tracking system.
 881 $brokenness
 882 $gMaintainer
 883 (administrator, $gProject $gBugs database)
 884 END
 885 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 886 To: $replyto
 887 Subject: $gBug#$ref: Info received (was $subject)
 888 Message-ID: <handler.$ref.$nn.ackinfo\@$gEmailDomain>
 889 In-Reply-To: $header{'message-id'}
 890 References: $header{'message-id'}
 891 Precedence: bulk
 892 X-$gProject-PR-Message: ack-info $ref
 893 X-$gProject-PR-Package: $data->{package}
 894 X-$gProject-PR-Keywords: $data->{keywords}
 895
 896 Thank you for the additional information you have supplied regarding
 897 this problem report.  It has been forwarded to the package maintainer(s)
 898 and to other interested parties to accompany the original report.
 899 $resentccexplain
 900 If you wish to continue to submit further information on your problem,
 901 please send it to $ref\@$gEmailDomain, as before.
 902
 903 Please do not reply to the address at the top of this message,
 904 unless you wish to report a problem with the $gBug-tracking system.
 905 $brokenness
 906 $gMaintainer
 907 (administrator, $gProject $gBugs database)
 908 END
 909 # Reply-To: in previous ack disabled by doogie due to mail loops.
 910 # Are these still a concern?
 911 # Reply-To: $ref\@$gEmailDomain
 912     }
 913 }
 914
 915 &appendlog;
 916 &finish;
 917
 918 sub overwrite {
 919     local ($f,$v) = @_;
 920     open(NEW,">$f.new") || &quit("$f.new: create: $!");
 921     print(NEW "$v") || &quit("$f.new: write: $!");
 922     close(NEW) || &quit("$f.new: close: $!");
 923     rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
 924 }
 925
 926 sub appendlog {
 927     my $hash = get_hashname($ref);
 928     if (!open(AP,">>db-h/$hash/$ref.log")) {
 929         print DEBUG "failed open log<\n";
 930         print DEBUG "failed open log err $!<\n";
 931         &quit("opening db-h/$hash/$ref.log (li): $!");
 932     }
 933     print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
 934     close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
 935 }
 936
 937 sub finish {
 938     utime(time,time,"db");
 939     local ($u);
 940     while ($u= $cleanups[$#cleanups]) { &$u; }
 941     unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
 942     exit $_[0];
 943 }
 944
 945 &quit("wot no exit");
 946
 947 sub chldhandle { $chldexit = 'yes'; }
 948
 949 sub htmllog {
 950     local ($whatobj,$whatverb,$where,$desc) = @_;
 951     my $hash = get_hashname($ref);
 952     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
 953     print(AP
 954           "\6\n".
 955           "<strong>$whatobj $whatverb</strong>".
 956           ($where eq '' ? "" : " to <code>".&sani($where)."</code>").
 957           ":<br>\n". $desc.
 958           "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
 959     close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
 960 }
 961
 962 sub stripbccs {
 963     my $msg = shift;
 964     my $ret = '';
 965     my $bcc = 0;
 966     while ($msg =~ s/(.*\n)//) {
 967         local $_ = $1;
 968         if (/^$/) {
 969             $ret .= $_;
 970             last;
 971         }
 972         if ($bcc) {
 973             # strip continuation lines too
 974             next if /^\s/;
 975             $bcc = 0;
 976         }
 977         if (/^Bcc:/i) {
 978             $bcc = 1;
 979         } else {
 980             $ret .= $_;
 981         }
 982     }
 983     return $ret . $msg;
 984 }
 985
 986 sub sendmessage {
 987     local ($msg,$recips,$bcc) = @_;
 988     if ((!ref($recips) && $recips eq '') || @$recips == 0) {
 989         $recips = ['-t'];
 990     }
 991     $msg = "X-Loop: $gMaintainerEmail\n" . $msg;
 992
 993     my $hash = get_hashname($ref);
 994     #save email to the log
 995     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
 996     print(AP "\2\n",join("\4",@$recips),"\n\5\n",
 997           @{escapelog(stripbccs($msg))},"\n\3\n") ||
 998         &quit("writing db-h/$hash/$ref.log (lo): $!");
 999     close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
1000
1001     if (ref($bcc)) {
1002         shift @$recips if $recips->[0] eq '-t';
1003         push @$recips, @$bcc;
1004     }
1005
1006 #if debugging.. save email to a log
1007 #    open AP, ">>debug";
1008 #    print AP join( '|', @$recips )."\n>>";
1009 #    print AP get_addresses( @$recips );
1010 #    print AP "<<\n".$msg;
1011 #    print AP "\n--------------------------------------------------------\n";
1012 #    close AP;
1013
1014     #start mailing
1015     $_ = '';
1016     $SIG{'CHLD'}='chldhandle';
1017     #print DEBUG "mailing sigchild set up<\n";
1018     $chldexit = 'no';
1019     $c= open(U,"-|");
1020     #print DEBUG "mailing opened pipe fork<\n";
1021     defined($c) || die $!;
1022     #print DEBUG "mailing opened pipe fork ok $c<\n";
1023     if (!$c) { # ie, we are in the child process
1024         #print DEBUG "mailing child<\n";
1025         unless (open(STDERR,">&STDOUT")) {
1026             #print DEBUG "mailing child opened stderr<\n";
1027             print STDOUT "redirect stderr: $!\n";
1028             #print DEBUG "mailing child opened stderr fail<\n";
1029             exit 1;
1030             #print DEBUG "mailing child opened stderr fail exit !?<\n";
1031         }
1032         #print DEBUG "mailing child opened stderr ok<\n";
1033         $c= open(D,"|-");
1034         #print DEBUG "mailing child forked again<\n";
1035         defined($c) || die $!;
1036         #print DEBUG "mailing child forked again ok $c<\n";
1037         if (!$c) { # ie, we are the child process
1038             #print DEBUG "mailing grandchild<\n";
1039             exec '/usr/lib/sendmail','-f'."$gMaintainerEmail",'-odq','-oem','-oi',get_addresses(@$recips);
1040             #print DEBUG "mailing grandchild exec failed<\n";
1041             die $!;
1042             #print DEBUG "mailing grandchild died !?<\n";
1043         }
1044         #print DEBUG "mailing child not grandchild<\n";
1045         print(D $msg) || die $!;
1046         #print DEBUG "mailing child printed msg<\n";
1047         close(D);
1048         #print DEBUG "mailing child closed pipe<\n";
1049         die "\n*** command returned exit status $?\n" if $?;
1050         #print DEBUG "mailing child exit status ok<\n";
1051         exit 0;
1052         #print DEBUG "mailing child exited ?!<\n";
1053     }
1054     #print DEBUG "mailing parent<\n";
1055     $results='';
1056     #print DEBUG "mailing parent results emptied<\n";
1057     while( $chldexit eq 'no' ) { $results.= $_; }
1058     #print DEBUG "mailing parent results read >$results<\n";
1059     close(U);
1060     #print DEBUG "mailing parent results closed<\n";
1061     $results.= "\n*** child returned exit status $?\n" if $?;
1062     #print DEBUG "mailing parent exit status ok<\n";
1063     $SIG{'CHLD'}='DEFAULT';
1064     #print DEBUG "mailing parent sigchild default<\n";
1065     if (length($results)) { &quit("running sendmail: $results"); }
1066     #print DEBUG "mailing parent results ok<\n";
1067 }
1068
1069 sub checkmaintainers {
1070     return if $maintainerschecked++;
1071     return if !length($data->{package});
1072     open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1073     while (<MAINT>) {
1074         m/^\n$/ && next;
1075         m/^\s*$/ && next;
1076         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1077         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1078         $maintainerof{$1}= $2;
1079     }
1080     close(MAINT);
1081     open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1082     while (<MAINT>) {
1083         m/^\n$/ && next;
1084         m/^\s*$/ && next;
1085         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1086         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1087         $maintainerof{$1}= $2;
1088     }
1089     close(MAINT);
1090     open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
1091     while (<SOURCES>) {
1092         next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1093         ($a,$b)=($1,$2);
1094         $a =~ y/A-Z/a-z/;
1095         $pkgsrc{$a} = $b;
1096     }
1097     close(SOURCES);
1098     $anymaintfound=0; $anymaintnotfound=0;
1099     for $p (split(m/[ \t?,():]+/,$data->{package})) {
1100         $p =~ y/A-Z/a-z/;
1101         $p =~ /([a-z0-9.+-]+)/;
1102         $p = $1;
1103         next unless defined $p;
1104         if (defined $gSubscriptionDomain) {
1105             if (defined($pkgsrc{$p})) {
1106                 push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
1107             } else {
1108                 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1109             }
1110         }
1111         if (defined($maintainerof{$p})) {
1112             print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
1113             $addmaint= $maintainerof{$p};
1114             push(@maintaddrs,$addmaint) unless
1115                 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
1116             $anymaintfound++;
1117         } else {
1118             print DEBUG "maintainer none >$p<\n";
1119             push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1120             $anymaintnotfound++;
1121             last;
1122         }
1123     }
1124
1125     if (length $data->{owner}) {
1126         print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
1127         $addmaint = $data->{owner};
1128         push(@maintaddrs, $addmaint) unless
1129             $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1130     }
1131 }