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);
15 use Debbugs::User qw(read_usertags write_usertags);
17 my $config_path = '/etc/debbugs';
18 my $lib_path = '/usr/lib/debbugs';
20 # TODO DLA; needs config reworking and errorlib reworking
24 require "$config_path/config";
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)$/;
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 if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) {
287 push @generalcc, "$gForwardList\@$gListDomain";
288 $generalcc= "$gForwardList\@$gListDomain";
293 if (length($data->{done}) and
294 not defined $pheader{'source-version'} and
295 not defined $pheader{'version'}) {
299 $receivedat= "done\@$gEmailDomain";
301 $set_done= $header{'from'};
302 if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) {
303 $generalcc= "$gDoneList\@$gListDomain";
304 push @generalcc, "$gDoneList\@$gListDomain";
309 if (defined $gStrongList and isstrongseverity($data->{severity})) {
310 $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain";
311 push @generalcc,"$gStrongList\@$gListDomain";
314 &htmllog("Warning","sent",$replyto,"Message ignored.");
315 &sendmessage(<<END, '');
316 From: $gMaintainerEmail ($gProject $gBug Tracking System)
318 Subject: Message with no $gBug number ignored by $receivedat
320 Message-ID: <header.x.$nn.warnignore\@$gEmailDomain>
321 In-Reply-To: $header{'message-id'}
322 References: $header{'message-id'} $data->{msgid}
324 X-$gProject-PR-Message: error
326 You sent a message to the $gProject $gBug tracking system old-style
327 unified mark as $markaswhat address ($receivedat),
328 without a recognisable $gBug number in the Subject.
329 Your message has been filed under junk but otherwise ignored.
331 If you don't know what I'm talking about then probably either:
333 (a) you unwittingly sent a message to done\@$gEmailDomain
334 because you replied to all recipients of the message a developer used
335 to mark a $gBug as done and you modified the Subject. In this case,
336 please do not be alarmed. To avoid confusion do not do it again, but
337 there is no need to apologise or mail anyone asking for an explanation.
339 (b) you are a system administrator, reading this because the $gBug
340 tracking system is responding to a misdirected bounce message. In this
341 case there is a serious mail system misconfiguration somewhere - please
342 contact me immediately.
344 Your message was dated $header{'date'} and had
345 message-id $header{'message-id'}
346 and subject $subject.
348 If you need any assistance or explanation please contact me.
351 (administrator, $gProject $gBugs database)
360 my @noticecc = grep($_ ne $replyto,@maintaddrs);
361 $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs));
362 $noticeccval =~ s/\s+\n\s+/ /g;
363 $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//;
365 @process= ($ref,split(/ /,$data->{mergedwith}));
368 for $ref (@process) {
369 if ($ref != $orgref) {
371 $data = &lockreadbug($ref)
372 || die "huh ? $ref from $orgref out of @process";
374 $data->{done}= $set_done if defined($set_done);
375 $data->{forwarded}= $set_forwarded if defined($set_forwarded);
376 if ($codeletter eq 'D') {
377 $data->{keywords} = join ' ', grep $_ ne 'pending',
378 split ' ', $data->{keywords};
379 if (defined $pheader{'source-version'}) {
380 addfixedversions($data, $pheader{source}, $pheader{'source-version'}, '');
381 } elsif (defined $pheader{version}) {
382 addfixedversions($data, $pheader{package}, $pheader{version}, 'binary');
386 # Add bug mailing list to $generalbcc as appropriate
387 # This array is used to specify bcc in the cases where we're using create_mime_message.
388 my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain");
389 my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain");
390 $generalbcc =~ s/\s+\n\s+/ /g;
391 $generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//;
392 if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"};
394 writebug($ref, $data);
396 my $hash = get_hashname($ref);
397 open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!");
398 $x= join('',<O>); close(O);
399 if ($codeletter eq 'F') {
400 &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded.");
401 &sendmessage(create_mime_message(
402 ["X-Loop" => "$gMaintainerEmail",
403 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
405 Subject => "$gBug#$ref: marked as forwarded ($data->{subject})",
406 "Message-ID" => "<header.$ref.$nn.ackfwdd\@$gEmailDomain>",
407 "In-Reply-To" => $header{'message-id'},
408 References => "$header{'message-id'} $data->{msgid}",
409 Precedence => 'bulk',
410 "X-$gProject-PR-Message" => "forwarded $ref",
411 "X-$gProject-PR-Package" => $data->{package},
412 "X-$gProject-PR-Keywords" => $data->{keywords},
413 # Only have a X-$gProject-PR-Source when we know the source package
414 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
415 ],<<END ,[join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
416 Your message dated $header{'date'}
417 with message-id $header{'message-id'}
418 has caused the $gProject $gBug report #$ref,
419 regarding $data->{subject}
420 to be marked as having been forwarded to the upstream software
421 author(s) $data->{forwarded}.
423 (NB: If you are a system administrator and have no idea what I am
424 talking about this indicates a serious mail system misconfiguration
425 somewhere. Please contact me immediately.)
428 (administrator, $gProject $gBugs database)
433 &htmllog("Reply","sent",$replyto,"You have taken responsibility.");
434 &sendmessage(create_mime_message(
435 ["X-Loop" => "$gMaintainerEmail",
436 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
438 Subject => "$gBug#$ref: marked as done ($data->{subject})",
439 "Message-ID" => "<handler.$ref.$nn.ackdone\@$gEmailDomain>",
440 "In-Reply-To" => $header{'message-id'},
441 References => "$header{'message-id'} $data->{msgid}",
442 Precedence => 'bulk',
443 "X-$gProject-PR-Message" => "closed $ref",
444 "X-$gProject-PR-Package" => $data->{package},
445 "X-$gProject-PR-Keywords" => $data->{keywords},
446 # Only have a X-$gProject-PR-Source when we know the source package
447 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
448 ],<<END ,[$x,join("\n",@msg)]),'',[$replyto,@generalbcc,@noticecc],1);
449 Your message dated $header{'date'}
450 with message-id $header{'message-id'}
451 and subject line $subject
452 has caused the attached $gBug report to be marked as done.
454 This means that you claim that the problem has been dealt with.
455 If this is not the case it is now your responsibility to reopen the
456 $gBug report if necessary, and/or fix the problem forthwith.
458 (NB: If you are a system administrator and have no idea what I am
459 talking about this indicates a serious mail system misconfiguration
460 somewhere. Please contact me immediately.)
463 (administrator, $gProject $gBugs database)
466 &htmllog("Notification","sent",$data->{originator},
467 "$gBug acknowledged by developer.");
468 &sendmessage(create_mime_message(
469 ["X-Loop" => "$gMaintainerEmail",
470 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
471 To => "$data->{originator}",
472 Subject => "$gBug#$ref closed by $markedby ($header{'subject'})",
473 "Message-ID" => "<handler.$ref.$nn.notifdone\@$gEmailDomain>",
474 "In-Reply-To" => "$data->{msgid}",
475 References => "$header{'message-id'} $data->{msgid}",
476 "X-$gProject-PR-Message" => "they-closed $ref",
477 "X-$gProject-PR-Package" => "$data->{package}",
478 "X-$gProject-PR-Keywords" => "$data->{keywords}",
479 # Only have a X-$gProject-PR-Source when we know the source package
480 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
481 "Reply-To" => "$ref\@$gEmailDomain",
482 "Content-Type" => 'text/plain; charset="utf-8"',
483 ],<<END ,[join("\n",@msg)]),'',undef,1);
484 This is an automatic notification regarding your $gBug report
485 #$ref: $data->{subject},
486 which was filed against the $data->{package} package.
488 It has been closed by $markedby.
490 Their explanation is attached below. If this explanation is
491 unsatisfactory and you have not received a better one in a separate
492 message then please contact $markedby by replying
496 (administrator, $gProject $gBugs database)
506 if ($codeletter eq 'U') {
507 &htmllog("Warning","sent",$replyto,"Message not forwarded.");
508 &sendmessage(<<END, '');
509 From: $gMaintainerEmail ($gProject $gBug Tracking System)
511 Subject: Message with no $gBug number cannot be sent to submitter !
513 Message-ID: <handler.x.$nn.nonumnosub\@$gEmailDomain>
514 In-Reply-To: $header{'message-id'}
515 References: $header{'message-id'} $data->{msgid}
517 X-$gProject-PR-Message: error
519 You sent a message to the $gProject $gBug tracking system's $gBug
520 report submitter address $baddress\@$gEmailDomain, without a
521 recognisable $gBug number in the Subject. Your message has been filed
522 under junk but otherwise ignored.
524 If you don't know what I'm talking about then probably either:
526 (a) you unwittingly sent a message to $baddress\@$gEmailDomain
527 because you replied to all recipients of the message a developer sent
528 to a $gBug\'s submitter and you modified the Subject. In this case,
529 please do not be alarmed. To avoid confusion do not do it again, but
530 there is no need to apologise or mail anyone asking for an
533 (b) you are a system administrator, reading this because the $gBug
534 tracking system is responding to a misdirected bounce message. In this
535 case there is a serious mail system misconfiguration somewhere - please
536 contact me immediately.
538 Your message was dated $header{'date'} and had
539 message-id $header{'message-id'}
540 and subject $subject.
542 If you need any assistance or explanation please contact me.
545 (administrator, $gProject $gBugs database)
552 $data->{found_versions} = [];
553 $data->{fixed_versions} = [];
555 if (defined $pheader{source}) {
556 $data->{package} = $pheader{source};
557 } elsif (defined $pheader{package}) {
558 $data->{package} = $pheader{package};
560 &htmllog("Warning","sent",$replyto,"Message not forwarded.");
561 &sendmessage(create_mime_message(
562 ["X-Loop" => "$gMaintainerEmail",
563 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
565 Subject => "Message with no Package: tag cannot be processed! ($subject)",
566 "Message-ID" => "<handler.x.$nn.nonumnosub\@$gEmailDomain>",
567 "In-Reply-To" => $header{'message-id'},
568 References => "$header{'message-id'} $data->{msgid}",
569 Precedence => 'bulk',
570 "X-$gProject-PR-Message" => 'error'
571 ],<<END,[join("\n", @msg)]), '',undef,1);
573 Your message didn't have a Package: line at the start (in the
574 pseudo-header following the real mail header), or didn't have a
575 pseudo-header at all. Your message has been filed under junk but
578 This makes it much harder for us to categorise and deal with your
579 problem report. Please _resubmit_ your report to $baddress\@$gEmailDomain
580 and tell us which package the report is on. For help, check out
581 http://$gWebDomain/Reporting$gHTMLSuffix.
583 Your message was dated $header{'date'} and had
584 message-id $header{'message-id'}
585 and subject $subject.
586 The complete text of it is attached to this message.
588 If you need any assistance or explanation please contact me.
591 (administrator, $gProject $gBugs database)
598 $data->{keywords}= '';
599 if (defined($pheader{'keywords'})) {
600 $data->{keywords}= $pheader{'keywords'};
601 } elsif (defined($pheader{'tags'})) {
602 $data->{keywords}= $pheader{'tags'};
604 if (length($data->{keywords})) {
606 my %gkws = map { ($_, 1) } @gTags;
607 foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) {
608 push @kws, $kw if (defined $gkws{$kw});
610 $data->{keywords} = join(" ", @kws);
612 $data->{severity}= '';
613 if (defined($pheader{'severity'}) || defined($pheader{'priority'})) {
614 $data->{severity}= $pheader{'severity'};
615 $data->{severity}= $pheader{'priority'} unless ($data->{severity});
616 $data->{severity} =~ s/^\s*(.+)\s*$/$1/;
618 if (!grep($_ eq $data->{severity}, @severities, "$gDefaultSeverity")) {
621 Your message specified a Severity: in the pseudo-header, but
622 the severity value $data->{severity} was not recognised.
623 The default severity $gDefaultSeverity is being used instead.
624 The recognised values are: $gShowSeverities.
626 # if we use @gSeverityList array in the above line, perl -c gives:
627 # In string, @gSeverityList now must be written as \@gSeverityList at
628 # process line 452, near "$gDefaultSeverity is being used instead.
629 $data->{severity}= '';
632 if (defined($pheader{owner})) {
633 $data->{owner}= $pheader{owner};
635 if (defined($pheader{forwarded})) {
636 $data->{'forwarded-to'} = $pheader{forwarded};
638 &filelock("nextnumber.lock");
639 open(N,"nextnumber") || &quit("nextnumber: read: $!");
640 $v=<N>; $v =~ s/\n$// || &quit("nextnumber bad format");
641 $ref= $v+0; $v += 1; $newref=1;
642 &overwrite('nextnumber', "$v\n");
644 my $hash = get_hashname($ref);
645 &overwrite("db-h/$hash/$ref.log",'');
646 $data->{originator} = $replyto;
647 $data->{date} = $intdate;
648 $data->{subject} = $subject;
649 $data->{msgid} = $header{'message-id'};
650 writebug($ref, $data);
652 if (exists $pheader{usertags}) {
654 $user = $pheader{user} if exists $pheader{user};
656 $user =~ s/^.*<(.*)>.*$/$1/;
657 $user =~ s/[(].*[)]//;
658 $user =~ s/^\s*(\S+)\s+.*$/$1/;
659 if ($user ne '' and Debbugs::User::is_valid_user($user)) {
660 $pheader{usertags} =~ s/(?:^\s+|\s+$)//g;
662 read_usertags(\%user_tags,$user);
663 for my $tag (split /[,\s]+/, $pheader{usertags}) {
664 if ($tag =~ /^[a-zA-Z0-9.+\@-]+/) {
666 @bugs_with_tag{@{$user_tags{$tag}}} = (1) x @{$user_tags{$tag}};
667 $bugs_with_tag{$ref} = 1;
668 $user_tags{$tag} = [keys %bugs_with_tag];
671 write_usertags(\%usertags,$user);
675 Your message tried to set a usertag, but didn't have a valid
676 user set ('$user' isn't valid)
680 &overwrite("db-h/$hash/$ref.report",
681 join("\n",@msg)."\n");
686 print DEBUG "maintainers >@maintaddrs<\n";
688 $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : '';
689 $newsubject= $subject; $newsubject =~ s/^$gBug#$ref:*\s*//;
691 $xcchdr= $header{ 'x-debbugs-cc' };
692 if ($xcchdr =~ m/\S/) {
693 push(@resentccs,$xcchdr);
694 $resentccexplain.= <<END;
696 As you requested using X-Debbugs-CC, your message was also forwarded to
698 (after having been given a $gBug report number, if it did not have one).
702 if (@maintaddrs && ($codeletter eq 'B' || $codeletter eq 'M')) {
703 push(@resentccs,@maintaddrs);
704 $resentccexplain.= <<END." ".join("\n ",@maintaddrs)."\n";
706 Your message has been sent to the package maintainer(s):
710 @bccs = @addsrcaddrs;
711 if (defined $gStrongList and isstrongseverity($data->{severity})) {
712 push @bccs, "$gStrongList\@$gListDomain";
715 # Send mail to the per bug list subscription too
716 push @bccs, "bugs=$ref\@$gListDomain";
718 if (defined $pheader{source}) {
719 # Prefix source versions with the name of the source package. They
720 # appear that way in version trees so that we can deal with binary
721 # packages moving from one source package to another.
722 if (defined $pheader{'source-version'}) {
723 addfoundversions($data, $pheader{source}, $pheader{'source-version'}, '');
724 } elsif (defined $pheader{version}) {
725 addfoundversions($data, $pheader{source}, $pheader{version}, '');
727 writebug($ref, $data);
728 } elsif (defined $pheader{package}) {
729 # TODO: could handle Source-Version: by looking up the source package?
730 addfoundversions($data, $pheader{package}, $pheader{version}, 'binary');
731 writebug($ref, $data);
734 $veryquiet= $codeletter eq 'Q';
735 if ($codeletter eq 'M' && !@maintaddrs) {
739 You requested that the message be sent to the package maintainer(s)
740 but either the $gBug report is not associated with any package (probably
741 because of a missing Package pseudo-header field in the original $gBug
742 report), or the package(s) specified do not have any maintainer(s).
744 Your message has *not* been sent to any package maintainers; it has
745 merely been filed in the $gBug tracking system. If you require assistance
746 please contact $gMaintainerEmail quoting the $gBug number $ref.
750 $resentccval.= join(', ',@resentccs);
751 $resentccval =~ s/\s+\n\s+/ /g; $resentccval =~ s/^\s+/ /; $resentccval =~ s/\s+$//;
752 if (length($resentccval)) {
753 $resentcc= "Resent-CC: $resentccval\n";
756 if ($codeletter eq 'U') {
757 &htmllog("Message", "sent on", $data->{originator}, "$gBug#$ref.");
758 &sendmessage(<<END,[$data->{originator},@resentccs],[@bccs]);
759 Subject: $gBug#$ref: $newsubject
760 Reply-To: $replyto, $ref-quiet\@$gEmailDomain
761 ${orgsender}Resent-To: $data->{originator}
762 ${resentcc}Resent-Date: $tdate
763 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
764 Resent-Sender: $gMaintainerEmail
765 X-$gProject-PR-Message: report $ref
766 X-$gProject-PR-Package: $data->{package}
767 X-$gProject-PR-Keywords: $data->{keywords}
768 ${source_pr_header}$fwd
770 } elsif ($codeletter eq 'B') { # Sent to submit
771 &htmllog($newref ? "Report" : "Information", "forwarded",
772 join(', ',"$gSubmitList\@$gListDomain",@resentccs),
773 "<code>$gBug#$ref</code>".
774 (length($data->{package})? "; Package <code>".&sani($data->{package})."</code>" : '').
776 &sendmessage(<<END,["$gSubmitList\@$gListDomain",@resentccs],[@bccs]);
777 Subject: $gBug#$ref: $newsubject
778 Reply-To: $replyto, $ref\@$gEmailDomain
779 Resent-From: $header{'from'}
780 ${orgsender}Resent-To: $gSubmitList\@$gListDomain
781 ${resentcc}Resent-Date: $tdate
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
789 } elsif (@resentccs or @bccs) { # Quiet or Maintainer
790 # D and F done far earlier; B just done - so this must be M or Q
791 # We preserve whichever it was in the Reply-To (possibly adding
794 &htmllog($newref ? "Report" : "Information", "forwarded",
796 "<code>$gBug#$ref</code>".
797 (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
800 &htmllog($newref ? "Report" : "Information", "stored",
802 "<code>$gBug#$ref</code>".
803 (length($data->{package}) ? "; Package <code>".&sani($data->{package})."</code>" : '').
806 &sendmessage(<<END,[@resentccs],[@bccs]);
807 Subject: $gBug#$ref: $newsubject
808 Reply-To: $replyto, $ref-$baddressroot\@$gEmailDomain
809 Resent-From: $header{'from'}
810 ${orgsender}Resent-To: $resentccval
812 Resent-Message-ID: <handler.$ref.$nn\@$gEmailDomain>
813 Resent-Sender: $gMaintainerEmail
814 X-$gProject-PR-Message: report $ref
815 X-$gProject-PR-Package: $data->{package}
816 X-$gProject-PR-Keywords: $data->{keywords}
817 ${source_pr_header}$fwd
821 $htmlbreak= length($brokenness) ? "<p>\n".&sani($brokenness)."\n<p>\n" : '';
822 $htmlbreak =~ s/\n\n/\n<P>\n\n/g;
823 if (length($resentccval)) {
824 $htmlbreak = " Copy sent to <code>".&sani($resentccval)."</code>.".
827 unless (exists $header{'x-debbugs-no-ack'}) {
829 &htmllog("Acknowledgement","sent",$replyto,
831 "New $gBug report received and filed, but not forwarded." :
832 "New $gBug report received and forwarded."). $htmlbreak);
834 &sendmessage(create_mime_message(
835 ["X-Loop" => "$gMaintainerEmail",
836 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
838 Subject => "$gBug#$ref: Acknowledgement of QUIET report ($subject)",
839 "Message-ID" => "<handler.$ref.$nn.ackquiet\@$gEmailDomain>",
840 "In-Reply-To" => $header{'message-id'},
841 References => $header{'message-id'},
842 Precedence => 'bulk',
843 "X-$gProject-PR-Message" => "ack-quiet $ref",
844 "X-$gProject-PR-Package" => $data->{package},
845 "X-$gProject-PR-Keywords" => $data->{keywords},
846 # Only have a X-$gProject-PR-Source when we know the source package
847 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
848 "Reply-To" => "$ref-quiet\@$gEmailDomain",
849 ],<<END,[join("\n", @msg)]), '',undef,1);
850 Thank you for the problem report you have sent regarding $gProject.
851 This is an automatically generated reply, to let you know your message
852 has been received. It has not been forwarded to the package maintainers
853 or other interested parties; you should ensure that the developers are
854 aware of the problem you have entered into the system - preferably
855 quoting the $gBug reference number, #$ref.
857 If you wish to submit further information on your problem, please send it
858 to $ref-$baddressroot\@$gEmailDomain (and *not*
859 to $baddress\@$gEmailDomain).
861 If you have filed this report in error and wish to close it, please
862 send mail to $ref-done\@$gEmailDomain with an explanation
863 why the bug report should be closed.
865 Please do not reply to the address at the top of this message,
866 unless you wish to report a problem with the $gBug-tracking system.
869 (administrator, $gProject $gBugs database)
872 elsif ($codeletter eq 'M') { # Maintonly
873 &sendmessage(create_mime_message(
874 ["X-Loop" => "$gMaintainerEmail",
875 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
877 Subject => "$gBug#$ref: Acknowledgement of maintainer-only report ($subject)",
878 "Message-ID" => "<handler.$ref.$nn.ackmaint\@$gEmailDomain>",
879 "In-Reply-To" => $header{'message-id'},
880 References => $header{'message-id'},
881 Precedence => 'bulk',
882 "X-$gProject-PR-Message" => "ack-maintonly $ref",
883 "X-$gProject-PR-Package" => $data->{package},
884 "X-$gProject-PR-Keywords" => $data->{keywords},
885 # Only have a X-$gProject-PR-Source when we know the source package
886 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
887 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
888 ],<<END,[]), '',undef,1);
889 Thank you for the problem report you have sent regarding $gProject.
890 This is an automatically generated reply, to let you know your message has
891 been received. It is being forwarded to the package maintainers (but not
892 other interested parties, as you requested) for their attention; they will
895 If you wish to submit further information on your problem, please send
896 it to $ref-$baddressroot\@$gEmailDomain (and *not*
897 to $baddress\@$gEmailDomain).
899 If you have filed this report in error and wish to close it, please
900 send mail to $ref-done\@$gEmailDomain with an explanation
901 why the bug report should be closed.
903 Please do not reply to the address at the top of this message,
904 unless you wish to report a problem with the $gBug-tracking system.
907 (administrator, $gProject $gBugs database)
911 &sendmessage(create_mime_message(
912 ["X-Loop" => "$gMaintainerEmail",
913 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
915 Subject => "$gBug#$ref: Acknowledgement ($subject)",
916 "Message-ID" => "<handler.$ref.$nn.ack\@$gEmailDomain>",
917 "In-Reply-To" => $header{'message-id'},
918 References => $header{'message-id'},
919 Precedence => 'bulk',
920 "X-$gProject-PR-Message" => "ack $ref",
921 "X-$gProject-PR-Package" => $data->{package},
922 "X-$gProject-PR-Keywords" => $data->{keywords},
923 # Only have a X-$gProject-PR-Source when we know the source package
924 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
925 "Reply-To" => "$ref\@$gEmailDomain",
926 ],<<END,[]), '',undef,1);
927 Thank you for the problem report you have sent regarding $gProject.
928 This is an automatically generated reply, to let you know your message has
929 been received. It is being forwarded to the package maintainers and other
930 interested parties for their attention; they will reply in due course.
932 If you wish to submit further information on your problem, please send
933 it to $ref\@$gEmailDomain (and *not* to
934 $baddress\@$gEmailDomain).
936 If you have filed this report in error and wish to close it, please
937 send mail to $ref-done\@$gEmailDomain with an explanation
938 why the bug report should be closed.
940 Please do not reply to the address at the top of this message,
941 unless you wish to report a problem with the $gBug-tracking system.
944 (administrator, $gProject $gBugs database)
947 } elsif ($codeletter ne 'U' and
948 $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/) {
949 &htmllog("Acknowledgement","sent",$replyto,
950 ($veryquiet ? "Extra info received and filed, but not forwarded." :
951 $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." :
952 "Extra info received and forwarded to list."). $htmlbreak);
954 &sendmessage(create_mime_message(
955 ["X-Loop" => "$gMaintainerEmail",
956 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
958 Subject => "$gBug#$ref: Info received and FILED only (was $subject)",
959 "Message-ID" => "<handler.$ref.$nn.ackinfoquiet\@$gEmailDomain>",
960 "In-Reply-To" => $header{'message-id'},
961 References => $header{'message-id'},
962 Precedence => 'bulk',
963 "X-$gProject-PR-Message" => "ack-info-quiet $ref",
964 "X-$gProject-PR-Package" => $data->{package},
965 "X-$gProject-PR-Keywords" => $data->{keywords},
966 # Only have a X-$gProject-PR-Source when we know the source package
967 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
968 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
969 ],<<END,[]), '',undef,1);
970 Thank you for the additional information you have supplied regarding
971 this problem report. It has NOT been forwarded to the package
972 maintainers, but will accompany the original report in the $gBug
973 tracking system. Please ensure that you yourself have sent a copy of
974 the additional information to any relevant developers or mailing lists.
976 If you wish to continue to submit further information on this problem,
977 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
979 Please do not reply to the address at the top of this message,
980 unless you wish to report a problem with the $gBug-tracking system.
983 (administrator, $gProject $gBugs database)
986 elsif ($codeletter eq 'M') {
987 &sendmessage(create_mime_message(
988 ["X-Loop" => "$gMaintainerEmail",
989 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
991 Subject => "$gBug#$ref: Info received for maintainer only (was $subject)",
992 "Message-ID" => "<handler.$ref.$nn.ackinfomaint\@$gEmailDomain>",
993 "In-Reply-To" => $header{'message-id'},
994 References => "$header{'message-id'} $data->{msgid}",
995 Precedence => 'bulk',
996 "X-$gProject-PR-Message" => "ack-info-maintonly $ref",
997 "X-$gProject-PR-Package" => $data->{package},
998 "X-$gProject-PR-Keywords" => $data->{keywords},
999 "Reply-To" => "$ref-maintonly\@$gEmailDomain",
1000 ],<<END,[]), '',undef,1);
1001 Thank you for the additional information you have supplied regarding
1002 this problem report. It has been forwarded to the package maintainer(s)
1003 (but not to other interested parties) to accompany the original report.
1005 If you wish to continue to submit further information on this problem,
1006 please send it to $ref-$baddressroot\@$gEmailDomain, as before.
1008 Please do not reply to the address at the top of this message,
1009 unless you wish to report a problem with the $gBug-tracking system.
1012 (administrator, $gProject $gBugs database)
1016 &sendmessage(create_mime_message(
1017 ["X-Loop" => "$gMaintainerEmail",
1018 From => "$gMaintainerEmail ($gProject $gBug Tracking System)",
1020 Subject => "$gBug#$ref: Info received ($subject)",
1021 "Message-ID" => "<handler.$ref.$nn.ackinfo\@$gEmailDomain>",
1022 "In-Reply-To" => $header{'message-id'},
1023 References => "$header{'message-id'} $data->{msgid}",
1024 Precedence => 'bulk',
1025 "X-$gProject-PR-Message" => "ack-info $ref",
1026 "X-$gProject-PR-Package" => $data->{package},
1027 "X-$gProject-PR-Keywords" => $data->{keywords},
1028 # Only have a X-$gProject-PR-Source when we know the source package
1029 length($source_package)?("X-$gProject-PR-Source" => $source_package):(),
1030 "Reply-To" => "$ref\@$gEmailDomain",
1031 ],<<END,[]), '',undef,1);
1032 Thank you for the additional information you have supplied regarding
1033 this problem report. It has been forwarded to the package maintainer(s)
1034 and to other interested parties to accompany the original report.
1036 If you wish to continue to submit further information on this problem,
1037 please send it to $ref\@$gEmailDomain, as before.
1039 Please do not reply to the address at the top of this message,
1040 unless you wish to report a problem with the $gBug-tracking system.
1043 (administrator, $gProject $gBugs database)
1055 open(NEW,">$f.new") || &quit("$f.new: create: $!");
1056 print(NEW "$v") || &quit("$f.new: write: $!");
1057 close(NEW) || &quit("$f.new: close: $!");
1058 rename("$f.new","$f") || &quit("rename $f.new to $f: $!");
1062 my $hash = get_hashname($ref);
1063 if (!open(AP,">>db-h/$hash/$ref.log")) {
1064 print DEBUG "failed open log<\n";
1065 print DEBUG "failed open log err $!<\n";
1066 &quit("opening db-h/$hash/$ref.log (li): $!");
1068 print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!");
1069 close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!");
1073 utime(time,time,"db");
1075 while ($u= $cleanups[$#cleanups]) { &$u; }
1076 unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!");
1080 &quit("wot no exit");
1083 local ($whatobj,$whatverb,$where,$desc) = @_;
1084 my $hash = get_hashname($ref);
1085 open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!");
1088 "<strong>$whatobj $whatverb</strong>".
1089 ($where eq '' ? "" : " to <code>".&sani($where)."</code>").
1091 "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!");
1092 close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!");
1099 while ($msg =~ s/(.*\n)//) {
1106 # strip continuation lines too
1121 send_message($the_message,\@recipients,\@bcc,$do_not_encode)
1123 The first argument is the scalar message, the second argument is the
1124 arrayref of recipients, the third is the arrayref of Bcc:'ed
1127 The final argument turns off header encoding and the addition of the
1128 X-Loop header if true, defaults to false.
1134 my ($msg,$recips,$bcc,$no_encode) = @_;
1135 if (not defined $recips or (!ref($recips) && $recips eq '')
1139 # This is suboptimal. The right solution is to send headers
1140 # separately from the rest of the message and encode them rather
1142 $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode;
1143 # The original message received is written out in appendlog, so
1144 # before writing out the other messages we've sent out, we need to
1145 # RFC1522 encode the header.
1146 $msg = encode_headers($msg) unless $no_encode;
1148 my $hash = get_hashname($ref);
1149 #save email to the log
1150 open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!");
1151 print(AP "\2\n",join("\4",@$recips),"\n\5\n",
1152 @{escapelog(stripbccs($msg))},"\n\3\n") ||
1153 &quit("writing db-h/$hash/$ref.log (lo): $!");
1154 close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!");
1157 shift @$recips if $recips->[0] eq '-t';
1158 push @$recips, @$bcc;
1161 send_mail_message(message => $msg,
1162 # Because we encode the headers above, we do not want to encode them here
1163 encode_headers => 0,
1164 recipients => $recips);
1167 my $maintainerschecked = 0;
1168 sub checkmaintainers {
1169 return if $maintainerschecked++;
1170 return if !length($data->{package});
1171 open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!");
1175 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'");
1176 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1177 # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1178 $maintainerof{$a}= $2;
1181 open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!");
1185 m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'");
1186 $a= $1; $b= $2; $a =~ y/A-Z/a-z/;
1187 # use the package which is normalized to lower case; we do this because we lc the pseudo headers.
1188 $maintainerof{$a}= $2;
1191 open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!");
1193 next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/;
1199 $anymaintfound=0; $anymaintnotfound=0;
1200 for $p (split(m/[ \t?,():]+/,$data->{package})) {
1202 $p =~ /([a-z0-9.+-]+)/;
1204 next unless defined $p;
1205 if (defined $gSubscriptionDomain) {
1206 if (defined($pkgsrc{$p})) {
1207 push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain";
1209 push @addsrcaddrs, "$p\@$gSubscriptionDomain";
1212 if (defined($maintainerof{$p})) {
1213 print DEBUG "maintainer add >$p|$maintainerof{$p}<\n";
1214 $addmaint= $maintainerof{$p};
1215 push(@maintaddrs,$addmaint) unless
1216 $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs);
1219 print DEBUG "maintainer none >$p<\n";
1220 push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound;
1221 $anymaintnotfound++;
1226 if (length $data->{owner}) {
1227 print DEBUG "owner add >$data->{package}|$data->{owner}<\n";
1228 $addmaint = $data->{owner};
1229 push(@maintaddrs, $addmaint) unless
1230 $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs);
1234 =head2 bug_list_forward
1236 bug_list_forward($spool_filename) if $codeletter eq 'L';
1239 Given the spool file, will forward a bug to the per bug mailing list
1240 subscription system.
1244 sub bug_list_forward{
1246 # Read the bug information and package information for passing to
1248 my ($bug_number) = $bug_fn =~ /^L(\d+)\./;
1249 my ($bfound, $data)= lockreadbugmerge($bug_number);
1250 my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!";
1253 my $bug_message = <$bug_fh>;
1254 my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/;
1255 my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/;
1256 if (not defined $envelope_from) {
1257 # Try to use the From: header or something to set it
1258 ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/;
1259 # Kludgy, and should really be using a full scale header
1260 # parser to do this.
1261 $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/;
1263 my ($header,$body) = split /\n\n/, $bug_message, 2;
1264 # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers
1265 $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n).
1266 qq(X-$gProject-PR-Package: $data->{package}\n).
1267 qq(X-$gProject-PR-Title: $data->{subject})
1269 print STDERR "Tried to loop me with $envelope_from\n"
1270 and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/;
1271 print DEBUG $envelope_from,qq(\n);
1272 # If we don't have a bug address, something has gone horribly wrong.
1273 print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address;
1274 $bug_address =~ s/\@.+//;
1275 print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n";
1276 print DEBUG $header.qq(\n\n).$body;
1277 send_mail_message(message => $header.qq(\n\n).$body,
1278 recipients => ["bugs=$bug_address\@$gListDomain"],
1279 envelope_from => $envelope_from,
1280 encode_headers => 0,
1282 unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!");