2 # $Id: process.in,v 1.109 2006/02/09 22:02:04 don Exp $
7 use POSIX qw(strftime);
10 use Debbugs::MIME qw(decode_rfc1522 create_mime_message);
11 use Debbugs::Mail qw(send_mail_message encode_headers);
12 use Debbugs::Packages qw(getpkgsrc);
13 use Debbugs::User qw(read_usertags write_usertags);
15 use Debbugs::CGI qw(html_escape);
17 use Debbugs::Log qw(:misc);
19 # TODO DLA; needs config reworking and errorlib reworking
23 use Debbugs::Status qw(:versions);
24 use Debbugs::Config qw(:globals);
25 my $lib_path = $gLibPath;
27 require "$lib_path/errorlib";
28 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
30 chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
32 #open(DEBUG,"> /tmp/debbugs.debug");
34 open DEBUG, ">/dev/null";
36 my $intdate = time or quit("failed to get time: $!");
39 m/^([BMQFDUL])(\d*)\.\d+$/ or quit("bad argument: $_");
41 my $tryref= length($2) ? $2 : -1;
44 if (!rename("incoming/G$nn","incoming/P$nn"))
46 $_=$!.''; m/no such file or directory/i && exit 0;
47 &quit("renaming to lock: $!");
50 my $baddress= 'submit' if $codeletter eq 'B';
51 $baddress= 'maintonly' if $codeletter eq 'M';
52 $baddress= 'quiet' if $codeletter eq 'Q';
53 $baddress= 'forwarded' if $codeletter eq 'F';
54 $baddress= 'done' if $codeletter eq 'D';
55 $baddress= 'submitter' if $codeletter eq 'U';
56 bug_list_forward($nn) if $codeletter eq 'L';
57 $baddress || &quit("bad codeletter $codeletter");
58 my $baddressroot= $baddress;
59 $baddress= "$tryref-$baddress" if $tryref>=0;
61 open(M,"incoming/P$nn");
68 print DEBUG "###\n",join("##\n",@msg),"\n###\n";
70 my $tdate = strftime "%a, %d %h %Y %T +0000", gmtime;
72 Received: via spool by $baddress\@$gEmailDomain id=$nn
73 (code $codeletter ref $tryref); $tdate
76 # header and decoded body respectively
77 my (@headerlines, @bodylines);
79 my $parser = new MIME::Parser;
80 mkdir "$gSpoolDir/mime.tmp", 0777;
81 $parser->output_under("$gSpoolDir/mime.tmp");
82 my $entity = eval { $parser->parse_data(join('',@log)) };
85 if ($entity and $entity->head->tags) {
86 @headerlines = @{$entity->head->header};
89 my $entity_body = getmailbody($entity);
90 @bodylines = $entity_body ? $entity_body->as_lines() : ();
93 # set $i to beginning of encoded body data, so we can dump it out
96 ++$i while $msg[$i] =~ /./;
98 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
99 for ($i = 0; $i <= $#msg; $i++) {
101 last unless length($_);
102 while ($msg[$i+1] =~ m/^\s/) {
106 push @headerlines, $_;
109 @bodylines = @msg[$i..$#msg];
114 for my $hdr (@headerlines) {
115 $hdr = decode_rfc1522($hdr);
118 &finish if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
119 my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
120 && !m/^From / && !m/^X-Debbugs-/i;
121 $fwd .= $hdr."\n" if $ins;
122 # print DEBUG ">$_<\n";
123 if (s/^(\S+):\s*//) {
125 print DEBUG ">$v=$_<\n";
128 print DEBUG "!>$_<\n";
133 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
135 # Strip off RFC2440-style PGP clearsigning.
136 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
137 shift @bodylines while @bodylines and length $bodylines[0];
138 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
139 for my $findsig (0 .. $#bodylines) {
140 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
141 $#bodylines = $findsig - 1;
145 map { s/^- // } @bodylines;
148 # extract pseudo-headers
149 for my $phline (@bodylines)
151 last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
152 my ($fn, $fv) = ($1, $2);
154 print DEBUG ">$fn|$fv|\n";
156 # Don't lc owner or forwarded
157 $fv = lc $fv unless $fh =~ /^(?:owner|forwarded|usertags|version|source-version)$/;
159 print DEBUG ">$fn~$fv<\n";
162 # Allow pseudo headers to set x-debbugs- stuff [#179340]
163 for my $key (grep /X-Debbugs-.*/i, keys %pheader) {
164 $header{$key} = $pheader{$key} if not exists $header{$key};
167 $fwd .= join("\n",@msg[$i..$#msg]);
169 print DEBUG "***\n$fwd\n***\n";
171 if (defined $header{'resent-from'} && !defined $header{'from'}) {
172 $header{'from'} = $header{'resent-from'};
174 defined($header{'from'}) || &quit("no From header");
176 my $replyto = $header{'reply-to'};
177 $replyto = '' unless defined $replyto;
180 unless (length $replyto) {
181 $replyto = $header{'from'};
184 my $subject = '(no subject)';
185 if (!defined($header{'subject'}))
189 Your message did not contain a Subject field. They are recommended and
190 useful because the title of a $gBug is determined using this field.
191 Please remember to include a Subject field in your messages in future.
195 $subject= $header{'subject'};
199 $subject =~ s/^Re:\s*//i; $_= $subject."\n";
200 if ($tryref < 0 && m/^Bug ?\#(\d+)\D/i) {
206 ($bfound, $data)= &lockreadbugmerge($tryref);
210 &htmllog("Reply","sent", $replyto,"Unknown problem report number <code>$tryref</code>.");
211 my $archivenote = '';
213 $archivenote = <<END;
214 This may be because that $gBug report has been resolved for more than $gRemoveAge
215 days, and the record of it has been archived and made read-only, or
216 because you mistyped the $gBug report number.
220 &sendmessage(<<END, '');
221 From: $gMaintainerEmail ($gProject $gBug Tracking System)
223 Subject: Unknown problem report $gBug#$tryref ($subject)
224 Message-ID: <handler.x.$nn.unknown\@$gEmailDomain>
225 In-Reply-To: $header{'message-id'}
226 References: $header{'message-id'} $data->{msgid}
228 X-$gProject-PR-Message: error
230 You sent a message to the $gBug tracking system which gave (in the
231 Subject line or encoded into the recipient at $gEmailDomain),
232 the number of a nonexistent $gBug report (#$tryref).
234 ${archivenote}Your message was dated $header{'date'} and was sent to
235 $baddress\@$gEmailDomain. It had
236 Message-ID $header{'message-id'}
237 and Subject $subject.
239 It has been filed (under junk) but otherwise ignored.
241 Please consult your records to find the correct $gBug report number, or
242 contact me, the system administrator, for assistance.
245 (administrator, $gProject $gBugs database)
247 (NB: If you are a system administrator and have no idea what I am
248 talking about this indicates a serious mail system misconfiguration
249 somewhere. Please contact me immediately.)
256 &filelock('lock/-1');
259 # Attempt to determine which source package this is
260 my $source_pr_header = '';
261 my $source_package = '';
262 if (defined $pheader{source}) {
263 $source_package = $pheader{source};
265 elsif (defined $data->{package} or defined $pheader{package}) {
266 my $pkg_src = getpkgsrc();
267 $source_package = $pkg_src->{defined $data->{package}?$data->{package}:$pheader{package}};
269 $source_pr_header = "X-$gProject-PR-Source: $source_package\n"
270 if defined $source_package and length $source_package;
272 # Done and Forwarded Bugs
273 if ($codeletter eq 'D' || $codeletter eq 'F')
275 if ($replyto =~ m/$gBounceFroms/o ||
276 $header{'from'} =~ m/$gBounceFroms/o)
278 &quit("bounce detected ! Mwaap! Mwaap!");
280 $markedby= $header{'from'} eq $replyto ? $replyto :
281 "$header{'from'} (reply to $replyto)";
283 if ($codeletter eq 'F') { # Forwarded
284 (&appendlog,&finish) if length($data->{forwarded});
285 $receivedat= "forwarded\@$gEmailDomain";
286 $markaswhat= 'forwarded';
287 $set_forwarded= $header{'to'};
288 # Dissallow forwarded being set to this bug tracking system
289 if (defined $set_forwarded and $set_forwarded =~ /\Q$gEmailDomain\E/) {
290 undef $set_forwarded;
292 if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
293 push @generalcc, "$gForwardList\@$gListDomain";
294 $generalcc= "$gForwardList\@$gListDomain";
299 if (length($data->{done}) and
300 not defined $pheader{'source-version'} and
301 not defined $pheader{'version'}) {
305 $receivedat= "done\@$gEmailDomain";
307 $set_done= $header{'from'};
308 if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
309 $generalcc= "$gDoneList\@$gListDomain";
310 push @generalcc, "$gDoneList\@$gListDomain";
315 if (defined $gStrongList and isstrongseverity($data->{severity})) {
316 $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
317 push @generalcc,"$gStrongList\@$gListDomain";
320 &htmllog("Warning","sent",$replyto,"Message ignored.");
321 &sendmessage(<<END, '');
322 From: $gMaintainerEmail ($gProject $gBug Tracking System)
324 Subject: Message with no $gBug number ignored by $receivedat
326 Message-ID: <header.x.$nn.warnignore\@$gEmailDomain>
327 In-Reply-To: $header{'message-id'}
328 References: $header{'message-id'} $data->{msgid}
330 X-$gProject-PR-Message: error
332 You sent a message to the $gProject $gBug tracking system old-style
333 unified mark as $markaswhat address ($receivedat),
334 without a recognisable $gBug number in the Subject.
335 Your message has been filed under junk but otherwise ignored.
337 If you don't know what I'm talking about then probably either:
339 (a) you unwittingly sent a message to done\@$gEmailDomain
340 because you replied to all recipients of the message a developer used
341 to mark a $gBug as done and you modified the Subject. In this case,
342 please do not be alarmed. To avoid confusion do not do it again, but
343 there is no need to apologise or mail anyone asking for an explanation.
345 (b) you are a system administrator, reading this because the $gBug
346 tracking system is responding to a misdirected bounce message. In this
347 case there is a serious mail system misconfiguration somewhere - please
348 contact me immediately.
350 Your message was dated $header{'date'} and had
351 message-id $header{'message-id'}
352 and subject $subject.
354 If you need any assistance or explanation please contact me.
357 (administrator, $gProject $gBugs database)
366 my @noticecc = grep($_ ne $replyto,@maintaddrs);
367 $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
368 $noticeccval =~ s/\s+\n\s+/ /g;
369 $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
371 @process= ($ref,split(/ /,$data->{mergedwith}));
374 for $ref (@process) {
375 if ($ref != $orgref) {
377 $data = &lockreadbug($ref)
378 || die "huh ? $ref from $orgref out of @process";
380 $data->{done}= $set_done if defined($set_done);
381 $data->{forwarded}= $set_forwarded if defined($set_forwarded);
382 if ($codeletter eq 'D') {
383 $data->{keywords} = join ' ', grep $_ ne 'pending',
384 split ' ', $data->{keywords};
385 if (defined $pheader{'source-version'}) {
386 addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
387 } elsif (defined $pheader{version}) {
388 addfixedversions($data, $pheader{package}, $pheader{version}, 'binary');
392 # Add bug mailing list to $generalbcc as appropriate
393 # This array is used to specify bcc in the cases where we're using create_mime_message.
394 my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
395 my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
396 $generalbcc =~ s/\s+\n\s+/ /g;
397 $generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
398 if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
400 writebug($ref, $data);
402 my $hash = get_hashname($ref);
403 open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!");
404 $x= join('',<O>); close(O);
405 if ($codeletter eq 'F') {
406 &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
407 &sendmessage(create_mime_message(
408 ["X-Loop" => "$gMaintainerEmail",
409 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
411 Subject => "$gBug#$ref: marked as forwarded ($data->{subject})",
412 "Message-ID" => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
413 "In-Reply-To" => $header{'message-id'},
414 References => "$header{'message-id'} $data->{msgid}",
415 Precedence => 'bulk',
416 "X-$gProject-PR-Message" => "forwarded $ref",
417 "X-$gProject-PR-Package" => $data->{package},
418 "X-$gProject-PR-Keywords" => $data->{keywords},
419 # Only have a X-$gProject-PR-Source when we know the source package
420 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
421 ],<<END ,[join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
422 Your message dated $header{'date'}
423 with message-id $header{'message-id'}
424 has caused the $gProject $gBug report #$ref,
425 regarding $data->{subject}
426 to be marked as having been forwarded to the upstream software
427 author(s) $data->{forwarded}.
429 (NB: If you are a system administrator and have no idea what I am
430 talking about this indicates a serious mail system misconfiguration
431 somewhere. Please contact me immediately.)
434 (administrator, $gProject $gBugs database)
439 &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
440 &sendmessage(create_mime_message(
441 ["X-Loop" => "$gMaintainerEmail",
442 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
444 Subject => "$gBug#$ref: marked as done ($data->{subject})",
445 "Message-ID" => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
446 "In-Reply-To" => $header{'message-id'},
447 References => "$header{'message-id'} $data->{msgid}",
448 Precedence => 'bulk',
449 "X-$gProject-PR-Message" => "closed $ref",
450 "X-$gProject-PR-Package" => $data->{package},
451 "X-$gProject-PR-Keywords" => $data->{keywords},
452 # Only have a X-$gProject-PR-Source when we know the source package
453 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
454 ],<<END ,[$x,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
455 Your message dated $header{'date'}
456 with message-id $header{'message-id'}
457 and subject line $subject
458 has caused the attached $gBug report to be marked as done.
460 This means that you claim that the problem has been dealt with.
461 If this is not the case it is now your responsibility to reopen the
462 $gBug report if necessary, and/or fix the problem forthwith.
464 (NB: If you are a system administrator and have no idea what I am
465 talking about this indicates a serious mail system misconfiguration
466 somewhere. Please contact me immediately.)
469 (administrator, $gProject $gBugs database)
472 &htmllog("Notification","sent",$data->{originator},
473 "$gBug acknowledged by developer.");
474 &sendmessage(create_mime_message(
475 ["X-Loop" => "$gMaintainerEmail",
476 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
477 To => "$data->{originator}",
478 Subject => "$gBug#$ref closed by $markedby ($header{'subject'})",
479 "Message-ID" => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
480 "In-Reply-To" => "$data->{msgid}",
481 References => "$header{'message-id'} $data->{msgid}",
482 "X-$gProject-PR-Message" => "they-closed $ref",
483 "X-$gProject-PR-Package" => "$data->{package}",
484 "X-$gProject-PR-Keywords" => "$data->{keywords}",
485 # Only have a X-$gProject-PR-Source when we know the source package
486 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
487 "Reply-To" => "$ref\@$gEmailDomain",
488 "Content-Type" => 'text/plain; charset="utf-8"',
489 ],<<END ,[join("\n",@msg)]),'',undef,1);
490 This is an automatic notification regarding your $gBug report
491 #$ref: $data->{subject},
492 which was filed against the $data->{package} package.
494 It has been closed by $markedby.
496 Their explanation is attached below. If this explanation is
497 unsatisfactory and you have not received a better one in a separate
498 message then please contact $markedby by replying
502 (administrator, $gProject $gBugs database)
512 if ($codeletter eq 'U') {
513 &htmllog("Warning","sent",$replyto,"Message not forwarded.");
514 &sendmessage(<<END, '');
515 From: $gMaintainerEmail ($gProject $gBug Tracking System)
517 Subject: Message with no $gBug number cannot be sent to submitter !
519 Message-ID: <handler.x.$nn.nonumnosub\@$gEmailDomain>
520 In-Reply-To: $header{'message-id'}
521 References: $header{'message-id'} $data->{msgid}
523 X-$gProject-PR-Message: error
525 You sent a message to the $gProject $gBug tracking system's $gBug
526 report submitter address $baddress\@$gEmailDomain, without a
527 recognisable $gBug number in the Subject. Your message has been filed
528 under junk but otherwise ignored.
530 If you don't know what I'm talking about then probably either:
532 (a) you unwittingly sent a message to $baddress\@$gEmailDomain
533 because you replied to all recipients of the message a developer sent
534 to a $gBug\'s submitter and you modified the Subject. In this case,
535 please do not be alarmed. To avoid confusion do not do it again, but
536 there is no need to apologise or mail anyone asking for an
539 (b) you are a system administrator, reading this because the $gBug
540 tracking system is responding to a misdirected bounce message. In this
541 case there is a serious mail system misconfiguration somewhere - please
542 contact me immediately.
544 Your message was dated $header{'date'} and had
545 message-id $header{'message-id'}
546 and subject $subject.
548 If you need any assistance or explanation please contact me.
551 (administrator, $gProject $gBugs database)
558 $data->{found_versions} = [];
559 $data->{fixed_versions} = [];
561 if (defined $pheader{source}) {
562 $data->{package} = $pheader{source};
563 } elsif (defined $pheader{package}) {
564 $data->{package} = $pheader{package};
566 &htmllog("Warning","sent",$replyto,"Message not forwarded.");
567 &sendmessage(create_mime_message(
568 ["X-Loop" => "$gMaintainerEmail",
569 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
571 Subject => "Message with no Package: tag cannot be processed! ($subject)",
572 "Message-ID" => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
573 "In-Reply-To" => $header{'message-id'},
574 References => "$header{'message-id'} $data->{msgid}",
575 Precedence => 'bulk',
576 "X-$gProject-PR-Message" => 'error'
577 ],<<END,[join("\n", @msg)]), '',undef,1);
579 Your message didn't have a Package: line at the start (in the
580 pseudo-header following the real mail header), or didn't have a
581 pseudo-header at all. Your message has been filed under junk but
584 This makes it much harder for us to categorise and deal with your
585 problem report. Please _resubmit_ your report to $baddress\@$gEmailDomain
586 and tell us which package the report is on. For help, check out
587 http://$gWebDomain/Reporting$gHTMLSuffix.
589 Your message was dated $header{'date'} and had
590 message-id $header{'message-id'}
591 and subject $subject.
592 The complete text of it is attached to this message.
594 If you need any assistance or explanation please contact me.
597 (administrator, $gProject $gBugs database)
604 $data->{keywords}= '';
605 if (defined($pheader{'keywords'})) {
606 $data->{keywords}= $pheader{'keywords'};
607 } elsif (defined($pheader{'tags'})) {
608 $data->{keywords}= $pheader{'tags'};
610 if (length($data->{keywords})) {
612 my %gkws = map { ($_, 1) } @gTags;
613 foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
614 push @kws, $kw if (defined $gkws{$kw});
616 $data->{keywords} = join(" ", @kws);
618 $data->{severity}= '';
619 if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
620 $data->{severity}= $pheader{'severity'};
621 $data->{severity}= $pheader{'priority'} unless ($data->{severity});
622 $data->{severity} =~ s/^\s*(.+)\s*$/$1/;
624 if (!grep($_ eq $data->{severity}, @severities, "$gDefaultSeverity")) {
627 Your message specified a Severity: in the pseudo-header, but
628 the severity value $data->{severity} was not recognised.
629 The default severity $gDefaultSeverity is being used instead.
630 The recognised values are: $gShowSeverities.
632 # if we use @gSeverityList array in the above line, perl -c gives:
633 # In string, @gSeverityList now must be written as \@gSeverityList at
634 # process line 452, near "$gDefaultSeverity is being used instead.
635 $data->{severity}= '';
638 if (defined($pheader{owner})) {
639 $data->{owner}= $pheader{owner};
641 if (defined($pheader{forwarded})) {
642 $data->{'forwarded-to'} = $pheader{forwarded};
644 &filelock("nextnumber.lock");
645 open(N,"nextnumber") || &quit("nextnumber: read: $!");
646 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
647 $ref= $v+0; $v += 1; $newref=1;
648 &overwrite('nextnumber', "$v\n");
650 my $hash = get_hashname($ref);
651 &overwrite("db-h/$hash/$ref.log",'');
652 $data->{originator} = $replyto;
653 $data->{date} = $intdate;
654 $data->{subject} = $subject;
655 $data->{msgid} = $header{'message-id'};
656 writebug($ref, $data);
658 if (exists $pheader{usertags}) {
660 $user = $pheader{user} if exists $pheader{user};
662 $user =~ s/^.*<(.*)>.*$/$1/;
663 $user =~ s/[(].*[)]//;
664 $user =~ s/^\s*(\S+)\s+.*$/$1/;
665 if ($user ne '' and Debbugs::User::is_valid_user($user)) {
666 $pheader{usertags} =~ s/(?:^\s+|\s+$)//g;
668 read_usertags(\%user_tags,$user);
669 for my $tag (split /[,\s]+/, $pheader{usertags}) {
670 if ($tag =~ /^[a-zA-Z0-9.+\@-]+/) {
672 @bugs_with_tag{@{$user_tags{$tag}}} = (1) x @{$user_tags{$tag}};
673 $bugs_with_tag{$ref} = 1;
674 $user_tags{$tag} = [keys %bugs_with_tag];
677 write_usertags(\%user_tags,$user);
681 Your message tried to set a usertag, but didn't have a valid
682 user set ('$user' isn't valid)
686 &overwrite("db-h/$hash/$ref.report",
687 join("\n",@msg)."\n");
692 print DEBUG "maintainers >@maintaddrs<\n";
694 $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
695 $newsubject= $subject; $newsubject =~ s/^$gBug#$ref:*\s*//;
697 $xcchdr= $header{ 'x-debbugs-cc' };
698 if ($xcchdr =~ m/\S/) {
699 push(@resentccs,$xcchdr);
700 $resentccexplain.= <<END;
702 As you requested using X-Debbugs-CC, your message was also forwarded to
704 (after having been given a $gBug report number, if it did not have one).
708 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
709 push(@resentccs,@maintaddrs);
710 $resentccexplain.= <<END." ".join("\n ",@maintaddrs)."\n";
712 Your message has been sent to the package maintainer(s):
716 @bccs = @addsrcaddrs;
717 if (defined $gStrongList and isstrongseverity($data->{severity})) {
718 push @bccs, "$gStrongList\@$gListDomain";
721 # Send mail to the per bug list subscription too
722 push @bccs, "bugs=$ref\@$gListDomain";
724 if (defined $pheader{source}) {
725 # Prefix source versions with the name of the source package. They
726 # appear that way in version trees so that we can deal with binary
727 # packages moving from one source package to another.
728 if (defined $pheader{'source-version'}) {
729 addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
730 } elsif (defined $pheader{version}) {
731 addfoundversions($data, $pheader{source}, $pheader{version}, '');
733 writebug($ref, $data);
734 } elsif (defined $pheader{package}) {
735 # TODO: could handle Source-Version: by looking up the source package?
736 addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
737 writebug($ref, $data);
740 $veryquiet= $codeletter eq 'Q';
741 if ($codeletter eq 'M' && !@maintaddrs) {
745 You requested that the message be sent to the package maintainer(s)
746 but either the $gBug report is not associated with any package (probably
747 because of a missing Package pseudo-header field in the original $gBug
748 report), or the package(s) specified do not have any maintainer(s).
750 Your message has *not* been sent to any package maintainers; it has
751 merely been filed in the $gBug tracking system. If you require assistance
752 please contact $gMaintainerEmail quoting the $gBug number $ref.
756 $resentccval.= join(', ',@resentccs);
757 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
758 if (length($resentccval)) {
759 $resentcc= "Resent-CC: $resentccval\n";
762 if ($codeletter eq 'U') {
763 &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
764 &sendmessage(<<END,[$data->{originator},@resentccs],[@bccs]);
765 Subject: $gBug#$ref: $newsubject
766 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
767 ${orgsender}Resent-To: $data->{originator}
768 ${resentcc}Resent-Date: $tdate
769 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
770 Resent-Sender: $gMaintainerEmail
771 X-$gProject-PR-Message: report $ref
772 X-$gProject-PR-Package: $data->{package}
773 X-$gProject-PR-Keywords: $data->{keywords}
774 ${source_pr_header}$fwd
776 } elsif ($codeletter eq 'B') { # Sent to submit
777 &htmllog($newref ? "Report" : "Information", "forwarded",
778 join(', ',"$gSubmitList\@$gListDomain",@resentccs),
779 "<code>$gBug#$ref</code>".
780 (length($data->{package})? "; Package <code>".html_escape($data->{package})."</code>" : '').
782 &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
783 Subject: $gBug#$ref: $newsubject
784 Reply-To: $replyto, $ref\@$gEmailDomain
785 Resent-From: $header{'from'}
786 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
787 ${resentcc}Resent-Date: $tdate
788 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
789 Resent-Sender: $gMaintainerEmail
790 X-$gProject-PR-Message: report $ref
791 X-$gProject-PR-Package: $data->{package}
792 X-$gProject-PR-Keywords: $data->{keywords}
793 ${source_pr_header}$fwd
795 } elsif (@resentccs or @bccs) { # Quiet or Maintainer
796 # D and F done far earlier; B just done - so this must be M or Q
797 # We preserve whichever it was in the Reply-To (possibly adding
800 &htmllog($newref ? "Report" : "Information", "forwarded",
802 "<code>$gBug#$ref</code>".
803 (length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
806 &htmllog($newref ? "Report" : "Information", "stored",
808 "<code>$gBug#$ref</code>".
809 (length($data->{package}) ? "; Package <code>".html_escape($data->{package})."</code>" : '').
812 &sendmessage(<<END,[@resentccs],[@bccs]);
813 Subject: $gBug#$ref: $newsubject
814 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
815 Resent-From: $header{'from'}
816 ${orgsender}Resent-To: $resentccval
818 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
819 Resent-Sender: $gMaintainerEmail
820 X-$gProject-PR-Message: report $ref
821 X-$gProject-PR-Package: $data->{package}
822 X-$gProject-PR-Keywords: $data->{keywords}
823 ${source_pr_header}$fwd
827 $htmlbreak= length($brokenness) ? "<p>\n".html_escape($brokenness)."\n<p>\n" : '';
828 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
829 if (length($resentccval)) {
830 $htmlbreak = " Copy sent to <code>".html_escape($resentccval)."</code>.".
833 unless (exists $header{'x-debbugs-no-ack'}) {
835 &htmllog("Acknowledgement","sent",$replyto,
837 "New $gBug report received and filed, but not forwarded." :
838 "New $gBug report received and forwarded."). $htmlbreak);
840 &sendmessage(create_mime_message(
841 ["X-Loop" => "$gMaintainerEmail",
842 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
844 Subject => "$gBug#$ref: Acknowledgement of QUIET report ($subject)",
845 "Message-ID" => "<handler.$ref.$nn.ackquiet\@$gEmailDomain>",
846 "In-Reply-To" => $header{'message-id'},
847 References => $header{'message-id'},
848 Precedence => 'bulk',
849 "X-$gProject-PR-Message" => "ack-quiet $ref",
850 "X-$gProject-PR-Package" => $data->{package},
851 "X-$gProject-PR-Keywords" => $data->{keywords},
852 # Only have a X-$gProject-PR-Source when we know the source package
853 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
854 "Reply-To" => "$ref-quiet\@$gEmailDomain",
855 ],<<END,[join("\n", @msg)]), '',undef,1);
856 Thank you for the problem report you have sent regarding $gProject.
857 This is an automatically generated reply, to let you know your message
858 has been received. It has not been forwarded to the package maintainers
859 or other interested parties; you should ensure that the developers are
860 aware of the problem you have entered into the system - preferably
861 quoting the $gBug reference number, #$ref.
863 If you wish to submit further information on your problem, please send it
864 to $ref-$baddressroot\@$gEmailDomain (and *not*
865 to $baddress\@$gEmailDomain).
867 If you have filed this report in error and wish to close it, please
868 send mail to $ref-done\@$gEmailDomain with an explanation
869 why the bug report should be closed.
871 Please do not reply to the address at the top of this message,
872 unless you wish to report a problem with the $gBug-tracking system.
875 (administrator, $gProject $gBugs database)
878 elsif ($codeletter eq 'M') { # Maintonly
879 &sendmessage(create_mime_message(
880 ["X-Loop" => "$gMaintainerEmail",
881 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
883 Subject => "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)",
884 "Message-ID" => "<handler.$ref.$nn.ackmaint\@$gEmailDomain>",
885 "In-Reply-To" => $header{'message-id'},
886 References => $header{'message-id'},
887 Precedence => 'bulk',
888 "X-$gProject-PR-Message" => "ack-maintonly $ref",
889 "X-$gProject-PR-Package" => $data->{package},
890 "X-$gProject-PR-Keywords" => $data->{keywords},
891 # Only have a X-$gProject-PR-Source when we know the source package
892 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
893 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
894 ],<<END,[]), '',undef,1);
895 Thank you for the problem report you have sent regarding $gProject.
896 This is an automatically generated reply, to let you know your message has
897 been received. It is being forwarded to the package maintainers (but not
898 other interested parties, as you requested) for their attention; they will
901 If you wish to submit further information on your problem, please send
902 it to $ref-$baddressroot\@$gEmailDomain (and *not*
903 to $baddress\@$gEmailDomain).
905 If you have filed this report in error and wish to close it, please
906 send mail to $ref-done\@$gEmailDomain with an explanation
907 why the bug report should be closed.
909 Please do not reply to the address at the top of this message,
910 unless you wish to report a problem with the $gBug-tracking system.
913 (administrator, $gProject $gBugs database)
917 &sendmessage(create_mime_message(
918 ["X-Loop" => "$gMaintainerEmail",
919 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
921 Subject => "$gBug#$ref: Acknowledgement ($subject)",
922 "Message-ID" => "<handler.$ref.$nn.ack\@$gEmailDomain>",
923 "In-Reply-To" => $header{'message-id'},
924 References => $header{'message-id'},
925 Precedence => 'bulk',
926 "X-$gProject-PR-Message" => "ack $ref",
927 "X-$gProject-PR-Package" => $data->{package},
928 "X-$gProject-PR-Keywords" => $data->{keywords},
929 # Only have a X-$gProject-PR-Source when we know the source package
930 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
931 "Reply-To" => "$ref\@$gEmailDomain",
932 ],<<END,[]), '',undef,1);
933 Thank you for the problem report you have sent regarding $gProject.
934 This is an automatically generated reply, to let you know your message has
935 been received. It is being forwarded to the package maintainers and other
936 interested parties for their attention; they will reply in due course.
938 If you wish to submit further information on your problem, please send
939 it to $ref\@$gEmailDomain (and *not* to
940 $baddress\@$gEmailDomain).
942 If you have filed this report in error and wish to close it, please
943 send mail to $ref-done\@$gEmailDomain with an explanation
944 why the bug report should be closed.
946 Please do not reply to the address at the top of this message,
947 unless you wish to report a problem with the $gBug-tracking system.
950 (administrator, $gProject $gBugs database)
953 } elsif ($codeletter ne 'U' and
954 $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/) {
955 &htmllog("Acknowledgement","sent",$replyto,
956 ($veryquiet ? "Extra info received and filed, but not forwarded." :
957 $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
958 "Extra info received and forwarded to list."). $htmlbreak);
960 &sendmessage(create_mime_message(
961 ["X-Loop" => "$gMaintainerEmail",
962 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
964 Subject => "$gBug#$ref: Info received and FILED only (was $subject)",
965 "Message-ID" => "<handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>",
966 "In-Reply-To" => $header{'message-id'},
967 References => $header{'message-id'},
968 Precedence => 'bulk',
969 "X-$gProject-PR-Message" => "ack-info-quiet $ref",
970 "X-$gProject-PR-Package" => $data->{package},
971 "X-$gProject-PR-Keywords" => $data->{keywords},
972 # Only have a X-$gProject-PR-Source when we know the source package
973 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
974 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
975 ],<<END,[]), '',undef,1);
976 Thank you for the additional information you have supplied regarding
977 this problem report. It has NOT been forwarded to the package
978 maintainers, but will accompany the original report in the $gBug
979 tracking system. Please ensure that you yourself have sent a copy of
980 the additional information to any relevant developers or mailing lists.
982 If you wish to continue to submit further information on this problem,
983 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
985 Please do not reply to the address at the top of this message,
986 unless you wish to report a problem with the $gBug-tracking system.
989 (administrator, $gProject $gBugs database)
992 elsif ($codeletter eq 'M') {
993 &sendmessage(create_mime_message(
994 ["X-Loop" => "$gMaintainerEmail",
995 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
997 Subject => "$gBug#$ref: Info received for maintainer only (was $subject)",
998 "Message-ID" => "<handler.$ref.$nn.ackinfomaint\@$gEmailDomain>",
999 "In-Reply-To" => $header{'message-id'},
1000 References => "$header{'message-id'} $data->{msgid}",
1001 Precedence => 'bulk',
1002 "X-$gProject-PR-Message" => "ack-info-maintonly $ref",
1003 "X-$gProject-PR-Package" => $data->{package},
1004 "X-$gProject-PR-Keywords" => $data->{keywords},
1005 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
1006 ],<<END,[]), '',undef,1);
1007 Thank you for the additional information you have supplied regarding
1008 this problem report. It has been forwarded to the package maintainer(s)
1009 (but not to other interested parties) to accompany the original report.
1011 If you wish to continue to submit further information on this problem,
1012 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
1014 Please do not reply to the address at the top of this message,
1015 unless you wish to report a problem with the $gBug-tracking system.
1018 (administrator, $gProject $gBugs database)
1022 &sendmessage(create_mime_message(
1023 ["X-Loop" => "$gMaintainerEmail",
1024 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
1026 Subject => "$gBug#$ref: Info received ($subject)",
1027 "Message-ID" => "<handler.$ref.$nn.ackinfo\@$gEmailDomain>",
1028 "In-Reply-To" => $header{'message-id'},
1029 References => "$header{'message-id'} $data->{msgid}",
1030 Precedence => 'bulk',
1031 "X-$gProject-PR-Message" => "ack-info $ref",
1032 "X-$gProject-PR-Package" => $data->{package},
1033 "X-$gProject-PR-Keywords" => $data->{keywords},
1034 # Only have a X-$gProject-PR-Source when we know the source package
1035 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
1036 "Reply-To" => "$ref\@$gEmailDomain",
1037 ],<<END,[]), '',undef,1);
1038 Thank you for the additional information you have supplied regarding
1039 this problem report. It has been forwarded to the package maintainer(s)
1040 and to other interested parties to accompany the original report.
1042 If you wish to continue to submit further information on this problem,
1043 please send it to $ref\@$gEmailDomain, as before.
1045 Please do not reply to the address at the top of this message,
1046 unless you wish to report a problem with the $gBug-tracking system.
1049 (administrator, $gProject $gBugs database)
1061 open(NEW,">$f.new") || &quit("$f.new: create: $!");
1062 print(NEW "$v") || &quit("$f.new: write: $!");
1063 close(NEW) || &quit("$f.new: close: $!");
1064 rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
1068 my $hash = get_hashname($ref);
1069 if (!open(AP,">>db-h/$hash/$ref.log")) {
1070 print DEBUG "failed open log<\n";
1071 print DEBUG "failed open log err $!<\n";
1072 &quit("opening db-h/$hash/$ref.log (li): $!");
1074 print(AP "\7\n",escape_log(@log),"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
1075 close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
1079 utime(time,time,"db");
1081 while ($u= $cleanups[$#cleanups]) { &$u; }
1082 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1086 &quit("wot no exit");
1089 local ($whatobj,$whatverb,$where,$desc) = @_;
1090 my $hash = get_hashname($ref);
1091 open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
1094 "<strong>$whatobj $whatverb</strong>".
1095 ($where eq '' ? "" : " to <code>".html_escape($where)."</code>").
1097 "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
1098 close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
1105 while ($msg =~ s/(.*\n)//) {
1112 # strip continuation lines too
1127 send_message($the_message,\@recipients,\@bcc,$do_not_encode)
1129 The first argument is the scalar message, the second argument is the
1130 arrayref of recipients, the third is the arrayref of Bcc:'ed
1133 The final argument turns off header encoding and the addition of the
1134 X-Loop header if true, defaults to false.
1140 my ($msg,$recips,$bcc,$no_encode) = @_;
1141 if (not defined $recips or (!ref($recips) && $recips eq '')
1145 # This is suboptimal. The right solution is to send headers
1146 # separately from the rest of the message and encode them rather
1148 $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
1149 # The original message received is written out in appendlog, so
1150 # before writing out the other messages we've sent out, we need to
1151 # RFC1522 encode the header.
1152 $msg = encode_headers($msg) unless $no_encode;
1154 my $hash = get_hashname($ref);
1155 #save email to the log
1156 open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
1157 print(AP "\2\n",join("\4",@$recips),"\n\5\n",
1158 escape_log(stripbccs($msg)),"\n\3\n") ||
1159 &quit("writing db-h/$hash/$ref.log (lo): $!");
1160 close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
1163 shift @$recips if $recips->[0] eq '-t';
1164 push @$recips, @$bcc;
1167 send_mail_message(message => $msg,
1168 # Because we encode the headers above, we do not want to encode them here
1169 encode_headers => 0,
1170 recipients => $recips);
1173 my $maintainerschecked = 0;
1174 sub checkmaintainers {
1175 return if $maintainerschecked++;
1176 return if !length($data->{package});
1177 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1181 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1182 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1183 # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1184 $maintainerof{$a}= $2;
1187 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1191 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1192 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1193 # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1194 $maintainerof{$a}= $2;
1197 open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
1199 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1205 $anymaintfound=0; $anymaintnotfound=0;
1206 for $p (split(m/[ \t?,():]+/,$data->{package})) {
1208 $p =~ /([a-z0-9.+-]+)/;
1210 next unless defined $p;
1211 if (defined $gSubscriptionDomain) {
1212 if (defined($pkgsrc{$p})) {
1213 push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
1215 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1218 if (defined($maintainerof{$p})) {
1219 print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
1220 $addmaint= $maintainerof{$p};
1221 push(@maintaddrs,$addmaint) unless
1222 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
1225 print DEBUG "maintainer none >$p<\n";
1226 push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1227 $anymaintnotfound++;
1232 if (length $data->{owner}) {
1233 print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
1234 $addmaint = $data->{owner};
1235 push(@maintaddrs, $addmaint) unless
1236 $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1240 =head2 bug_list_forward
1242 bug_list_forward($spool_filename) if $codeletter eq 'L';
1245 Given the spool file, will forward a bug to the per bug mailing list
1246 subscription system.
1250 sub bug_list_forward{
1252 # Read the bug information and package information for passing to
1254 my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
1255 my ($bfound, $data)= lockreadbugmerge($bug_number);
1256 my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!";
1259 my $bug_message = <$bug_fh>;
1260 my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
1261 my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
1262 if (not defined $envelope_from) {
1263 # Try to use the From: header or something to set it
1264 ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
1265 # Kludgy, and should really be using a full scale header
1266 # parser to do this.
1267 $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
1269 my ($header,$body) = split /\n\n/, $bug_message, 2;
1270 # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
1271 $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
1272 qq(X-$gProject-PR-Package: $data->{package}\n).
1273 qq(X-$gProject-PR-Title: $data->{subject})
1275 print STDERR "Tried to loop me with $envelope_from\n"
1276 and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
1277 print DEBUG $envelope_from,qq(\n);
1278 # If we don't have a bug address, something has gone horribly wrong.
1279 print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
1280 $bug_address =~ s/\@.+//;
1281 print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
1282 print DEBUG $header.qq(\n\n).$body;
1283 send_mail_message(message => $header.qq(\n\n).$body,
1284 recipients => ["bugs=$bug_address\@$gListDomain"],
1285 envelope_from => $envelope_from,
1286 encode_headers => 0,
1288 unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");