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