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/ and
 906              # Workaround for gcc mail loops; bugzilla should do Precedence:
 907              # instead. Deliberately not in CVS. - cjwatson
 908              not exists $header{'x-bugzilla-reason'}) {
 909         &htmllog("Acknowledgement","sent",$replyto,
 910                  ($veryquiet ? "Extra info received and filed, but not forwarded." :
 911                   $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
 912                   "Extra info received and forwarded to list."). $htmlbreak);
 913         if ($veryquiet) {
 914              &sendmessage(create_mime_message(
 915                        ["X-Loop"      => "$gMaintainerEmail",
 916                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 917                         To            => $replyto,
 918                         Subject       => "$gBug#$ref: Info received and FILED only (was $subject)",
 919                         "Message-ID"  => "<handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>",
 920                         "In-Reply-To" => $header{'message-id'},
 921                         References    => $header{'message-id'},
 922                         Precedence    => 'bulk',
 923                         "X-$gProject-PR-Message" => "ack-info-quiet $ref",
 924                         "X-$gProject-PR-Package"  => $data->{package},
 925                         "X-$gProject-PR-Keywords" => $data->{keywords},
 926                         # Only have a X-$gProject-PR-Source when we know the source package
 927                         length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
 928                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
 929                        ],<<END,[]), '',undef,1);
 930 Thank you for the additional information you have supplied regarding
 931 this problem report.  It has NOT been forwarded to the package
 932 maintainers, but will accompany the original report in the $gBug
 933 tracking system.  Please ensure that you yourself have sent a copy of
 934 the additional information to any relevant developers or mailing lists.
 935 $resentccexplain
 936 If you wish to continue to submit further information on your problem,
 937 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 938
 939 Please do not reply to the address at the top of this message,
 940 unless you wish to report a problem with the $gBug-tracking system.
 941 $brokenness
 942 $gMaintainer
 943 (administrator, $gProject $gBugs database)
 944 END
 945                  }
 946         elsif ($codeletter eq 'M') {
 947              &sendmessage(create_mime_message(
 948                        ["X-Loop"      => "$gMaintainerEmail",
 949                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 950                         To            => $replyto,
 951                         Subject       => "$gBug#$ref: Info received for maintainer only (was $subject)",
 952                         "Message-ID"  => "<handler.$ref.$nn.ackinfomaint\@$gEmailDomain>",
 953                         "In-Reply-To" => $header{'message-id'},
 954                         References    => "$header{'message-id'} $data->{msgid}",
 955                         Precedence    => 'bulk',
 956                         "X-$gProject-PR-Message" => "ack-info-maintonly $ref",
 957                         "X-$gProject-PR-Package"  => $data->{package},
 958                         "X-$gProject-PR-Keywords" => $data->{keywords},
 959                         "Reply-To"               => "$ref-maintonly\@$gEmailDomain",
 960                        ],<<END,[]), '',undef,1);
 961 Thank you for the additional information you have supplied regarding
 962 this problem report.  It has been forwarded to the package maintainer(s)
 963 (but not to other interested parties) to accompany the original report.
 964 $resentccexplain
 965 If you wish to continue to submit further information on your problem,
 966 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
 967
 968 Please do not reply to the address at the top of this message,
 969 unless you wish to report a problem with the $gBug-tracking system.
 970 $brokenness
 971 $gMaintainer
 972 (administrator, $gProject $gBugs database)
 973 END
 974                    }
 975         else {
 976              &sendmessage(create_mime_message(
 977                        ["X-Loop"      => "$gMaintainerEmail",
 978                         From          => "$gMaintainerEmail ($gProject $gBug Tracking System)",
 979                         To            => $replyto,
 980                         Subject       => "$gBug#$ref: Info received ($subject)",
 981                         "Message-ID"  => "<handler.$ref.$nn.ackinfo\@$gEmailDomain>",
 982                         "In-Reply-To" => $header{'message-id'},
 983                         References    => "$header{'message-id'} $data->{msgid}",
 984                         Precedence    => 'bulk',
 985                         "X-$gProject-PR-Message"  => "ack-info $ref",
 986                         "X-$gProject-PR-Package"  => $data->{package},
 987                         "X-$gProject-PR-Keywords" => $data->{keywords},
 988                         # Only have a X-$gProject-PR-Source when we know the source package
 989                         length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
 990                         "Reply-To"                => "$ref\@$gEmailDomain",
 991                        ],<<END,[]), '',undef,1);
 992 Thank you for the additional information you have supplied regarding
 993 this problem report.  It has been forwarded to the package maintainer(s)
 994 and to other interested parties to accompany the original report.
 995 $resentccexplain
 996 If you wish to continue to submit further information on your problem,
 997 please send it to $ref\@$gEmailDomain, as before.
 998
 999 Please do not reply to the address at the top of this message,
1000 unless you wish to report a problem with the $gBug-tracking system.
1001 $brokenness
1002 $gMaintainer
1003 (administrator, $gProject $gBugs database)
1004 END
1005
1006                    }
1007    }
1008 }
1009
1010 &appendlog;
1011 &finish;
1012
1013 sub overwrite {
1014     local ($f,$v) = @_;
1015     open(NEW,">$f.new") || &quit("$f.new: create: $!");
1016     print(NEW "$v") || &quit("$f.new: write: $!");
1017     close(NEW) || &quit("$f.new: close: $!");
1018     rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
1019 }
1020
1021 sub appendlog {
1022     my $hash = get_hashname($ref);
1023     if (!open(AP,">>db-h/$hash/$ref.log")) {
1024         print DEBUG "failed open log<\n";
1025         print DEBUG "failed open log err $!<\n";
1026         &quit("opening db-h/$hash/$ref.log (li): $!");
1027     }
1028     print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
1029     close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
1030 }
1031
1032 sub finish {
1033     utime(time,time,"db");
1034     local ($u);
1035     while ($u= $cleanups[$#cleanups]) { &$u; }
1036     unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1037     exit $_[0];
1038 }
1039
1040 &quit("wot no exit");
1041
1042 sub htmllog {
1043     local ($whatobj,$whatverb,$where,$desc) = @_;
1044     my $hash = get_hashname($ref);
1045     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
1046     print(AP
1047           "\6\n".
1048           "<strong>$whatobj $whatverb</strong>".
1049           ($where eq '' ? "" : " to <code>".&sani($where)."</code>").
1050           ":<br>\n". $desc.
1051           "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
1052     close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
1053 }
1054
1055 sub stripbccs {
1056     my $msg = shift;
1057     my $ret = '';
1058     my $bcc = 0;
1059     while ($msg =~ s/(.*\n)//) {
1060         local $_ = $1;
1061         if (/^$/) {
1062             $ret .= $_;
1063             last;
1064         }
1065         if ($bcc) {
1066             # strip continuation lines too
1067             next if /^\s/;
1068             $bcc = 0;
1069         }
1070         if (/^Bcc:/i) {
1071             $bcc = 1;
1072         } else {
1073             $ret .= $_;
1074         }
1075     }
1076     return $ret . $msg;
1077 }
1078
1079 =head2 send_message
1080
1081      send_message($the_message,\@recipients,\@bcc,$do_not_encode)
1082
1083 The first argument is the scalar message, the second argument is the
1084 arrayref of recipients, the third is the arrayref of Bcc:'ed
1085 recipients.
1086
1087 The final argument turns off header encoding and the addition of the
1088 X-Loop header if true, defaults to false.
1089
1090 =cut
1091
1092
1093 sub sendmessage {
1094     my ($msg,$recips,$bcc,$no_encode) = @_;
1095     if (not defined $recips or (!ref($recips) && $recips eq '')
1096         or @$recips == 0) {
1097         $recips = ['-t'];
1098     }
1099     # This is suboptimal. The right solution is to send headers
1100     # separately from the rest of the message and encode them rather
1101     # than doing this.
1102     $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
1103     # The original message received is written out in appendlog, so
1104     # before writing out the other messages we've sent out, we need to
1105     # RFC1522 encode the header.
1106     $msg = encode_headers($msg) unless $no_encode;
1107
1108     my $hash = get_hashname($ref);
1109     #save email to the log
1110     open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
1111     print(AP "\2\n",join("\4",@$recips),"\n\5\n",
1112           @{escapelog(stripbccs($msg))},"\n\3\n") ||
1113         &quit("writing db-h/$hash/$ref.log (lo): $!");
1114     close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
1115
1116     if (ref($bcc)) {
1117         shift @$recips if $recips->[0] eq '-t';
1118         push @$recips, @$bcc;
1119     }
1120
1121     send_mail_message(message        => $msg,
1122                       # Because we encode the headers above, we do not want to encode them here
1123                       encode_headers => 0,
1124                       recipients     => $recips);
1125 }
1126
1127 my $maintainerschecked = 0;
1128 sub checkmaintainers {
1129     return if $maintainerschecked++;
1130     return if !length($data->{package});
1131     open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1132     while (<MAINT>) {
1133         m/^\n$/ && next;
1134         m/^\s*$/ && next;
1135         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1136         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1137         # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1138         $maintainerof{$a}= $2;
1139     }
1140     close(MAINT);
1141     open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1142     while (<MAINT>) {
1143         m/^\n$/ && next;
1144         m/^\s*$/ && next;
1145         m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1146         $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1147         # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1148         $maintainerof{$a}= $2;
1149     }
1150     close(MAINT);
1151     open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
1152     while (<SOURCES>) {
1153         next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1154         ($a,$b)=($1,$2);
1155         $a =~ y/A-Z/a-z/;
1156         $pkgsrc{$a} = $b;
1157     }
1158     close(SOURCES);
1159     $anymaintfound=0; $anymaintnotfound=0;
1160     for $p (split(m/[ \t?,():]+/,$data->{package})) {
1161         $p =~ y/A-Z/a-z/;
1162         $p =~ /([a-z0-9.+-]+)/;
1163         $p = $1;
1164         next unless defined $p;
1165         if (defined $gSubscriptionDomain) {
1166             if (defined($pkgsrc{$p})) {
1167                 push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
1168             } else {
1169                 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1170             }
1171         }
1172         if (defined($maintainerof{$p})) {
1173             print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
1174             $addmaint= $maintainerof{$p};
1175             push(@maintaddrs,$addmaint) unless
1176                 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
1177             $anymaintfound++;
1178         } else {
1179             print DEBUG "maintainer none >$p<\n";
1180             push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1181             $anymaintnotfound++;
1182             last;
1183         }
1184     }
1185
1186     if (length $data->{owner}) {
1187         print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
1188         $addmaint = $data->{owner};
1189         push(@maintaddrs, $addmaint) unless
1190             $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1191     }
1192 }
1193
1194 =head2 bug_list_forward
1195
1196      bug_list_forward($spool_filename) if $codeletter eq 'L';
1197
1198
1199 Given the spool file, will forward a bug to the per bug mailing list
1200 subscription system.
1201
1202 =cut
1203
1204 sub bug_list_forward{
1205      my ($bug_fn) = @_;
1206      # Read the bug information and package information for passing to
1207      # the mailing list
1208      my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
1209      my ($bfound, $data)= lockreadbugmerge($bug_number);
1210      my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!";
1211
1212      local $/ = undef;
1213      my $bug_message = <$bug_fh>;
1214      my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
1215      my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
1216      if (not defined $envelope_from) {
1217           # Try to use the From: header or something to set it
1218           ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
1219           # Kludgy, and should really be using a full scale header
1220           # parser to do this.
1221           $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
1222      }
1223      my ($header,$body) = split /\n\n/, $bug_message, 2;
1224      # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
1225      $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
1226           qq(X-$gProject-PR-Package: $data->{package}\n).
1227                qq(X-$gProject-PR-Title: $data->{subject})
1228                if defined $data;
1229      print STDERR "Tried to loop me with $envelope_from\n"
1230           and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
1231      print DEBUG $envelope_from,qq(\n);
1232      # If we don't have a bug address, something has gone horribly wrong.
1233      print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
1234      $bug_address =~ s/\@.+//;
1235      print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
1236      print DEBUG $header.qq(\n\n).$body;
1237      send_mail_message(message        => $header.qq(\n\n).$body,
1238                        recipients     => ["bugs=$bug_address\@$gListDomain"],
1239                        envelope_from  => $envelope_from,
1240                        encode_headers => 0,
1241                       );
1242      unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");
1243      exit 0;
1244 }