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