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 HTML::Entities qw(encode_entities);
17 # TODO DLA; needs config reworking and errorlib reworking
21 use Debbugs::Status qw(:versions);
22 use Debbugs::Config qw(:globals);
23 my $lib_path = $gLibPath;
25 require "$lib_path/errorlib";
26 $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'};
28 chdir( "$gSpoolDir" ) || die "chdir spool: $!\n";
30 #open(DEBUG,"> /tmp/debbugs.debug");
32 open DEBUG, ">/dev/null";
34 my $intdate = time or quit("failed to get time: $!");
37 m/^([BMQFDUL])(\d*)\.\d+$/ or quit("bad argument: $_");
39 my $tryref= length($2) ? $2 : -1;
42 if (!rename("incoming/G$nn","incoming/P$nn"))
44 $_=$!.''; m/no such file or directory/i && exit 0;
45 &quit("renaming to lock: $!");
48 my $baddress= 'submit' if $codeletter eq 'B';
49 $baddress= 'maintonly' if $codeletter eq 'M';
50 $baddress= 'quiet' if $codeletter eq 'Q';
51 $baddress= 'forwarded' if $codeletter eq 'F';
52 $baddress= 'done' if $codeletter eq 'D';
53 $baddress= 'submitter' if $codeletter eq 'U';
54 bug_list_forward($nn) if $codeletter eq 'L';
55 $baddress || &quit("bad codeletter $codeletter");
56 my $baddressroot= $baddress;
57 $baddress= "$tryref-$baddress" if $tryref>=0;
59 open(M,"incoming/P$nn");
66 print DEBUG "###\n",join("##\n",@msg),"\n###\n";
68 my $tdate = strftime "%a, %d %h %Y %T +0000", gmtime;
70 Received: via spool by $baddress\@$gEmailDomain id=$nn
71 (code $codeletter ref $tryref); $tdate
74 # header and decoded body respectively
75 my (@headerlines, @bodylines);
77 my $parser = new MIME::Parser;
78 mkdir "$gSpoolDir/mime.tmp", 0777;
79 $parser->output_under("$gSpoolDir/mime.tmp");
80 my $entity = eval { $parser->parse_data(join('',@log)) };
83 if ($entity and $entity->head->tags) {
84 @headerlines = @{$entity->head->header};
87 my $entity_body = getmailbody($entity);
88 @bodylines = $entity_body ? $entity_body->as_lines() : ();
91 # set $i to beginning of encoded body data, so we can dump it out
94 ++$i while $msg[$i] =~ /./;
96 # Legacy pre-MIME code, kept around in case MIME::Parser fails.
97 for ($i = 0; $i <= $#msg; $i++) {
99 last unless length($_);
100 while ($msg[$i+1] =~ m/^\s/) {
104 push @headerlines, $_;
107 @bodylines = @msg[$i..$#msg];
112 for my $hdr (@headerlines) {
113 $hdr = decode_rfc1522($hdr);
116 &finish if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail";
117 my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i
118 && !m/^From / && !m/^X-Debbugs-/i;
119 $fwd .= $hdr."\n" if $ins;
120 # print DEBUG ">$_<\n";
121 if (s/^(\S+):\s*//) {
123 print DEBUG ">$v=$_<\n";
126 print DEBUG "!>$_<\n";
131 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
133 # Strip off RFC2440-style PGP clearsigning.
134 if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) {
135 shift @bodylines while @bodylines and length $bodylines[0];
136 shift @bodylines while @bodylines and $bodylines[0] !~ /\S/;
137 for my $findsig (0 .. $#bodylines) {
138 if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) {
139 $#bodylines = $findsig - 1;
143 map { s/^- // } @bodylines;
146 # extract pseudo-headers
147 for my $phline (@bodylines)
149 last if $phline !~ m/^([\w-]+):\s*(\S.*)/;
150 my ($fn, $fv) = ($1, $2);
152 print DEBUG ">$fn|$fv|\n";
154 # Don't lc owner or forwarded
155 $fv = lc $fv unless $fh =~ /^(?:owner|forwarded|usertags|version|source-version)$/;
157 print DEBUG ">$fn~$fv<\n";
160 # Allow pseudo headers to set x-debbugs- stuff [#179340]
161 for my $key (grep /X-Debbugs-.*/i, keys %pheader) {
162 $header{$key} = $pheader{$key} if not exists $header{$key};
165 $fwd .= join("\n",@msg[$i..$#msg]);
167 print DEBUG "***\n$fwd\n***\n";
169 if (defined $header{'resent-from'} && !defined $header{'from'}) {
170 $header{'from'} = $header{'resent-from'};
172 defined($header{'from'}) || &quit("no From header");
174 my $replyto = $header{'reply-to'};
175 $replyto = '' unless defined $replyto;
178 unless (length $replyto) {
179 $replyto = $header{'from'};
182 my $subject = '(no subject)';
183 if (!defined($header{'subject'}))
187 Your message did not contain a Subject field. They are recommended and
188 useful because the title of a $gBug is determined using this field.
189 Please remember to include a Subject field in your messages in future.
193 $subject= $header{'subject'};
197 $subject =~ s/^Re:\s*//i; $_= $subject."\n";
198 if ($tryref < 0 && m/^Bug ?\#(\d+)\D/i) {
204 ($bfound, $data)= &lockreadbugmerge($tryref);
208 &htmllog("Reply","sent", $replyto,"Unknown problem report number <code>$tryref</code>.");
209 my $archivenote = '';
211 $archivenote = <<END;
212 This may be because that $gBug report has been resolved for more than $gRemoveAge
213 days, and the record of it has been archived and made read-only, or
214 because you mistyped the $gBug report number.
218 &sendmessage(<<END, '');
219 From: $gMaintainerEmail ($gProject $gBug Tracking System)
221 Subject: Unknown problem report $gBug#$tryref ($subject)
222 Message-ID: <handler.x.$nn.unknown\@$gEmailDomain>
223 In-Reply-To: $header{'message-id'}
224 References: $header{'message-id'} $data->{msgid}
226 X-$gProject-PR-Message: error
228 You sent a message to the $gBug tracking system which gave (in the
229 Subject line or encoded into the recipient at $gEmailDomain),
230 the number of a nonexistent $gBug report (#$tryref).
232 ${archivenote}Your message was dated $header{'date'} and was sent to
233 $baddress\@$gEmailDomain. It had
234 Message-ID $header{'message-id'}
235 and Subject $subject.
237 It has been filed (under junk) but otherwise ignored.
239 Please consult your records to find the correct $gBug report number, or
240 contact me, the system administrator, for assistance.
243 (administrator, $gProject $gBugs database)
245 (NB: If you are a system administrator and have no idea what I am
246 talking about this indicates a serious mail system misconfiguration
247 somewhere. Please contact me immediately.)
254 &filelock('lock/-1');
257 # Attempt to determine which source package this is
258 my $source_pr_header = '';
259 my $source_package = '';
260 if (defined $pheader{source}) {
261 $source_package = $pheader{source};
263 elsif (defined $data->{package} or defined $pheader{package}) {
264 my $pkg_src = getpkgsrc();
265 $source_package = $pkg_src->{defined $data->{package}?$data->{package}:$pheader{package}};
267 $source_pr_header = "X-$gProject-PR-Source: $source_package\n"
268 if defined $source_package and length $source_package;
270 # Done and Forwarded Bugs
271 if ($codeletter eq 'D' || $codeletter eq 'F')
273 if ($replyto =~ m/$gBounceFroms/o ||
274 $header{'from'} =~ m/$gBounceFroms/o)
276 &quit("bounce detected ! Mwaap! Mwaap!");
278 $markedby= $header{'from'} eq $replyto ? $replyto :
279 "$header{'from'} (reply to $replyto)";
281 if ($codeletter eq 'F') { # Forwarded
282 (&appendlog,&finish) if length($data->{forwarded});
283 $receivedat= "forwarded\@$gEmailDomain";
284 $markaswhat= 'forwarded';
285 $set_forwarded= $header{'to'};
286 # Dissallow forwarded being set to this bug tracking system
287 if (defined $set_forwarded and $set_forwarded =~ /\Q$gEmailDomain\E/) {
288 undef $set_forwarded;
290 if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
291 push @generalcc, "$gForwardList\@$gListDomain";
292 $generalcc= "$gForwardList\@$gListDomain";
297 if (length($data->{done}) and
298 not defined $pheader{'source-version'} and
299 not defined $pheader{'version'}) {
303 $receivedat= "done\@$gEmailDomain";
305 $set_done= $header{'from'};
306 if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
307 $generalcc= "$gDoneList\@$gListDomain";
308 push @generalcc, "$gDoneList\@$gListDomain";
313 if (defined $gStrongList and isstrongseverity($data->{severity})) {
314 $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
315 push @generalcc,"$gStrongList\@$gListDomain";
318 &htmllog("Warning","sent",$replyto,"Message ignored.");
319 &sendmessage(<<END, '');
320 From: $gMaintainerEmail ($gProject $gBug Tracking System)
322 Subject: Message with no $gBug number ignored by $receivedat
324 Message-ID: <header.x.$nn.warnignore\@$gEmailDomain>
325 In-Reply-To: $header{'message-id'}
326 References: $header{'message-id'} $data->{msgid}
328 X-$gProject-PR-Message: error
330 You sent a message to the $gProject $gBug tracking system old-style
331 unified mark as $markaswhat address ($receivedat),
332 without a recognisable $gBug number in the Subject.
333 Your message has been filed under junk but otherwise ignored.
335 If you don't know what I'm talking about then probably either:
337 (a) you unwittingly sent a message to done\@$gEmailDomain
338 because you replied to all recipients of the message a developer used
339 to mark a $gBug as done and you modified the Subject. In this case,
340 please do not be alarmed. To avoid confusion do not do it again, but
341 there is no need to apologise or mail anyone asking for an explanation.
343 (b) you are a system administrator, reading this because the $gBug
344 tracking system is responding to a misdirected bounce message. In this
345 case there is a serious mail system misconfiguration somewhere - please
346 contact me immediately.
348 Your message was dated $header{'date'} and had
349 message-id $header{'message-id'}
350 and subject $subject.
352 If you need any assistance or explanation please contact me.
355 (administrator, $gProject $gBugs database)
364 my @noticecc = grep($_ ne $replyto,@maintaddrs);
365 $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
366 $noticeccval =~ s/\s+\n\s+/ /g;
367 $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
369 @process= ($ref,split(/ /,$data->{mergedwith}));
372 for $ref (@process) {
373 if ($ref != $orgref) {
375 $data = &lockreadbug($ref)
376 || die "huh ? $ref from $orgref out of @process";
378 $data->{done}= $set_done if defined($set_done);
379 $data->{forwarded}= $set_forwarded if defined($set_forwarded);
380 if ($codeletter eq 'D') {
381 $data->{keywords} = join ' ', grep $_ ne 'pending',
382 split ' ', $data->{keywords};
383 if (defined $pheader{'source-version'}) {
384 addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
385 } elsif (defined $pheader{version}) {
386 addfixedversions($data, $pheader{package}, $pheader{version}, 'binary');
390 # Add bug mailing list to $generalbcc as appropriate
391 # This array is used to specify bcc in the cases where we're using create_mime_message.
392 my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
393 my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
394 $generalbcc =~ s/\s+\n\s+/ /g;
395 $generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
396 if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
398 writebug($ref, $data);
400 my $hash = get_hashname($ref);
401 open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!");
402 $x= join('',<O>); close(O);
403 if ($codeletter eq 'F') {
404 &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
405 &sendmessage(create_mime_message(
406 ["X-Loop" => "$gMaintainerEmail",
407 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
409 Subject => "$gBug#$ref: marked as forwarded ($data->{subject})",
410 "Message-ID" => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
411 "In-Reply-To" => $header{'message-id'},
412 References => "$header{'message-id'} $data->{msgid}",
413 Precedence => 'bulk',
414 "X-$gProject-PR-Message" => "forwarded $ref",
415 "X-$gProject-PR-Package" => $data->{package},
416 "X-$gProject-PR-Keywords" => $data->{keywords},
417 # Only have a X-$gProject-PR-Source when we know the source package
418 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
419 ],<<END ,[join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
420 Your message dated $header{'date'}
421 with message-id $header{'message-id'}
422 has caused the $gProject $gBug report #$ref,
423 regarding $data->{subject}
424 to be marked as having been forwarded to the upstream software
425 author(s) $data->{forwarded}.
427 (NB: If you are a system administrator and have no idea what I am
428 talking about this indicates a serious mail system misconfiguration
429 somewhere. Please contact me immediately.)
432 (administrator, $gProject $gBugs database)
437 &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
438 &sendmessage(create_mime_message(
439 ["X-Loop" => "$gMaintainerEmail",
440 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
442 Subject => "$gBug#$ref: marked as done ($data->{subject})",
443 "Message-ID" => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
444 "In-Reply-To" => $header{'message-id'},
445 References => "$header{'message-id'} $data->{msgid}",
446 Precedence => 'bulk',
447 "X-$gProject-PR-Message" => "closed $ref",
448 "X-$gProject-PR-Package" => $data->{package},
449 "X-$gProject-PR-Keywords" => $data->{keywords},
450 # Only have a X-$gProject-PR-Source when we know the source package
451 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
452 ],<<END ,[$x,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
453 Your message dated $header{'date'}
454 with message-id $header{'message-id'}
455 and subject line $subject
456 has caused the attached $gBug report to be marked as done.
458 This means that you claim that the problem has been dealt with.
459 If this is not the case it is now your responsibility to reopen the
460 $gBug report if necessary, and/or fix the problem forthwith.
462 (NB: If you are a system administrator and have no idea what I am
463 talking about this indicates a serious mail system misconfiguration
464 somewhere. Please contact me immediately.)
467 (administrator, $gProject $gBugs database)
470 &htmllog("Notification","sent",$data->{originator},
471 "$gBug acknowledged by developer.");
472 &sendmessage(create_mime_message(
473 ["X-Loop" => "$gMaintainerEmail",
474 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
475 To => "$data->{originator}",
476 Subject => "$gBug#$ref closed by $markedby ($header{'subject'})",
477 "Message-ID" => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
478 "In-Reply-To" => "$data->{msgid}",
479 References => "$header{'message-id'} $data->{msgid}",
480 "X-$gProject-PR-Message" => "they-closed $ref",
481 "X-$gProject-PR-Package" => "$data->{package}",
482 "X-$gProject-PR-Keywords" => "$data->{keywords}",
483 # Only have a X-$gProject-PR-Source when we know the source package
484 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
485 "Reply-To" => "$ref\@$gEmailDomain",
486 "Content-Type" => 'text/plain; charset="utf-8"',
487 ],<<END ,[join("\n",@msg)]),'',undef,1);
488 This is an automatic notification regarding your $gBug report
489 #$ref: $data->{subject},
490 which was filed against the $data->{package} package.
492 It has been closed by $markedby.
494 Their explanation is attached below. If this explanation is
495 unsatisfactory and you have not received a better one in a separate
496 message then please contact $markedby by replying
500 (administrator, $gProject $gBugs database)
510 if ($codeletter eq 'U') {
511 &htmllog("Warning","sent",$replyto,"Message not forwarded.");
512 &sendmessage(<<END, '');
513 From: $gMaintainerEmail ($gProject $gBug Tracking System)
515 Subject: Message with no $gBug number cannot be sent to submitter !
517 Message-ID: <handler.x.$nn.nonumnosub\@$gEmailDomain>
518 In-Reply-To: $header{'message-id'}
519 References: $header{'message-id'} $data->{msgid}
521 X-$gProject-PR-Message: error
523 You sent a message to the $gProject $gBug tracking system's $gBug
524 report submitter address $baddress\@$gEmailDomain, without a
525 recognisable $gBug number in the Subject. Your message has been filed
526 under junk but otherwise ignored.
528 If you don't know what I'm talking about then probably either:
530 (a) you unwittingly sent a message to $baddress\@$gEmailDomain
531 because you replied to all recipients of the message a developer sent
532 to a $gBug\'s submitter and you modified the Subject. In this case,
533 please do not be alarmed. To avoid confusion do not do it again, but
534 there is no need to apologise or mail anyone asking for an
537 (b) you are a system administrator, reading this because the $gBug
538 tracking system is responding to a misdirected bounce message. In this
539 case there is a serious mail system misconfiguration somewhere - please
540 contact me immediately.
542 Your message was dated $header{'date'} and had
543 message-id $header{'message-id'}
544 and subject $subject.
546 If you need any assistance or explanation please contact me.
549 (administrator, $gProject $gBugs database)
556 $data->{found_versions} = [];
557 $data->{fixed_versions} = [];
559 if (defined $pheader{source}) {
560 $data->{package} = $pheader{source};
561 } elsif (defined $pheader{package}) {
562 $data->{package} = $pheader{package};
564 &htmllog("Warning","sent",$replyto,"Message not forwarded.");
565 &sendmessage(create_mime_message(
566 ["X-Loop" => "$gMaintainerEmail",
567 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
569 Subject => "Message with no Package: tag cannot be processed! ($subject)",
570 "Message-ID" => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
571 "In-Reply-To" => $header{'message-id'},
572 References => "$header{'message-id'} $data->{msgid}",
573 Precedence => 'bulk',
574 "X-$gProject-PR-Message" => 'error'
575 ],<<END,[join("\n", @msg)]), '',undef,1);
577 Your message didn't have a Package: line at the start (in the
578 pseudo-header following the real mail header), or didn't have a
579 pseudo-header at all. Your message has been filed under junk but
582 This makes it much harder for us to categorise and deal with your
583 problem report. Please _resubmit_ your report to $baddress\@$gEmailDomain
584 and tell us which package the report is on. For help, check out
585 http://$gWebDomain/Reporting$gHTMLSuffix.
587 Your message was dated $header{'date'} and had
588 message-id $header{'message-id'}
589 and subject $subject.
590 The complete text of it is attached to this message.
592 If you need any assistance or explanation please contact me.
595 (administrator, $gProject $gBugs database)
602 $data->{keywords}= '';
603 if (defined($pheader{'keywords'})) {
604 $data->{keywords}= $pheader{'keywords'};
605 } elsif (defined($pheader{'tags'})) {
606 $data->{keywords}= $pheader{'tags'};
608 if (length($data->{keywords})) {
610 my %gkws = map { ($_, 1) } @gTags;
611 foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
612 push @kws, $kw if (defined $gkws{$kw});
614 $data->{keywords} = join(" ", @kws);
616 $data->{severity}= '';
617 if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
618 $data->{severity}= $pheader{'severity'};
619 $data->{severity}= $pheader{'priority'} unless ($data->{severity});
620 $data->{severity} =~ s/^\s*(.+)\s*$/$1/;
622 if (!grep($_ eq $data->{severity}, @severities, "$gDefaultSeverity")) {
625 Your message specified a Severity: in the pseudo-header, but
626 the severity value $data->{severity} was not recognised.
627 The default severity $gDefaultSeverity is being used instead.
628 The recognised values are: $gShowSeverities.
630 # if we use @gSeverityList array in the above line, perl -c gives:
631 # In string, @gSeverityList now must be written as \@gSeverityList at
632 # process line 452, near "$gDefaultSeverity is being used instead.
633 $data->{severity}= '';
636 if (defined($pheader{owner})) {
637 $data->{owner}= $pheader{owner};
639 if (defined($pheader{forwarded})) {
640 $data->{'forwarded-to'} = $pheader{forwarded};
642 &filelock("nextnumber.lock");
643 open(N,"nextnumber") || &quit("nextnumber: read: $!");
644 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
645 $ref= $v+0; $v += 1; $newref=1;
646 &overwrite('nextnumber', "$v\n");
648 my $hash = get_hashname($ref);
649 &overwrite("db-h/$hash/$ref.log",'');
650 $data->{originator} = $replyto;
651 $data->{date} = $intdate;
652 $data->{subject} = $subject;
653 $data->{msgid} = $header{'message-id'};
654 writebug($ref, $data);
656 if (exists $pheader{usertags}) {
658 $user = $pheader{user} if exists $pheader{user};
660 $user =~ s/^.*<(.*)>.*$/$1/;
661 $user =~ s/[(].*[)]//;
662 $user =~ s/^\s*(\S+)\s+.*$/$1/;
663 if ($user ne '' and Debbugs::User::is_valid_user($user)) {
664 $pheader{usertags} =~ s/(?:^\s+|\s+$)//g;
666 read_usertags(\%user_tags,$user);
667 for my $tag (split /[,\s]+/, $pheader{usertags}) {
668 if ($tag =~ /^[a-zA-Z0-9.+\@-]+/) {
670 @bugs_with_tag{@{$user_tags{$tag}}} = (1) x @{$user_tags{$tag}};
671 $bugs_with_tag{$ref} = 1;
672 $user_tags{$tag} = [keys %bugs_with_tag];
675 write_usertags(\%user_tags,$user);
679 Your message tried to set a usertag, but didn't have a valid
680 user set ('$user' isn't valid)
684 &overwrite("db-h/$hash/$ref.report",
685 join("\n",@msg)."\n");
690 print DEBUG "maintainers >@maintaddrs<\n";
692 $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
693 $newsubject= $subject; $newsubject =~ s/^$gBug#$ref:*\s*//;
695 $xcchdr= $header{ 'x-debbugs-cc' };
696 if ($xcchdr =~ m/\S/) {
697 push(@resentccs,$xcchdr);
698 $resentccexplain.= <<END;
700 As you requested using X-Debbugs-CC, your message was also forwarded to
702 (after having been given a $gBug report number, if it did not have one).
706 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
707 push(@resentccs,@maintaddrs);
708 $resentccexplain.= <<END." ".join("\n ",@maintaddrs)."\n";
710 Your message has been sent to the package maintainer(s):
714 @bccs = @addsrcaddrs;
715 if (defined $gStrongList and isstrongseverity($data->{severity})) {
716 push @bccs, "$gStrongList\@$gListDomain";
719 # Send mail to the per bug list subscription too
720 push @bccs, "bugs=$ref\@$gListDomain";
722 if (defined $pheader{source}) {
723 # Prefix source versions with the name of the source package. They
724 # appear that way in version trees so that we can deal with binary
725 # packages moving from one source package to another.
726 if (defined $pheader{'source-version'}) {
727 addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
728 } elsif (defined $pheader{version}) {
729 addfoundversions($data, $pheader{source}, $pheader{version}, '');
731 writebug($ref, $data);
732 } elsif (defined $pheader{package}) {
733 # TODO: could handle Source-Version: by looking up the source package?
734 addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
735 writebug($ref, $data);
738 $veryquiet= $codeletter eq 'Q';
739 if ($codeletter eq 'M' && !@maintaddrs) {
743 You requested that the message be sent to the package maintainer(s)
744 but either the $gBug report is not associated with any package (probably
745 because of a missing Package pseudo-header field in the original $gBug
746 report), or the package(s) specified do not have any maintainer(s).
748 Your message has *not* been sent to any package maintainers; it has
749 merely been filed in the $gBug tracking system. If you require assistance
750 please contact $gMaintainerEmail quoting the $gBug number $ref.
754 $resentccval.= join(', ',@resentccs);
755 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
756 if (length($resentccval)) {
757 $resentcc= "Resent-CC: $resentccval\n";
760 if ($codeletter eq 'U') {
761 &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
762 &sendmessage(<<END,[$data->{originator},@resentccs],[@bccs]);
763 Subject: $gBug#$ref: $newsubject
764 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
765 ${orgsender}Resent-To: $data->{originator}
766 ${resentcc}Resent-Date: $tdate
767 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
768 Resent-Sender: $gMaintainerEmail
769 X-$gProject-PR-Message: report $ref
770 X-$gProject-PR-Package: $data->{package}
771 X-$gProject-PR-Keywords: $data->{keywords}
772 ${source_pr_header}$fwd
774 } elsif ($codeletter eq 'B') { # Sent to submit
775 &htmllog($newref ? "Report" : "Information", "forwarded",
776 join(', ',"$gSubmitList\@$gListDomain",@resentccs),
777 "<code>$gBug#$ref</code>".
778 (length($data->{package})? "; Package <code>".encode_entities($data->{package})."</code>" : '').
780 &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
781 Subject: $gBug#$ref: $newsubject
782 Reply-To: $replyto, $ref\@$gEmailDomain
783 Resent-From: $header{'from'}
784 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
785 ${resentcc}Resent-Date: $tdate
786 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
787 Resent-Sender: $gMaintainerEmail
788 X-$gProject-PR-Message: report $ref
789 X-$gProject-PR-Package: $data->{package}
790 X-$gProject-PR-Keywords: $data->{keywords}
791 ${source_pr_header}$fwd
793 } elsif (@resentccs or @bccs) { # Quiet or Maintainer
794 # D and F done far earlier; B just done - so this must be M or Q
795 # We preserve whichever it was in the Reply-To (possibly adding
798 &htmllog($newref ? "Report" : "Information", "forwarded",
800 "<code>$gBug#$ref</code>".
801 (length($data->{package}) ? "; Package <code>".encode_entities($data->{package})."</code>" : '').
804 &htmllog($newref ? "Report" : "Information", "stored",
806 "<code>$gBug#$ref</code>".
807 (length($data->{package}) ? "; Package <code>".encode_entities($data->{package})."</code>" : '').
810 &sendmessage(<<END,[@resentccs],[@bccs]);
811 Subject: $gBug#$ref: $newsubject
812 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
813 Resent-From: $header{'from'}
814 ${orgsender}Resent-To: $resentccval
816 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
817 Resent-Sender: $gMaintainerEmail
818 X-$gProject-PR-Message: report $ref
819 X-$gProject-PR-Package: $data->{package}
820 X-$gProject-PR-Keywords: $data->{keywords}
821 ${source_pr_header}$fwd
825 $htmlbreak= length($brokenness) ? "<p>\n".encode_entities($brokenness)."\n<p>\n" : '';
826 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
827 if (length($resentccval)) {
828 $htmlbreak = " Copy sent to <code>".encode_entities($resentccval)."</code>.".
831 unless (exists $header{'x-debbugs-no-ack'}) {
833 &htmllog("Acknowledgement","sent",$replyto,
835 "New $gBug report received and filed, but not forwarded." :
836 "New $gBug report received and forwarded."). $htmlbreak);
838 &sendmessage(create_mime_message(
839 ["X-Loop" => "$gMaintainerEmail",
840 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
842 Subject => "$gBug#$ref: Acknowledgement of QUIET report ($subject)",
843 "Message-ID" => "<handler.$ref.$nn.ackquiet\@$gEmailDomain>",
844 "In-Reply-To" => $header{'message-id'},
845 References => $header{'message-id'},
846 Precedence => 'bulk',
847 "X-$gProject-PR-Message" => "ack-quiet $ref",
848 "X-$gProject-PR-Package" => $data->{package},
849 "X-$gProject-PR-Keywords" => $data->{keywords},
850 # Only have a X-$gProject-PR-Source when we know the source package
851 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
852 "Reply-To" => "$ref-quiet\@$gEmailDomain",
853 ],<<END,[join("\n", @msg)]), '',undef,1);
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
856 has been received. It has not been forwarded to the package maintainers
857 or other interested parties; you should ensure that the developers are
858 aware of the problem you have entered into the system - preferably
859 quoting the $gBug reference number, #$ref.
861 If you wish to submit further information on your problem, please send it
862 to $ref-$baddressroot\@$gEmailDomain (and *not*
863 to $baddress\@$gEmailDomain).
865 If you have filed this report in error and wish to close it, please
866 send mail to $ref-done\@$gEmailDomain with an explanation
867 why the bug report should be closed.
869 Please do not reply to the address at the top of this message,
870 unless you wish to report a problem with the $gBug-tracking system.
873 (administrator, $gProject $gBugs database)
876 elsif ($codeletter eq 'M') { # Maintonly
877 &sendmessage(create_mime_message(
878 ["X-Loop" => "$gMaintainerEmail",
879 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
881 Subject => "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)",
882 "Message-ID" => "<handler.$ref.$nn.ackmaint\@$gEmailDomain>",
883 "In-Reply-To" => $header{'message-id'},
884 References => $header{'message-id'},
885 Precedence => 'bulk',
886 "X-$gProject-PR-Message" => "ack-maintonly $ref",
887 "X-$gProject-PR-Package" => $data->{package},
888 "X-$gProject-PR-Keywords" => $data->{keywords},
889 # Only have a X-$gProject-PR-Source when we know the source package
890 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
891 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
892 ],<<END,[]), '',undef,1);
893 Thank you for the problem report you have sent regarding $gProject.
894 This is an automatically generated reply, to let you know your message has
895 been received. It is being forwarded to the package maintainers (but not
896 other interested parties, as you requested) for their attention; they will
899 If you wish to submit further information on your problem, please send
900 it to $ref-$baddressroot\@$gEmailDomain (and *not*
901 to $baddress\@$gEmailDomain).
903 If you have filed this report in error and wish to close it, please
904 send mail to $ref-done\@$gEmailDomain with an explanation
905 why the bug report should be closed.
907 Please do not reply to the address at the top of this message,
908 unless you wish to report a problem with the $gBug-tracking system.
911 (administrator, $gProject $gBugs database)
915 &sendmessage(create_mime_message(
916 ["X-Loop" => "$gMaintainerEmail",
917 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
919 Subject => "$gBug#$ref: Acknowledgement ($subject)",
920 "Message-ID" => "<handler.$ref.$nn.ack\@$gEmailDomain>",
921 "In-Reply-To" => $header{'message-id'},
922 References => $header{'message-id'},
923 Precedence => 'bulk',
924 "X-$gProject-PR-Message" => "ack $ref",
925 "X-$gProject-PR-Package" => $data->{package},
926 "X-$gProject-PR-Keywords" => $data->{keywords},
927 # Only have a X-$gProject-PR-Source when we know the source package
928 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
929 "Reply-To" => "$ref\@$gEmailDomain",
930 ],<<END,[]), '',undef,1);
931 Thank you for the problem report you have sent regarding $gProject.
932 This is an automatically generated reply, to let you know your message has
933 been received. It is being forwarded to the package maintainers and other
934 interested parties for their attention; they will reply in due course.
936 If you wish to submit further information on your problem, please send
937 it to $ref\@$gEmailDomain (and *not* to
938 $baddress\@$gEmailDomain).
940 If you have filed this report in error and wish to close it, please
941 send mail to $ref-done\@$gEmailDomain with an explanation
942 why the bug report should be closed.
944 Please do not reply to the address at the top of this message,
945 unless you wish to report a problem with the $gBug-tracking system.
948 (administrator, $gProject $gBugs database)
951 } elsif ($codeletter ne 'U' and
952 $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/) {
953 &htmllog("Acknowledgement","sent",$replyto,
954 ($veryquiet ? "Extra info received and filed, but not forwarded." :
955 $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
956 "Extra info received and forwarded to list."). $htmlbreak);
958 &sendmessage(create_mime_message(
959 ["X-Loop" => "$gMaintainerEmail",
960 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
962 Subject => "$gBug#$ref: Info received and FILED only (was $subject)",
963 "Message-ID" => "<handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>",
964 "In-Reply-To" => $header{'message-id'},
965 References => $header{'message-id'},
966 Precedence => 'bulk',
967 "X-$gProject-PR-Message" => "ack-info-quiet $ref",
968 "X-$gProject-PR-Package" => $data->{package},
969 "X-$gProject-PR-Keywords" => $data->{keywords},
970 # Only have a X-$gProject-PR-Source when we know the source package
971 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
972 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
973 ],<<END,[]), '',undef,1);
974 Thank you for the additional information you have supplied regarding
975 this problem report. It has NOT been forwarded to the package
976 maintainers, but will accompany the original report in the $gBug
977 tracking system. Please ensure that you yourself have sent a copy of
978 the additional information to any relevant developers or mailing lists.
980 If you wish to continue to submit further information on this problem,
981 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
983 Please do not reply to the address at the top of this message,
984 unless you wish to report a problem with the $gBug-tracking system.
987 (administrator, $gProject $gBugs database)
990 elsif ($codeletter eq 'M') {
991 &sendmessage(create_mime_message(
992 ["X-Loop" => "$gMaintainerEmail",
993 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
995 Subject => "$gBug#$ref: Info received for maintainer only (was $subject)",
996 "Message-ID" => "<handler.$ref.$nn.ackinfomaint\@$gEmailDomain>",
997 "In-Reply-To" => $header{'message-id'},
998 References => "$header{'message-id'} $data->{msgid}",
999 Precedence => 'bulk',
1000 "X-$gProject-PR-Message" => "ack-info-maintonly $ref",
1001 "X-$gProject-PR-Package" => $data->{package},
1002 "X-$gProject-PR-Keywords" => $data->{keywords},
1003 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
1004 ],<<END,[]), '',undef,1);
1005 Thank you for the additional information you have supplied regarding
1006 this problem report. It has been forwarded to the package maintainer(s)
1007 (but not to other interested parties) to accompany the original report.
1009 If you wish to continue to submit further information on this problem,
1010 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
1012 Please do not reply to the address at the top of this message,
1013 unless you wish to report a problem with the $gBug-tracking system.
1016 (administrator, $gProject $gBugs database)
1020 &sendmessage(create_mime_message(
1021 ["X-Loop" => "$gMaintainerEmail",
1022 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
1024 Subject => "$gBug#$ref: Info received ($subject)",
1025 "Message-ID" => "<handler.$ref.$nn.ackinfo\@$gEmailDomain>",
1026 "In-Reply-To" => $header{'message-id'},
1027 References => "$header{'message-id'} $data->{msgid}",
1028 Precedence => 'bulk',
1029 "X-$gProject-PR-Message" => "ack-info $ref",
1030 "X-$gProject-PR-Package" => $data->{package},
1031 "X-$gProject-PR-Keywords" => $data->{keywords},
1032 # Only have a X-$gProject-PR-Source when we know the source package
1033 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
1034 "Reply-To" => "$ref\@$gEmailDomain",
1035 ],<<END,[]), '',undef,1);
1036 Thank you for the additional information you have supplied regarding
1037 this problem report. It has been forwarded to the package maintainer(s)
1038 and to other interested parties to accompany the original report.
1040 If you wish to continue to submit further information on this problem,
1041 please send it to $ref\@$gEmailDomain, as before.
1043 Please do not reply to the address at the top of this message,
1044 unless you wish to report a problem with the $gBug-tracking system.
1047 (administrator, $gProject $gBugs database)
1059 open(NEW,">$f.new") || &quit("$f.new: create: $!");
1060 print(NEW "$v") || &quit("$f.new: write: $!");
1061 close(NEW) || &quit("$f.new: close: $!");
1062 rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
1066 my $hash = get_hashname($ref);
1067 if (!open(AP,">>db-h/$hash/$ref.log")) {
1068 print DEBUG "failed open log<\n";
1069 print DEBUG "failed open log err $!<\n";
1070 &quit("opening db-h/$hash/$ref.log (li): $!");
1072 print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
1073 close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
1077 utime(time,time,"db");
1079 while ($u= $cleanups[$#cleanups]) { &$u; }
1080 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1084 &quit("wot no exit");
1087 local ($whatobj,$whatverb,$where,$desc) = @_;
1088 my $hash = get_hashname($ref);
1089 open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
1092 "<strong>$whatobj $whatverb</strong>".
1093 ($where eq '' ? "" : " to <code>".encode_entities($where)."</code>").
1095 "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
1096 close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
1103 while ($msg =~ s/(.*\n)//) {
1110 # strip continuation lines too
1125 send_message($the_message,\@recipients,\@bcc,$do_not_encode)
1127 The first argument is the scalar message, the second argument is the
1128 arrayref of recipients, the third is the arrayref of Bcc:'ed
1131 The final argument turns off header encoding and the addition of the
1132 X-Loop header if true, defaults to false.
1138 my ($msg,$recips,$bcc,$no_encode) = @_;
1139 if (not defined $recips or (!ref($recips) && $recips eq '')
1143 # This is suboptimal. The right solution is to send headers
1144 # separately from the rest of the message and encode them rather
1146 $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
1147 # The original message received is written out in appendlog, so
1148 # before writing out the other messages we've sent out, we need to
1149 # RFC1522 encode the header.
1150 $msg = encode_headers($msg) unless $no_encode;
1152 my $hash = get_hashname($ref);
1153 #save email to the log
1154 open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
1155 print(AP "\2\n",join("\4",@$recips),"\n\5\n",
1156 @{escapelog(stripbccs($msg))},"\n\3\n") ||
1157 &quit("writing db-h/$hash/$ref.log (lo): $!");
1158 close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
1161 shift @$recips if $recips->[0] eq '-t';
1162 push @$recips, @$bcc;
1165 send_mail_message(message => $msg,
1166 # Because we encode the headers above, we do not want to encode them here
1167 encode_headers => 0,
1168 recipients => $recips);
1171 my $maintainerschecked = 0;
1172 sub checkmaintainers {
1173 return if $maintainerschecked++;
1174 return if !length($data->{package});
1175 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1179 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1180 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1181 # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1182 $maintainerof{$a}= $2;
1185 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1189 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1190 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1191 # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1192 $maintainerof{$a}= $2;
1195 open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
1197 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1203 $anymaintfound=0; $anymaintnotfound=0;
1204 for $p (split(m/[ \t?,():]+/,$data->{package})) {
1206 $p =~ /([a-z0-9.+-]+)/;
1208 next unless defined $p;
1209 if (defined $gSubscriptionDomain) {
1210 if (defined($pkgsrc{$p})) {
1211 push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
1213 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1216 if (defined($maintainerof{$p})) {
1217 print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
1218 $addmaint= $maintainerof{$p};
1219 push(@maintaddrs,$addmaint) unless
1220 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
1223 print DEBUG "maintainer none >$p<\n";
1224 push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1225 $anymaintnotfound++;
1230 if (length $data->{owner}) {
1231 print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
1232 $addmaint = $data->{owner};
1233 push(@maintaddrs, $addmaint) unless
1234 $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1238 =head2 bug_list_forward
1240 bug_list_forward($spool_filename) if $codeletter eq 'L';
1243 Given the spool file, will forward a bug to the per bug mailing list
1244 subscription system.
1248 sub bug_list_forward{
1250 # Read the bug information and package information for passing to
1252 my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
1253 my ($bfound, $data)= lockreadbugmerge($bug_number);
1254 my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!";
1257 my $bug_message = <$bug_fh>;
1258 my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
1259 my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
1260 if (not defined $envelope_from) {
1261 # Try to use the From: header or something to set it
1262 ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
1263 # Kludgy, and should really be using a full scale header
1264 # parser to do this.
1265 $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
1267 my ($header,$body) = split /\n\n/, $bug_message, 2;
1268 # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
1269 $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
1270 qq(X-$gProject-PR-Package: $data->{package}\n).
1271 qq(X-$gProject-PR-Title: $data->{subject})
1273 print STDERR "Tried to loop me with $envelope_from\n"
1274 and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
1275 print DEBUG $envelope_from,qq(\n);
1276 # If we don't have a bug address, something has gone horribly wrong.
1277 print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
1278 $bug_address =~ s/\@.+//;
1279 print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
1280 print DEBUG $header.qq(\n\n).$body;
1281 send_mail_message(message => $header.qq(\n\n).$body,
1282 recipients => ["bugs=$bug_address\@$gListDomain"],
1283 envelope_from => $envelope_from,
1284 encode_headers => 0,
1286 unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");