scripts/process.in

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