2 # $Id: process.in,v 1.109 2006/02/09 22:02:04 don Exp $
7 use POSIX qw(strftime tzset);
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);
16 my $config_path = '/etc/debbugs';
17 my $lib_path = '/usr/lib/debbugs';
19 # TODO DLA; needs config reworking and errorlib reworking
23 require "$config_path/config";
24 require "$lib_path/errorlib";
25 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
27 chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
29 #open(DEBUG,"> /tmp/debbugs.debug");
31 open DEBUG, ">/dev/null";
33 my $intdate = time or quit("failed to get time: $!");
36 m/^([BMQFDUL])(\d*)\.\d+$/ or quit("bad argument: $_");
38 my $tryref= length($2) ? $2 : -1;
41 if (!rename("incoming/G$nn","incoming/P$nn"))
43 $_=$!.''; m/no such file or directory/i && exit 0;
44 &quit("renaming to lock: $!");
47 my $baddress= 'submit' if $codeletter eq 'B';
48 $baddress= 'maintonly' if $codeletter eq 'M';
49 $baddress= 'quiet' if $codeletter eq 'Q';
50 $baddress= 'forwarded' if $codeletter eq 'F';
51 $baddress= 'done' if $codeletter eq 'D';
52 $baddress= 'submitter' if $codeletter eq 'U';
53 bug_list_forward($nn) if $codeletter eq 'L';
54 $baddress || &quit("bad codeletter $codeletter");
55 my $baddressroot= $baddress;
56 $baddress= "$tryref-$baddress" if $tryref>=0;
58 open(M,"incoming/P$nn");
65 print DEBUG "###\n",join("##\n",@msg),"\n###\n";
67 my $tdate = strftime "%a, %d %h %Y %T +0000", gmtime;
69 Received: via spool by $baddress\@$gEmailDomain id=$nn
70 (code $codeletter ref $tryref); $tdate
73 # header and decoded body respectively
74 my (@headerlines, @bodylines);
76 my $parser = new MIME::Parser;
77 mkdir "$gSpoolDir/mime.tmp", 0777;
78 $parser->output_under("$gSpoolDir/mime.tmp");
79 my $entity = eval { $parser->parse_data(join('',@log)) };
82 if ($entity and $entity->head->tags) {
83 @headerlines = @{$entity->head->header};
86 my $entity_body = getmailbody($entity);
87 @bodylines = $entity_body ? $entity_body->as_lines() : ();
90 # set $i to beginning of encoded body data, so we can dump it out
93 ++$i while $msg[$i] =~ /./;
95 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
96 for ($i = 0; $i <= $#msg; $i++) {
98 last unless length($_);
99 while ($msg[$i+1] =~ m/^\s/) {
103 push @headerlines, $_;
106 @bodylines = @msg[$i..$#msg];
111 for my $hdr (@headerlines) {
112 $hdr = decode_rfc1522($hdr);
115 &finish if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
116 my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
117 && !m/^From / && !m/^X-Debbugs-/i;
118 $fwd .= $hdr."\n" if $ins;
119 # print DEBUG ">$_<\n";
120 if (s/^(\S+):\s*//) {
122 print DEBUG ">$v=$_<\n";
125 print DEBUG "!>$_<\n";
130 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
132 # Strip off RFC2440-style PGP clearsigning.
133 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
134 shift @bodylines while @bodylines and length $bodylines[0];
135 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
136 for my $findsig (0 .. $#bodylines) {
137 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
138 $#bodylines = $findsig - 1;
142 map { s/^- // } @bodylines;
145 # extract pseudo-headers
146 for my $phline (@bodylines)
148 last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
149 my ($fn, $fv) = ($1, $2);
151 print DEBUG ">$fn|$fv|\n";
153 # Don't lc owner or forwarded
154 $fv = lc $fv unless $fh =~ /^(?:owner|forwarded)$/;
156 print DEBUG ">$fn~$fv<\n";
159 # Allow pseudo headers to set x-debbugs- stuff [#179340]
160 for my $key (grep /X-Debbugs-.*/i, keys %pheader) {
161 $header{$key} = $pheader{$key} if not exists $header{$key};
164 $fwd .= join("\n",@msg[$i..$#msg]);
166 print DEBUG "***\n$fwd\n***\n";
168 if (defined $header{'resent-from'} && !defined $header{'from'}) {
169 $header{'from'} = $header{'resent-from'};
171 defined($header{'from'}) || &quit("no From header");
173 my $replyto = $header{'reply-to'};
174 $replyto = '' unless defined $replyto;
177 unless (length $replyto) {
178 $replyto = $header{'from'};
181 my $subject = '(no subject)';
182 if (!defined($header{'subject'}))
186 Your message did not contain a Subject field. They are recommended and
187 useful because the title of a $gBug is determined using this field.
188 Please remember to include a Subject field in your messages in future.
192 $subject= $header{'subject'};
196 $subject =~ s/^Re:\s*//i; $_= $subject."\n";
197 if ($tryref < 0 && m/^Bug ?\#(\d+)\D/i) {
203 ($bfound, $data)= &lockreadbugmerge($tryref);
207 &htmllog("Reply","sent", $replyto,"Unknown problem report number <code>$tryref</code>.");
208 my $archivenote = '';
210 $archivenote = <<END;
211 This may be because that $gBug report has been resolved for more than $gRemoveAge
212 days, and the record of it has been archived and made read-only, or
213 because you mistyped the $gBug report number.
217 &sendmessage(<<END, '');
218 From: $gMaintainerEmail ($gProject $gBug Tracking System)
220 Subject: Unknown problem report $gBug#$tryref ($subject)
221 Message-ID: <handler.x.$nn.unknown\@$gEmailDomain>
222 In-Reply-To: $header{'message-id'}
223 References: $header{'message-id'} $data->{msgid}
225 X-$gProject-PR-Message: error
227 You sent a message to the $gBug tracking system which gave (in the
228 Subject line or encoded into the recipient at $gEmailDomain),
229 the number of a nonexistent $gBug report (#$tryref).
231 ${archivenote}Your message was dated $header{'date'} and was sent to
232 $baddress\@$gEmailDomain. It had
233 Message-ID $header{'message-id'}
234 and Subject $subject.
236 It has been filed (under junk) but otherwise ignored.
238 Please consult your records to find the correct $gBug report number, or
239 contact me, the system administrator, for assistance.
242 (administrator, $gProject $gBugs database)
244 (NB: If you are a system administrator and have no idea what I am
245 talking about this indicates a serious mail system misconfiguration
246 somewhere. Please contact me immediately.)
253 &filelock('lock/-1');
256 # Attempt to determine which source package this is
257 my $source_pr_header = '';
258 my $source_package = '';
259 if (defined $pheader{source}) {
260 $source_package = $pheader{source};
262 elsif (defined $data->{package} or defined $pheader{package}) {
263 my $pkg_src = getpkgsrc();
264 $source_package = $pkg_src->{defined $data->{package}?$data->{package}:$pheader{package}};
266 $source_pr_header = "X-$gProject-PR-Source: $source_package\n"
267 if defined $source_package and length $source_package;
269 # Done and Forwarded Bugs
270 if ($codeletter eq 'D' || $codeletter eq 'F')
272 if ($replyto =~ m/$gBounceFroms/o ||
273 $header{'from'} =~ m/$gBounceFroms/o)
275 &quit("bounce detected ! Mwaap! Mwaap!");
277 $markedby= $header{'from'} eq $replyto ? $replyto :
278 "$header{'from'} (reply to $replyto)";
280 if ($codeletter eq 'F') { # Forwarded
281 (&appendlog,&finish) if length($data->{forwarded});
282 $receivedat= "forwarded\@$gEmailDomain";
283 $markaswhat= 'forwarded';
284 $set_forwarded= $header{'to'};
285 if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
286 push @generalcc, "$gForwardList\@$gListDomain";
287 $generalcc= "$gForwardList\@$gListDomain";
292 if (length($data->{done}) and
293 not defined $pheader{'source-version'} and
294 not defined $pheader{'version'}) {
298 $receivedat= "done\@$gEmailDomain";
300 $set_done= $header{'from'};
301 if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
302 $generalcc= "$gDoneList\@$gListDomain";
303 push @generalcc, "$gDoneList\@$gListDomain";
308 if (defined $gStrongList and isstrongseverity($data->{severity})) {
309 $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
310 push @generalcc,"$gStrongList\@$gListDomain";
313 &htmllog("Warning","sent",$replyto,"Message ignored.");
314 &sendmessage(<<END, '');
315 From: $gMaintainerEmail ($gProject $gBug Tracking System)
317 Subject: Message with no $gBug number ignored by $receivedat
319 Message-ID: <header.x.$nn.warnignore\@$gEmailDomain>
320 In-Reply-To: $header{'message-id'}
321 References: $header{'message-id'} $data->{msgid}
323 X-$gProject-PR-Message: error
325 You sent a message to the $gProject $gBug tracking system old-style
326 unified mark as $markaswhat address ($receivedat),
327 without a recognisable $gBug number in the Subject.
328 Your message has been filed under junk but otherwise ignored.
330 If you don't know what I'm talking about then probably either:
332 (a) you unwittingly sent a message to done\@$gEmailDomain
333 because you replied to all recipients of the message a developer used
334 to mark a $gBug as done and you modified the Subject. In this case,
335 please do not be alarmed. To avoid confusion do not do it again, but
336 there is no need to apologise or mail anyone asking for an explanation.
338 (b) you are a system administrator, reading this because the $gBug
339 tracking system is responding to a misdirected bounce message. In this
340 case there is a serious mail system misconfiguration somewhere - please
341 contact me immediately.
343 Your message was dated $header{'date'} and had
344 message-id $header{'message-id'}
345 and subject $subject.
347 If you need any assistance or explanation please contact me.
350 (administrator, $gProject $gBugs database)
359 my @noticecc = grep($_ ne $replyto,@maintaddrs);
360 $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
361 $noticeccval =~ s/\s+\n\s+/ /g;
362 $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
364 @process= ($ref,split(/ /,$data->{mergedwith}));
367 for $ref (@process) {
368 if ($ref != $orgref) {
370 $data = &lockreadbug($ref)
371 || die "huh ? $ref from $orgref out of @process";
373 $data->{done}= $set_done if defined($set_done);
374 $data->{forwarded}= $set_forwarded if defined($set_forwarded);
375 if ($codeletter eq 'D') {
376 $data->{keywords} = join ' ', grep $_ ne 'pending',
377 split ' ', $data->{keywords};
378 if (defined $pheader{'source-version'}) {
379 addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
380 } elsif (defined $pheader{version}) {
381 addfixedversions($data, $pheader{package}, $pheader{version}, 'binary');
385 # Add bug mailing list to $generalbcc as appropriate
386 # This array is used to specify bcc in the cases where we're using create_mime_message.
387 my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
388 my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
389 $generalbcc =~ s/\s+\n\s+/ /g;
390 $generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
391 if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
393 writebug($ref, $data);
395 my $hash = get_hashname($ref);
396 open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!");
397 $x= join('',<O>); close(O);
398 if ($codeletter eq 'F') {
399 &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
400 &sendmessage(create_mime_message(
401 ["X-Loop" => "$gMaintainerEmail",
402 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
404 Subject => "$gBug#$ref: marked as forwarded ($data->{subject})",
405 "Message-ID" => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
406 "In-Reply-To" => $header{'message-id'},
407 References => "$header{'message-id'} $data->{msgid}",
408 Precedence => 'bulk',
409 "X-$gProject-PR-Message" => "forwarded $ref",
410 "X-$gProject-PR-Package" => $data->{package},
411 "X-$gProject-PR-Keywords" => $data->{keywords},
412 # Only have a X-$gProject-PR-Source when we know the source package
413 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
414 ],<<END ,[join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
415 Your message dated $header{'date'}
416 with message-id $header{'message-id'}
417 has caused the $gProject $gBug report #$ref,
418 regarding $data->{subject}
419 to be marked as having been forwarded to the upstream software
420 author(s) $data->{forwarded}.
422 (NB: If you are a system administrator and have no idea what I am
423 talking about this indicates a serious mail system misconfiguration
424 somewhere. Please contact me immediately.)
427 (administrator, $gProject $gBugs database)
432 &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
433 &sendmessage(create_mime_message(
434 ["X-Loop" => "$gMaintainerEmail",
435 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
437 Subject => "$gBug#$ref: marked as done ($data->{subject})",
438 "Message-ID" => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
439 "In-Reply-To" => $header{'message-id'},
440 References => "$header{'message-id'} $data->{msgid}",
441 Precedence => 'bulk',
442 "X-$gProject-PR-Message" => "closed $ref",
443 "X-$gProject-PR-Package" => $data->{package},
444 "X-$gProject-PR-Keywords" => $data->{keywords},
445 # Only have a X-$gProject-PR-Source when we know the source package
446 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
447 ],<<END ,[$x,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
448 Your message dated $header{'date'}
449 with message-id $header{'message-id'}
450 and subject line $subject
451 has caused the attached $gBug report to be marked as done.
453 This means that you claim that the problem has been dealt with.
454 If this is not the case it is now your responsibility to reopen the
455 $gBug report if necessary, and/or fix the problem forthwith.
457 (NB: If you are a system administrator and have no idea what I am
458 talking about this indicates a serious mail system misconfiguration
459 somewhere. Please contact me immediately.)
462 (administrator, $gProject $gBugs database)
465 &htmllog("Notification","sent",$data->{originator},
466 "$gBug acknowledged by developer.");
467 &sendmessage(create_mime_message(
468 ["X-Loop" => "$gMaintainerEmail",
469 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
470 To => "$data->{originator}",
471 Subject => "$gBug#$ref closed by $markedby ($header{'subject'})",
472 "Message-ID" => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
473 "In-Reply-To" => "$data->{msgid}",
474 References => "$header{'message-id'} $data->{msgid}",
475 "X-$gProject-PR-Message" => "they-closed $ref",
476 "X-$gProject-PR-Package" => "$data->{package}",
477 "X-$gProject-PR-Keywords" => "$data->{keywords}",
478 # Only have a X-$gProject-PR-Source when we know the source package
479 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
480 "Reply-To" => "$ref\@$gEmailDomain",
481 "Content-Type" => 'text/plain; charset="utf-8"',
482 ],<<END ,[join("\n",@msg)]),'',undef,1);
483 This is an automatic notification regarding your $gBug report
484 #$ref: $data->{subject},
485 which was filed against the $data->{package} package.
487 It has been closed by $markedby.
489 Their explanation is attached below. If this explanation is
490 unsatisfactory and you have not received a better one in a separate
491 message then please contact $markedby by replying
495 (administrator, $gProject $gBugs database)
505 if ($codeletter eq 'U') {
506 &htmllog("Warning","sent",$replyto,"Message not forwarded.");
507 &sendmessage(<<END, '');
508 From: $gMaintainerEmail ($gProject $gBug Tracking System)
510 Subject: Message with no $gBug number cannot be sent to submitter !
512 Message-ID: <handler.x.$nn.nonumnosub\@$gEmailDomain>
513 In-Reply-To: $header{'message-id'}
514 References: $header{'message-id'} $data->{msgid}
516 X-$gProject-PR-Message: error
518 You sent a message to the $gProject $gBug tracking system's $gBug
519 report submitter address $baddress\@$gEmailDomain, without a
520 recognisable $gBug number in the Subject. Your message has been filed
521 under junk but otherwise ignored.
523 If you don't know what I'm talking about then probably either:
525 (a) you unwittingly sent a message to $baddress\@$gEmailDomain
526 because you replied to all recipients of the message a developer sent
527 to a $gBug\'s submitter and you modified the Subject. In this case,
528 please do not be alarmed. To avoid confusion do not do it again, but
529 there is no need to apologise or mail anyone asking for an
532 (b) you are a system administrator, reading this because the $gBug
533 tracking system is responding to a misdirected bounce message. In this
534 case there is a serious mail system misconfiguration somewhere - please
535 contact me immediately.
537 Your message was dated $header{'date'} and had
538 message-id $header{'message-id'}
539 and subject $subject.
541 If you need any assistance or explanation please contact me.
544 (administrator, $gProject $gBugs database)
551 $data->{found_versions} = [];
552 $data->{fixed_versions} = [];
554 if (defined $pheader{source}) {
555 $data->{package} = $pheader{source};
556 } elsif (defined $pheader{package}) {
557 $data->{package} = $pheader{package};
559 &htmllog("Warning","sent",$replyto,"Message not forwarded.");
560 &sendmessage(create_mime_message(
561 ["X-Loop" => "$gMaintainerEmail",
562 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
564 Subject => "Message with no Package: tag cannot be processed! ($subject)",
565 "Message-ID" => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
566 "In-Reply-To" => $header{'message-id'},
567 References => "$header{'message-id'} $data->{msgid}",
568 Precedence => 'bulk',
569 "X-$gProject-PR-Message" => 'error'
570 ],<<END,[join("\n", @msg)]), '',undef,1);
572 Your message didn't have a Package: line at the start (in the
573 pseudo-header following the real mail header), or didn't have a
574 pseudo-header at all. Your message has been filed under junk but
577 This makes it much harder for us to categorise and deal with your
578 problem report. Please _resubmit_ your report to $baddress\@$gEmailDomain
579 and tell us which package the report is on. For help, check out
580 http://$gWebDomain/Reporting$gHTMLSuffix.
582 Your message was dated $header{'date'} and had
583 message-id $header{'message-id'}
584 and subject $subject.
585 The complete text of it is attached to this message.
587 If you need any assistance or explanation please contact me.
590 (administrator, $gProject $gBugs database)
597 $data->{keywords}= '';
598 if (defined($pheader{'keywords'})) {
599 $data->{keywords}= $pheader{'keywords'};
600 } elsif (defined($pheader{'tags'})) {
601 $data->{keywords}= $pheader{'tags'};
603 if (length($data->{keywords})) {
605 my %gkws = map { ($_, 1) } @gTags;
606 foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
607 push @kws, $kw if (defined $gkws{$kw});
609 $data->{keywords} = join(" ", @kws);
611 $data->{severity}= '';
612 if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
613 $data->{severity}= $pheader{'severity'};
614 $data->{severity}= $pheader{'priority'} unless ($data->{severity});
615 $data->{severity} =~ s/^\s*(.+)\s*$/$1/;
617 if (!grep($_ eq $data->{severity}, @severities, "$gDefaultSeverity")) {
620 Your message specified a Severity: in the pseudo-header, but
621 the severity value $data->{severity} was not recognised.
622 The default severity $gDefaultSeverity is being used instead.
623 The recognised values are: $gShowSeverities.
625 # if we use @gSeverityList array in the above line, perl -c gives:
626 # In string, @gSeverityList now must be written as \@gSeverityList at
627 # process line 452, near "$gDefaultSeverity is being used instead.
628 $data->{severity}= '';
631 if (defined($pheader{owner})) {
632 $data->{owner}= $pheader{owner};
634 if (defined($pheader{forwarded})) {
635 $data->{'forwarded-to'} = $pheader{forwarded};
637 &filelock("nextnumber.lock");
638 open(N,"nextnumber") || &quit("nextnumber: read: $!");
639 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
640 $ref= $v+0; $v += 1; $newref=1;
641 &overwrite('nextnumber', "$v\n");
643 my $hash = get_hashname($ref);
644 &overwrite("db-h/$hash/$ref.log",'');
645 $data->{originator} = $replyto;
646 $data->{date} = $intdate;
647 $data->{subject} = $subject;
648 $data->{msgid} = $header{'message-id'};
649 writebug($ref, $data);
650 &overwrite("db-h/$hash/$ref.report",
651 join("\n",@msg)."\n");
656 print DEBUG "maintainers >@maintaddrs<\n";
658 $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
659 $newsubject= $subject; $newsubject =~ s/^$gBug#$ref:*\s*//;
661 $xcchdr= $header{ 'x-debbugs-cc' };
662 if ($xcchdr =~ m/\S/) {
663 push(@resentccs,$xcchdr);
664 $resentccexplain.= <<END;
666 As you requested using X-Debbugs-CC, your message was also forwarded to
668 (after having been given a $gBug report number, if it did not have one).
672 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
673 push(@resentccs,@maintaddrs);
674 $resentccexplain.= <<END." ".join("\n ",@maintaddrs)."\n";
676 Your message has been sent to the package maintainer(s):
680 @bccs = @addsrcaddrs;
681 if (defined $gStrongList and isstrongseverity($data->{severity})) {
682 push @bccs, "$gStrongList\@$gListDomain";
685 # Send mail to the per bug list subscription too
686 push @bccs, "bugs=$ref\@$gListDomain";
688 if (defined $pheader{source}) {
689 # Prefix source versions with the name of the source package. They
690 # appear that way in version trees so that we can deal with binary
691 # packages moving from one source package to another.
692 if (defined $pheader{'source-version'}) {
693 addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
694 } elsif (defined $pheader{version}) {
695 addfoundversions($data, $pheader{source}, $pheader{version}, '');
697 writebug($ref, $data);
698 } elsif (defined $pheader{package}) {
699 # TODO: could handle Source-Version: by looking up the source package?
700 addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
701 writebug($ref, $data);
704 $veryquiet= $codeletter eq 'Q';
705 if ($codeletter eq 'M' && !@maintaddrs) {
709 You requested that the message be sent to the package maintainer(s)
710 but either the $gBug report is not associated with any package (probably
711 because of a missing Package pseudo-header field in the original $gBug
712 report), or the package(s) specified do not have any maintainer(s).
714 Your message has *not* been sent to any package maintainers; it has
715 merely been filed in the $gBug tracking system. If you require assistance
716 please contact $gMaintainerEmail quoting the $gBug number $ref.
720 $resentccval.= join(', ',@resentccs);
721 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
722 if (length($resentccval)) {
723 $resentcc= "Resent-CC: $resentccval\n";
726 if ($codeletter eq 'U') {
727 &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
728 &sendmessage(<<END,[$data->{originator},@resentccs],[@bccs]);
729 Subject: $gBug#$ref: $newsubject
730 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
731 ${orgsender}Resent-To: $data->{originator}
732 ${resentcc}Resent-Date: $tdate
733 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
734 Resent-Sender: $gMaintainerEmail
735 X-$gProject-PR-Message: report $ref
736 X-$gProject-PR-Package: $data->{package}
737 X-$gProject-PR-Keywords: $data->{keywords}
738 ${source_pr_header}$fwd
740 } elsif ($codeletter eq 'B') { # Sent to submit
741 &htmllog($newref ? "Report" : "Information", "forwarded",
742 join(', ',"$gSubmitList\@$gListDomain",@resentccs),
743 "<code>$gBug#$ref</code>".
744 (length($data->{package})? "; Package <code>".&sani($data->{package})."</code>" : '').
746 &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
747 Subject: $gBug#$ref: $newsubject
748 Reply-To: $replyto, $ref\@$gEmailDomain
749 Resent-From: $header{'from'}
750 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
751 ${resentcc}Resent-Date: $tdate
752 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
753 Resent-Sender: $gMaintainerEmail
754 X-$gProject-PR-Message: report $ref
755 X-$gProject-PR-Package: $data->{package}
756 X-$gProject-PR-Keywords: $data->{keywords}
757 ${source_pr_header}$fwd
759 } elsif (@resentccs or @bccs) { # Quiet or Maintainer
760 # D and F done far earlier; B just done - so this must be M or Q
761 # We preserve whichever it was in the Reply-To (possibly adding
764 &htmllog($newref ? "Report" : "Information", "forwarded",
766 "<code>$gBug#$ref</code>".
767 (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
770 &htmllog($newref ? "Report" : "Information", "stored",
772 "<code>$gBug#$ref</code>".
773 (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
776 &sendmessage(<<END,[@resentccs],[@bccs]);
777 Subject: $gBug#$ref: $newsubject
778 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
779 Resent-From: $header{'from'}
780 ${orgsender}Resent-To: $resentccval
782 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
783 Resent-Sender: $gMaintainerEmail
784 X-$gProject-PR-Message: report $ref
785 X-$gProject-PR-Package: $data->{package}
786 X-$gProject-PR-Keywords: $data->{keywords}
787 ${source_pr_header}$fwd
791 $htmlbreak= length($brokenness) ? "<p>\n".&sani($brokenness)."\n<p>\n" : '';
792 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
793 if (length($resentccval)) {
794 $htmlbreak = " Copy sent to <code>".&sani($resentccval)."</code>.".
797 unless (exists $header{'x-debbugs-no-ack'}) {
799 &htmllog("Acknowledgement","sent",$replyto,
801 "New $gBug report received and filed, but not forwarded." :
802 "New $gBug report received and forwarded."). $htmlbreak);
804 &sendmessage(create_mime_message(
805 ["X-Loop" => "$gMaintainerEmail",
806 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
808 Subject => "$gBug#$ref: Acknowledgement of QUIET report ($subject)",
809 "Message-ID" => "<handler.$ref.$nn.ackquiet\@$gEmailDomain>",
810 "In-Reply-To" => $header{'message-id'},
811 References => $header{'message-id'},
812 Precedence => 'bulk',
813 "X-$gProject-PR-Message" => "ack-quiet $ref",
814 "X-$gProject-PR-Package" => $data->{package},
815 "X-$gProject-PR-Keywords" => $data->{keywords},
816 # Only have a X-$gProject-PR-Source when we know the source package
817 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
818 "Reply-To" => "$ref-quiet\@$gEmailDomain",
819 ],<<END,[join("\n", @msg)]), '',undef,1);
820 Thank you for the problem report you have sent regarding $gProject.
821 This is an automatically generated reply, to let you know your message
822 has been received. It has not been forwarded to the package maintainers
823 or other interested parties; you should ensure that the developers are
824 aware of the problem you have entered into the system - preferably
825 quoting the $gBug reference number, #$ref.
827 If you wish to submit further information on your problem, please send it
828 to $ref-$baddressroot\@$gEmailDomain (and *not*
829 to $baddress\@$gEmailDomain).
831 If you have filed this report in error and wish to close it, please
832 send mail to $ref-done\@$gEmailDomain with an explanation
833 why the bug report should be closed.
835 Please do not reply to the address at the top of this message,
836 unless you wish to report a problem with the $gBug-tracking system.
839 (administrator, $gProject $gBugs database)
842 elsif ($codeletter eq 'M') { # Maintonly
843 &sendmessage(create_mime_message(
844 ["X-Loop" => "$gMaintainerEmail",
845 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
847 Subject => "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)",
848 "Message-ID" => "<handler.$ref.$nn.ackmaint\@$gEmailDomain>",
849 "In-Reply-To" => $header{'message-id'},
850 References => $header{'message-id'},
851 Precedence => 'bulk',
852 "X-$gProject-PR-Message" => "ack-maintonly $ref",
853 "X-$gProject-PR-Package" => $data->{package},
854 "X-$gProject-PR-Keywords" => $data->{keywords},
855 # Only have a X-$gProject-PR-Source when we know the source package
856 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
857 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
858 ],<<END,[]), '',undef,1);
859 Thank you for the problem report you have sent regarding $gProject.
860 This is an automatically generated reply, to let you know your message has
861 been received. It is being forwarded to the package maintainers (but not
862 other interested parties, as you requested) for their attention; they will
865 If you wish to submit further information on your problem, please send
866 it to $ref-$baddressroot\@$gEmailDomain (and *not*
867 to $baddress\@$gEmailDomain).
869 If you have filed this report in error and wish to close it, please
870 send mail to $ref-done\@$gEmailDomain with an explanation
871 why the bug report should be closed.
873 Please do not reply to the address at the top of this message,
874 unless you wish to report a problem with the $gBug-tracking system.
877 (administrator, $gProject $gBugs database)
881 &sendmessage(create_mime_message(
882 ["X-Loop" => "$gMaintainerEmail",
883 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
885 Subject => "$gBug#$ref: Acknowledgement ($subject)",
886 "Message-ID" => "<handler.$ref.$nn.ack\@$gEmailDomain>",
887 "In-Reply-To" => $header{'message-id'},
888 References => $header{'message-id'},
889 Precedence => 'bulk',
890 "X-$gProject-PR-Message" => "ack $ref",
891 "X-$gProject-PR-Package" => $data->{package},
892 "X-$gProject-PR-Keywords" => $data->{keywords},
893 # Only have a X-$gProject-PR-Source when we know the source package
894 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
895 "Reply-To" => "$ref\@$gEmailDomain",
896 ],<<END,[]), '',undef,1);
897 Thank you for the problem report you have sent regarding $gProject.
898 This is an automatically generated reply, to let you know your message has
899 been received. It is being forwarded to the package maintainers and other
900 interested parties for their attention; they will reply in due course.
902 If you wish to submit further information on your problem, please send
903 it to $ref\@$gEmailDomain (and *not* to
904 $baddress\@$gEmailDomain).
906 If you have filed this report in error and wish to close it, please
907 send mail to $ref-done\@$gEmailDomain with an explanation
908 why the bug report should be closed.
910 Please do not reply to the address at the top of this message,
911 unless you wish to report a problem with the $gBug-tracking system.
914 (administrator, $gProject $gBugs database)
917 } elsif ($codeletter ne 'U' and
918 $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/) {
919 &htmllog("Acknowledgement","sent",$replyto,
920 ($veryquiet ? "Extra info received and filed, but not forwarded." :
921 $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
922 "Extra info received and forwarded to list."). $htmlbreak);
924 &sendmessage(create_mime_message(
925 ["X-Loop" => "$gMaintainerEmail",
926 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
928 Subject => "$gBug#$ref: Info received and FILED only (was $subject)",
929 "Message-ID" => "<handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>",
930 "In-Reply-To" => $header{'message-id'},
931 References => $header{'message-id'},
932 Precedence => 'bulk',
933 "X-$gProject-PR-Message" => "ack-info-quiet $ref",
934 "X-$gProject-PR-Package" => $data->{package},
935 "X-$gProject-PR-Keywords" => $data->{keywords},
936 # Only have a X-$gProject-PR-Source when we know the source package
937 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
938 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
939 ],<<END,[]), '',undef,1);
940 Thank you for the additional information you have supplied regarding
941 this problem report. It has NOT been forwarded to the package
942 maintainers, but will accompany the original report in the $gBug
943 tracking system. Please ensure that you yourself have sent a copy of
944 the additional information to any relevant developers or mailing lists.
946 If you wish to continue to submit further information on this problem,
947 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
949 Please do not reply to the address at the top of this message,
950 unless you wish to report a problem with the $gBug-tracking system.
953 (administrator, $gProject $gBugs database)
956 elsif ($codeletter eq 'M') {
957 &sendmessage(create_mime_message(
958 ["X-Loop" => "$gMaintainerEmail",
959 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
961 Subject => "$gBug#$ref: Info received for maintainer only (was $subject)",
962 "Message-ID" => "<handler.$ref.$nn.ackinfomaint\@$gEmailDomain>",
963 "In-Reply-To" => $header{'message-id'},
964 References => "$header{'message-id'} $data->{msgid}",
965 Precedence => 'bulk',
966 "X-$gProject-PR-Message" => "ack-info-maintonly $ref",
967 "X-$gProject-PR-Package" => $data->{package},
968 "X-$gProject-PR-Keywords" => $data->{keywords},
969 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
970 ],<<END,[]), '',undef,1);
971 Thank you for the additional information you have supplied regarding
972 this problem report. It has been forwarded to the package maintainer(s)
973 (but not to other interested parties) to accompany the original report.
975 If you wish to continue to submit further information on this problem,
976 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
978 Please do not reply to the address at the top of this message,
979 unless you wish to report a problem with the $gBug-tracking system.
982 (administrator, $gProject $gBugs database)
986 &sendmessage(create_mime_message(
987 ["X-Loop" => "$gMaintainerEmail",
988 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
990 Subject => "$gBug#$ref: Info received ($subject)",
991 "Message-ID" => "<handler.$ref.$nn.ackinfo\@$gEmailDomain>",
992 "In-Reply-To" => $header{'message-id'},
993 References => "$header{'message-id'} $data->{msgid}",
994 Precedence => 'bulk',
995 "X-$gProject-PR-Message" => "ack-info $ref",
996 "X-$gProject-PR-Package" => $data->{package},
997 "X-$gProject-PR-Keywords" => $data->{keywords},
998 # Only have a X-$gProject-PR-Source when we know the source package
999 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
1000 "Reply-To" => "$ref\@$gEmailDomain",
1001 ],<<END,[]), '',undef,1);
1002 Thank you for the additional information you have supplied regarding
1003 this problem report. It has been forwarded to the package maintainer(s)
1004 and to other interested parties to accompany the original report.
1006 If you wish to continue to submit further information on this problem,
1007 please send it to $ref\@$gEmailDomain, as before.
1009 Please do not reply to the address at the top of this message,
1010 unless you wish to report a problem with the $gBug-tracking system.
1013 (administrator, $gProject $gBugs database)
1025 open(NEW,">$f.new") || &quit("$f.new: create: $!");
1026 print(NEW "$v") || &quit("$f.new: write: $!");
1027 close(NEW) || &quit("$f.new: close: $!");
1028 rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
1032 my $hash = get_hashname($ref);
1033 if (!open(AP,">>db-h/$hash/$ref.log")) {
1034 print DEBUG "failed open log<\n";
1035 print DEBUG "failed open log err $!<\n";
1036 &quit("opening db-h/$hash/$ref.log (li): $!");
1038 print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
1039 close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
1043 utime(time,time,"db");
1045 while ($u= $cleanups[$#cleanups]) { &$u; }
1046 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1050 &quit("wot no exit");
1053 local ($whatobj,$whatverb,$where,$desc) = @_;
1054 my $hash = get_hashname($ref);
1055 open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
1058 "<strong>$whatobj $whatverb</strong>".
1059 ($where eq '' ? "" : " to <code>".&sani($where)."</code>").
1061 "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
1062 close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
1069 while ($msg =~ s/(.*\n)//) {
1076 # strip continuation lines too
1091 send_message($the_message,\@recipients,\@bcc,$do_not_encode)
1093 The first argument is the scalar message, the second argument is the
1094 arrayref of recipients, the third is the arrayref of Bcc:'ed
1097 The final argument turns off header encoding and the addition of the
1098 X-Loop header if true, defaults to false.
1104 my ($msg,$recips,$bcc,$no_encode) = @_;
1105 if (not defined $recips or (!ref($recips) && $recips eq '')
1109 # This is suboptimal. The right solution is to send headers
1110 # separately from the rest of the message and encode them rather
1112 $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
1113 # The original message received is written out in appendlog, so
1114 # before writing out the other messages we've sent out, we need to
1115 # RFC1522 encode the header.
1116 $msg = encode_headers($msg) unless $no_encode;
1118 my $hash = get_hashname($ref);
1119 #save email to the log
1120 open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
1121 print(AP "\2\n",join("\4",@$recips),"\n\5\n",
1122 @{escapelog(stripbccs($msg))},"\n\3\n") ||
1123 &quit("writing db-h/$hash/$ref.log (lo): $!");
1124 close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
1127 shift @$recips if $recips->[0] eq '-t';
1128 push @$recips, @$bcc;
1131 send_mail_message(message => $msg,
1132 # Because we encode the headers above, we do not want to encode them here
1133 encode_headers => 0,
1134 recipients => $recips);
1137 my $maintainerschecked = 0;
1138 sub checkmaintainers {
1139 return if $maintainerschecked++;
1140 return if !length($data->{package});
1141 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1145 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1146 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1147 # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1148 $maintainerof{$a}= $2;
1151 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1155 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1156 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1157 # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1158 $maintainerof{$a}= $2;
1161 open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
1163 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1169 $anymaintfound=0; $anymaintnotfound=0;
1170 for $p (split(m/[ \t?,():]+/,$data->{package})) {
1172 $p =~ /([a-z0-9.+-]+)/;
1174 next unless defined $p;
1175 if (defined $gSubscriptionDomain) {
1176 if (defined($pkgsrc{$p})) {
1177 push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
1179 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1182 if (defined($maintainerof{$p})) {
1183 print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
1184 $addmaint= $maintainerof{$p};
1185 push(@maintaddrs,$addmaint) unless
1186 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
1189 print DEBUG "maintainer none >$p<\n";
1190 push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1191 $anymaintnotfound++;
1196 if (length $data->{owner}) {
1197 print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
1198 $addmaint = $data->{owner};
1199 push(@maintaddrs, $addmaint) unless
1200 $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1204 =head2 bug_list_forward
1206 bug_list_forward($spool_filename) if $codeletter eq 'L';
1209 Given the spool file, will forward a bug to the per bug mailing list
1210 subscription system.
1214 sub bug_list_forward{
1216 # Read the bug information and package information for passing to
1218 my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
1219 my ($bfound, $data)= lockreadbugmerge($bug_number);
1220 my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!";
1223 my $bug_message = <$bug_fh>;
1224 my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
1225 my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
1226 if (not defined $envelope_from) {
1227 # Try to use the From: header or something to set it
1228 ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
1229 # Kludgy, and should really be using a full scale header
1230 # parser to do this.
1231 $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
1233 my ($header,$body) = split /\n\n/, $bug_message, 2;
1234 # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
1235 $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
1236 qq(X-$gProject-PR-Package: $data->{package}\n).
1237 qq(X-$gProject-PR-Title: $data->{subject})
1239 print STDERR "Tried to loop me with $envelope_from\n"
1240 and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
1241 print DEBUG $envelope_from,qq(\n);
1242 # If we don't have a bug address, something has gone horribly wrong.
1243 print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
1244 $bug_address =~ s/\@.+//;
1245 print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
1246 print DEBUG $header.qq(\n\n).$body;
1247 send_mail_message(message => $header.qq(\n\n).$body,
1248 recipients => ["bugs=$bug_address\@$gListDomain"],
1249 envelope_from => $envelope_from,
1250 encode_headers => 0,
1252 unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");