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