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