X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fbugreport.cgi;h=83e9b12a2573cc0928b8019793c80ddd7cae76d4;hb=54be6c024cb57d9d537d3b06475a84b4b5929898;hp=5f56eaaa992049e1bc3886421c682af85d7a13c5;hpb=682b8888e2aebb968cf16b7ff3e6356b7f67ec78;p=debbugs.git diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi index 5f56eaa..5cd3d06 100755 --- a/cgi/bugreport.cgi +++ b/cgi/bugreport.cgi @@ -1,34 +1,80 @@ -#!/usr/bin/perl -wT +#!/usr/bin/perl use warnings; use strict; -use POSIX qw(strftime tzset); + +# Sanitize environent for taint +BEGIN{ + delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; +} + + +use POSIX qw(strftime); use MIME::Parser; use MIME::Decoder; use IO::Scalar; use IO::File; -use Debbugs::Config qw(:globals :text); +# if we're running out of git, we want to use the git base directory as the +# first INC directory. If you're not running out of git, don't do that. +use File::Basename qw(dirname); +use Cwd qw(abs_path); +our $debbugs_dir; +BEGIN { + $debbugs_dir = + abs_path(dirname(abs_path(__FILE__)) . '/../'); + # clear the taint; we'll assume that the absolute path to __FILE__ is the + # right path if there's a .git directory there + ($debbugs_dir) = $debbugs_dir =~ /([[:print:]]+)/; + if (defined $debbugs_dir and + -d $debbugs_dir . '/.git/') { + } else { + undef $debbugs_dir; + } + # if the first directory in @INC is not an absolute directory, assume that + # someone has overridden us via -I. + if ($INC[0] !~ /^\//) { + } +} +use if defined $debbugs_dir, lib => $debbugs_dir; + +use Debbugs::Config qw(:globals :text :config); # 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); -use Debbugs::Packages qw(getpkgsrc); -use Debbugs::Status qw(get_bug_status isstrongseverity); +use Debbugs::Log qw(:read); +use Debbugs::Log::Spam; +use Debbugs::CGI qw(:url :html :util :cache :usertags); +use Debbugs::CGI::Bugreport qw(:all); +use Debbugs::Common qw(buglog getmaintainers make_list bug_status package_maintainer); +use Debbugs::Packages qw(binary_to_source); +use Debbugs::DB; +use Debbugs::Status qw(splitpackages split_status_fields get_bug_status isstrongseverity); +use Debbugs::Bug; use Scalar::Util qw(looks_like_number); + +use Debbugs::Text qw(:templates); +use URI::Escape qw(uri_escape_utf8); +use List::AllUtils qw(max); + +my $s; +if (defined $config{database}) { + $s = Debbugs::DB->connect($config{database}) or + die "Unable to connect to database"; +} + use CGI::Simple; my $q = new CGI::Simple; +# STDOUT should be using the utf8 io layer +binmode(STDOUT,':raw:encoding(UTF-8)'); my %param = cgi_parameters(query => $q, single => [qw(bug msg att boring terse), qw(reverse mbox mime trim), qw(mboxstat mboxmaint archive), - qw(repeatmerged) + qw(repeatmerged avatars), ], - default => {msg => '', + default => {# msg => '', boring => 'no', terse => 'no', reverse => 'no', @@ -37,443 +83,182 @@ my %param = cgi_parameters(query => $q, mboxstat => 'no', mboxmaint => 'no', archive => 'no', + repeatmerged => 'yes', + avatars => 'yes', }, ); # This is craptacular. -my $tail_html; - -my $ref = $param{bug} or quitcgi("No bug number"); -$ref =~ /(\d+)/ or quitcgi("Invalid bug number"); +my $ref = $param{bug} or quitcgi("No bug number", '400 Bad Request'); +$ref =~ /(\d+)/ or quitcgi("Invalid bug number", '400 Bad Request'); $ref = $1; my $short = "#$ref"; -my $msg = $param{'msg'}; -my $att = $param{'att'}; +my ($msg) = $param{msg} =~ /^(\d+)$/ if exists $param{msg}; +my ($att) = $param{att} =~ /^(\d+)$/ if exists $param{att}; 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 $avatars = $param{avatars} eq 'yes'; -my $trim_headers = ($param{trim} || ($msg?'no':'yes')) eq 'yes'; +my $trim_headers = ($param{trim} || ((defined $msg and $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'} eq 'yes'; my $repeatmerged = $param{'repeatmerged'} eq 'yes'; -my $buglog = buglog($ref); - -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]); - print "Last-Modified: $mtime\n"; - } - print "\n"; - exit 0; -} - -sub display_entity ($$$$\$\@); -sub display_entity ($$$$\$\@) { - my $entity = shift; - my $ref = shift; - my $top = shift; - my $xmessage = shift; - my $this = shift; - my $attachments = shift; - - my $head = $entity->head; - my $disposition = $head->mime_attr('content-disposition'); - $disposition = 'inline' if not defined $disposition or $disposition eq ''; - my $type = $entity->effective_type; - my $filename = $entity->head->recommended_filename; - $filename = '' unless defined $filename; - $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"; - } +my %bugusertags; +my %ut; +my %seen_users; - 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 $printname = $filename; - $printname = 'Message part ' . ($#$attachments + 1) if $filename eq ''; - $$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"; - 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); - } - } - - return if not $top and $disposition eq 'attachment' and not defined($att); - return unless ($type =~ m[^text/?] and - $type !~ m[^text/(?:html|enriched)(?:;|$)]) or - $type =~ m[^application/pgp(?:;|$)] or - $entity->parts; - - if ($entity->is_multipart) { - my @parts = $entity->parts; - foreach my $part (@parts) { - display_entity($part, $ref, 0, $xmessage, - $$this, @$attachments); - $$this .= "\n"; - } - } elsif ($entity->parts) { - # We must be dealing with a nested message. - $$this .= "
\n"; - my @parts = $entity->parts; - foreach my $part (@parts) { - display_entity($part, $ref, 1, $xmessage, - $$this, @$attachments); - $$this .= "\n"; - } - $$this .= "\n"; - } else { - 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( \n); - } - } +my $buglog = buglog($ref); +my $bug_status = bug_status($ref); +if (not defined $buglog or not defined $bug_status) { + no_such_bug($q,$ref); } -my %maintainer = %{getmaintainers()}; -my %pkgsrc = %{getpkgsrc()}; - -my $indexentry; -my $showseverity; - -my $tpack; -my $tmain; - -my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime; -$tail_html = $gHTMLTail; -$tail_html =~ s/SUBSTITUTE_DTIME/$dtime/; - -my %status = %{get_bug_status(bug=>$ref)}; -unless (%status) { - print <
There is no record of $gBug $short. -Try the search page instead.
-$tail_html -EOF +sub no_such_bug { + my ($q,$ref) = @_; + print $q->header(-status => 404, + -content_type => "text/html", + -charset => 'utf-8', + -cache_control => 'public, max-age=600', + ); + print fill_in_template(template=>'cgi/no_such_bug', + variables => {modify_time => strftime('%a, %e %b %Y %T UTC', gmtime), + bug_num => $ref, + }, + ); exit 0; } -$|=1; - -$tpack = lc $status{'package'}; -my @tpacks = splitpackages($tpack); - -if ($status{severity} eq 'normal') { - $showseverity = ''; -} elsif (isstrongseverity($status{severity})) { - $showseverity = "Severity: $status{severity};\n"; -} else { - $showseverity = "Severity: $status{severity};\n"; +## calculate etag for this bugreport.cgi call +my $etag; +## identify the files that we need to look at; if someone just wants the mbox, +## they don't need to see anything but the buglog; otherwise, track what is +## necessary for the usertags and things to calculate status. + +my @dependent_files = ($buglog); +my $need_status = 0; +if (not (($mbox and not $mbox_status_message) or + (defined $att and defined $msg))) { + $need_status = 1; + push @dependent_files, + $bug_status, + defined $config{version_index} ? $config{version_index}:(), + defined $config{binary_source_map} ? $config{binary_source_map}:(); } -$indexentry .= "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) { +if (defined($msg) and ($msg-1) <= $#records) { @records = ($records[$msg-1]); $msg_num = $msg - 1; } my @log; if ( $mbox ) { + binmode(STDOUT,":raw"); 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"; + print $q->header(-type => "application/mbox", + -cache_control => 'public, max-age=600', + -etag => $etag, + content_disposition => qq(attachment; filename="bug_${ref}.mbox"), + ); } else { $msg_num++; - print qq(Content-Disposition: attachment; filename="bug_${ref}_message_${msg_num}.mbox"\n); - print "Content-Type: message/rfc822\n\n"; + print $q->header(-type => "message/rfc822", + -cache_control => 'public, max-age=86400', + -etag => $etag, + content_disposition => qq(attachment; filename="bug_${ref}_message_${msg_num}.mbox"), + ); } if ($mbox_status_message and @records > 1) { my $status_message=''; @@ -512,28 +297,56 @@ END 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}; - $seen_message_ids{$msg_id} = 1; - next if $msg_id =~/handler\..+\.ack(?:info)?\@/; - $record_wanted_anyway = 1 if $record->{text} =~ /^Received: \(at control\)/; - next if not $boring and $record->{type} ne $wanted_type and not $record_wanted_anyway and @records > 1; - my @lines = split( "\n", $record->{text}, -1 ); + my ($msg_id) = record_regex($record,qr/^Message-Id:\s+<(.+)>/im); + next if defined $msg_id and exists $seen_message_ids{$msg_id}; + next if defined $msg_id and $msg_id =~/handler\..+\.ack(?:info|done)?\@/; + $record_wanted_anyway = 1 if record_regex($record,qr/^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 if defined $msg_id; + # skip spam messages if we're outputting more than one message + next if @records > 1 and $bug->is_spam($msg_id); + my @lines; + if ($record->{inner_file}) { + push @lines, scalar $record->{fh}->getline; + push @lines, scalar $record->{fh}->getline; + chomp $lines[0]; + chomp $lines[1]; + } else { + @lines = split( "\n", $record->{text}, -1 ); + } if ( $lines[ 1 ] =~ m/^From / ) { - my $tmp = $lines[ 0 ]; - $lines[ 0 ] = $lines[ 1 ]; - $lines[ 1 ] = $tmp; + @lines = reverse @lines; } if ( !( $lines[ 0 ] =~ m/^From / ) ) { unshift @lines, "From unknown $date"; - } - map { s/^(>*From )/>$1/ } @lines[ 1 .. $#lines ]; - print join( "\n", @lines ) . "\n"; + } + print $lines[0]."\n"; + print map { s/^(>*From )/>$1/; $_."\n" } @lines[ 1 .. $#lines ]; + if ($record->{inner_file}) { + my $fh = $record->{fh}; + print $_ while (<$fh>); + } } exit 0; } else { + if (defined $att and defined $msg and @records) { + binmode(STDOUT,":raw"); + $msg_num++; + ## allow this to be cached for a week + print "Status: 200 OK\n"; + print "Cache-Control: public, max-age=604800\n"; + print "Etag: $etag\n"; + print handle_email_message($records[0], + ref => $ref, + msg_num => $msg_num, + att => $att, + msg => $msg, + trim_headers => $trim_headers, + ); + exit 0; + } my %seen_msg_ids; for my $record (@records) { $msg_num++; @@ -542,7 +355,15 @@ else { next; } $skip_next = 1 if $record->{type} eq 'html' and not $boring; - push @log, handle_record($record,$ref,$msg_num,\%seen_msg_ids); + push @log, handle_record($record,$ref,$msg_num, + \%seen_msg_ids, + trim_headers => $trim_headers, + avatars => $avatars, + terse => $terse, + # if we're only looking at one record, allow + # spam to be output + spam => (@records > 1)?$bug:undef, + ); } } @@ -550,54 +371,127 @@ else { $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 <Reply ), - qq(or subscribe ), - qq(to this bug.
\n); -print qq(); -printf qq(View this report as an mbox folder, ). - qq(status mbox, maintainer mbox
Send a report that this bug log contains spam.
\n