scripts/process.in

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