#!/usr/bin/perl # $Id: process.in,v 1.109 2006/02/09 22:02:04 don Exp $ # # Usage: process nn # Temps: incoming/Pnn use POSIX qw(strftime tzset); $ENV{"TZ"} = 'UTC'; tzset(); use MIME::Parser; use Debbugs::MIME qw(decode_rfc1522 create_mime_message); use Debbugs::Mail qw(send_mail_message encode_headers); $config_path = '/etc/debbugs'; $lib_path = '/usr/lib/debbugs'; require "$config_path/config"; require "$lib_path/errorlib"; $ENV{'PATH'} = $lib_path.':'.$ENV{'PATH'}; chdir( "$gSpoolDir" ) || die "chdir spool: $!\n"; #open(DEBUG,"> /tmp/debbugs.debug"); umask(002); open DEBUG, ">/dev/null"; defined( $intdate= time ) || &quit( "failed to get time: $!" ); $_=shift; m/^([BMQFDUL])(\d*)\.\d+$/ || &quit("bad argument"); $codeletter= $1; $tryref= length($2) ? $2+0 : -1; $nn= $_; if (!rename("incoming/G$nn","incoming/P$nn")) { $_=$!.''; m/no such file or directory/i && exit 0; &quit("renaming to lock: $!"); } $baddress= 'submit' if $codeletter eq 'B'; $baddress= 'maintonly' if $codeletter eq 'M'; $baddress= 'quiet' if $codeletter eq 'Q'; $baddress= 'forwarded' if $codeletter eq 'F'; $baddress= 'done' if $codeletter eq 'D'; $baddress= 'submitter' if $codeletter eq 'U'; bug_list_forward($nn) if $codeletter eq 'L'; $baddress || &quit("bad codeletter $codeletter"); $baddressroot= $baddress; $baddress= "$tryref-$baddress" if $tryref>=0; open(M,"incoming/P$nn"); @log=; close(M); @msg=@log; chomp @msg; print DEBUG "###\n",join("##\n",@msg),"\n###\n"; $tdate = strftime "%a, %d %h %Y %T UTC", localtime; $fwd= <output_under("$gSpoolDir/mime.tmp"); my $entity = eval { $parser->parse_data(join('',@log)) }; if ($entity and $entity->head->tags) { @headerlines = @{$entity->head->header}; chomp @headerlines; my $entity_body = getmailbody($entity); @bodylines = $entity_body ? $entity_body->as_lines() : (); chomp @bodylines; # set $i to beginning of encoded body data, so we can dump it out # verbatim later $i = 0; ++$i while $msg[$i] =~ /./; } else { # Legacy pre-MIME code, kept around in case MIME::Parser fails. for ($i = 0; $i <= $#msg; $i++) { $_ = $msg[$i]; last unless length($_); while ($msg[$i+1] =~ m/^\s/) { $i++; $_ .= "\n".$msg[$i]; } push @headerlines, $_; } @bodylines = @msg[$i..$#msg]; } my %header; for my $hdr (@headerlines) { $hdr = decode_rfc1522($hdr); $_ = $hdr; s/\n\s/ /g; &finish if m/^x-loop: (\S+)$/i && $1 eq "$gMaintainerEmail"; my $ins = !m/^subject:/i && !m/^reply-to:/i && !m/^return-path:/i && !m/^From / && !m/^X-Debbugs-/i; $fwd .= $hdr."\n" if $ins; # print DEBUG ">$_<\n"; if (s/^(\S+):\s*//) { my $v = lc $1; print DEBUG ">$v=$_<\n"; $header{$v} = $_; } else { print DEBUG "!>$_<\n"; } } # remove blank lines shift @bodylines while @bodylines and $bodylines[0] !~ /\S/; # Strip off RFC2440-style PGP clearsigning. if (@bodylines and $bodylines[0] =~ /^-----BEGIN PGP SIGNED/) { shift @bodylines while @bodylines and length $bodylines[0]; shift @bodylines while @bodylines and $bodylines[0] !~ /\S/; for my $findsig (0 .. $#bodylines) { if ($bodylines[$findsig] =~ /^-----BEGIN PGP SIGNATURE/) { $#bodylines = $findsig - 1; last; } } map { s/^- // } @bodylines; } # extract pseudo-headers for my $phline (@bodylines) { last if $phline !~ m/^([\w-]+):\s*(\S.*)/; my ($fn, $fv) = ($1, $2); $fv =~ s/\s*$//; print DEBUG ">$fn|$fv|\n"; $fn = lc $fn; $fv = lc $fv; $pheader{$fn} = $fv; print DEBUG ">$fn~$fv<\n"; } # Allow pseudo headers to set x-debbugs- stuff [#179340] for my $key (grep /X-Debbugs-.*/i, keys %pheader) { $header{$key} = $pheader{$key} if not exists $header{$key}; } $fwd .= join("\n",@msg[$i..$#msg]); print DEBUG "***\n$fwd\n***\n"; if (defined $header{'resent-from'} && !defined $header{'from'}) { $header{'from'} = $header{'resent-from'}; } defined($header{'from'}) || &quit("no From header"); $replyto = $header{'reply-to'}; $replyto = '' unless defined $replyto; $replyto =~ s/^ +//; $replyto =~ s/ +$//; unless (length $replyto) { $replyto = $header{'from'}; } $_= $replyto; $_= "$2 <$1>" if m/^([^\<\> \t\n\(\)]+) \(([^\(\)\<\>]+)\)$/; $replytocompare= $_; print DEBUG "replytocompare >$replytocompare<\n"; if (!defined($header{'subject'})) { $brokenness.= <= 0) { ($bfound, $data)= &lockreadbugmerge($tryref); if ($bfound) { $ref= $tryref; } else { &htmllog("Reply","sent", $replyto,"Unknown problem report number $tryref."); my $archivenote = ''; if ($gRemoveAge) { $archivenote = < In-Reply-To: $header{'message-id'} References: $header{'message-id'} $data->{msgid} Precedence: bulk X-$gProject-PR-Message: error You sent a message to the $gBug tracking system which gave (in the Subject line or encoded into the recipient at $gEmailDomain), the number of a nonexistent $gBug report (#$tryref). ${archivenote}Your message was dated $header{'date'} and was sent to $baddress\@$gEmailDomain. It had Message-ID $header{'message-id'} and Subject $subject. It has been filed (under junk) but otherwise ignored. Please consult your records to find the correct $gBug report number, or contact me, the system administrator, for assistance. $gMaintainer (administrator, $gProject $gBugs database) (NB: If you are a system administrator and have no idea what I am talking about this indicates a serious mail system misconfiguration somewhere. Please contact me immediately.) END &appendlog; &finish; } } else { &filelock('lock/-1'); } if ($codeletter eq 'D' || $codeletter eq 'F') { if ($replyto =~ m/$gBounceFroms/o || $header{'from'} =~ m/$gBounceFroms/o) { &quit("bounce detected ! Mwaap! Mwaap!"); } $markedby= $header{'from'} eq $replyto ? $replyto : "$header{'from'} (reply to $replyto)"; my @generalcc; if ($codeletter eq 'F') { (&appendlog,&finish) if length($data->{forwarded}); $receivedat= "forwarded\@$gEmailDomain"; $markaswhat= 'forwarded'; $set_forwarded= $header{'to'}; if ( length( $gListDomain ) > 0 && length( $gForwardList ) > 0 ) { push @generalcc, "$gForwardList\@$gListDomain"; $generalcc= "$gForwardList\@$gListDomain"; } else { $generalcc=''; } } else { if (length($data->{done}) and not defined $pheader{'source-version'} and not defined $pheader{'version'}) { &appendlog; &finish; } $receivedat= "done\@$gEmailDomain"; $markaswhat= 'done'; $set_done= $header{'from'}; if ( length( $gListDomain ) > 0 && length( $gDoneList ) > 0 ) { $generalcc= "$gDoneList\@$gListDomain"; push @generalcc, "$gDoneList\@$gListDomain"; } else { $generalcc=''; } } if (defined $gStrongList and isstrongseverity($data->{severity})) { $generalcc = join ', ', $generalcc, "$gStrongList\@$gListDomain"; push @generalcc,"$gStrongList\@$gListDomain"; } if ($ref<0) { &htmllog("Warning","sent",$replyto,"Message ignored."); &sendmessage(< In-Reply-To: $header{'message-id'} References: $header{'message-id'} $data->{msgid} Precedence: bulk X-$gProject-PR-Message: error You sent a message to the $gProject $gBug tracking system old-style unified mark as $markaswhat address ($receivedat), without a recognisable $gBug number in the Subject. Your message has been filed under junk but otherwise ignored. If you don't know what I'm talking about then probably either: (a) you unwittingly sent a message to done\@$gEmailDomain because you replied to all recipients of the message a developer used to mark a $gBug as done and you modified the Subject. In this case, please do not be alarmed. To avoid confusion do not do it again, but there is no need to apologise or mail anyone asking for an explanation. (b) you are a system administrator, reading this because the $gBug tracking system is responding to a misdirected bounce message. In this case there is a serious mail system misconfiguration somewhere - please contact me immediately. Your message was dated $header{'date'} and had message-id $header{'message-id'} and subject $subject. If you need any assistance or explanation please contact me. $gMaintainer (administrator, $gProject $gBugs database) END &appendlog; &finish; } &checkmaintainers; my @noticecc = grep($_ ne $replyto,@maintaddrs); $noticeccval.= join(', ', grep($_ ne $replyto,@maintaddrs)); $noticeccval =~ s/\s+\n\s+/ /g; $noticeccval =~ s/^\s+/ /; $noticeccval =~ s/\s+$//; if (length($noticeccval)) { $noticecc= "Cc: $noticeccval\n"; } @process= ($ref,split(/ /,$data->{mergedwith})); $orgref= $ref; for $ref (@process) { if ($ref != $orgref) { &unfilelock; $data = &lockreadbug($ref) || die "huh ? $ref from $orgref out of @process"; } $data->{done}= $set_done if defined($set_done); $data->{forwarded}= $set_forwarded if defined($set_forwarded); if ($codeletter eq 'D') { $data->{keywords} = join ' ', grep $_ ne 'pending', split ' ', $data->{keywords}; if (defined $pheader{'source-version'}) { addfixedversions($data, $pheader{source}, $pheader{'source-version'}, ''); } elsif (defined $pheader{version}) { addfixedversions($data, $pheader{package}, $pheader{version}, 'binary'); } } # Add bug mailing list to $generalbcc as appropriate # This array is used to specify bcc in the cases where we're using create_mime_message. my @generalbcc = (@generalcc,@addsrcaddrs,"bugs=$ref\@$gListDomain"); my $generalbcc = join(', ', $generalcc, @addsrcaddrs,"bugs=$ref\@$gListDomain"); $generalbcc =~ s/\s+\n\s+/ /g; $generalbcc =~ s/^\s+/ /; $generalbcc =~ s/\s+$//; if (length $generalbcc) {$generalbcc = "Bcc: $generalbcc\n"}; writebug($ref, $data); my $hash = get_hashname($ref); open(O,"db-h/$hash/$ref.report") || &quit("read original report: $!"); $x= join('',); close(O); if ($codeletter eq 'F') { &htmllog("Reply","sent",$replyto,"You have marked $gBug as forwarded."); &sendmessage(create_mime_message( ["X-Loop" => "$gMaintainerEmail", From => "$gMaintainerEmail ($gProject $gBug Tracking System)", To => "$replyto", Subject => "$gBug#$ref: marked as forwarded ($data->{subject})", "Message-ID" => "", "In-Reply-To" => $header{'message-id'}, References => "$header{'message-id'} $data->{msgid}", Precedence => 'bulk', "X-$gProject-PR-Message" => "forwarded $ref", "X-$gProject-PR-Package" => $data->{package}, "X-$gProject-PR-Keywords" => $data->{keywords} ],<{subject} to be marked as having been forwarded to the upstream software author(s) $data->{forwarded}. (NB: If you are a system administrator and have no idea what I am talking about this indicates a serious mail system misconfiguration somewhere. Please contact me immediately.) $gMaintainer (administrator, $gProject $gBugs database) END } else { &htmllog("Reply","sent",$replyto,"You have taken responsibility."); &sendmessage(create_mime_message( ["X-Loop" => "$gMaintainerEmail", From => "$gMaintainerEmail ($gProject $gBug Tracking System)", To => $replyto, Subject => "$gBug#$ref: marked as done ($data->{subject})", "Message-ID" => "", "In-Reply-To" => $header{'message-id'}, References => "$header{'message-id'} $data->{msgid}", Precedence => 'bulk', "X-$gProject-PR-Message" => "closed $ref", "X-$gProject-PR-Package" => $data->{package}, "X-$gProject-PR-Keywords" => $data->{keywords} ],<{originator}, "$gBug acknowledged by developer."); &sendmessage(create_mime_message( ["X-Loop" => "$gMaintainerEmail", From => "$gMaintainerEmail ($gProject $gBug Tracking System)", To => "$data->{originator}", Subject => "$gBug#$ref acknowledged by developer ($header{'subject'})", "Message-ID" => "", "In-Reply-To" => "$data->{msgid}", References => "$header{'message-id'} $data->{msgid}", "X-$gProject-PR-Message" => "they-closed $ref", "X-$gProject-PR-Package" => "$data->{package}", "X-$gProject-PR-Keywords" => "$data->{keywords}", "Reply-To" => "$ref\@$gEmailDomain", "Content-Type" => 'text/plain; charset="utf-8"', ],<{subject}, which was filed against the $data->{package} package. It has been closed by one of the developers, namely $markedby. Their explanation is attached below. If this explanation is unsatisfactory and you have not received a better one in a separate message then please contact the developer, by replying to this email. $gMaintainer (administrator, $gProject $gBugs database) END } &appendlog; } &finish; } if ($ref<0) { if ($codeletter eq 'U') { &htmllog("Warning","sent",$replyto,"Message not forwarded."); &sendmessage(< In-Reply-To: $header{'message-id'} References: $header{'message-id'} $data->{msgid} Precedence: bulk X-$gProject-PR-Message: error You sent a message to the $gProject $gBug tracking system's $gBug report submitter address $baddress\@$gEmailDomain, without a recognisable $gBug number in the Subject. Your message has been filed under junk but otherwise ignored. If you don't know what I'm talking about then probably either: (a) you unwittingly sent a message to $baddress\@$gEmailDomain because you replied to all recipients of the message a developer sent to a $gBug\'s submitter and you modified the Subject. In this case, please do not be alarmed. To avoid confusion do not do it again, but there is no need to apologise or mail anyone asking for an explanation. (b) you are a system administrator, reading this because the $gBug tracking system is responding to a misdirected bounce message. In this case there is a serious mail system misconfiguration somewhere - please contact me immediately. Your message was dated $header{'date'} and had message-id $header{'message-id'} and subject $subject. If you need any assistance or explanation please contact me. $gMaintainer (administrator, $gProject $gBugs database) END &appendlog; &finish; } $data->{found_versions} = []; $data->{fixed_versions} = []; if (defined $pheader{source}) { $data->{package} = $pheader{source}; } elsif (defined $pheader{package}) { $data->{package} = $pheader{package}; } else { &htmllog("Warning","sent",$replyto,"Message not forwarded."); &sendmessage(create_mime_message( ["X-Loop" => "$gMaintainerEmail", From => "$gMaintainerEmail ($gProject $gBug Tracking System)", To => $replyto, Subject => "Message with no Package: tag cannot be processed! ($subject)", "Message-ID" => "", "In-Reply-To" => $header{'message-id'}, References => "$header{'message-id'} $data->{msgid}", Precedence => 'bulk', "X-$gProject-PR-Message" => 'error' ],<{keywords}= ''; if (defined($pheader{'keywords'})) { $data->{keywords}= $pheader{'keywords'}; } elsif (defined($pheader{'tags'})) { $data->{keywords}= $pheader{'tags'}; } if (length($data->{keywords})) { my @kws; my %gkws = map { ($_, 1) } @gTags; foreach my $kw (sort split(/[,\s]+/, lc($data->{keywords}))) { push @kws, $kw if (defined $gkws{$kw}); } $data->{keywords} = join(" ", @kws); } $data->{severity}= ''; if (defined($pheader{'severity'}) || defined($pheader{'priority'})) { $data->{severity}= $pheader{'severity'}; $data->{severity}= $pheader{'priority'} unless ($data->{severity}); $data->{severity} =~ s/^\s*(.+)\s*$/$1/; if (!grep($_ eq $data->{severity}, @severities, "$gDefaultSeverity")) { $brokenness.= <{severity} was not recognised. The default severity $gDefaultSeverity is being used instead. The recognised values are: $gShowSeverities. END # if we use @gSeverityList array in the above line, perl -c gives: # In string, @gSeverityList now must be written as \@gSeverityList at # process line 452, near "$gDefaultSeverity is being used instead. $data->{severity}= ''; } } if (defined($pheader{owner})) { $data->{owner}= $pheader{owner}; } if (defined($pheader{forwarded})) { $data->{'forwarded-to'} = $pheader{forwarded}; } &filelock("nextnumber.lock"); open(N,"nextnumber") || &quit("nextnumber: read: $!"); $v=; $v =~ s/\n$// || &quit("nextnumber bad format"); $ref= $v+0; $v += 1; $newref=1; &overwrite('nextnumber', "$v\n"); &unfilelock; my $hash = get_hashname($ref); &overwrite("db-h/$hash/$ref.log",''); $data->{originator} = $replyto; $data->{date} = $intdate; $data->{subject} = $subject; $data->{msgid} = $header{'message-id'}; writebug($ref, $data); &overwrite("db-h/$hash/$ref.report", join("\n",@msg)."\n"); } &checkmaintainers; print DEBUG "maintainers >@maintaddrs<\n"; $orgsender= defined($header{'sender'}) ? "Original-Sender: $header{'sender'}\n" : ''; $newsubject= $subject; $newsubject =~ s/^$gBug#$ref:*\s*//; $xcchdr= $header{ 'x-debbugs-cc' }; if ($xcchdr =~ m/\S/) { push(@resentccs,$xcchdr); $resentccexplain.= <{severity})) { push @bccs, "$gStrongList\@$gListDomain"; } # Send mail to the per bug list subscription too push @bccs, "bugs=$ref\@$gListDomain"; if (defined $pheader{source}) { # Prefix source versions with the name of the source package. They # appear that way in version trees so that we can deal with binary # packages moving from one source package to another. if (defined $pheader{'source-version'}) { addfoundversions($data, $pheader{source}, $pheader{'source-version'}, ''); } elsif (defined $pheader{version}) { addfoundversions($data, $pheader{source}, $pheader{version}, ''); } writebug($ref, $data); } elsif (defined $pheader{package}) { # TODO: could handle Source-Version: by looking up the source package? addfoundversions($data, $pheader{package}, $pheader{version}, 'binary'); writebug($ref, $data); } $veryquiet= $codeletter eq 'Q'; if ($codeletter eq 'M' && !@maintaddrs) { $veryquiet= 1; $brokenness.= <{originator}, "$gBug#$ref."); &sendmessage(<{originator},@resentccs],[@bccs]); Subject: $gBug#$ref: $newsubject Reply-To: $replyto, $ref-quiet\@$gEmailDomain ${orgsender}Resent-To: $data->{originator} ${resentcc}Resent-Date: $tdate Resent-Message-ID: Resent-Sender: $gMaintainerEmail X-$gProject-PR-Message: report $ref X-$gProject-PR-Package: $data->{package} X-$gProject-PR-Keywords: $data->{keywords} $fwd END } elsif ($codeletter eq 'B') { &htmllog($newref ? "Report" : "Information", "forwarded", join(', ',"$gSubmitList\@$gListDomain",@resentccs), "$gBug#$ref". (length($data->{package})? "; Package ".&sani($data->{package})."" : ''). "."); &sendmessage(< Resent-Sender: $gMaintainerEmail X-$gProject-PR-Message: report $ref X-$gProject-PR-Package: $data->{package} X-$gProject-PR-Keywords: $data->{keywords} $fwd END } elsif (@resentccs or @bccs) { # D and F done far earlier; B just done - so this must be M or Q # We preserve whichever it was in the Reply-To (possibly adding # the $gBug#). if (@resentccs) { &htmllog($newref ? "Report" : "Information", "forwarded", $resentccval, "$gBug#$ref". (length($data->{package}) ? "; Package ".&sani($data->{package})."" : ''). "."); } else { &htmllog($newref ? "Report" : "Information", "stored", "", "$gBug#$ref". (length($data->{package}) ? "; Package ".&sani($data->{package})."" : ''). "."); } &sendmessage(< Resent-Sender: $gMaintainerEmail X-$gProject-PR-Message: report $ref X-$gProject-PR-Package: $data->{package} X-$gProject-PR-Keywords: $data->{keywords} $fwd END } $htmlbreak= length($brokenness) ? "

\n".&sani($brokenness)."\n

\n" : ''; $htmlbreak =~ s/\n\n/\n

\n\n/g; if (length($resentccval)) { $htmlbreak = " Copy sent to ".&sani($resentccval).".". $htmlbreak; } unless (exists $header{'x-debbugs-no-ack'}) { if ($newref) { &htmllog("Acknowledgement","sent",$replyto, ($veryquiet ? "New $gBug report received and filed, but not forwarded." : "New $gBug report received and forwarded."). $htmlbreak); &sendmessage($veryquiet ? < In-Reply-To: $header{'message-id'} References: $header{'message-id'} Precedence: bulk X-$gProject-PR-Message: ack-quiet $ref X-$gProject-PR-Package: $data->{package} X-$gProject-PR-Keywords: $data->{keywords} Reply-To: $ref-quiet\@$gEmailDomain Thank you for the problem report you have sent regarding $gProject. This is an automatically generated reply, to let you know your message has been received. It has not been forwarded to the package maintainers or other interested parties; you should ensure that the developers are aware of the problem you have entered into the system - preferably quoting the $gBug reference number, #$ref. $resentccexplain If you wish to submit further information on your problem, please send it to $ref-$baddressroot\@$gEmailDomain (and *not* to $baddress\@$gEmailDomain). Please do not reply to the address at the top of this message, unless you wish to report a problem with the $gBug-tracking system. $brokenness $gMaintainer (administrator, $gProject $gBugs database) END From: $gMaintainerEmail ($gProject $gBug Tracking System) To: $replyto Subject: $gBug#$ref: Acknowledgement of maintainer-only report ($subject) Message-ID: In-Reply-To: $header{'message-id'} References: $header{'message-id'} Precedence: bulk X-$gProject-PR-Message: ack-maintonly $ref X-$gProject-PR-Package: $data->{package} X-$gProject-PR-Keywords: $data->{keywords} Reply-To: $ref-maintonly\@$gEmailDomain Thank you for the problem report you have sent regarding $gProject. This is an automatically generated reply, to let you know your message has been received. It is being forwarded to the package maintainers (but not other interested parties, as you requested) for their attention; they will reply in due course. $resentccexplain If you wish to submit further information on your problem, please send it to $ref-$baddressroot\@$gEmailDomain (and *not* to $baddress\@$gEmailDomain). Please do not reply to the address at the top of this message, unless you wish to report a problem with the $gBug-tracking system. $brokenness $gMaintainer (administrator, $gProject $gBugs database) END From: $gMaintainerEmail ($gProject $gBug Tracking System) To: $replyto Subject: $gBug#$ref: Acknowledgement ($subject) Message-ID: In-Reply-To: $header{'message-id'} References: $header{'message-id'} Precedence: bulk X-$gProject-PR-Message: ack $ref X-$gProject-PR-Package: $data->{package} X-$gProject-PR-Keywords: $data->{keywords} Reply-To: $ref\@$gEmailDomain Thank you for the problem report you have sent regarding $gProject. This is an automatically generated reply, to let you know your message has been received. It is being forwarded to the package maintainers and other interested parties for their attention; they will reply in due course. $resentccexplain If you wish to submit further information on your problem, please send it to $ref\@$gEmailDomain (and *not* to $baddress\@$gEmailDomain). Please do not reply to the address at the top of this message, unless you wish to report a problem with the $gBug-tracking system. $brokenness $gMaintainer (administrator, $gProject $gBugs database) END } elsif ($codeletter ne 'U' and $header{'precedence'} !~ /\b(?:bulk|junk|list)\b/) { &htmllog("Acknowledgement","sent",$replyto, ($veryquiet ? "Extra info received and filed, but not forwarded." : $codeletter eq 'M' ? "Extra info received and forwarded to maintainer." : "Extra info received and forwarded to list."). $htmlbreak); &sendmessage($veryquiet ? < In-Reply-To: $header{'message-id'} References: $header{'message-id'} Precedence: bulk X-$gProject-PR-Message: ack-info-quiet $ref X-$gProject-PR-Package: $data->{package} X-$gProject-PR-Keywords: $data->{keywords} Reply-To: $ref-quiet\@$gEmailDomain Thank you for the additional information you have supplied regarding this problem report. It has NOT been forwarded to the package maintainers, but will accompany the original report in the $gBug tracking system. Please ensure that you yourself have sent a copy of the additional information to any relevant developers or mailing lists. $resentccexplain If you wish to continue to submit further information on your problem, please send it to $ref-$baddressroot\@$gEmailDomain, as before. Please do not reply to the address at the top of this message, unless you wish to report a problem with the $gBug-tracking system. $brokenness $gMaintainer (administrator, $gProject $gBugs database) END From: $gMaintainerEmail ($gProject $gBug Tracking System) To: $replyto Subject: $gBug#$ref: Info received for maintainer only (was $subject) Message-ID: In-Reply-To: $header{'message-id'} References: $header{'message-id'} Precedence: bulk X-$gProject-PR-Message: ack-info-maintonly $ref X-$gProject-PR-Package: $data->{package} X-$gProject-PR-Keywords: $data->{keywords} Reply-To: $ref-maintonly\@$gEmailDomain Thank you for the additional information you have supplied regarding this problem report. It has been forwarded to the package maintainer(s) (but not to other interested parties) to accompany the original report. $resentccexplain If you wish to continue to submit further information on your problem, please send it to $ref-$baddressroot\@$gEmailDomain, as before. Please do not reply to the address at the top of this message, unless you wish to report a problem with the $gBug-tracking system. $brokenness $gMaintainer (administrator, $gProject $gBugs database) END From: $gMaintainerEmail ($gProject $gBug Tracking System) To: $replyto Subject: $gBug#$ref: Info received (was $subject) Message-ID: In-Reply-To: $header{'message-id'} References: $header{'message-id'} Precedence: bulk X-$gProject-PR-Message: ack-info $ref X-$gProject-PR-Package: $data->{package} X-$gProject-PR-Keywords: $data->{keywords} Thank you for the additional information you have supplied regarding this problem report. It has been forwarded to the package maintainer(s) and to other interested parties to accompany the original report. $resentccexplain If you wish to continue to submit further information on your problem, please send it to $ref\@$gEmailDomain, as before. Please do not reply to the address at the top of this message, unless you wish to report a problem with the $gBug-tracking system. $brokenness $gMaintainer (administrator, $gProject $gBugs database) END # Reply-To: in previous ack disabled by doogie due to mail loops. # Are these still a concern? # Reply-To: $ref\@$gEmailDomain } } &appendlog; &finish; sub overwrite { local ($f,$v) = @_; open(NEW,">$f.new") || &quit("$f.new: create: $!"); print(NEW "$v") || &quit("$f.new: write: $!"); close(NEW) || &quit("$f.new: close: $!"); rename("$f.new","$f") || &quit("rename $f.new to $f: $!"); } sub appendlog { my $hash = get_hashname($ref); if (!open(AP,">>db-h/$hash/$ref.log")) { print DEBUG "failed open log<\n"; print DEBUG "failed open log err $!<\n"; &quit("opening db-h/$hash/$ref.log (li): $!"); } print(AP "\7\n",@{escapelog(@log)},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (li): $!"); close(AP) || &quit("closing db-h/$hash/$ref.log (li): $!"); } sub finish { utime(time,time,"db"); local ($u); while ($u= $cleanups[$#cleanups]) { &$u; } unlink("incoming/P$nn") || &quit("unlinking incoming/P$nn: $!"); exit $_[0]; } &quit("wot no exit"); sub chldhandle { $chldexit = 'yes'; } sub htmllog { local ($whatobj,$whatverb,$where,$desc) = @_; my $hash = get_hashname($ref); open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lh): $!"); print(AP "\6\n". "$whatobj $whatverb". ($where eq '' ? "" : " to ".&sani($where).""). ":
\n". $desc. "\n\3\n") || &quit("writing db-h/$hash/$ref.log (lh): $!"); close(AP) || &quit("closing db-h/$hash/$ref.log (lh): $!"); } sub stripbccs { my $msg = shift; my $ret = ''; my $bcc = 0; while ($msg =~ s/(.*\n)//) { local $_ = $1; if (/^$/) { $ret .= $_; last; } if ($bcc) { # strip continuation lines too next if /^\s/; $bcc = 0; } if (/^Bcc:/i) { $bcc = 1; } else { $ret .= $_; } } return $ret . $msg; } =head2 send_message send_message($the_message,\@recipients,\@bcc,$do_not_encode) The first argument is the scalar message, the second argument is the arrayref of recipients, the third is the arrayref of Bcc:'ed recipients. The final argument turns off header encoding and the addition of the X-Loop header if true, defaults to false. =cut sub sendmessage { my ($msg,$recips,$bcc,$no_encode) = @_; if (not defined $recips or (!ref($recips) && $recips eq '') or @$recips == 0) { $recips = ['-t']; } # This is suboptimal. The right solution is to send headers # separately from the rest of the message and encode them rather # than doing this. $msg = "X-Loop: $gMaintainerEmail\n" . $msg unless $no_encode; # The original message received is written out in appendlog, so # before writing out the other messages we've sent out, we need to # RFC1522 encode the header. $msg = encode_headers($msg) unless $no_encode; my $hash = get_hashname($ref); #save email to the log open(AP,">>db-h/$hash/$ref.log") || &quit("opening db-h/$hash/$ref.log (lo): $!"); print(AP "\2\n",join("\4",@$recips),"\n\5\n", @{escapelog(stripbccs($msg))},"\n\3\n") || &quit("writing db-h/$hash/$ref.log (lo): $!"); close(AP) || &quit("closing db-h/$hash/$ref.log (lo): $!"); if (ref($bcc)) { shift @$recips if $recips->[0] eq '-t'; push @$recips, @$bcc; } send_mail_message(message => $msg, # Because we encode the headers above, we do not want to encode them here encode_headers => 0, recipients => $recips); } sub checkmaintainers { return if $maintainerschecked++; return if !length($data->{package}); open(MAINT,"$gMaintainerFile") || die &quit("maintainers open: $!"); while () { m/^\n$/ && next; m/^\s*$/ && next; m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers bogus \`$_'"); $a= $1; $b= $2; $a =~ y/A-Z/a-z/; # use the package which is normalized to lower case; we do this because we lc the pseudo headers. $maintainerof{$a}= $2; } close(MAINT); open(MAINT,"$gMaintainerFileOverride") || die &quit("maintainers.override open: $!"); while () { m/^\n$/ && next; m/^\s*$/ && next; m/^(\S+)\s+(\S.*\S)\s*\n$/ || &quit("maintainers.override bogus \`$_'"); $a= $1; $b= $2; $a =~ y/A-Z/a-z/; # use the package which is normalized to lower case; we do this because we lc the pseudo headers. $maintainerof{$a}= $2; } close(MAINT); open(SOURCES,"$gPackageSource") || &quit("pkgsrc open: $!"); while () { next unless m/^(\S+)\s+\S+\s+(\S.*\S)\s*$/; ($a,$b)=($1,$2); $a =~ y/A-Z/a-z/; $pkgsrc{$a} = $b; } close(SOURCES); $anymaintfound=0; $anymaintnotfound=0; for $p (split(m/[ \t?,():]+/,$data->{package})) { $p =~ y/A-Z/a-z/; $p =~ /([a-z0-9.+-]+)/; $p = $1; next unless defined $p; if (defined $gSubscriptionDomain) { if (defined($pkgsrc{$p})) { push @addsrcaddrs, "$pkgsrc{$p}\@$gSubscriptionDomain"; } else { push @addsrcaddrs, "$p\@$gSubscriptionDomain"; } } if (defined($maintainerof{$p})) { print DEBUG "maintainer add >$p|$maintainerof{$p}<\n"; $addmaint= $maintainerof{$p}; push(@maintaddrs,$addmaint) unless $addmaint eq $replyto || grep($_ eq $addmaint, @maintaddrs); $anymaintfound++; } else { print DEBUG "maintainer none >$p<\n"; push(@maintaddrs,$gUnknownMaintainerEmail) unless $anymaintnotfound; $anymaintnotfound++; last; } } if (length $data->{owner}) { print DEBUG "owner add >$data->{package}|$data->{owner}<\n"; $addmaint = $data->{owner}; push(@maintaddrs, $addmaint) unless $addmaint eq $replyto or grep($_ eq $addmaint, @maintaddrs); } } =head2 bug_list_forward bug_list_forward($spool_filename) if $codeletter eq 'L'; Given the spool file, will forward a bug to the per bug mailing list subscription system. =cut sub bug_list_forward{ my ($bug_fn) = @_; # Read the bug information and package information for passing to # the mailing list my ($bug_number) = $bug_fn =~ /^L(\d+)\./; my ($bfound, $data)= lockreadbugmerge($bug_number); my $bug_fh = new IO::File "incoming/P$bug_fn" or die "Unable to open incoming/P$bug_fn $!"; local $/ = undef; my $bug_message = <$bug_fh>; my ($bug_address) = $bug_message =~ /^Received: \(at ([^\)]+)\) by/; my ($envelope_from) = $bug_message =~ s/\nFrom\s+([^\s]+)[^\n]+\n/\n/; if (not defined $envelope_from) { # Try to use the From: header or something to set it ($envelope_from) = $bug_message =~ /\nFrom:\s+(.+?)\n/; # Kludgy, and should really be using a full scale header # parser to do this. $envelope_from =~ s/^.+?<([^>]+)>.+$/$1/; } my ($header,$body) = split /\n\n/, $bug_message, 2; # Add X-$gProject-PR-Message: list bug_number, package name, and bug title headers $header .= qq(\nX-$gProject-PR-Message: list $bug_number\n). qq(X-$gProject-PR-Package: $data->{package}\n). qq(X-$gProject-PR-Title: $data->{subject}) if defined $data; print STDERR "Tried to loop me with $envelope_from\n" and exit 1 if $envelope_from =~ /\Q$gListDomain\E|\Q$gEmailDomain\E/; print DEBUG $envelope_from,qq(\n); # If we don't have a bug address, something has gone horribly wrong. print STDERR "Doesn't match: $bug_address\n" and exit 1 unless defined $bug_address; $bug_address =~ s/\@.+//; print DEBUG "Sending message to bugs=$bug_address\@$gListDomain\n"; print DEBUG $header.qq(\n\n).$body; send_mail_message(message => $header.qq(\n\n).$body, recipients => ["bugs=$bug_address\@$gListDomain"], envelope_from => $envelope_from, encode_headers => 0, ); unlink("incoming/P$bug_fn") || &quit("unlinking incoming/P$bug_fn: $!"); exit 0; }