scripts/process.in

   1 #!/usr/bin/perl
   2 # $Id: process.in,v 1.46 2002/02/07 17:33:52 joy 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     link("db-h/$hash/$ref.log", "db/$ref.log");
 497     link("db-h/$hash/$ref.status", "db/$ref.status");
 498     link("db-h/$hash/$ref.report", "db/$ref.report");
 499 }
 500
 501 &checkmaintainers;
 502
 503 print DEBUG "maintainers >@maintaddrs<\n";
 504
 505 $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
 506 $newsubject= $subject;  $newsubject =~ s/^$gBug#$ref\W*\s*//;
 507
 508 $xcchdr= $header{ 'x-debbugs-cc' };
 509 if ($xcchdr =~ m/\S/) {
 510     push(@resentccs,$xcchdr);
 511     $resentccexplain.= <<END;
 512
 513 As you requested using X-Debbugs-CC, your message was also forwarded to
 514    $xcchdr
 515 (after having been given a $gBug report number, if it did not have one).
 516 END
 517 }
 518
 519 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
 520     push(@resentccs,@maintaddrs);
 521     $resentccexplain.= <<END." ".join("\n ",@maintaddrs)."\n";
 522
 523 Your message has been sent to the package maintainer(s):
 524 END
 525 }
 526
 527 push(@resentccs, @addsrcaddrs);
 528
 529 $veryquiet= $codeletter eq 'Q';
 530 if ($codeletter eq 'M' && !@maintaddrs) {
 531     $veryquiet= 1;
 532     $brokenness.= <<END;
 533
 534 You requested that the message be sent to the package maintainer(s)
 535 but either the $gBug report is not associated with any package (probably
 536 because of a missing Package pseudo-header field in the original $gBug
 537 report), or the package(s) specified do not have any maintainer(s).
 538
 539 Your message has *not* been sent to any package maintainers; it has
 540 merely been filed in the $gBug tracking system.  If you require assistance
 541 please contact $gMaintainerEmail quoting the $gBug number $ref.
 542 END
 543 }
 544
 545 $resentccval.= join(', ',@resentccs);
 546 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
 547 if (length($resentccval)) { $resentcc= "Resent-CC: $resentccval\n"; }
 548
 549 if ($codeletter eq 'U') {
 550     &htmllog("Message", "sent on", $s_originator, "$gBug#$ref.");
 551     &sendmessage(<<END,$s_originator,@resentccs);
 552 Subject: $gBug#$ref: $newsubject
 553 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
 554 ${orgsender}Resent-To: $s_originator
 555 ${resentcc}Resent-Date: $tdate
 556 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 557 Resent-Sender: $gMaintainerEmail
 558 X-$gProject-PR-Message: report $ref
 559 X-$gProject-PR-Package: $s_package
 560 X-$gProject-PR-Keywords: $s_keywords
 561 $fwd
 562 END
 563 } elsif ($codeletter eq 'B') {
 564     &htmllog($newref ? "Report" : "Information", "forwarded",
 565              join(', ',"$gSubmitList\@$gListDomain",@resentccs),
 566              "<code>$gBug#$ref</code>".
 567              (length($s_package)? "; Package <code>".&sani($s_package)."</code>" : '').
 568              ".");
 569     &sendmessage(<<END,"$gSubmitList\@$gListDomain",@resentccs);
 570 Subject: $gBug#$ref: $newsubject
 571 Reply-To: $replyto, $ref\@$gEmailDomain
 572 Resent-From: $header{'from'}
 573 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
 574 ${resentcc}Resent-Date: $tdate
 575 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 576 Resent-Sender: $gMaintainerEmail
 577 X-$gProject-PR-Message: report $ref
 578 X-$gProject-PR-Package: $s_package
 579 X-$gProject-PR-Keywords: $s_keywords
 580 $fwd
 581 END
 582 } elsif (@resentccs) {
 583     # D and F done far earlier; B just done - so this must be M or Q
 584     # We preserve whichever it was in the Reply-To (possibly adding
 585     # the $gBug#).
 586     &htmllog($newref ? "Report" : "Information", "forwarded",
 587              $resentccval,
 588              "<code>$gBug#$ref</code>".
 589              (length($s_package)? "; Package <code>".&sani($s_package)."</code>" : '').
 590              ".");
 591     &sendmessage(<<END,@resentccs);
 592 Subject: $gBug#$ref: $newsubject
 593 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
 594 Resent-From: $header{'from'}
 595 ${orgsender}Resent-To: $resentccval
 596 Resent-Date: $tdate
 597 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 598 Resent-Sender: $gMaintainerEmail
 599 X-$gProject-PR-Message: report $ref
 600 X-$gProject-PR-Package: $s_package
 601 X-$gProject-PR-Keywords: $s_keywords
 602 $fwd
 603 END
 604 }
 605
 606 $htmlbreak= length($brokenness) ? "<p>\n".&sani($brokenness)."\n<p>\n" : '';
 607 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
 608 if (length($resentccval)) {
 609     $htmlbreak =
 610         "  Copy sent to <code>".&sani($resentccval)."</code>.".
 611         $htmlbreak;
 612 }
 613 if ($newref) {
 614     &htmllog("Acknowledgement","sent",$replyto,
 615              ($veryquiet ?
 616               "New $gBug report received and filed, but not forwarded." :
 617               "New $gBug report received and forwarded."). $htmlbreak);
 618     &sendmessage($veryquiet ? <<END : $codeletter eq 'M' ? <<END : <<END,'');
 619 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 620 To: $replyto
 621 Subject: $gBug#$ref: Acknowledgement of QUIET report
 622          ($subject)
 623 Message-ID: <handler.$ref.$nn.ackquiet\@$gEmailDomain>
 624 In-Reply-To: $header{'message-id'}
 625 References: $header{'message-id'}
 626 X-$gProject-PR-Message: ack-quiet $ref
 627 Reply-To: $ref-quiet\@$gEmailDomain
 628
 629 Thank you for the problem report you have sent regarding $gProject.
 630 This is an automatically generated reply, to let you know your message
 631 has been received.  It has not been forwarded to the developers or
 632 their mailing list; you should ensure that the developers are aware of
 633 the problem you have entered into the system - preferably quoting the
 634 $gBug reference number, #$ref.
 635 $resentccexplain
 636 If you wish to submit further information on your problem, please send it
 637 to $ref-$baddressroot\@$gEmailDomain (and *not*
 638 to $baddress\@$gEmailDomain).
 639
 640 Please do not reply to the address at the top of this message,
 641 unless you wish to report a problem with the $gBug-tracking system.
 642 $brokenness
 643 $gMaintainer
 644 (administrator, $gProject $gBugs database)
 645 END
 646 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 647 To: $replyto
 648 Subject: $gBug#$ref: Acknowledgement of maintainer-only report
 649          ($subject)
 650 Message-ID: <handler.$ref.$nn.ackmaint\@$gEmailDomain>
 651 In-Reply-To: $header{'message-id'}
 652 References: $header{'message-id'}
 653 X-$gProject-PR-Message: ack-maintonly $ref
 654 Reply-To: $ref-maintonly\@$gEmailDomain
 655
 656 Thank you for the problem report you have sent regarding $gProject.
 657 This is an automatically generated reply, to let you know your message has
 658 been received.  It is being forwarded to the developers (but not the mailing
 659 list, as you requested) for their attention; they will reply in due course.
 660 $resentccexplain
 661 If you wish to submit further information on your problem, please send
 662 it to $ref-$baddressroot\@$gEmailDomain (and *not*
 663 to $baddress\@$gEmailDomain).
 664
 665 Please do not reply to the address at the top of this message,
 666 unless you wish to report a problem with the $gBug-tracking system.
 667 $brokenness
 668 $gMaintainer
 669 (administrator, $gProject $gBugs database)
 670 END
 671 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 672 To: $replyto
 673 Subject: $gBug#$ref: Acknowledgement ($subject)
 674 Message-ID: <handler.$ref.$nn.ack\@$gEmailDomain>
 675 In-Reply-To: $header{'message-id'}
 676 References: $header{'message-id'}
 677 X-$gProject-PR-Message: ack $ref
 678 Reply-To: $ref\@$gEmailDomain
 679
 680 Thank you for the problem report you have sent regarding $gProject.
 681 This is an automatically generated reply, to let you know your message has
 682 been received.  It is being forwarded to the developers mailing list for
 683 their attention; they will reply in due course.
 684 $resentccexplain
 685 If you wish to submit further information on your problem, please send
 686 it to $ref\@$gEmailDomain (and *not* to
 687 $baddress\@$gEmailDomain).
 688
 689 Please do not reply to the address at the top of this message,
 690 unless you wish to report a problem with the $gBug-tracking system.
 691 $brokenness
 692 $gMaintainer
 693 (administrator, $gProject $gBugs database)
 694 END
 695 } elsif ($codeletter ne 'U') {
 696     &htmllog("Acknowledgement","sent",$replyto,
 697              ($veryquiet ? "Extra info received and filed, but not forwarded." :
 698               $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
 699               "Extra info received and forwarded to list."). $htmlbreak);
 700     &sendmessage($veryquiet ? <<END : $codeletter eq 'M' ? <<END : <<END,'');
 701 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 702 To: $replyto
 703 Subject: $gBug#$ref: Info received and FILED only
 704          (was $subject)
 705 Message-ID: <handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>
 706 In-Reply-To: $header{'message-id'}
 707 References: $header{'message-id'}
 708 X-$gProject-PR-Message: ack-info-quiet $ref
 709 Reply-To: $ref-quiet\@$gEmailDomain
 710
 711 Thank you for the additional information you have supplied regarding
 712 this problem report.  It has NOT been forwarded to the developers, but
 713 will accompany the original report in the $gBug tracking system.  Please
 714 ensure that you yourself have sent a copy of the additional
 715 information to any relevant developers or mailing lists.
 716 $resentccexplain
 717 If you wish to continue to submit further information on your problem,
 718 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 719
 720 Please do not reply to the address at the top of this message,
 721 unless you wish to report a problem with the $gBug-tracking system.
 722 $brokenness
 723 $gMaintainer
 724 (administrator, $gProject $gBugs database)
 725 END
 726 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 727 To: $replyto
 728 Subject: $gBug#$ref: Info received for maintainer only
 729          (was $subject)
 730 Message-ID: <handler.$ref.$nn.ackinfomaint\@$gEmailDomain>
 731 In-Reply-To: $header{'message-id'}
 732 References: $header{'message-id'}
 733 X-$gProject-PR-Message: ack-info-maintonly $ref
 734 Reply-To: $ref-maintonly\@$gEmailDomain
 735
 736 Thank you for the additional information you have supplied regarding
 737 this problem report.  It has been forwarded to the developer(s) (but
 738 not to the mailing list) to accompany the original report.
 739 $resentccexplain
 740 If you wish to continue to submit further information on your problem,
 741 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 742
 743 Please do not reply to the address at the top of this message,
 744 unless you wish to report a problem with the $gBug-tracking system.
 745 $brokenness
 746 $gMaintainer
 747 (administrator, $gProject $gBugs database)
 748 END
 749 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 750 To: $replyto
 751 Subject: $gBug#$ref: Info received (was $subject)
 752 Message-ID: <handler.$ref.$nn.ackinfo\@$gEmailDomain>
 753 In-Reply-To: $header{'message-id'}
 754 References: $header{'message-id'}
 755 X-$gProject-PR-Message: ack-info $ref
 756 Disabled-Doogie-Reply-To: $ref\@$gEmailDomain
 757
 758 Thank you for the additional information you have supplied regarding
 759 this problem report.  It has been forwarded to the developer(s) and
 760 to the developers mailing list to accompany the original report.
 761 $resentccexplain
 762 If you wish to continue to submit further information on your problem,
 763 please send it to $ref\@$gEmailDomain, as before.
 764
 765 Please do not reply to the address at the top of this message,
 766 unless you wish to report a problem with the $gBug-tracking system.
 767 $brokenness
 768 $gMaintainer
 769 (administrator, $gProject $gBugs database)
 770 END
 771 }
 772
 773 &appendlog;
 774 &finish;
 775
 776 sub overwrite {
 777     local ($f,$v) = @_;
 778     open(NEW,">$f.new") || &quit("$f.new: create: $!");
 779     print(NEW "$v") || &quit("$f.new: write: $!");
 780     close(NEW) || &quit("$f.new: close: $!");
 781     rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
 782 }
 783
 784 sub appendlog {
 785     my $hash = get_hashname($ref);
 786     if (!open(AP,">>db-h/$hash/$ref.log")) {
 787         print DEBUG "failed open log<\n";
 788         print DEBUG "failed open log err $!<\n";
 789         &quit("opening db-h/$hash/$ref.log (li): $!");
 790     }
 791     print(AP "\7\n",@log,"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
 792     close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
 793 }
 794
 795 sub finish {
 796     utime(time,time,"db");
 797     local ($u);
 798     while ($u= $cleanups[$#cleanups]) { &$u; }
 799     unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
 800     exit $_[0];
 801 }
 802
 803 &quit("wot no exit");
 804
 805 sub chldhandle { $chldexit = 'yes'; }
 806
 807 sub htmllog {
 808     local ($whatobj,$whatverb,$where,$desc) = @_;
 809     my $hash = get_hashname($ref);
 810     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
 811     print(AP
 812           "\6\n".
 813           "<strong>$whatobj $whatverb</strong> to <code>".&sani($where).
 814           "</code>:<br>\n". $desc.
 815           "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
 816     close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
 817 }
 818
 819 sub get_addresses {
 820         return
 821                 map { $_->address() }
 822                 map { Mail::Address->parse($_) } @_;
 823 }
 824
 825 sub sendmessage {
 826     local ($msg,@recips) = @_;
 827     if ($recips[0] eq '' && $#recips == 0) { @recips= ('-t'); }
 828     $msg = "X-Loop: $gMaintainerEmail\n" . $msg;
 829
 830     my $hash = get_hashname($ref);
 831     #save email to the log
 832     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
 833     print(AP "\2\n",join("\4",@recips),"\n\5\n$msg\n\3\n") ||
 834         &quit("writing db-h/$hash/$ref.log (lo): $!");
 835     close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
 836
 837 #if debbuging.. save email to a log
 838 #    open AP, ">>debug";
 839 #    print AP join( '|', @recips )."\n>>";
 840 #    print AP get_addresses( @recips );
 841 #    print AP "<<\n".$msg;
 842 #    print AP "\n--------------------------------------------------------\n";
 843 #    close AP;
 844
 845     #start mailing
 846     $_ = '';
 847     $SIG{'CHLD'}='chldhandle';
 848     #print DEBUG "mailing sigchild set up<\n";
 849     $chldexit = 'no';
 850     $c= open(U,"-|");
 851     #print DEBUG "mailing opened pipe fork<\n";
 852     defined($c) || die $!;
 853     #print DEBUG "mailing opened pipe fork ok $c<\n";
 854     if (!$c) { # ie, we are in the child process
 855         #print DEBUG "mailing child<\n";
 856         unless (open(STDERR,">&STDOUT")) {
 857             #print DEBUG "mailing child opened stderr<\n";
 858             print STDOUT "redirect stderr: $!\n";
 859             #print DEBUG "mailing child opened stderr fail<\n";
 860             exit 1;
 861             #print DEBUG "mailing child opened stderr fail exit !?<\n";
 862         }
 863         #print DEBUG "mailing child opened stderr ok<\n";
 864         $c= open(D,"|-");
 865         #print DEBUG "mailing child forked again<\n";
 866         defined($c) || die $!;
 867         #print DEBUG "mailing child forked again ok $c<\n";
 868         if (!$c) { # ie, we are the child process
 869             #print DEBUG "mailing grandchild<\n";
 870             exec '/usr/lib/sendmail','-f'."$gMaintainerEmail",'-odq','-oem','-oi',get_addresses(@recips);
 871             #print DEBUG "mailing grandchild exec failed<\n";
 872             die $!;
 873             #print DEBUG "mailing grandchild died !?<\n";
 874         }
 875         #print DEBUG "mailing child not grandchild<\n";
 876         print(D $msg) || die $!;
 877         #print DEBUG "mailing child printed msg<\n";
 878         close(D);
 879         #print DEBUG "mailing child closed pipe<\n";
 880         die "\n*** command returned exit status $?\n" if $?;
 881         #print DEBUG "mailing child exit status ok<\n";
 882         exit 0;
 883         #print DEBUG "mailing child exited ?!<\n";
 884     }
 885     #print DEBUG "mailing parent<\n";
 886     $results='';
 887     #print DEBUG "mailing parent results emptied<\n";
 888     while( $chldexit eq 'no' ) { $results.= $_; }
 889     #print DEBUG "mailing parent results read >$results<\n";
 890     close(U);
 891     #print DEBUG "mailing parent results closed<\n";
 892     $results.= "\n*** child returned exit status $?\n" if $?;
 893     #print DEBUG "mailing parent exit status ok<\n";
 894     $SIG{'CHLD'}='DEFAULT';
 895     #print DEBUG "mailing parent sigchild default<\n";
 896     if (length($results)) { &quit("running sendmail: $results"); }
 897     #print DEBUG "mailing parent results ok<\n";
 898 }
 899
 900 sub checkmaintainers {
 901     return if $maintainerschecked++;
 902     return if !length($s_package);
 903     open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
 904     while (<MAINT>) {
 905         m/^\n$/ && next;
 906         m/^\s*$/ && next;
 907         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
 908         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
 909         $maintainerof{$1}= $2;
 910     }
 911     close(MAINT);
 912     open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
 913     while (<MAINT>) {
 914         m/^\n$/ && next;
 915         m/^\s*$/ && next;
 916         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
 917         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
 918         $maintainerof{$1}= $2;
 919     }
 920     close(MAINT);
 921     open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
 922     while (<SOURCES>) {
 923         next unless m/^(\S+)\s+(\S.*\S)\s*$/;
 924         ($a,$b)=($1,$2);
 925         $a =~ y/A-Z/a-z/;
 926         $pkgsrc{$a} = $b;
 927     }
 928     close(SOURCES);
 929     $anymaintfound=0; $anymaintnotfound=0;
 930     for $p (split(m/[ \t?,()]+/,$s_package)) {
 931         $p =~ y/A-Z/a-z/;
 932         if (defined($pkgsrc{$p})) {
 933             push @addsrcaddrs, "$pkgsrc{$p}\@packages.qa.debian.org";
 934         } else {
 935             push @addsrcaddrs, "$p\@packages.qa.debian.org";
 936         }
 937         if (defined($maintainerof{$p})) {
 938 print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
 939             $addmaint= $maintainerof{$p};
 940             push(@maintaddrs,$addmaint) unless
 941                 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
 942             $anymaintfound++;
 943         } else {
 944 print DEBUG "maintainer none >$p<\n";
 945             push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
 946             $anymaintnotfound++;
 947             last;
 948         }
 949     }
 950 }