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