scripts/process.in

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