X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fbugreport.cgi;h=4c8e05d750766b56a2f996e9fdf969602d7daa77;hb=1ada21acbca5ff899357471aae7de3f9ee5d1f3d;hp=5fe8db54e18e84350e762858b277d5a142ec8519;hpb=2ee73259657d024a84208bc1f056606b668d2f74;p=debbugs.git diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi index 5fe8db5..4c8e05d 100755 --- a/cgi/bugreport.cgi +++ b/cgi/bugreport.cgi @@ -1,49 +1,77 @@ #!/usr/bin/perl -wT -package debbugs; - +use warnings; use strict; use POSIX qw(strftime tzset); use MIME::Parser; use MIME::Decoder; use IO::Scalar; -use IO::Lines; - -#require '/usr/lib/debbugs/errorlib'; -require './common.pl'; - -require '/etc/debbugs/config'; -require '/etc/debbugs/text'; - -use vars(qw($gEmailDomain $gHTMLTail $gSpoolDir $gWebDomain)); - -my %param = readparse(); +use IO::File; + +use Debbugs::Config qw(:globals :text); + +# for read_log_records +use Debbugs::Log; +use Debbugs::MIME qw(convert_to_utf8 decode_rfc1522 create_mime_message); +use Debbugs::CGI qw(:url :html :util); +use Debbugs::Common qw(buglog getmaintainers); +use Debbugs::Packages qw(getpkgsrc); +use Debbugs::Status qw(splitpackages get_bug_status isstrongseverity); + +use Scalar::Util qw(looks_like_number); +use CGI::Simple; +my $q = new CGI::Simple; + +my %param = cgi_parameters(query => $q, + single => [qw(bug msg att boring terse), + qw(reverse mbox mime trim), + qw(mboxstat mboxmaint archive), + qw(repeatmerged) + ], + default => {msg => '', + boring => 'no', + terse => 'no', + reverse => 'no', + mbox => 'no', + mime => 'no', + mboxstat => 'no', + mboxmaint => 'no', + archive => 'no', + repeatmerged => 'yes', + }, + ); +# This is craptacular. my $tail_html; -my $ref = $param{'bug'} || quitcgi("No bug number"); +my $ref = $param{bug} or quitcgi("No bug number"); $ref =~ /(\d+)/ or quitcgi("Invalid bug number"); $ref = $1; my $short = "#$ref"; -my $msg = $param{'msg'} || ""; +my $msg = $param{'msg'}; my $att = $param{'att'}; -my $boring = ($param{'boring'} || 'no') eq 'yes'; -my $terse = ($param{'terse'} || 'no') eq 'yes'; -my $reverse = ($param{'reverse'} || 'no') eq 'yes'; -my $mbox = ($param{'mbox'} || 'no') eq 'yes'; -my $mime = ($param{'mime'} || 'yes') eq 'yes'; +my $boring = $param{'boring'} eq 'yes'; +my $terse = $param{'terse'} eq 'yes'; +my $reverse = $param{'reverse'} eq 'yes'; +my $mbox = $param{'mbox'} eq 'yes'; +my $mime = $param{'mime'} eq 'yes'; + +my $trim_headers = ($param{trim} || ($msg?'no':'yes')) eq 'yes'; + +my $mbox_status_message = $param{mboxstat} eq 'yes'; +my $mbox_maint = $param{mboxmaint} eq 'yes'; +$mbox = 1 if $mbox_status_message or $mbox_maint; + # Not used by this script directly, but fetch these so that pkgurl() and # friends can propagate them correctly. -my $archive = ($param{'archive'} || 'no') eq 'yes'; -my $repeatmerged = ($param{'repeatmerged'} || 'yes') eq 'yes'; -set_option('archive', $archive); -set_option('repeatmerged', $repeatmerged); +my $archive = $param{'archive'} eq 'yes'; +my $repeatmerged = $param{'repeatmerged'} eq 'yes'; my $buglog = buglog($ref); -if ($ENV{REQUEST_METHOD} eq 'HEAD' and not defined($att) and not $mbox) { - print "Content-Type: text/html\n"; +if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD' and not defined($att) and not $mbox) { + print "Content-Type: text/html; charset=utf-8\n"; my @stat = stat $buglog; if (@stat) { my $mtime = strftime '%a, %d %b %Y %T GMT', gmtime($stat[9]); @@ -68,29 +96,50 @@ sub display_entity ($$$$\$\@) { my $type = $entity->effective_type; my $filename = $entity->head->recommended_filename; $filename = '' unless defined $filename; - - if ($top) { - $$this .= htmlsanit($entity->stringify_header) unless ($terse); - $$this .= "\n"; + $filename = decode_rfc1522($filename); + + if ($top and not $terse) { + my $header = $entity->head; + $$this .= "
\n";
+	 if ($trim_headers) {
+	      my @headers;
+	      foreach (qw(From To Cc Subject Date)) {
+		   my $head_field = $head->get($_);
+		   next unless defined $head_field and $head_field ne '';
+		   push @headers, qq($_: ) . html_escape(decode_rfc1522($head_field));
+	      }
+	      $$this .= join(qq(), @headers) unless $terse;
+	 } else {
+	      $$this .= html_escape(decode_rfc1522($entity->head->stringify));
+	 }
+	 $$this .= "
\n"; } unless (($top and $type =~ m[^text(?:/plain)?(?:;|$)]) or ($type =~ m[^multipart/])) { push @$attachments, $entity; - my @dlargs = ($ref, "msg=$xmessage", "att=$#$attachments"); - push @dlargs, "filename=$filename" if $filename ne ''; + my @dlargs = ($ref, msg=>$xmessage, att=>$#$attachments); + push @dlargs, (filename=>$filename) if $filename ne ''; my $printname = $filename; $printname = 'Message part ' . ($#$attachments + 1) if $filename eq ''; - $$this .= '[$printname } . - "($type, $disposition)]\n\n"; + $$this .= '
[$printname } .
+		  "($type, $disposition)]
\n"; if ($msg and defined($att) and $att eq $#$attachments) { my $head = $entity->head; chomp(my $type = $entity->effective_type); my $body = $entity->stringify_body; print "Content-Type: $type"; - print "; name=$filename" if $filename ne ''; - print "\n\n"; + my ($charset) = $head->get('Content-Type:') =~ m/charset\s*=\s*\"?([\w-]+)\"?/i; + print qq(; charset="$charset") if defined $charset; + print "\n"; + if ($filename ne '') { + my $qf = $filename; + $qf =~ s/"/\\"/g; + $qf =~ s[.*/][]; + print qq{Content-Disposition: inline; filename="$qf"\n}; + } + print "\n"; my $decoder = new MIME::Decoder($head->mime_encoding); $decoder->decode(new IO::Scalar(\$body), \*STDOUT); exit(0); @@ -98,7 +147,8 @@ sub display_entity ($$$$\$\@) { } return if not $top and $disposition eq 'attachment' and not defined($att); - return unless ($type =~ m[^text/?] and $type !~ m[^text/html(?:;|$)]) or + return unless ($type =~ m[^text/?] and + $type !~ m[^text/(?:html|enriched)(?:;|$)]) or $type =~ m[^application/pgp(?:;|$)] or $entity->parts; @@ -120,7 +170,19 @@ sub display_entity ($$$$\$\@) { } $$this .= "\n"; } else { - $$this .= htmlsanit($entity->bodyhandle->as_string) unless ($terse); + if (not $terse) { + my $content_type = $entity->head->get('Content-Type:') || "text/html"; + my ($charset) = $content_type =~ m/charset\s*=\s*\"?([\w-]+)\"?/i; + my $body = $entity->bodyhandle->as_string; + $body = convert_to_utf8($body,$charset) if defined $charset; + $body = html_escape($body); + # Add links to URLs + $body =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),$1$3,go; + # Add links to bug closures + $body =~ s[(closes:\s*(?:bug)?\#?\s?\d+(?:,?\s*(?:bug)?\#?\s?\d+)*) + ][my $temp = $1; $temp =~ s{(\d+)}{qq($1)}ge; $temp;]gxie; + $$this .= qq(
$body
\n); + } } } @@ -128,30 +190,26 @@ my %maintainer = %{getmaintainers()}; my %pkgsrc = %{getpkgsrc()}; my $indexentry; -my $descriptivehead; my $showseverity; my $tpack; my $tmain; -$ENV{"TZ"} = 'UTC'; -tzset(); - -my $dtime = strftime "%a, %e %b %Y %T UTC", localtime; -$tail_html = $debbugs::gHTMLTail; +my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime; +$tail_html = $gHTMLTail; $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/; -my %status = %{getbugstatus($ref)}; +my %status = %{get_bug_status(bug=>$ref)}; unless (%status) { print < -$debbugs::gProject $debbugs::gBug report logs - $short +$short - $gProject $gBug report logs -

$debbugs::gProject $debbugs::gBug report logs - $short

-

There is no record of $debbugs::gBug $short. +

$gProject $gBug report logs - $short

+

There is no record of $gBug $short. Try the search page instead.

$tail_html EOF @@ -165,34 +223,69 @@ my @tpacks = splitpackages($tpack); if ($status{severity} eq 'normal') { $showseverity = ''; -#} elsif (isstrongseverity($status{severity})) { -# $showseverity = "Severity: $status{severity};\n"; +} elsif (isstrongseverity($status{severity})) { + $showseverity = "Severity: $status{severity};\n"; } else { - $showseverity = "Severity: $status{severity};\n"; + $showseverity = "Severity: $status{severity};\n"; +} + +if (@{$status{found_versions}} or @{$status{fixed_versions}}) { + $indexentry.= q(
version graph
}; +} + + +$indexentry .= "
\n"; +$indexentry .= htmlize_packagelinks($status{package}, 0) . ";\n"; + +foreach my $pkg (@tpacks) { + my $tmaint = defined($maintainer{$pkg}) ? $maintainer{$pkg} : '(unknown)'; + my $tsrc = defined($pkgsrc{$pkg}) ? $pkgsrc{$pkg} : '(unknown)'; + + $indexentry .= + htmlize_maintlinks(sub { $_[0] == 1 ? "Maintainer for $pkg is\n" + : "Maintainers for $pkg are\n" }, + $tmaint); + $indexentry .= ";\nSource for $pkg is\n". + '$tsrc" if ($tsrc ne "(unknown)"); + $indexentry .= ".\n"; } -$indexentry .= "

$showseverity"; -$indexentry .= htmlpackagelinks($status{package}, 0); +$indexentry .= "
"; +$indexentry .= htmlize_addresslinks("Reported by: ", \&submitterurl, + $status{originator}) . ";\n"; +$indexentry .= sprintf "Date: %s.\n", + (strftime "%a, %e %b %Y %T UTC", localtime($status{date})); -$indexentry .= "Reported by: " . htmlsanit($status{originator}) . ";\n"; +$indexentry .= "
Owned by: " . html_escape($status{owner}) . ".\n" + if length $status{owner}; -my $dummy = strftime "%a, %e %b %Y %T UTC", localtime($status{date}); -$indexentry .= "Date: ".$dummy.";\n
"; +$indexentry .= "

\n"; my @descstates; -push @descstates, "Tags: " - . htmlsanit(join(", ", sort(split(/\s+/, $status{tags})))) - . "" +$indexentry .= "

$showseverity"; +$indexentry .= sprintf "Tags: %s;\n", + html_escape(join(", ", sort(split(/\s+/, $status{tags})))) if length($status{tags}); +$indexentry .= "
" if (length($showseverity) or length($status{tags})); my @merged= split(/ /,$status{mergedwith}); if (@merged) { - my $descmerged = 'merged with '; + my $descmerged = 'Merged with '; my $mseparator = ''; for my $m (@merged) { - $descmerged .= $mseparator."#$m"; + $descmerged .= $mseparator."#$m"; $mseparator= ",\n"; } push @descstates, $descmerged; @@ -201,253 +294,335 @@ if (@merged) { if (@{$status{found_versions}}) { my $foundtext = 'Found in '; $foundtext .= (@{$status{found_versions}} == 1) ? 'version ' : 'versions '; - $foundtext .= join ', ', map htmlsanit($_), @{$status{found_versions}}; + $foundtext .= join ', ', map html_escape($_), @{$status{found_versions}}; push @descstates, $foundtext; } - if (@{$status{fixed_versions}}) { my $fixedtext = 'Fixed in '; $fixedtext .= (@{$status{fixed_versions}} == 1) ? 'version ' : 'versions '; - $fixedtext .= join ', ', map htmlsanit($_), @{$status{fixed_versions}}; + $fixedtext .= join ', ', map html_escape($_), @{$status{fixed_versions}}; if (length($status{done})) { - $fixedtext .= ' by ' . htmlsanit($status{done}); + $fixedtext .= ' by ' . html_escape(decode_rfc1522($status{done})); } push @descstates, $fixedtext; -} elsif (length($status{done})) { - push @descstates, "Done: ".htmlsanit($status{done}); -} elsif (length($status{forwarded})) { - push @descstates, "Forwarded to ".maybelink($status{forwarded}); } -$indexentry .= join(";\n", @descstates) . ";\n
" if @descstates; +if (@{$status{found_versions}} or @{$status{fixed_versions}}) { + push @descstates, 'Version Graph}; +} -$descriptivehead = $indexentry; -foreach my $pkg (@tpacks) { - my $tmaint = defined($maintainer{$pkg}) ? $maintainer{$pkg} : '(unknown)'; - my $tsrc = defined($pkgsrc{$pkg}) ? $pkgsrc{$pkg} : '(unknown)'; +if (length($status{done})) { + push @descstates, "Done: ".html_escape(decode_rfc1522($status{done})); +} - $descriptivehead .= - htmlmaintlinks(sub { $_[0] == 1 ? "Maintainer for $pkg is\n" - : "Maintainers for $pkg are\n" }, - $tmaint); - $descriptivehead .= ";\nSource for $pkg is\n". - '$tsrc" if ($tsrc ne "(unknown)"); - $descriptivehead .= ".\n
"; +if (length($status{forwarded})) { + push @descstates, "Forwarded to ".maybelink($status{forwarded}); +} + + +my @blockedby= split(/ /, $status{blockedby}); +if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) { + for my $b (@blockedby) { + my %s = %{get_bug_status($b)}; + next if $s{"pending"} eq 'fixed' || length $s{done}; + push @descstates, "Fix blocked by #$b: ".html_escape($s{subject}); + } +} + +my @blocks= split(/ /, $status{blocks}); +if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) { + for my $b (@blocks) { + my %s = %{get_bug_status($b)}; + next if $s{"pending"} eq 'fixed' || length $s{done}; + push @descstates, "Blocking fix for #$b: ".html_escape($s{subject}); + } } -open L, "<$buglog" or &quitcgi("open log for $ref: $!"); if ($buglog !~ m#^\Q$gSpoolDir/db#) { - $descriptivehead .= "\n

Bug is archived. No further changes may be made.

"; + push @descstates, "Bug is archived. No further changes may be made"; } -my $log=''; +$indexentry .= join(";\n
", @descstates) . ".\n" if @descstates; +$indexentry .= "

\n"; -my $xmessage = 1; -my $suppressnext = 0; -my $found_msgid = 0; -my %seen_msgid = (); - -my $thisheader = ''; -my $this = ''; - -my $cmsg = 1; - -my $normstate= 'kill-init'; -my $linenum = 0; -my @mail = (); -my @mails = (); -while(my $line = ) { - $linenum++; - if ($line =~ m/^.$/ and 1 <= ord($line) && ord($line) <= 7) { - # state transitions - my $newstate; - my $statenum = ord($line); - - $newstate = 'autocheck' if ($statenum == 1); - $newstate = 'recips' if ($statenum == 2); - $newstate = 'kill-end' if ($statenum == 3); - $newstate = 'go' if ($statenum == 5); - $newstate = 'html' if ($statenum == 6); - $newstate = 'incoming-recv' if ($statenum == 7); - - # disallowed transitions: - $_ = "$normstate $newstate"; - unless (m/^(go|go-nox|html) kill-end$/ - || m/^(kill-init|kill-end) (incoming-recv|autocheck|recips|html)$/ - || m/^kill-body go$/) - { - &quitcgi("$ref: Transition from $normstate to $newstate at $linenum disallowed"); - } - -#$this .= "\n
states: $normstate $newstate
\n"; - -# if ($newstate eq 'go') { -# $this .= "
\n";
-#		}
-		if ($newstate eq 'html') {
-			$this = '';
-		}
-
-		if ($newstate eq 'kill-end') {
-
-			my $show = 1;
-			$show = $boring
-				if ($suppressnext && $normstate ne 'html');
-
-			$show = ($xmessage == $msg) if ($msg);
-
-			push @mails, join( '', @mail ) if ( $mbox && @mail );
-			if ($show) {
-				if (not $mime and @mail) {
-					$this .= htmlsanit(join '', @mail);
-				} elsif (@mail) {
-					my $parser = new MIME::Parser;
-					$parser->tmp_to_core(1);
-					$parser->output_to_core(1);
-#					$parser->output_under("/tmp");
-					my $entity = $parser->parse( new IO::Lines \@mail );
-					# TODO: make local subdir, clean it ourselves
-					# the following does NOT delete the msg dirs in /tmp
-					END { if ( $entity ) { $entity->purge; } if ( $parser ) { $parser->filer->purge; } }
-					my @attachments = ();
-					display_entity($entity, $ref, 1, $xmessage, $this, @attachments);
-				}
-#				if ($normstate eq 'go' || $normstate eq 'go-nox') {
-				if ($normstate ne 'html') {
-					$this = "
\n$this
\n"; - } - if ($normstate eq 'html') { - $this .= " Full text available."; - } - $this = "$thisheader$this" if $thisheader && !( $normstate eq 'html' );; - $thisheader = ''; - my $delim = $terse ? "

" : "


"; - if ($reverse) { - $log = "$this\n$delim$log"; - } else { - $log .= "$this\n$delim\n"; - } - } - - $xmessage++ if ($normstate ne 'html'); - - $suppressnext = $normstate eq 'html'; - $found_msgid = 0; - } - - $normstate = $newstate; - @mail = (); - next; - } +my $descriptivehead = $indexentry; + +my $buglogfh; +if ($buglog =~ m/\.gz$/) { + my $oldpath = $ENV{'PATH'}; + $ENV{'PATH'} = '/bin:/usr/bin'; + $buglogfh = new IO::File "zcat $buglog |" or &quitcgi("open log for $ref: $!"); + $ENV{'PATH'} = $oldpath; +} else { + $buglogfh = new IO::File "<$buglog" or &quitcgi("open log for $ref: $!"); +} + + +my @records; +eval{ + @records = read_log_records($buglogfh); +}; +if ($@) { + quitcgi("Bad bug log for $gBug $ref. Unable to read records: $@"); +} +undef $buglogfh; + +=head2 handle_email_message + + handle_email_message($record->{text}, + ref => $bug_number, + msg_number => $msg_number, + ); + +Returns a decoded e-mail message and displays entities/attachments as +appropriate. + + +=cut + +sub handle_email_message{ + my ($email,%options) = @_; + + my $output = ''; + my $parser = new MIME::Parser; + # Because we are using memory, not tempfiles, there's no need to + # clean up here like in Debbugs::MIME + $parser->tmp_to_core(1); + $parser->output_to_core(1); + my $entity = $parser->parse_data( $email); + my @attachments = (); + display_entity($entity, $options{ref}, 1, $options{msg_number}, $output, @attachments); + return $output; - $_ = $line; - if ($normstate eq 'incoming-recv') { - my $pl= $_; - $pl =~ s/\n+$//; - m/^Received: \(at (\S+)\) by (\S+)\;/ - || &quitcgi("bad line \`$pl' in state incoming-recv"); - $thisheader = "

Message received at ".htmlsanit("$1\@$2") - . ":

\n"; - $this = ''; - $normstate= 'go'; - push @mail, $_; - } elsif ($normstate eq 'html') { - $this .= $_; - } elsif ($normstate eq 'go') { - s/^\030//; - if (!$suppressnext && !$found_msgid && - /^Message-ID: <(.*)>/i) { - my $msgid = $1; - $found_msgid = 1; - if ($seen_msgid{$msgid}) { - $suppressnext = 1; - } else { - $seen_msgid{$msgid} = 1; - } - } - if (@mail) { - push @mail, $_; - } else { - $this .= htmlsanit($_); - } - } elsif ($normstate eq 'go-nox') { - next if !s/^X//; - if (!$suppressnext && !$found_msgid && - /^Message-ID: <(.*)>/i) { - my $msgid = $1; - $found_msgid = 1; - if ($seen_msgid{$msgid}) { - $suppressnext = 1; - } else { - $seen_msgid{$msgid} = 1; - } - } - if (@mail) { - push @mail, $_; - } else { - $this .= htmlsanit($_); - } - } elsif ($normstate eq 'recips') { - if (m/^-t$/) { - $thisheader = "

Message sent:

\n"; - } else { - s/\04/, /g; s/\n$//; - $thisheader = "

Message sent to ".htmlsanit($_).":

\n"; - } - $this = ""; - $normstate= 'kill-body'; - } elsif ($normstate eq 'autocheck') { - next if !m/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/; - $normstate= 'autowait'; - $thisheader = "

Message received at $2:

\n"; - $this = ''; - push @mail, $_; - } elsif ($normstate eq 'autowait') { - next if !m/^$/; - $normstate= 'go-nox'; - } else { - &quitcgi("$ref state $normstate line \`$_'"); - } } -&quitcgi("$ref state $normstate at end") unless $normstate eq 'kill-end'; -close(L); +=head2 handle_record + + push @log, handle_record($record,$ref,$msg_num); + +Deals with a record in a bug log as returned by +L; returns the log information that +should be output to the browser. + +=cut + +sub handle_record{ + my ($record,$bug_number,$msg_number,$seen_msg_ids) = @_; + + my $output = ''; + local $_ = $record->{type}; + if (/html/) { + my $class = $record->{text} =~ /^(?:Acknowledgement|Reply|Information|Report|Notification)/ ? 'infmessage':'msgreceived'; + $output .= decode_rfc1522($record->{text}); + # Link to forwarded http:// urls in the midst of the report + # (even though these links already exist at the top) + $output =~ s,((?:ftp|http|https)://[\S~-]+?/?)([\)\'\:\.\,]?(?:\s|\.<|$)),$1$2,go; + # Add links to the cloned bugs + $output =~ s{(Bug )(\d+)( cloned as bugs? )(\d+)(?:\-(\d+)|)}{$1.bug_links($2).$3.bug_links($4,$5)}eo; + # Add links to merged bugs + $output =~ s{(?<=Merged )([\d\s]+)(?=\.)}{join(' ',map {bug_links($_)} (split /\s+/, $1))}eo; + # Add links to blocked bugs + $output =~ s{(?<=Blocking bugs)(?:( of )(\d+))?( (?:added|set to|removed):\s+)([\d\s\,]+)} + {(defined $2?$1.bug_links($2):'').$3. + join(' ',map {bug_links($_)} (split /\,?\s+/, $4))}eo; + # Add links to reassigned packages + $output =~ s{(Bug reassigned from package \`)([^\']+)(' to \`)([^\']+)(')} + {$1.q($2).$3.q($4).$5}eo; + $output .= 'Full text and rfc822 format available.'; + + $output = qq(

\n\n) . $output . "
\n"; + } + elsif (/recips/) { + my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im; + if (defined $msg_id and exists $$seen_msg_ids{$msg_id}) { + return (); + } + elsif (defined $msg_id) { + $$seen_msg_ids{$msg_id} = 1; + } + $output .= qq(

\n); + $output .= 'View this message in rfc822 format

'; + $output .= handle_email_message($record->{text}, + ref => $bug_number, + msg_number => $msg_number, + ); + } + elsif (/autocheck/) { + # Do nothing + } + elsif (/incoming-recv/) { + my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im; + if (defined $msg_id and exists $$seen_msg_ids{$msg_id}) { + return (); + } + elsif (defined $msg_id) { + $$seen_msg_ids{$msg_id} = 1; + } + # Incomming Mail Message + my ($received,$hostname) = $record->{text} =~ m/Received: \(at (\S+)\) by (\S+)\;/; + $output .= qq|

Message received at |. + html_escape("$received\@$hostname") . q| (full text'.q|, mbox)'.":

\n"; + $output .= handle_email_message($record->{text}, + ref => $bug_number, + msg_number => $msg_number, + ); + } + else { + die "Unknown record type $_"; + } + return $output; +} + +my $log=''; +my $msg_num = 0; +my $skip_next = 0; +if (looks_like_number($msg) and ($msg-1) <= $#records) { + @records = ($records[$msg-1]); + $msg_num = $msg - 1; +} +my @log; if ( $mbox ) { - print "Content-Type: text/plain\n\n"; - foreach ( @mails ) { - my @lines = split( "\n", $_, -1 ); - if ( $lines[ 1 ] =~ m/^From / ) { - my $tmp = $lines[ 0 ]; - $lines[ 0 ] = $lines[ 1 ]; - $lines[ 1 ] = $tmp; - } - if ( !( $lines[ 0 ] =~ m/^From / ) ) { - my $date = strftime "%a %b %d %T %Y", localtime; - unshift @lines, "From unknown $date"; - } - map { s/^(>*From )/>$1/ } @lines[ 1 .. $#lines ]; - $_ = join( "\n", @lines ) . "\n"; - } - print join("", @mails ); - exit 0; + my $date = strftime "%a %b %d %T %Y", localtime; + if (@records > 1) { + print qq(Content-Disposition: attachment; filename="bug_${ref}.mbox"\n); + print "Content-Type: text/plain\n\n"; + } + else { + $msg_num++; + print qq(Content-Disposition: attachment; filename="bug_${ref}_message_${msg_num}.mbox"\n); + print "Content-Type: message/rfc822\n\n"; + } + if ($mbox_status_message and @records > 1) { + my $status_message=''; + my @status_fields = (retitle => 'subject', + package => 'package', + submitter => 'originator', + severity => 'severity', + tag => 'tags', + owner => 'owner', + blocks => 'blocks', + forward => 'forward', + ); + my ($key,$value); + while (($key,$value) = splice(@status_fields,0,2)) { + if (defined $status{$value} and length $status{$value}) { + $status_message .= qq($key $ref $status{$value}\n); + } + } + print STDOUT qq(From unknown $date\n), + create_mime_message([From => "$gBug#$ref <$ref\@$gEmailDomain>", + To => "$gBug#$ref <$ref\@$gEmailDomain>", + Subject => "Status: $status{subject}", + "Reply-To" => "$gBug#$ref <$ref\@$gEmailDomain>", + ], + <{type} !~ /^(?:recips|incoming-recv)$/; + my $wanted_type = $mbox_maint?'recips':'incoming-recv'; + # we want to include control messages anyway + my $record_wanted_anyway = 0; + my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im; + next if exists $seen_message_ids{$msg_id}; + next if $msg_id =~/handler\..+\.ack(?:info|done)?\@/; + $record_wanted_anyway = 1 if $record->{text} =~ /^Received: \(at control\)/; + next if not $boring and not $record->{type} eq $wanted_type and not $record_wanted_anyway and @records > 1; + $seen_message_ids{$msg_id} = 1; + my @lines = split( "\n", $record->{text}, -1 ); + if ( $lines[ 1 ] =~ m/^From / ) { + my $tmp = $lines[ 0 ]; + $lines[ 0 ] = $lines[ 1 ]; + $lines[ 1 ] = $tmp; + } + if ( !( $lines[ 0 ] =~ m/^From / ) ) { + unshift @lines, "From unknown $date"; + } + map { s/^(>*From )/>$1/ } @lines[ 1 .. $#lines ]; + print join( "\n", @lines ) . "\n"; + } + exit 0; } -print "Content-Type: text/html\n\n"; -my $title = htmlsanit($status{subject}); +else { + my %seen_msg_ids; + for my $record (@records) { + $msg_num++; + if ($skip_next) { + $skip_next = 0; + next; + } + $skip_next = 1 if $record->{type} eq 'html' and not $boring; + push @log, handle_record($record,$ref,$msg_num,\%seen_msg_ids); + } +} + +@log = reverse @log if $reverse; +$log = join("\n",@log); + + +print "Content-Type: text/html; charset=utf-8\n\n"; + +my $title = html_escape($status{subject}); + +my $dummy2 = $gWebHostBugDir; print "\n"; -print "\n" . - "$debbugs::gProject $debbugs::gBug report logs - $short - $title\n" . - "\n" . - '' . - "\n"; -print "

" . "$debbugs::gProject $debbugs::gBug report logs - $short" . +print < +$short - $title - $gProject $gBug report logs + + + + + +END +print "

" . "$gProject $gBug report logs - $short" . "
" . $title . "

\n"; - print "$descriptivehead\n"; -printf "

View this report as an mbox folder.

\n", mboxurl($ref); -print "
"; + +if (looks_like_number($msg)) { + printf qq(

Full log

),html_escape(bug_url($ref)); +} +else { + print qq(

Reply ), + qq(or subscribe ), + qq(to this bug.

\n); + print qq(

Toggle useless messages

); + printf qq(

View this report as an mbox folder, ). + qq(status mbox, maintainer mbox

\n), + html_escape(bug_url($ref, mbox=>'yes')), + html_escape(bug_url($ref, mbox=>'yes',mboxstatus=>'yes')), + html_escape(bug_url($ref, mbox=>'yes',mboxmaint=>'yes')); +} print "$log"; +print "
"; +print "

Send a report that this bug log contains spam.

\n
\n"; print $tail_html; print "\n";