scripts/process.in

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