From: Don Armstrong \n);
- $output .= 'View this message in rfc822 format
",
- bug_url($bug->{bug}), $bug->{bug}, html_escape($bug->{status}{subject});
- $html .= htmlize_bugstatus($bug->{status}) . "\n";
- }
- return @html;
+
+sub htmlize_packagelinks {
+ my ($pkgs) = @_;
+ return '' unless defined $pkgs and $pkgs ne '';
+ my @pkglist = splitpackages($pkgs);
+
+ carp "htmlize_packagelinks is deprecated";
+
+ return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' .
+ join(', ',
+ package_links(package =>\@pkglist,
+ class => 'submitter'
+ )
+ );
}
+=head2 package_links
-sub htmlize_bugstatus {
- my %status = %{$_[0]};
+ join(', ', package_links(packages => \@packages))
- my $result = "";
+Given a list of packages, return a list of html which links to the package
- my $showseverity;
- if ($status{severity} eq $config{default_severity}) {
- $showseverity = '';
- } elsif (isstrongseverity($status{severity})) {
- $showseverity = "Severity: $status{severity};\n";
- } else {
- $showseverity = "Severity: $status{severity};\n";
- }
+=over
- $result .= htmlize_packagelinks($status{"package"}, 1);
+=item package -- arrayref or scalar of package(s)
- my $showversions = '';
- if (@{$status{found_versions}}) {
- my @found = @{$status{found_versions}};
- local $_;
- s{/}{ } foreach @found;
- $showversions .= join ', ', map html_escape($_), @found;
- }
- if (@{$status{fixed_versions}}) {
- $showversions .= '; ' if length $showversions;
- $showversions .= 'fixed: ';
- my @fixed = @{$status{fixed_versions}};
- $showversions .= join ', ', map {s#/##; html_escape($_)} @fixed;
+=item submitter -- arrayref or scalar of submitter(s)
+
+=item source -- arrayref or scalar of source(s)
+
+=item maintainer -- arrayref or scalar of maintainer(s)
+
+=item links_only -- return only links, not htmlized links, defaults to
+returning htmlized links.
+
+=item class -- class of the a href, defaults to ''
+
+=back
+
+=cut
+
+sub package_links {
+ my %param = validate_with(params => \@_,
+ spec => {package => {type => SCALAR|ARRAYREF,
+ optional => 1,
+ },
+ source => {type => SCALAR|ARRAYREF,
+ optional => 1,
+ },
+ maintainer => {type => SCALAR|ARRAYREF,
+ optional => 1,
+ },
+ submitter => {type => SCALAR|ARRAYREF,
+ optional => 1,
+ },
+ owner => {type => SCALAR|ARRAYREF,
+ optional => 1,
+ },
+ links_only => {type => BOOLEAN,
+ default => 0,
+ },
+ class => {type => SCALAR,
+ default => '',
+ },
+ separator => {type => SCALAR,
+ default => ', ',
+ },
+ },
+ );
+ my @links = ();
+ push @links, map {(pkg_url(source => $_),$_)
+ } make_list($param{source}) if exists $param{source};
+ push @links, map {my $addr = getparsedaddrs($_);
+ $addr = defined $addr?$addr->address:'';
+ (pkg_url(maint => $addr),$_)
+ } make_list($param{maintainer}) if exists $param{maintainer};
+ push @links, map {my $addr = getparsedaddrs($_);
+ $addr = defined $addr?$addr->address:'';
+ (pkg_url(owner => $addr),$_)
+ } make_list($param{owner}) if exists $param{owner};
+ push @links, map {my $addr = getparsedaddrs($_);
+ $addr = defined $addr?$addr->address:'';
+ (pkg_url(submitter => $addr),$_)
+ } make_list($param{submitter}) if exists $param{submitter};
+ push @links, map {(pkg_url(pkg => $_),
+ html_escape($_))
+ } make_list($param{package}) if exists $param{package};
+ my @return = ();
+ my ($link,$link_name);
+ my $class = '';
+ if (length $param{class}) {
+ $class = q( class=").html_escape($param{class}).q(");
}
- $result .= " ($showversions)" if length $showversions;
- $result .= ";\n";
-
- $result .= $showseverity;
- $result .= htmlize_addresslinks("Reported by: ", \&submitterurl,
- $status{originator});
- $result .= ";\nOwned by: " . html_escape($status{owner})
- if length $status{owner};
- $result .= ";\nTags: "
- . html_escape(join(", ", sort(split(/\s+/, $status{tags}))))
- . ""
- if (length($status{tags}));
-
- $result .= ";\nMerged with ".
- bug_linklist(', ',
- 'submitter',
- split(/ /,$status{mergedwith}))
- if length $status{mergedwith};
- $result .= ";\nBlocked by ".
- bug_linklist(", ",
- 'submitter',
- split(/ /,$status{blockedby}))
- if length $status{blockedby};
- $result .= ";\nBlocks ".
- bug_linklist(", ",
- 'submitter',
- split(/ /,$status{blocks})
- )
- if length $status{blocks};
-
- my $days = 0;
- if (length($status{done})) {
- $result .= "
Done: " . html_escape($status{done});
- $days = ceil($debbugs::gRemoveAge - -M buglog($status{id}));
- if ($days >= 0) {
- $result .= ";\nWill be archived" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ) . "";
- } else {
- $result .= ";\nArchived";
+ while (($link,$link_name) = splice(@links,0,2)) {
+ if ($param{links_only}) {
+ push @return,$link
}
+ else {
+ push @return,
+ qq().
+ html_escape($link_name).q();
+ }
+ }
+ if (wantarray) {
+ return @return;
}
else {
- if (length($status{forwarded})) {
- $result .= ";\nForwarded to "
- . maybelink($status{forwarded});
- }
- my $daysold = int((time - $status{date}) / 86400); # seconds to days
- if ($daysold >= 7) {
- my $font = "";
- my $efont = "";
- $font = "em" if ($daysold > 30);
- $font = "strong" if ($daysold > 60);
- $efont = "$font>" if ($font);
- $font = "<$font>" if ($font);
-
- my $yearsold = int($daysold / 365);
- $daysold -= $yearsold * 365;
-
- $result .= ";\n $font";
- my @age;
- push @age, "1 year" if ($yearsold == 1);
- push @age, "$yearsold years" if ($yearsold > 1);
- push @age, "1 day" if ($daysold == 1);
- push @age, "$daysold days" if ($daysold > 1);
- $result .= join(" and ", @age);
- $result .= " old$efont";
- }
- }
+ return join($param{separator},@return);
+ }
+}
- $result .= ".";
+=head2 bug_links
- return $result;
-}
+ join(', ', bug_links(bug => \@packages))
-=head2 htmlize_packagelinks
+Given a list of bugs, return a list of html which links to the bugs
- htmlize_packagelinks
+=over
-Given a scalar containing a list of packages separated by something
-that L\n";
- if ($trim_headers) {
+ if ($param{trim_headers}) {
my @headers;
foreach (qw(From To Cc Subject Date)) {
my $head_field = $head->get($_);
@@ -150,7 +157,7 @@ sub display_entity {
"($type, $disposition)]
\n";
if (exists $param{msg} and exists $param{att} and
- $att == $#$attachments) {
+ $param{att} == $#$attachments) {
my $head = $entity->head;
chomp(my $type = $entity->effective_type);
my $body = $entity->stringify_body;
@@ -171,7 +178,7 @@ sub display_entity {
}
}
- return if not $top and $disposition eq 'attachment' and not defined($att);
+ return if not $top and $disposition eq 'attachment' and not defined($param{att});
return unless ($type =~ m[^text/?] and
$type !~ m[^text/(?:html|enriched)(?:;|$)]) or
$type =~ m[^application/pgp(?:;|$)] or
@@ -223,9 +230,11 @@ sub display_entity {
# flowed e-mails cause they don't really matter.
}
# Add links to URLs
- # We don't html escape here because we escape above
- $body =~ s{((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$))}
- {$1$3}go;
+ # We don't html escape here because we escape above;
+ # wierd terminators are because of that
+ $body =~ s{((?:ftp|http|https|svn|ftps|rsync)://[\S~-]+?/?) # Url
+ ((?:\>\;)?[)]?(?:'|\&\#39\;)?[:.\,]?(?:\s|$)) # terminators
+ }{$1$2}gox;
# Add links to bug closures
$body =~ s[(closes:\s*(?:bug)?\#?\s?\d+(?:,?\s*(?:bug)?\#?\s?\d+)*)]
[my $temp = $1;
@@ -244,7 +253,7 @@ sub display_entity {
handle_email_message($record->{text},
ref => $bug_number,
- msg_number => $msg_number,
+ msg_num => $msg_number,
);
Returns a decoded e-mail message and displays entities/attachments as
@@ -254,7 +263,7 @@ appropriate.
=cut
sub handle_email_message{
- my ($email,%options) = @_;
+ my ($email,%param) = @_;
my $output = '';
my $parser = new MIME::Parser;
@@ -265,12 +274,12 @@ sub handle_email_message{
my $entity = $parser->parse_data( $email);
my @attachments = ();
display_entity(entity => $entity,
- bug_num => $options{ref},
+ bug_num => $param{ref},
outer => 1,
- msg_number => $options{msg_number},
- ouput => $output,
+ msg_num => $param{msg_num},
+ output => \$output,
attachments => \@attachments,
- terse => $params{terse},
+ terse => $param{terse},
exists $param{msg}?(msg=>$param{msg}):(),
exists $param{att}?(attachment=>$param{att}):(),
);
@@ -301,21 +310,21 @@ sub handle_record{
# (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;
+ $output =~ s{(Bug )(\d+)( cloned as bugs? )(\d+)(?:\-(\d+)|)}{$1.bug_links(bug=>$2).$3.bug_links(bug=>[$4..$5])}eo;
# Add links to merged bugs
- $output =~ s{(?<=Merged )([\d\s]+)(?=\.)}{join(' ',map {bug_links($_)} (split /\s+/, $1))}eo;
+ $output =~ s{(?<=Merged )([\d\s]+)(?=\.)}{join(' ',map {bug_links(bug=>$_)} (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;
+ {(defined $2?$1.bug_links(bug=>$2):'').$3.
+ join(' ',map {bug_links(bug=>$_)} (split /\,?\s+/, $4))}eo;
# Add links to reassigned packages
$output =~ s{(Bug reassigned from package \`)([^']+?)((?:'|\&\#39;) to \`)([^']+?)((?:'|\&\#39;))}
{$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 .= 'Full text and rfc822 format available.';
$output = qq(\n";
}
@@ -328,11 +337,11 @@ sub handle_record{
$$seen_msg_ids{$msg_id} = 1;
}
$output .= qq(
Message #$msg_number received at |. html_escape("$received\@$hostname") . - q| (full text'. - q|, mbox)'.":
\n"; + q| (full text'. + q|, mbox)'.":\n"; $output .= handle_email_message($record->{text}, - ref => $bug_number, - msg_number => $msg_number, - ); + ref => $bug_number, + msg_num => $msg_number, + ); } else { die "Unknown record type $_"; diff --git a/Debbugs/Common.pm b/Debbugs/Common.pm index bb42bf8..8d83729 100644 --- a/Debbugs/Common.pm +++ b/Debbugs/Common.pm @@ -430,7 +430,7 @@ instead. (Or possibly a die handler, if the cleanups are important) =cut sub quit { - print $DEBUG_FH "quitting >$_[0]<\n" if $DEBUG; + print {$DEBUG_FH} "quitting >$_[0]<\n" if $DEBUG; my ($u); while ($u= $cleanups[$#cleanups]) { &$u; } die "*** $_[0]\n"; diff --git a/Debbugs/Config.pm b/Debbugs/Config.pm index 895b799..5c3e643 100644 --- a/Debbugs/Config.pm +++ b/Debbugs/Config.pm @@ -67,7 +67,7 @@ BEGIN { qw(@gDefaultArchitectures), qw($gTemplateDir), qw($gDefaultPackage), - qw($gSpamMaxThreads $gSpamSpamsPerThread $gSpamKeepRunning $gSpamScan $gSpamCrossassassinDb) + qw($gSpamMaxThreads $gSpamSpamsPerThread $gSpamKeepRunning $gSpamScan $gSpamCrossassassinDb), ], text => [qw($gBadEmailPrefix $gHTMLTail $gHTMLExpireNote), ], @@ -76,6 +76,7 @@ BEGIN { @EXPORT_OK = (); Exporter::export_ok_tags(qw(globals text config)); $EXPORT_TAGS{all} = [@EXPORT_OK]; + $ENV{HOME} = '' if not defined $ENV{HOME}; } use File::Basename qw(dirname); @@ -729,7 +730,6 @@ Site rules directory for spamassassin, defaults to set_default(\%config,'spam_rules_dir','/usr/share/spamassassin'); - =back diff --git a/Debbugs/MIME.pm b/Debbugs/MIME.pm index 183adc7..2a695e5 100644 --- a/Debbugs/MIME.pm +++ b/Debbugs/MIME.pm @@ -215,8 +215,7 @@ BEGIN { ])); } -sub decode_rfc1522 ($) -{ +sub decode_rfc1522 { my ($string) = @_; # this is craptacular, but leading space is hacked off by unmime. @@ -240,7 +239,7 @@ MIME::Words::encode_mimeword on distinct words as appropriate. # We cannot use MIME::Words::encode_mimewords because that function # does not handle spaces properly at all. -sub encode_rfc1522 ($) { +sub encode_rfc1522 { my ($rawstr) = @_; # handle being passed undef properly diff --git a/Debbugs/Text.pm b/Debbugs/Text.pm index 0f3a529..c499814 100644 --- a/Debbugs/Text.pm +++ b/Debbugs/Text.pm @@ -16,8 +16,8 @@ Debbugs::Text -- General routines for text templates =head1 SYNOPSIS -use Debbugs::Text qw(:templates); -print fill_in_template(template => 'cgi/foo'); + use Debbugs::Text qw(:templates); + print fill_in_template(template => 'cgi/foo'); =head1 DESCRIPTION @@ -164,6 +164,7 @@ sub fill_in_template{ qw(padsv padav padhv padany), qw(rv2gv refgen srefgen ref), qw(caller require entereval), + qw(gmtime sprintf prtf), ); $safe->share('*STDERR'); $safe->share('%config'); @@ -191,7 +192,7 @@ sub fill_in_template{ my $tt; if ($tt_type eq 'FILE' and defined $tt_templates{$tt_source} and - (stat $tt_source)[9] > $tt_templates{$tt_source}{mtime} + (stat $tt_source)[9] <= $tt_templates{$tt_source}{mtime} ) { $tt = $tt_templates{$tt_source}{template}; } @@ -202,6 +203,7 @@ sub fill_in_template{ } $tt = Text::Template->new(TYPE => $tt_type, SOURCE => $tt_source, + UNTAINT => 1, ); if ($tt_type eq 'FILE') { $tt_templates{$tt_source}{template} = $tt; @@ -210,10 +212,7 @@ sub fill_in_template{ if (not defined $tt) { die "Unable to create Text::Template for $tt_type:$tt_source"; } - my $ret = $tt->fill_in(#(defined $param{nosafe} and $param{nosafe})?():(HASH=>$param{variables}), - #(defined $param{nosafe} and $param{nosafe})?():(SAFE=>$safe), - SAFE => $safe, - #(defined $param{nosafe} and $param{nosafe})?(PACKAGE => 'main'):(), + my $ret = $tt->fill_in(SAFE => $safe, defined $param{output}?(OUTPUT=>$param{output}):(), ); if (not defined $ret) { diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi index dcb6482..28c7824 100755 --- a/cgi/bugreport.cgi +++ b/cgi/bugreport.cgi @@ -3,7 +3,7 @@ use warnings; use strict; -use POSIX qw(strftime tzset); +use POSIX qw(strftime); use MIME::Parser; use MIME::Decoder; use IO::Scalar; @@ -13,7 +13,6 @@ use Debbugs::Config qw(:globals :text); # for read_log_records use Debbugs::Log qw(read_log_records); -use Debbugs::MIME qw(convert_to_utf8 decode_rfc1522 create_mime_message); use Debbugs::CGI qw(:url :html :util); use Debbugs::CGI::Bugreport qw(:all); use Debbugs::Common qw(buglog getmaintainers); @@ -21,6 +20,9 @@ use Debbugs::Packages qw(getpkgsrc); use Debbugs::Status qw(splitpackages get_bug_status isstrongseverity); use Scalar::Util qw(looks_like_number); + +use Debbugs::Text qw(:templates); + use CGI::Simple; my $q = new CGI::Simple; @@ -44,14 +46,12 @@ my %param = cgi_parameters(query => $q, ); # This is craptacular. -my $tail_html; - 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 $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'; @@ -71,16 +71,18 @@ my $archive = $param{'archive'} eq 'yes'; my $repeatmerged = $param{'repeatmerged'} eq 'yes'; my $buglog = buglog($ref); +my @stat = stat $buglog; +my $mtime = ''; +if (@stat) { + $mtime = strftime '%a, %d %b %Y %T GMT', gmtime($stat[9]); +} -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; +if ($q->request_method() eq 'HEAD' and not defined($att) and not $mbox) { + print $q->header(-type => "text/html", + -charset => 'utf-8', + (length $mtime)?(-last_modified => $mtime):(), + ); + exit 0; } @@ -88,13 +90,15 @@ 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: $!"); + $buglogfh = IO::File->new("zcat $buglog |") or quitcgi("open log for $ref: $!"); $ENV{'PATH'} = $oldpath; } else { - $buglogfh = new IO::File "<$buglog" or &quitcgi("open log for $ref: $!"); + $buglogfh = IO::File->new($buglog,'r') or quitcgi("open log for $ref: $!"); } +my %status = %{get_bug_status(bug=>$ref)}; + my @records; eval{ @records = read_log_records($buglogfh); @@ -211,218 +215,104 @@ 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 "Content-Type: text/html; charset=utf-8\n\n"; + print $q->header(-type => "text/html", + -charset => 'utf-8', + (length $mtime)?(-last_modified => $mtime):(), + ); print fill_in_template(template=>'cgi/no_such_bug', variables => {modify_time => $dtime, bug_num => $ref, }, - ) + ); exit 0; } -$|=1; +#$|=1; -$tpack = lc $status{'package'}; -my @tpacks = splitpackages($tpack); +my %package; +my @packages = splitpackages($status{package}); -if ($status{severity} eq 'normal') { - $showseverity = ''; -} elsif (isstrongseverity($status{severity})) { - $showseverity = "Severity: $status{severity};\n"; -} else { - $showseverity = "Severity: $status{severity};\n"; +foreach my $pkg (@packages) { + $package{$pkg} = {maintainer => exists($maintainer{$pkg}) ? $maintainer{$pkg} : '(unknown)', + source => exists($pkgsrc{$pkg}) ? $pkgsrc{$pkg} : '(unknown)', + package => $pkg, + }; } +# fixup various bits of the status +$status{tags_array} = [sort(split(/\s+/, $status{tags}))]; +$status{date_text} = strftime('%a, %e %b %Y %T UTC', gmtime($status{date})); +$status{mergedwith_array} = [split(/ /,$status{mergedwith})]; + + +my $version_graph = ''; if (@{$status{found_versions}} or @{$status{fixed_versions}}) { - $indexentry.= q(}; -} - - -$indexentry .= "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