scripts/process.in

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