scripts/process.in

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