scripts/process.in

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