scripts/process.in

   1 #!/usr/bin/perl
   2 # $Id: process.in,v 1.36 2001/08/19 02:09:18 doogie 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
 345 This is an automatic notification regarding your $gBug report
 346 #$ref: $s_subject,
 347 which was filed against the $s_package package.
 348
 349 It has been closed by one of the developers, namely
 350 $markedby.
 351
 352 Their explanation is attached below.  If this explanation is
 353 unsatisfactory and you have not received a better one in a separate
 354 message then please contact the developer directly, or email
 355 $ref\@$gEmailDomain or me.
 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
 622 Thank you for the problem report you have sent regarding $gProject.
 623 This is an automatically generated reply, to let you know your message
 624 has been received.  It has not been forwarded to the developers or
 625 their mailing list; you should ensure that the developers are aware of
 626 the problem you have entered into the system - preferably quoting the
 627 $gBug reference number, #$ref.
 628 $resentccexplain
 629 If you wish to submit further information on your problem, please send it
 630 to $ref-$baddressroot\@$gEmailDomain (and *not*
 631 to $baddress\@$gEmailDomain).
 632
 633 Please do not reply to the address at the top of this message,
 634 unless you wish to report a problem with the $gBug-tracking system.
 635 $brokenness
 636 $gMaintainer
 637 (administrator, $gProject $gBugs database)
 638 END
 639 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 640 To: $replyto
 641 Subject: $gBug#$ref: Acknowledgement of maintainer-only report
 642          ($subject)
 643 Message-ID: <handler.$ref.$nn.ackmaint\@$gEmailDomain>
 644 In-Reply-To: $header{'message-id'}
 645 References: $header{'message-id'}
 646 X-$gProject-PR-Message: ack-maintonly $ref
 647
 648 Thank you for the problem report you have sent regarding $gProject.
 649 This is an automatically generated reply, to let you know your message has
 650 been received.  It is being forwarded to the developers (but not the mailing
 651 list, as you requested) for their attention; they will reply in due course.
 652 $resentccexplain
 653 If you wish to submit further information on your problem, please send
 654 it to $ref-$baddressroot\@$gEmailDomain (and *not*
 655 to $baddress\@$gEmailDomain).
 656
 657 Please do not reply to the address at the top of this message,
 658 unless you wish to report a problem with the $gBug-tracking system.
 659 $brokenness
 660 $gMaintainer
 661 (administrator, $gProject $gBugs database)
 662 END
 663 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 664 To: $replyto
 665 Subject: $gBug#$ref: Acknowledgement ($subject)
 666 Message-ID: <handler.$ref.$nn.ack\@$gEmailDomain>
 667 In-Reply-To: $header{'message-id'}
 668 References: $header{'message-id'}
 669 X-$gProject-PR-Message: ack $ref
 670
 671 Thank you for the problem report you have sent regarding $gProject.
 672 This is an automatically generated reply, to let you know your message has
 673 been received.  It is being forwarded to the developers mailing list for
 674 their attention; they will reply in due course.
 675 $resentccexplain
 676 If you wish to submit further information on your problem, please send
 677 it to $ref\@$gEmailDomain (and *not* to
 678 $baddress\@$gEmailDomain).
 679
 680 Please do not reply to the address at the top of this message,
 681 unless you wish to report a problem with the $gBug-tracking system.
 682 $brokenness
 683 $gMaintainer
 684 (administrator, $gProject $gBugs database)
 685 END
 686 } elsif ($codeletter ne 'U') {
 687     &htmllog("Acknowledgement","sent",$replyto,
 688              ($veryquiet ? "Extra info received and filed, but not forwarded." :
 689               $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
 690               "Extra info received and forwarded to list."). $htmlbreak);
 691     &sendmessage($veryquiet ? <<END : $codeletter eq 'M' ? <<END : <<END,'');
 692 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 693 To: $replyto
 694 Subject: $gBug#$ref: Info received and FILED only
 695          (was $subject)
 696 Message-ID: <handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>
 697 In-Reply-To: $header{'message-id'}
 698 References: $header{'message-id'}
 699 X-$gProject-PR-Message: ack-info-quiet $ref
 700
 701 Thank you for the additional information you have supplied regarding
 702 this problem report.  It has NOT been forwarded to the developers, but
 703 will accompany the original report in the $gBug tracking system.  Please
 704 ensure that you yourself have sent a copy of the additional
 705 information to any relevant developers or mailing lists.
 706 $resentccexplain
 707 If you wish to continue to submit further information on your problem,
 708 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 709
 710 Please do not reply to the address at the top of this message,
 711 unless you wish to report a problem with the $gBug-tracking system.
 712 $brokenness
 713 $gMaintainer
 714 (administrator, $gProject $gBugs database)
 715 END
 716 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 717 To: $replyto
 718 Subject: $gBug#$ref: Info received for maintainer only
 719          (was $subject)
 720 Message-ID: <handler.$ref.$nn.ackinfomaint\@$gEmailDomain>
 721 In-Reply-To: $header{'message-id'}
 722 References: $header{'message-id'}
 723 X-$gProject-PR-Message: ack-info $ref
 724
 725 Thank you for the additional information you have supplied regarding
 726 this problem report.  It has been forwarded to the developer(s) (but
 727 not to the mailing list) to accompany the original report.
 728 $resentccexplain
 729 If you wish to continue to submit further information on your problem,
 730 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 731
 732 Please do not reply to the address at the top of this message,
 733 unless you wish to report a problem with the $gBug-tracking system.
 734 $brokenness
 735 $gMaintainer
 736 (administrator, $gProject $gBugs database)
 737 END
 738 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 739 To: $replyto
 740 Subject: $gBug#$ref: Info received (was $subject)
 741 Message-ID: <handler.$ref.$nn.ackinfo\@$gEmailDomain>
 742 In-Reply-To: $header{'message-id'}
 743 References: $header{'message-id'}
 744 X-$gProject-PR-Message: ack-info-maintonly $ref
 745
 746 Thank you for the additional information you have supplied regarding
 747 this problem report.  It has been forwarded to the developer(s) and
 748 to the developers mailing list to accompany the original report.
 749 $resentccexplain
 750 If you wish to continue to submit further information on your problem,
 751 please send it to $ref\@$gEmailDomain, as before.
 752
 753 Please do not reply to the address at the top of this message,
 754 unless you wish to report a problem with the $gBug-tracking system.
 755 $brokenness
 756 $gMaintainer
 757 (administrator, $gProject $gBugs database)
 758 END
 759 }
 760
 761 &appendlog;
 762 &finish;
 763
 764 sub overwrite {
 765     local ($f,$v) = @_;
 766     open(NEW,">$f.new") || &quit("$f.new: create: $!");
 767     print(NEW "$v") || &quit("$f.new: write: $!");
 768     close(NEW) || &quit("$f.new: close: $!");
 769     rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
 770 }
 771
 772 sub appendlog {
 773     my $hash = get_hashname($ref);
 774     if (!open(AP,">>db-h/$hash/$ref.log")) {
 775         print DEBUG "failed open log<\n";
 776         print DEBUG "failed open log err $!<\n";
 777         &quit("opening db-h/$hash/$ref.log (li): $!");
 778     }
 779     print(AP "\7\n",@log,"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
 780     close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
 781 }
 782
 783 sub finish {
 784     utime(time,time,"db");
 785     local ($u);
 786     while ($u= $cleanups[$#cleanups]) { &$u; }
 787     unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
 788     exit $_[0];
 789 }
 790
 791 &quit("wot no exit");
 792
 793 sub chldhandle { $chldexit = 'yes'; }
 794
 795 sub htmllog {
 796     local ($whatobj,$whatverb,$where,$desc) = @_;
 797     my $hash = get_hashname($ref);
 798     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
 799     print(AP
 800           "\6\n".
 801           "<strong>$whatobj $whatverb</strong> to <code>".&sani($where).
 802           "</code>:<br>\n". $desc.
 803           "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
 804     close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
 805 }
 806
 807 sub get_addresses {
 808         return
 809                 map { $_->address() }
 810                 map { Mail::Address->parse($_) } @_;
 811 }
 812
 813
 814 sub sendmessage {
 815     local ($msg,@recips) = @_;
 816     if ($recips[0] eq '' && $#recips == 0) { @recips= ('-t'); }
 817
 818     my $hash = get_hashname($ref);
 819         #save email to the log
 820     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
 821     print(AP "\2\n",join("\4",@recips),"\n\5\n$msg\n\3\n") ||
 822         &quit("writing db-h/$hash/$ref.log (lo): $!");
 823     close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
 824
 825         #if debbuging.. save email to a log
 826 #       open AP, ">>debug";
 827 #       print AP join( '|', @recips )."\n>>";
 828 #       print AP get_addresses( @recips );
 829 #       print AP "<<\n".$msg;
 830 #       print AP "\n--------------------------------------------------------\n";
 831 #       close AP;
 832
 833         #start mailing
 834         $_ = '';
 835     $SIG{'CHLD'}='chldhandle';
 836         #print DEBUG "mailing sigchild set up<\n";
 837         $chldexit = 'no';
 838     $c= open(U,"-|");
 839         #print DEBUG "mailing opened pipe fork<\n";
 840     defined($c) || die $!;
 841         #print DEBUG "mailing opened pipe fork ok $c<\n";
 842     if (!$c) { # ie, we are in the child process
 843                 #print DEBUG "mailing child<\n";
 844         unless (open(STDERR,">&STDOUT")) {
 845                         #print DEBUG "mailing child opened stderr<\n";
 846             print STDOUT "redirect stderr: $!\n";
 847                         #print DEBUG "mailing child opened stderr fail<\n";
 848             exit 1;
 849                         #print DEBUG "mailing child opened stderr fail exit !?<\n";
 850         }
 851                 #print DEBUG "mailing child opened stderr ok<\n";
 852         $c= open(D,"|-");
 853                 #print DEBUG "mailing child forked again<\n";
 854         defined($c) || die $!;
 855                 #print DEBUG "mailing child forked again ok $c<\n";
 856         if (!$c) { # ie, we are the child process
 857                         #print DEBUG "mailing grandchild<\n";
 858             exec '/usr/lib/sendmail','-f'."$gMaintainerEmail",'-odq','-oem','-oi',get_addresses(@recips);
 859                         #print DEBUG "mailing grandchild exec failed<\n";
 860             die $!;
 861                         #print DEBUG "mailing grandchild died !?<\n";
 862         }
 863                 #print DEBUG "mailing child not grandchild<\n";
 864         print(D $msg) || die $!;
 865                 #print DEBUG "mailing child printed msg<\n";
 866         close(D);
 867                 #print DEBUG "mailing child closed pipe<\n";
 868         die "\n*** command returned exit status $?\n" if $?;
 869                 #print DEBUG "mailing child exit status ok<\n";
 870         exit 0;
 871                 #print DEBUG "mailing child exited ?!<\n";
 872     }
 873         #print DEBUG "mailing parent<\n";
 874     $results='';
 875         #print DEBUG "mailing parent results emptied<\n";
 876     while( $chldexit eq 'no' ) { $results.= $_; }
 877         #print DEBUG "mailing parent results read >$results<\n";
 878     close(U);
 879         #print DEBUG "mailing parent results closed<\n";
 880     $results.= "\n*** child returned exit status $?\n" if $?;
 881         #print DEBUG "mailing parent exit status ok<\n";
 882     $SIG{'CHLD'}='DEFAULT';
 883         #print DEBUG "mailing parent sigchild default<\n";
 884     if (length($results)) { &quit("running sendmail: $results"); }
 885         #print DEBUG "mailing parent results ok<\n";
 886 }
 887
 888 sub checkmaintainers {
 889     return if $maintainerschecked++;
 890     return if !length($s_package);
 891     open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
 892     while (<MAINT>) {
 893         m/^\n$/ && next;
 894         m/^\s*$/ && next;
 895         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
 896         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
 897         $maintainerof{$1}= $2;
 898     }
 899     close(MAINT);
 900     open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
 901     while (<MAINT>) {
 902         m/^\n$/ && next;
 903         m/^\s*$/ && next;
 904         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
 905         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
 906         $maintainerof{$1}= $2;
 907     }
 908     close(MAINT);
 909     $anymaintfound=0; $anymaintnotfound=0;
 910     for $p (split(m/[ \t?,()]+/,$s_package)) {
 911         $p =~ y/A-Z/a-z/;
 912         if (defined($maintainerof{$p})) {
 913 print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
 914             $addmaint= $maintainerof{$p};
 915             push(@maintaddrs,$addmaint) unless
 916                 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
 917             $anymaintfound++;
 918         } else {
 919 print DEBUG "maintainer none >$p<\n";
 920             push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
 921             $anymaintnotfound++;
 922             last;
 923         }
 924     }
 925 }