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