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