scripts/process.in

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