scripts/process.in

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