scripts/process.in

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