scripts/process.in

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