scripts/process.in

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