scripts/process.in

   1 #!/usr/bin/perl
   2 # $Id: process.in,v 1.109 2006/02/09 22:02:04 don Exp $
   3 #
   4 # Usage: process nn
   5 # Temps:  incoming/Pnn
   6
   7 use POSIX qw(strftime tzset);
   8 $ENV{"TZ"} = 'UTC';
   9 tzset();
  10
  11 use MIME::Parser;
  12 use Debbugs::MIME qw(decode_rfc1522 create_mime_message);
  13 use Debbugs::Mail qw(send_mail_message encode_headers);
  14 use Debbugs::Packages qw(getpkgsrc);
  15
  16 my $config_path = '/etc/debbugs';
  17 my $lib_path = '/usr/lib/debbugs';
  18
  19 # TODO DLA; needs config reworking and errorlib reworking
  20 # use warnings;
  21 # use strict;
  22
  23 require "$config_path/config";
  24 require "$lib_path/errorlib";
  25 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
  26
  27 chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
  28
  29 #open(DEBUG,"> /tmp/debbugs.debug");
  30 umask(002);
  31 open DEBUG, ">/dev/null";
  32
  33 my $intdate = time or quit("failed to get time: $!");
  34
  35 $_=shift;
  36 m/^([BMQFDUL])(\d*)\.\d+$/ or quit("bad argument: $_");
  37 my $codeletter= $1;
  38 my $tryref= length($2) ? $2 : -1;
  39 my $nn= $_;
  40
  41 if (!rename("incoming/G$nn","incoming/P$nn"))
  42 {
  43     $_=$!.'';  m/no such file or directory/i && exit 0;
  44     &quit("renaming to lock: $!");
  45 }
  46
  47 my $baddress= 'submit' if $codeletter eq 'B';
  48 $baddress= 'maintonly' if $codeletter eq 'M';
  49 $baddress= 'quiet' if $codeletter eq 'Q';
  50 $baddress= 'forwarded' if $codeletter eq 'F';
  51 $baddress= 'done' if $codeletter eq 'D';
  52 $baddress= 'submitter' if $codeletter eq 'U';
  53 bug_list_forward($nn) if $codeletter eq 'L';
  54 $baddress || &quit("bad codeletter $codeletter");
  55 my $baddressroot= $baddress;
  56 $baddress= "$tryref-$baddress" if $tryref>=0;
  57
  58 open(M,"incoming/P$nn");
  59 my @log=<M>;
  60 close(M);
  61
  62 my @msg = @log;
  63 chomp @msg;
  64
  65 print DEBUG "###\n",join("##\n",@msg),"\n###\n";
  66
  67 my $tdate = strftime "%a, %d %h %Y %T UTC", gmtime;
  68 my $fwd= <<END;
  69 Received: via spool by $baddress\@$gEmailDomain id=$nn
  70           (code $codeletter ref $tryref); $tdate
  71 END
  72
  73 # header and decoded body respectively
  74 my (@headerlines, @bodylines);
  75
  76 my $parser = new MIME::Parser;
  77 mkdir "$gSpoolDir/mime.tmp", 0777;
  78 $parser->output_under("$gSpoolDir/mime.tmp");
  79 my $entity = eval { $parser->parse_data(join('',@log)) };
  80
  81 my $i;
  82 if ($entity and $entity->head->tags) {
  83     @headerlines = @{$entity->head->header};
  84     chomp @headerlines;
  85
  86     my $entity_body = getmailbody($entity);
  87     @bodylines = $entity_body ? $entity_body->as_lines() : ();
  88     chomp @bodylines;
  89
  90     # set $i to beginning of encoded body data, so we can dump it out
  91     # verbatim later
  92     $i = 0;
  93     ++$i while $msg[$i] =~ /./;
  94 } else {
  95     # Legacy pre-MIME code, kept around in case MIME::Parser fails.
  96     for ($i = 0; $i <= $#msg; $i++) {
  97         $_ = $msg[$i];
  98         last unless length($_);
  99         while ($msg[$i+1] =~ m/^\s/) {
 100             $i++;
 101             $_ .= "\n".$msg[$i];
 102         }
 103         push @headerlines, $_;
 104     }
 105
 106     @bodylines = @msg[$i..$#msg];
 107 }
 108
 109 my %header;
 110
 111 for my $hdr (@headerlines) {
 112     $hdr = decode_rfc1522($hdr);
 113     $_ = $hdr;
 114     s/\n\s/ /g;
 115     &finish if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
 116     my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
 117            && !m/^From / && !m/^X-Debbugs-/i;
 118     $fwd .= $hdr."\n" if $ins;
 119     # print DEBUG ">$_<\n";
 120     if (s/^(\S+):\s*//) {
 121         my $v = lc $1;
 122         print DEBUG ">$v=$_<\n";
 123         $header{$v} = $_;
 124     } else {
 125         print DEBUG "!>$_<\n";
 126     }
 127 }
 128
 129 # remove blank lines
 130 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
 131
 132 # Strip off RFC2440-style PGP clearsigning.
 133 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
 134     shift @bodylines while @bodylines and length $bodylines[0];
 135     shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
 136     for my $findsig (0 .. $#bodylines) {
 137         if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
 138             $#bodylines = $findsig - 1;
 139             last;
 140         }
 141     }
 142     map { s/^- // } @bodylines;
 143 }
 144
 145 # extract pseudo-headers
 146 for my $phline (@bodylines)
 147 {
 148     last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
 149     my ($fn, $fv) = ($1, $2);
 150     $fv =~ s/\s*$//;
 151     print DEBUG ">$fn|$fv|\n";
 152     $fn = lc $fn;
 153     $fv = lc $fv;
 154     $pheader{$fn} = $fv;
 155     print DEBUG ">$fn~$fv<\n";
 156 }
 157
 158 # Allow pseudo headers to set x-debbugs- stuff [#179340]
 159 for my $key (grep /X-Debbugs-.*/i, keys %pheader) {
 160      $header{$key} = $pheader{$key} if not exists $header{$key};
 161 }
 162
 163 $fwd .= join("\n",@msg[$i..$#msg]);
 164
 165 print DEBUG "***\n$fwd\n***\n";
 166
 167 if (defined $header{'resent-from'} && !defined $header{'from'}) {
 168     $header{'from'} = $header{'resent-from'};
 169 }
 170 defined($header{'from'}) || &quit("no From header");
 171
 172 my $replyto = $header{'reply-to'};
 173 $replyto = '' unless defined $replyto;
 174 $replyto =~ s/^ +//;
 175 $replyto =~ s/ +$//;
 176 unless (length $replyto) {
 177     $replyto = $header{'from'};
 178 }
 179
 180 my $subject = '(no subject)';
 181 if (!defined($header{'subject'}))
 182 {
 183         $brokenness.= <<END;
 184
 185 Your message did not contain a Subject field. They are recommended and
 186 useful because the title of a $gBug is determined using this field.
 187 Please remember to include a Subject field in your messages in future.
 188 END
 189
 190 } else {
 191     $subject= $header{'subject'};
 192 }
 193
 194 my $ref=-1;
 195 $subject =~ s/^Re:\s*//i; $_= $subject."\n";
 196 if ($tryref < 0 && m/^Bug ?\#(\d+)\D/i) {
 197     $tryref= $1+0;
 198 }
 199
 200 if ($tryref >= 0)
 201 {
 202     ($bfound, $data)= &lockreadbugmerge($tryref);
 203     if ($bfound) {
 204         $ref= $tryref;
 205     } else {
 206         &htmllog("Reply","sent", $replyto,"Unknown problem report number <code>$tryref</code>.");
 207         my $archivenote = '';
 208         if ($gRemoveAge) {
 209             $archivenote = <<END;
 210 This may be because that $gBug report has been resolved for more than $gRemoveAge
 211 days, and the record of it has been archived and made read-only, or
 212 because you mistyped the $gBug report number.
 213
 214 END
 215         }
 216         &sendmessage(<<END, '');
 217 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 218 To: $replyto
 219 Subject: Unknown problem report $gBug#$tryref ($subject)
 220 Message-ID: <handler.x.$nn.unknown\@$gEmailDomain>
 221 In-Reply-To: $header{'message-id'}
 222 References: $header{'message-id'} $data->{msgid}
 223 Precedence: bulk
 224 X-$gProject-PR-Message: error
 225
 226 You sent a message to the $gBug tracking system which gave (in the
 227 Subject line or encoded into the recipient at $gEmailDomain),
 228 the number of a nonexistent $gBug report (#$tryref).
 229
 230 ${archivenote}Your message was dated $header{'date'} and was sent to
 231 $baddress\@$gEmailDomain.  It had
 232 Message-ID $header{'message-id'}
 233 and Subject $subject.
 234
 235 It has been filed (under junk) but otherwise ignored.
 236
 237 Please consult your records to find the correct $gBug report number, or
 238 contact me, the system administrator, for assistance.
 239
 240 $gMaintainer
 241 (administrator, $gProject $gBugs database)
 242
 243 (NB: If you are a system administrator and have no idea what I am
 244 talking about this indicates a serious mail system misconfiguration
 245 somewhere.  Please contact me immediately.)
 246
 247 END
 248         &appendlog;
 249         &finish;
 250     }
 251 } else {
 252     &filelock('lock/-1');
 253 }
 254
 255 # Attempt to determine which source package this is
 256 my $source_pr_header = '';
 257 my $source_package = '';
 258 if (defined $pheader{source}) {
 259      $source_package = $pheader{source};
 260 }
 261 elsif (defined $data->{package}) {
 262      my $pkg_src = getpkgsrc();
 263      $source_package = $pkg_src->{$data->{package}};
 264 }
 265 $source_pr_header = "X-$gProject-Pr-Source: $source_package\n"
 266      if length $source_package;
 267
 268 # Done and Forwarded Bugs
 269 if ($codeletter eq 'D' || $codeletter eq 'F')
 270 {
 271     if ($replyto =~ m/$gBounceFroms/o ||
 272         $header{'from'} =~ m/$gBounceFroms/o)
 273     {
 274         &quit("bounce detected !  Mwaap! Mwaap!");
 275     }
 276     $markedby= $header{'from'} eq $replyto ? $replyto :
 277                "$header{'from'} (reply to $replyto)";
 278     my @generalcc;
 279     if ($codeletter eq 'F') { # Forwarded
 280         (&appendlog,&finish) if length($data->{forwarded});
 281         $receivedat= "forwarded\@$gEmailDomain";
 282         $markaswhat= 'forwarded';
 283         $set_forwarded= $header{'to'};
 284         if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
 285             push @generalcc, "$gForwardList\@$gListDomain";
 286             $generalcc= "$gForwardList\@$gListDomain";
 287         } else {
 288             $generalcc='';
 289         }
 290     } else { # Done
 291         if (length($data->{done}) and
 292                 not defined $pheader{'source-version'} and
 293                 not defined $pheader{'version'}) {
 294             &appendlog;
 295             &finish;
 296         }
 297         $receivedat= "done\@$gEmailDomain";
 298         $markaswhat= 'done';
 299         $set_done= $header{'from'};
 300         if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
 301             $generalcc= "$gDoneList\@$gListDomain";
 302             push @generalcc, "$gDoneList\@$gListDomain";
 303         } else {
 304             $generalcc='';
 305         }
 306     }
 307     if (defined $gStrongList and isstrongseverity($data->{severity})) {
 308         $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
 309         push @generalcc,"$gStrongList\@$gListDomain";
 310     }
 311     if ($ref<0) {
 312         &htmllog("Warning","sent",$replyto,"Message ignored.");
 313         &sendmessage(<<END, '');
 314 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 315 To: $replyto
 316 Subject: Message with no $gBug number ignored by $receivedat
 317          ($subject)
 318 Message-ID: <header.x.$nn.warnignore\@$gEmailDomain>
 319 In-Reply-To: $header{'message-id'}
 320 References: $header{'message-id'} $data->{msgid}
 321 Precedence: bulk
 322 X-$gProject-PR-Message: error
 323
 324 You sent a message to the $gProject $gBug tracking system old-style
 325 unified mark as $markaswhat address ($receivedat),
 326 without a recognisable $gBug number in the Subject.
 327 Your message has been filed under junk but otherwise ignored.
 328
 329 If you don't know what I'm talking about then probably either:
 330
 331 (a) you unwittingly sent a message to done\@$gEmailDomain
 332 because you replied to all recipients of the message a developer used
 333 to mark a $gBug as done and you modified the Subject.  In this case,
 334 please do not be alarmed.  To avoid confusion do not do it again, but
 335 there is no need to apologise or mail anyone asking for an explanation.
 336
 337 (b) you are a system administrator, reading this because the $gBug
 338 tracking system is responding to a misdirected bounce message.  In this
 339 case there is a serious mail system misconfiguration somewhere - please
 340 contact me immediately.
 341
 342 Your message was dated $header{'date'} and had
 343 message-id $header{'message-id'}
 344 and subject $subject.
 345
 346 If you need any assistance or explanation please contact me.
 347
 348 $gMaintainer
 349 (administrator, $gProject $gBugs database)
 350
 351 END
 352         &appendlog;
 353         &finish;
 354     }
 355
 356     &checkmaintainers;
 357
 358     my @noticecc = grep($_ ne $replyto,@maintaddrs);
 359     $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
 360     $noticeccval =~ s/\s+\n\s+/ /g;
 361     $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
 362
 363     @process= ($ref,split(/ /,$data->{mergedwith}));
 364     $orgref= $ref;
 365
 366     for $ref (@process) {
 367         if ($ref != $orgref) {
 368             &unfilelock;
 369             $data = &lockreadbug($ref)
 370                 || die "huh ? $ref from $orgref out of @process";
 371         }
 372         $data->{done}= $set_done if defined($set_done);
 373         $data->{forwarded}= $set_forwarded if defined($set_forwarded);
 374         if ($codeletter eq 'D') {
 375             $data->{keywords} = join ' ', grep $_ ne 'pending',
 376                                      split ' ', $data->{keywords};
 377             if (defined $pheader{'source-version'}) {
 378                 addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
 379             } elsif (defined $pheader{version}) {
 380                 addfixedversions($data, $pheader{package}, $pheader{version}, 'binary');
 381             }
 382         }
 383
 384         # Add bug mailing list to $generalbcc as appropriate
 385         # This array is used to specify bcc in the cases where we're using create_mime_message.
 386         my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
 387         my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
 388         $generalbcc =~ s/\s+\n\s+/ /g;
 389         $generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
 390         if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
 391
 392         writebug($ref, $data);
 393
 394         my $hash = get_hashname($ref);
 395         open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!");
 396         $x= join('',<O>); close(O);
 397         if ($codeletter eq 'F') {
 398             &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
 399             &sendmessage(create_mime_message(
 400              ["X-Loop"      => "$gMaintainerEmail",
 401               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 402               To            => "$replyto",
 403               Subject       => "$gBug#$ref: marked as forwarded ($data->{subject})",
 404               "Message-ID"  => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
 405               "In-Reply-To" => $header{'message-id'},
 406               References    => "$header{'message-id'} $data->{msgid}",
 407               Precedence    => 'bulk',
 408               "X-$gProject-PR-Message"  => "forwarded $ref",
 409               "X-$gProject-PR-Package"  => $data->{package},
 410               "X-$gProject-PR-Keywords" => $data->{keywords},
 411               # Only have a X-$gProject-PR-Source when we know the source package
 412               length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
 413              ],<<END ,[join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
 414 Your message dated $header{'date'}
 415 with message-id $header{'message-id'}
 416 has caused the $gProject $gBug report #$ref,
 417 regarding $data->{subject}
 418 to be marked as having been forwarded to the upstream software
 419 author(s) $data->{forwarded}.
 420
 421 (NB: If you are a system administrator and have no idea what I am
 422 talking about this indicates a serious mail system misconfiguration
 423 somewhere.  Please contact me immediately.)
 424
 425 $gMaintainer
 426 (administrator, $gProject $gBugs database)
 427
 428 END
 429
 430         } else {
 431             &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
 432             &sendmessage(create_mime_message(
 433              ["X-Loop"      => "$gMaintainerEmail",
 434               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 435               To            => $replyto,
 436               Subject       => "$gBug#$ref: marked as done ($data->{subject})",
 437               "Message-ID"  => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
 438               "In-Reply-To" => $header{'message-id'},
 439               References    => "$header{'message-id'} $data->{msgid}",
 440               Precedence    => 'bulk',
 441               "X-$gProject-PR-Message"  => "closed $ref",
 442               "X-$gProject-PR-Package"  => $data->{package},
 443               "X-$gProject-PR-Keywords" => $data->{keywords},
 444               # Only have a X-$gProject-PR-Source when we know the source package
 445               length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
 446              ],<<END ,[$x,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
 447 Your message dated $header{'date'}
 448 with message-id $header{'message-id'}
 449 and subject line $subject
 450 has caused the attached $gBug report to be marked as done.
 451
 452 This means that you claim that the problem has been dealt with.
 453 If this is not the case it is now your responsibility to reopen the
 454 $gBug report if necessary, and/or fix the problem forthwith.
 455
 456 (NB: If you are a system administrator and have no idea what I am
 457 talking about this indicates a serious mail system misconfiguration
 458 somewhere.  Please contact me immediately.)
 459
 460 $gMaintainer
 461 (administrator, $gProject $gBugs database)
 462
 463 END
 464             &htmllog("Notification","sent",$data->{originator},
 465                 "$gBug acknowledged by developer.");
 466             &sendmessage(create_mime_message(
 467              ["X-Loop"      => "$gMaintainerEmail",
 468               From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 469               To            => "$data->{originator}",
 470               Subject       => "$gBug#$ref closed by $markedby ($header{'subject'})",
 471               "Message-ID"  => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
 472               "In-Reply-To" => "$data->{msgid}",
 473               References    => "$header{'message-id'} $data->{msgid}",
 474               "X-$gProject-PR-Message"  => "they-closed $ref",
 475               "X-$gProject-PR-Package"  => "$data->{package}",
 476               "X-$gProject-PR-Keywords" => "$data->{keywords}",
 477               # Only have a X-$gProject-PR-Source when we know the source package
 478               length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
 479               "Reply-To"                => "$ref\@$gEmailDomain",
 480               "Content-Type"            => 'text/plain; charset="utf-8"',
 481              ],<<END ,[join("\n",@msg)]),'',undef,1);
 482 This is an automatic notification regarding your $gBug report
 483 #$ref: $data->{subject},
 484 which was filed against the $data->{package} package.
 485
 486 It has been closed by $markedby.
 487
 488 Their explanation is attached below.  If this explanation is
 489 unsatisfactory and you have not received a better one in a separate
 490 message then please contact $markedby by replying
 491 to this email.
 492
 493 $gMaintainer
 494 (administrator, $gProject $gBugs database)
 495
 496 END
 497         }
 498         &appendlog;
 499     }
 500     &finish;
 501 }
 502
 503 if ($ref<0) {
 504     if ($codeletter eq 'U') {
 505         &htmllog("Warning","sent",$replyto,"Message not forwarded.");
 506         &sendmessage(<<END, '');
 507 From: $gMaintainerEmail ($gProject $gBug Tracking System)
 508 To: $replyto
 509 Subject: Message with no $gBug number cannot be sent to submitter !
 510          ($subject)
 511 Message-ID: <handler.x.$nn.nonumnosub\@$gEmailDomain>
 512 In-Reply-To: $header{'message-id'}
 513 References: $header{'message-id'} $data->{msgid}
 514 Precedence: bulk
 515 X-$gProject-PR-Message: error
 516
 517 You sent a message to the $gProject $gBug tracking system's $gBug
 518 report submitter address $baddress\@$gEmailDomain, without a
 519 recognisable $gBug number in the Subject.  Your message has been filed
 520 under junk but otherwise ignored.
 521
 522 If you don't know what I'm talking about then probably either:
 523
 524 (a) you unwittingly sent a message to $baddress\@$gEmailDomain
 525 because you replied to all recipients of the message a developer sent
 526 to a $gBug\'s submitter and you modified the Subject.  In this case,
 527 please do not be alarmed.  To avoid confusion do not do it again, but
 528 there is no need to apologise or mail anyone asking for an
 529 explanation.
 530
 531 (b) you are a system administrator, reading this because the $gBug
 532 tracking system is responding to a misdirected bounce message.  In this
 533 case there is a serious mail system misconfiguration somewhere - please
 534 contact me immediately.
 535
 536 Your message was dated $header{'date'} and had
 537 message-id $header{'message-id'}
 538 and subject $subject.
 539
 540 If you need any assistance or explanation please contact me.
 541
 542 $gMaintainer
 543 (administrator, $gProject $gBugs database)
 544
 545 END
 546         &appendlog;
 547         &finish;
 548     }
 549
 550     $data->{found_versions} = [];
 551     $data->{fixed_versions} = [];
 552
 553     if (defined $pheader{source}) {
 554         $data->{package} = $pheader{source};
 555     } elsif (defined $pheader{package}) {
 556         $data->{package} = $pheader{package};
 557     } else {
 558         &htmllog("Warning","sent",$replyto,"Message not forwarded.");
 559         &sendmessage(create_mime_message(
 560                        ["X-Loop"      => "$gMaintainerEmail",
 561                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 562                         To            => $replyto,
 563                         Subject       => "Message with no Package: tag cannot be processed! ($subject)",
 564                         "Message-ID"  => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
 565                         "In-Reply-To" => $header{'message-id'},
 566                         References    => "$header{'message-id'} $data->{msgid}",
 567                         Precedence    => 'bulk',
 568                         "X-$gProject-PR-Message" => 'error'
 569                        ],<<END,[join("\n", @msg)]), '',undef,1);
 570
 571 Your message didn't have a Package: line at the start (in the
 572 pseudo-header following the real mail header), or didn't have a
 573 pseudo-header at all.  Your message has been filed under junk but
 574 otherwise ignored.
 575
 576 This makes it much harder for us to categorise and deal with your
 577 problem report. Please _resubmit_ your report to $baddress\@$gEmailDomain
 578 and tell us which package the report is on. For help, check out
 579 http://$gWebDomain/Reporting$gHTMLSuffix.
 580
 581 Your message was dated $header{'date'} and had
 582 message-id $header{'message-id'}
 583 and subject $subject.
 584 The complete text of it is attached to this message.
 585
 586 If you need any assistance or explanation please contact me.
 587
 588 $gMaintainer
 589 (administrator, $gProject $gBugs database)
 590
 591 END
 592         &appendlog;
 593         &finish;
 594     }
 595
 596     $data->{keywords}= '';
 597     if (defined($pheader{'keywords'})) {
 598         $data->{keywords}= $pheader{'keywords'};
 599     } elsif (defined($pheader{'tags'})) {
 600         $data->{keywords}= $pheader{'tags'};
 601     }
 602     if (length($data->{keywords})) {
 603         my @kws;
 604         my %gkws = map { ($_, 1) } @gTags;
 605         foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
 606             push @kws, $kw if (defined $gkws{$kw});
 607         }
 608         $data->{keywords} = join(" ", @kws);
 609     }
 610     $data->{severity}= '';
 611     if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
 612         $data->{severity}= $pheader{'severity'};
 613         $data->{severity}= $pheader{'priority'} unless ($data->{severity});
 614         $data->{severity} =~ s/^\s*(.+)\s*$/$1/;
 615
 616         if (!grep($_ eq $data->{severity}, @severities, "$gDefaultSeverity")) {
 617             $brokenness.= <<END;
 618
 619 Your message specified a Severity: in the pseudo-header, but
 620 the severity value $data->{severity} was not recognised.
 621 The default severity $gDefaultSeverity is being used instead.
 622 The recognised values are: $gShowSeverities.
 623 END
 624 # if we use @gSeverityList array in the above line, perl -c gives:
 625 # In string, @gSeverityList now must be written as \@gSeverityList at
 626 #          process line 452, near "$gDefaultSeverity is being used instead.
 627             $data->{severity}= '';
 628         }
 629     }
 630     if (defined($pheader{owner})) {
 631         $data->{owner}= $pheader{owner};
 632     }
 633     if (defined($pheader{forwarded})) {
 634         $data->{'forwarded-to'} = $pheader{forwarded};
 635     }
 636     &filelock("nextnumber.lock");
 637     open(N,"nextnumber") || &quit("nextnumber: read: $!");
 638     $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
 639     $ref= $v+0;  $v += 1;  $newref=1;
 640     &overwrite('nextnumber', "$v\n");
 641     &unfilelock;
 642     my $hash = get_hashname($ref);
 643     &overwrite("db-h/$hash/$ref.log",'');
 644     $data->{originator} = $replyto;
 645     $data->{date} = $intdate;
 646     $data->{subject} = $subject;
 647     $data->{msgid} = $header{'message-id'};
 648     writebug($ref, $data);
 649     &overwrite("db-h/$hash/$ref.report",
 650                join("\n",@msg)."\n");
 651 }
 652
 653 &checkmaintainers;
 654
 655 print DEBUG "maintainers >@maintaddrs<\n";
 656
 657 $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
 658 $newsubject= $subject;  $newsubject =~ s/^$gBug#$ref:*\s*//;
 659
 660 $xcchdr= $header{ 'x-debbugs-cc' };
 661 if ($xcchdr =~ m/\S/) {
 662     push(@resentccs,$xcchdr);
 663     $resentccexplain.= <<END;
 664
 665 As you requested using X-Debbugs-CC, your message was also forwarded to
 666    $xcchdr
 667 (after having been given a $gBug report number, if it did not have one).
 668 END
 669 }
 670
 671 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
 672     push(@resentccs,@maintaddrs);
 673     $resentccexplain.= <<END." ".join("\n ",@maintaddrs)."\n";
 674
 675 Your message has been sent to the package maintainer(s):
 676 END
 677 }
 678
 679 @bccs = @addsrcaddrs;
 680 if (defined $gStrongList and isstrongseverity($data->{severity})) {
 681     push @bccs, "$gStrongList\@$gListDomain";
 682 }
 683
 684 # Send mail to the per bug list subscription too
 685 push @bccs, "bugs=$ref\@$gListDomain";
 686
 687 if (defined $pheader{source}) {
 688     # Prefix source versions with the name of the source package. They
 689     # appear that way in version trees so that we can deal with binary
 690     # packages moving from one source package to another.
 691     if (defined $pheader{'source-version'}) {
 692         addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
 693     } elsif (defined $pheader{version}) {
 694         addfoundversions($data, $pheader{source}, $pheader{version}, '');
 695     }
 696     writebug($ref, $data);
 697 } elsif (defined $pheader{package}) {
 698     # TODO: could handle Source-Version: by looking up the source package?
 699     addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
 700     writebug($ref, $data);
 701 }
 702
 703 $veryquiet= $codeletter eq 'Q';
 704 if ($codeletter eq 'M' && !@maintaddrs) {
 705     $veryquiet= 1;
 706     $brokenness.= <<END;
 707
 708 You requested that the message be sent to the package maintainer(s)
 709 but either the $gBug report is not associated with any package (probably
 710 because of a missing Package pseudo-header field in the original $gBug
 711 report), or the package(s) specified do not have any maintainer(s).
 712
 713 Your message has *not* been sent to any package maintainers; it has
 714 merely been filed in the $gBug tracking system.  If you require assistance
 715 please contact $gMaintainerEmail quoting the $gBug number $ref.
 716 END
 717 }
 718
 719 $resentccval.= join(', ',@resentccs);
 720 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
 721 if (length($resentccval)) {
 722     $resentcc= "Resent-CC: $resentccval\n";
 723 }
 724
 725 if ($codeletter eq 'U') {
 726     &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
 727     &sendmessage(<<END,[$data->{originator},@resentccs],[@bccs]);
 728 Subject: $gBug#$ref: $newsubject
 729 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
 730 ${orgsender}Resent-To: $data->{originator}
 731 ${resentcc}Resent-Date: $tdate
 732 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 733 Resent-Sender: $gMaintainerEmail
 734 X-$gProject-PR-Message: report $ref
 735 X-$gProject-PR-Package: $data->{package}
 736 X-$gProject-PR-Keywords: $data->{keywords}
 737 ${source_pr_header}$fwd
 738 END
 739 } elsif ($codeletter eq 'B') { # Sent to submit
 740     &htmllog($newref ? "Report" : "Information", "forwarded",
 741              join(', ',"$gSubmitList\@$gListDomain",@resentccs),
 742              "<code>$gBug#$ref</code>".
 743              (length($data->{package})? "; Package <code>".&sani($data->{package})."</code>" : '').
 744              ".");
 745     &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
 746 Subject: $gBug#$ref: $newsubject
 747 Reply-To: $replyto, $ref\@$gEmailDomain
 748 Resent-From: $header{'from'}
 749 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
 750 ${resentcc}Resent-Date: $tdate
 751 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 752 Resent-Sender: $gMaintainerEmail
 753 X-$gProject-PR-Message: report $ref
 754 X-$gProject-PR-Package: $data->{package}
 755 X-$gProject-PR-Keywords: $data->{keywords}
 756 ${source_pr_header}$fwd
 757 END
 758 } elsif (@resentccs or @bccs) { # Quiet or Maintainer
 759     # D and F done far earlier; B just done - so this must be M or Q
 760     # We preserve whichever it was in the Reply-To (possibly adding
 761     # the $gBug#).
 762     if (@resentccs) {
 763         &htmllog($newref ? "Report" : "Information", "forwarded",
 764                  $resentccval,
 765                  "<code>$gBug#$ref</code>".
 766                  (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
 767                  ".");
 768     } else {
 769         &htmllog($newref ? "Report" : "Information", "stored",
 770                  "",
 771                  "<code>$gBug#$ref</code>".
 772                  (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
 773                  ".");
 774     }
 775     &sendmessage(<<END,[@resentccs],[@bccs]);
 776 Subject: $gBug#$ref: $newsubject
 777 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
 778 Resent-From: $header{'from'}
 779 ${orgsender}Resent-To: $resentccval
 780 Resent-Date: $tdate
 781 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
 782 Resent-Sender: $gMaintainerEmail
 783 X-$gProject-PR-Message: report $ref
 784 X-$gProject-PR-Package: $data->{package}
 785 X-$gProject-PR-Keywords: $data->{keywords}
 786 ${source_pr_header}$fwd
 787 END
 788 }
 789
 790 $htmlbreak= length($brokenness) ? "<p>\n".&sani($brokenness)."\n<p>\n" : '';
 791 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
 792 if (length($resentccval)) {
 793     $htmlbreak = "  Copy sent to <code>".&sani($resentccval)."</code>.".
 794         $htmlbreak;
 795 }
 796 unless (exists $header{'x-debbugs-no-ack'}) {
 797     if ($newref) {
 798         &htmllog("Acknowledgement","sent",$replyto,
 799                  ($veryquiet ?
 800                   "New $gBug report received and filed, but not forwarded." :
 801                   "New $gBug report received and forwarded."). $htmlbreak);
 802         if ($veryquiet) {
 803              &sendmessage(create_mime_message(
 804                        ["X-Loop"      => "$gMaintainerEmail",
 805                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 806                         To            => $replyto,
 807                         Subject       => "$gBug#$ref: Acknowledgement of QUIET report ($subject)",
 808                         "Message-ID"  => "<handler.$ref.$nn.ackquiet\@$gEmailDomain>",
 809                         "In-Reply-To" => $header{'message-id'},
 810                         References    => $header{'message-id'},
 811                         Precedence    => 'bulk',
 812                         "X-$gProject-PR-Message"  => "ack-quiet $ref",
 813                         "X-$gProject-PR-Package"  => $data->{package},
 814                         "X-$gProject-PR-Keywords" => $data->{keywords},
 815                         # Only have a X-$gProject-PR-Source when we know the source package
 816                         length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
 817                         "Reply-To"                => "$ref-quiet\@$gEmailDomain",
 818                        ],<<END,[join("\n", @msg)]), '',undef,1);
 819 Thank you for the problem report you have sent regarding $gProject.
 820 This is an automatically generated reply, to let you know your message
 821 has been received.  It has not been forwarded to the package maintainers
 822 or other interested parties; you should ensure that the developers are
 823 aware of the problem you have entered into the system - preferably
 824 quoting the $gBug reference number, #$ref.
 825 $resentccexplain
 826 If you wish to submit further information on your problem, please send it
 827 to $ref-$baddressroot\@$gEmailDomain (and *not*
 828 to $baddress\@$gEmailDomain).
 829
 830 Please do not reply to the address at the top of this message,
 831 unless you wish to report a problem with the $gBug-tracking system.
 832 $brokenness
 833 $gMaintainer
 834 (administrator, $gProject $gBugs database)
 835 END
 836         }
 837         elsif ($codeletter eq 'M') { # Maintonly
 838              &sendmessage(create_mime_message(
 839                        ["X-Loop"      => "$gMaintainerEmail",
 840                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 841                         To            => $replyto,
 842                         Subject       => "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)",
 843                         "Message-ID"  => "<handler.$ref.$nn.ackmaint\@$gEmailDomain>",
 844                         "In-Reply-To" => $header{'message-id'},
 845                         References    => $header{'message-id'},
 846                         Precedence    => 'bulk',
 847                         "X-$gProject-PR-Message" => "ack-maintonly $ref",
 848                         "X-$gProject-PR-Package"  => $data->{package},
 849                         "X-$gProject-PR-Keywords" => $data->{keywords},
 850                         # Only have a X-$gProject-PR-Source when we know the source package
 851                         length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
 852                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
 853                        ],<<END,[]), '',undef,1);
 854 Thank you for the problem report you have sent regarding $gProject.
 855 This is an automatically generated reply, to let you know your message has
 856 been received.  It is being forwarded to the package maintainers (but not
 857 other interested parties, as you requested) for their attention; they will
 858 reply in due course.
 859 $resentccexplain
 860 If you wish to submit further information on your problem, please send
 861 it to $ref-$baddressroot\@$gEmailDomain (and *not*
 862 to $baddress\@$gEmailDomain).
 863
 864 Please do not reply to the address at the top of this message,
 865 unless you wish to report a problem with the $gBug-tracking system.
 866 $brokenness
 867 $gMaintainer
 868 (administrator, $gProject $gBugs database)
 869 END
 870                    }
 871         else {
 872              &sendmessage(create_mime_message(
 873                        ["X-Loop"      => "$gMaintainerEmail",
 874                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 875                         To            => $replyto,
 876                         Subject       => "$gBug#$ref: Acknowledgement ($subject)",
 877                         "Message-ID"  => "<handler.$ref.$nn.ack\@$gEmailDomain>",
 878                         "In-Reply-To" => $header{'message-id'},
 879                         References    => $header{'message-id'},
 880                         Precedence    => 'bulk',
 881                         "X-$gProject-PR-Message"  => "ack $ref",
 882                         "X-$gProject-PR-Package"  => $data->{package},
 883                         "X-$gProject-PR-Keywords" => $data->{keywords},
 884                         # Only have a X-$gProject-PR-Source when we know the source package
 885                         length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
 886                         "Reply-To"                => "$ref\@$gEmailDomain",
 887                        ],<<END,[]), '',undef,1);
 888 Thank you for the problem report you have sent regarding $gProject.
 889 This is an automatically generated reply, to let you know your message has
 890 been received.  It is being forwarded to the package maintainers and other
 891 interested parties for their attention; they will reply in due course.
 892 $resentccexplain
 893 If you wish to submit further information on your problem, please send
 894 it to $ref\@$gEmailDomain (and *not* to
 895 $baddress\@$gEmailDomain).
 896
 897 Please do not reply to the address at the top of this message,
 898 unless you wish to report a problem with the $gBug-tracking system.
 899 $brokenness
 900 $gMaintainer
 901 (administrator, $gProject $gBugs database)
 902 END
 903                    }
 904     } elsif ($codeletter ne 'U' and
 905              $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/) {
 906         &htmllog("Acknowledgement","sent",$replyto,
 907                  ($veryquiet ? "Extra info received and filed, but not forwarded." :
 908                   $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
 909                   "Extra info received and forwarded to list."). $htmlbreak);
 910         if ($veryquiet) {
 911              &sendmessage(create_mime_message(
 912                        ["X-Loop"      => "$gMaintainerEmail",
 913                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 914                         To            => $replyto,
 915                         Subject       => "$gBug#$ref: Info received and FILED only (was $subject)",
 916                         "Message-ID"  => "<handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>",
 917                         "In-Reply-To" => $header{'message-id'},
 918                         References    => $header{'message-id'},
 919                         Precedence    => 'bulk',
 920                         "X-$gProject-PR-Message" => "ack-info-quiet $ref",
 921                         "X-$gProject-PR-Package"  => $data->{package},
 922                         "X-$gProject-PR-Keywords" => $data->{keywords},
 923                         # Only have a X-$gProject-PR-Source when we know the source package
 924                         length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
 925                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
 926                        ],<<END,[]), '',undef,1);
 927 Thank you for the additional information you have supplied regarding
 928 this problem report.  It has NOT been forwarded to the package
 929 maintainers, but will accompany the original report in the $gBug
 930 tracking system.  Please ensure that you yourself have sent a copy of
 931 the additional information to any relevant developers or mailing lists.
 932 $resentccexplain
 933 If you wish to continue to submit further information on your problem,
 934 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 935
 936 Please do not reply to the address at the top of this message,
 937 unless you wish to report a problem with the $gBug-tracking system.
 938 $brokenness
 939 $gMaintainer
 940 (administrator, $gProject $gBugs database)
 941 END
 942                  }
 943         elsif ($codeletter eq 'M') {
 944              &sendmessage(create_mime_message(
 945                        ["X-Loop"      => "$gMaintainerEmail",
 946                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 947                         To            => $replyto,
 948                         Subject       => "$gBug#$ref: Info received for maintainer only (was $subject)",
 949                         "Message-ID"  => "<handler.$ref.$nn.ackinfomaint\@$gEmailDomain>",
 950                         "In-Reply-To" => $header{'message-id'},
 951                         References    => "$header{'message-id'} $data->{msgid}",
 952                         Precedence    => 'bulk',
 953                         "X-$gProject-PR-Message" => "ack-info-maintonly $ref",
 954                         "X-$gProject-PR-Package"  => $data->{package},
 955                         "X-$gProject-PR-Keywords" => $data->{keywords},
 956                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
 957                        ],<<END,[]), '',undef,1);
 958 Thank you for the additional information you have supplied regarding
 959 this problem report.  It has been forwarded to the package maintainer(s)
 960 (but not to other interested parties) to accompany the original report.
 961 $resentccexplain
 962 If you wish to continue to submit further information on your problem,
 963 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 964
 965 Please do not reply to the address at the top of this message,
 966 unless you wish to report a problem with the $gBug-tracking system.
 967 $brokenness
 968 $gMaintainer
 969 (administrator, $gProject $gBugs database)
 970 END
 971                    }
 972         else {
 973              &sendmessage(create_mime_message(
 974                        ["X-Loop"      => "$gMaintainerEmail",
 975                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 976                         To            => $replyto,
 977                         Subject       => "$gBug#$ref: Info received ($subject)",
 978                         "Message-ID"  => "<handler.$ref.$nn.ackinfo\@$gEmailDomain>",
 979                         "In-Reply-To" => $header{'message-id'},
 980                         References    => "$header{'message-id'} $data->{msgid}",
 981                         Precedence    => 'bulk',
 982                         "X-$gProject-PR-Message"  => "ack-info $ref",
 983                         "X-$gProject-PR-Package"  => $data->{package},
 984                         "X-$gProject-PR-Keywords" => $data->{keywords},
 985                         # Only have a X-$gProject-PR-Source when we know the source package
 986                         length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
 987                         "Reply-To"                => "$ref\@$gEmailDomain",
 988                        ],<<END,[]), '',undef,1);
 989 Thank you for the additional information you have supplied regarding
 990 this problem report.  It has been forwarded to the package maintainer(s)
 991 and to other interested parties to accompany the original report.
 992 $resentccexplain
 993 If you wish to continue to submit further information on your problem,
 994 please send it to $ref\@$gEmailDomain, as before.
 995
 996 Please do not reply to the address at the top of this message,
 997 unless you wish to report a problem with the $gBug-tracking system.
 998 $brokenness
 999 $gMaintainer
1000 (administrator, $gProject $gBugs database)
1001 END
1002
1003                    }
1004    }
1005 }
1006
1007 &appendlog;
1008 &finish;
1009
1010 sub overwrite {
1011     local ($f,$v) = @_;
1012     open(NEW,">$f.new") || &quit("$f.new: create: $!");
1013     print(NEW "$v") || &quit("$f.new: write: $!");
1014     close(NEW) || &quit("$f.new: close: $!");
1015     rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
1016 }
1017
1018 sub appendlog {
1019     my $hash = get_hashname($ref);
1020     if (!open(AP,">>db-h/$hash/$ref.log")) {
1021         print DEBUG "failed open log<\n";
1022         print DEBUG "failed open log err $!<\n";
1023         &quit("opening db-h/$hash/$ref.log (li): $!");
1024     }
1025     print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
1026     close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
1027 }
1028
1029 sub finish {
1030     utime(time,time,"db");
1031     local ($u);
1032     while ($u= $cleanups[$#cleanups]) { &$u; }
1033     unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1034     exit $_[0];
1035 }
1036
1037 &quit("wot no exit");
1038
1039 sub htmllog {
1040     local ($whatobj,$whatverb,$where,$desc) = @_;
1041     my $hash = get_hashname($ref);
1042     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
1043     print(AP
1044           "\6\n".
1045           "<strong>$whatobj $whatverb</strong>".
1046           ($where eq '' ? "" : " to <code>".&sani($where)."</code>").
1047           ":<br>\n". $desc.
1048           "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
1049     close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
1050 }
1051
1052 sub stripbccs {
1053     my $msg = shift;
1054     my $ret = '';
1055     my $bcc = 0;
1056     while ($msg =~ s/(.*\n)//) {
1057         local $_ = $1;
1058         if (/^$/) {
1059             $ret .= $_;
1060             last;
1061         }
1062         if ($bcc) {
1063             # strip continuation lines too
1064             next if /^\s/;
1065             $bcc = 0;
1066         }
1067         if (/^Bcc:/i) {
1068             $bcc = 1;
1069         } else {
1070             $ret .= $_;
1071         }
1072     }
1073     return $ret . $msg;
1074 }
1075
1076 =head2 send_message
1077
1078      send_message($the_message,\@recipients,\@bcc,$do_not_encode)
1079
1080 The first argument is the scalar message, the second argument is the
1081 arrayref of recipients, the third is the arrayref of Bcc:'ed
1082 recipients.
1083
1084 The final argument turns off header encoding and the addition of the
1085 X-Loop header if true, defaults to false.
1086
1087 =cut
1088
1089
1090 sub sendmessage {
1091     my ($msg,$recips,$bcc,$no_encode) = @_;
1092     if (not defined $recips or (!ref($recips) && $recips eq '')
1093         or @$recips == 0) {
1094         $recips = ['-t'];
1095     }
1096     # This is suboptimal. The right solution is to send headers
1097     # separately from the rest of the message and encode them rather
1098     # than doing this.
1099     $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
1100     # The original message received is written out in appendlog, so
1101     # before writing out the other messages we've sent out, we need to
1102     # RFC1522 encode the header.
1103     $msg = encode_headers($msg) unless $no_encode;
1104
1105     my $hash = get_hashname($ref);
1106     #save email to the log
1107     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
1108     print(AP "\2\n",join("\4",@$recips),"\n\5\n",
1109           @{escapelog(stripbccs($msg))},"\n\3\n") ||
1110         &quit("writing db-h/$hash/$ref.log (lo): $!");
1111     close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
1112
1113     if (ref($bcc)) {
1114         shift @$recips if $recips->[0] eq '-t';
1115         push @$recips, @$bcc;
1116     }
1117
1118     send_mail_message(message        => $msg,
1119                       # Because we encode the headers above, we do not want to encode them here
1120                       encode_headers => 0,
1121                       recipients     => $recips);
1122 }
1123
1124 my $maintainerschecked = 0;
1125 sub checkmaintainers {
1126     return if $maintainerschecked++;
1127     return if !length($data->{package});
1128     open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1129     while (<MAINT>) {
1130         m/^\n$/ && next;
1131         m/^\s*$/ && next;
1132         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1133         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1134         # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1135         $maintainerof{$a}= $2;
1136     }
1137     close(MAINT);
1138     open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1139     while (<MAINT>) {
1140         m/^\n$/ && next;
1141         m/^\s*$/ && next;
1142         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1143         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1144         # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1145         $maintainerof{$a}= $2;
1146     }
1147     close(MAINT);
1148     open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
1149     while (<SOURCES>) {
1150         next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1151         ($a,$b)=($1,$2);
1152         $a =~ y/A-Z/a-z/;
1153         $pkgsrc{$a} = $b;
1154     }
1155     close(SOURCES);
1156     $anymaintfound=0; $anymaintnotfound=0;
1157     for $p (split(m/[ \t?,():]+/,$data->{package})) {
1158         $p =~ y/A-Z/a-z/;
1159         $p =~ /([a-z0-9.+-]+)/;
1160         $p = $1;
1161         next unless defined $p;
1162         if (defined $gSubscriptionDomain) {
1163             if (defined($pkgsrc{$p})) {
1164                 push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
1165             } else {
1166                 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1167             }
1168         }
1169         if (defined($maintainerof{$p})) {
1170             print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
1171             $addmaint= $maintainerof{$p};
1172             push(@maintaddrs,$addmaint) unless
1173                 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
1174             $anymaintfound++;
1175         } else {
1176             print DEBUG "maintainer none >$p<\n";
1177             push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1178             $anymaintnotfound++;
1179             last;
1180         }
1181     }
1182
1183     if (length $data->{owner}) {
1184         print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
1185         $addmaint = $data->{owner};
1186         push(@maintaddrs, $addmaint) unless
1187             $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1188     }
1189 }
1190
1191 =head2 bug_list_forward
1192
1193      bug_list_forward($spool_filename) if $codeletter eq 'L';
1194
1195
1196 Given the spool file, will forward a bug to the per bug mailing list
1197 subscription system.
1198
1199 =cut
1200
1201 sub bug_list_forward{
1202      my ($bug_fn) = @_;
1203      # Read the bug information and package information for passing to
1204      # the mailing list
1205      my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
1206      my ($bfound, $data)= lockreadbugmerge($bug_number);
1207      my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!";
1208
1209      local $/ = undef;
1210      my $bug_message = <$bug_fh>;
1211      my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
1212      my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
1213      if (not defined $envelope_from) {
1214           # Try to use the From: header or something to set it
1215           ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
1216           # Kludgy, and should really be using a full scale header
1217           # parser to do this.
1218           $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
1219      }
1220      my ($header,$body) = split /\n\n/, $bug_message, 2;
1221      # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
1222      $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
1223           qq(X-$gProject-PR-Package: $data->{package}\n).
1224                qq(X-$gProject-PR-Title: $data->{subject})
1225                if defined $data;
1226      print STDERR "Tried to loop me with $envelope_from\n"
1227           and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
1228      print DEBUG $envelope_from,qq(\n);
1229      # If we don't have a bug address, something has gone horribly wrong.
1230      print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
1231      $bug_address =~ s/\@.+//;
1232      print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
1233      print DEBUG $header.qq(\n\n).$body;
1234      send_mail_message(message        => $header.qq(\n\n).$body,
1235                        recipients     => ["bugs=$bug_address\@$gListDomain"],
1236                        envelope_from  => $envelope_from,
1237                        encode_headers => 0,
1238                       );
1239      unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");
1240      exit 0;
1241 }