scripts/process.in

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