X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fbugreport.cgi;h=c04854b8d7499bb5a6e8dec555ef86985d650bc7;hb=36d34844900d653da2cfa79c00e67a6c4fca7fae;hp=64e367a5f0f25a482e999337618f2857110a9172;hpb=0f065213f9397f5a319264cdccac24bd1ad5d3e6;p=debbugs.git diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi index 64e367a..c04854b 100755 --- a/cgi/bugreport.cgi +++ b/cgi/bugreport.cgi @@ -1,7 +1,6 @@ #!/usr/bin/perl -wT -package debbugs; - +use warnings; use strict; use POSIX qw(strftime tzset); use MIME::Parser; @@ -9,44 +8,65 @@ use MIME::Decoder; use IO::Scalar; use IO::File; -#require '/usr/lib/debbugs/errorlib'; -require './common.pl'; - -require '/etc/debbugs/config'; -require '/etc/debbugs/text'; - -use vars(qw($gEmailDomain $gHTMLTail $gSpoolDir $gWebDomain)); +use Debbugs::Config qw(:globals :text); # for read_log_records use Debbugs::Log; -use Debbugs::MIME qw(convert_to_utf8 decode_rfc1522); +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); - -my %param = readparse(); +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); @@ -86,11 +106,11 @@ sub display_entity ($$$$\$\@) { foreach (qw(From To Cc Subject Date)) { my $head_field = $head->get($_); next unless defined $head_field and $head_field ne ''; - push @headers, qq($_: ) . htmlsanit(decode_rfc1522($head_field)); + push @headers, qq($_: ) . html_escape(decode_rfc1522($head_field)); } $$this .= join(qq(), @headers) unless $terse; } else { - $$this .= htmlsanit(decode_rfc1522($entity->head->stringify)); + $$this .= html_escape(decode_rfc1522($entity->head->stringify)); } $$this .= "\n"; } @@ -98,11 +118,11 @@ sub display_entity ($$$$\$\@) { 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 } .
+	$$this .= '
[$printname } .
 		  "($type, $disposition)]
\n"; if ($msg and defined($att) and $att eq $#$attachments) { @@ -155,12 +175,12 @@ sub display_entity ($$$$\$\@) { 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 = htmlsanit($body); + $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; + ][my $temp = $1; $temp =~ s{(\d+)}{qq($1)}ge; $temp;]gxie; $$this .= qq(
$body
\n); } } @@ -175,24 +195,21 @@ 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 < -$short - $debbugs::gProject $debbugs::gBug report logs +$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 @@ -212,29 +229,45 @@ if ($status{severity} eq 'normal') { $showseverity = "Severity: $status{severity};\n"; } +if (@{$status{found_versions}} or @{$status{fixed_versions}}) { + $indexentry.= q(
version graph
}; +} + + $indexentry .= "
\n"; -$indexentry .= htmlpackagelinks($status{package}, 0) . ";\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 .= - htmlmaintlinks(sub { $_[0] == 1 ? "Maintainer for $pkg is\n" + 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)"); + '$tsrc" if ($tsrc ne "(unknown)"); $indexentry .= ".\n"; } $indexentry .= "
"; -$indexentry .= htmladdresslinks("Reported by: ", \&submitterurl, +$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 .= "
Owned by: " . htmlsanit($status{owner}) . ".\n" +$indexentry .= "
Owned by: " . html_escape($status{owner}) . ".\n" if length $status{owner}; $indexentry .= "
\n"; @@ -243,7 +276,7 @@ my @descstates; $indexentry .= "

$showseverity"; $indexentry .= sprintf "Tags: %s;\n", - htmlsanit(join(", ", sort(split(/\s+/, $status{tags})))) + html_escape(join(", ", sort(split(/\s+/, $status{tags})))) if length($status{tags}); $indexentry .= "
" if (length($showseverity) or length($status{tags})); @@ -252,7 +285,7 @@ if (@merged) { my $descmerged = 'Merged with '; my $mseparator = ''; for my $m (@merged) { - $descmerged .= $mseparator."#$m"; + $descmerged .= $mseparator."#$m"; $mseparator= ",\n"; } push @descstates, $descmerged; @@ -261,21 +294,32 @@ 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(decode_rfc1522($status{done})); + $fixedtext .= ' by ' . html_escape(decode_rfc1522($status{done})); } push @descstates, $fixedtext; -} elsif (length($status{done})) { - push @descstates, "Done: ".htmlsanit(decode_rfc1522($status{done})); -} elsif (length($status{forwarded})) { +} + +if (@{$status{found_versions}} or @{$status{fixed_versions}}) { + push @descstates, 'Version Graph}; +} + +if (length($status{done})) { + push @descstates, "Done: ".html_escape(decode_rfc1522($status{done})); +} + +if (length($status{forwarded})) { push @descstates, "Forwarded to ".maybelink($status{forwarded}); } @@ -283,18 +327,18 @@ if (@{$status{fixed_versions}}) { my @blockedby= split(/ /, $status{blockedby}); if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) { for my $b (@blockedby) { - my %s = %{getbugstatus($b)}; + my %s = %{get_bug_status($b)}; next if $s{"pending"} eq 'fixed' || length $s{done}; - push @descstates, "Fix blocked by #$b: ".htmlsanit($s{subject}); + 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 = %{getbugstatus($b)}; + my %s = %{get_bug_status($b)}; next if $s{"pending"} eq 'fixed' || length $s{done}; - push @descstates, "Blocking fix for #$b: ".htmlsanit($s{subject}); + push @descstates, "Blocking fix for #$b: ".html_escape($s{subject}); } } @@ -323,7 +367,7 @@ eval{ @records = read_log_records($buglogfh); }; if ($@) { - quitcgi("Bad bug log for $debbugs::gBug $ref. Unable to read records: $@"); + quitcgi("Bad bug log for $gBug $ref. Unable to read records: $@"); } undef $buglogfh; @@ -356,30 +400,6 @@ sub handle_email_message{ } -=head2 bug_links - - bug_links($one_bug); - bug_links($starting_bug,$stoping_bugs,); - -Creates a set of links to bugs, starting with bug number -$starting_bug, and finishing with $stoping_bug; if only one bug is -passed, makes a link to only a single bug. - -The content of the link is the bug number. - -=cut - -sub bug_links{ - my ($start,$stop,$query_arguments) = @_; - $stop = $stop || $start; - $query_arguments ||= ''; - my @output; - for my $bug ($start..$stop) { - push @output,'$bug); - } - return join(', ',@output); -} - =head2 handle_record push @log, handle_record($record,$ref,$msg_num); @@ -396,6 +416,8 @@ sub handle_record{ my $output = ''; local $_ = $record->{type}; if (/html/) { + my ($time) = $record->{text} =~ //; + 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) @@ -404,13 +426,20 @@ sub handle_record{ $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.'; + {$1.q($2).$3.q($4).$5}eo; + if (defined $time) { + $output .= ' ('.strftime('%a, %d %b %Y %T GMT',gmtime($time)).') '; + } + $output .= 'Full text and rfc822 format available.'; - $output = qq(\n"; + $output = qq(

\n
\n) . $output . "
\n"; } elsif (/recips/) { my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im; @@ -420,8 +449,8 @@ sub handle_record{ elsif (defined $msg_id) { $$seen_msg_ids{$msg_id} = 1; } - $output .= qq(\n); - $output .= 'View this message in rfc822 format'; + $output .= qq(

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

'; $output .= handle_email_message($record->{text}, ref => $bug_number, msg_number => $msg_number, @@ -440,8 +469,8 @@ sub handle_record{ } # Incomming Mail Message my ($received,$hostname) = $record->{text} =~ m/Received: \(at (\S+)\) by (\S+)\;/; - $output .= qq|

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

\n"; + $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, @@ -462,6 +491,7 @@ if (looks_like_number($msg) and ($msg-1) <= $#records) { } my @log; if ( $mbox ) { + 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"; @@ -471,9 +501,49 @@ if ( $mbox ) { 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)$/; - next if not $boring and $record->{type} eq 'recips' and @records > 1; + 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 ]; @@ -481,7 +551,6 @@ if ( $mbox ) { $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 ]; @@ -504,29 +573,57 @@ else { } @log = reverse @log if $reverse; -$log = join('
',@log); +$log = join("\n",@log); print "Content-Type: text/html; charset=utf-8\n\n"; -my $title = htmlsanit($status{subject}); +my $title = html_escape($status{subject}); -my $dummy2 = $debbugs::gWebHostBugDir; +my $dummy2 = $gWebHostBugDir; print "\n"; -print "\n" . - "$short - $title - $debbugs::gProject $debbugs::gBug report logs\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", bugurl($ref, "mbox"); -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";