X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fcommon.pl;h=db9d1f4dd7ee096a9927ca5bdc5b69bbf52b0a02;hb=ea796b6cf43908baacaf6b3ba58fa4efa861d0c4;hp=14d1ab37d10be64ab0df8bf28acdb1fb53e2c66d;hpb=9c95e269a8a569e57e297c5297eda2f045cee31f;p=debbugs.git diff --git a/cgi/common.pl b/cgi/common.pl index 14d1ab3..db9d1f4 100644 --- a/cgi/common.pl +++ b/cgi/common.pl @@ -2,80 +2,162 @@ use DB_File; use Fcntl qw/O_RDONLY/; +use Mail::Address; +use MLDBM qw/DB_File/; +use POSIX qw/ceil/; + $config_path = '/etc/debbugs'; $lib_path = '/usr/lib/debbugs'; require "$lib_path/errorlib"; +use Debbugs::Versions; +use Debbugs::MIME qw(decode_rfc1522); + +$MLDBM::RemoveTaint = 1; + my $common_archive = 0; my $common_repeatmerged = 1; my %common_include = (); my %common_exclude = (); my $common_raw_sort = 0; my $common_bug_reverse = 0; -my $common_pending_reverse = 0; -my $common_severity_reverse = 0; -my @common_pending_include = (); -my @common_pending_exclude = (); -my @common_severity_include = (); -my @common_severity_exclude = (); +my %common_reverse = ( + 'pending' => 0, + 'severity' => 0, +); +my %common = ( + 'show_list_header' => 1, + 'show_list_footer' => 1, +); + +sub exact_field_match { + my ($field, $values, $status) = @_; + my @values = @$values; + my @ret = grep {$_ eq $status->{$field} } @values; + $#ret != -1; +} +sub contains_field_match { + my ($field, $values, $status) = @_; + foreach my $data (@$values) { + return 1 if (index($status->{$field}, $data) > -1); + } + return 0; +} + +sub detect_user_agent { + my $userAgent = $ENV{HTTP_USER_AGENT}; + return { 'name' => 'unknown' } unless defined $userAgent; + return { 'name' => 'links' } if ( $userAgent =~ m,^ELinks,); + return { 'name' => 'lynx' } if ( $userAgent =~ m,^Lynx,); + return { 'name' => 'wget' } if ( $userAgent =~ m,^Wget,); + return { 'name' => 'gecko' } if ( $userAgent =~ m,^Mozilla.* Gecko/,); + return { 'name' => 'ie' } if ( $userAgent =~ m,^.*MSIE.*,); + return { 'name' => 'unknown' }; +} + +my %field_match = ( + 'subject' => \&contains_field_match, + 'tags' => sub { + my ($field, $values, $status) = @_; + my %values = map {$_=>1} @$values; + foreach my $t (split /\s+/, $status->{$field}) { + return 1 if (defined $values{$t}); + } + return 0; + }, + 'severity' => \&exact_field_match, + 'pending' => \&exact_field_match, + 'originator' => \%contains_field_match, + 'forwarded' => \%contains_field_match, + 'owner' => \%contains_field_match, +); +my @common_grouping = ( 'severity', 'pending' ); +my %common_grouping_order = ( + 'pending' => [ qw( pending forwarded pending-fixed fixed done absent ) ], + 'severity' => \@debbugs::gSeverityList, +); +my %common_grouping_display = ( + 'pending' => 'Status', + 'severity' => 'Severity', +); +my %common_headers = ( + 'pending' => { + "pending" => "outstanding", + "pending-fixed" => "pending upload", + "fixed" => "fixed in NMU", + "done" => "resolved", + "forwarded" => "forwarded to upstream software authors", + "absent" => "not applicable to this version", + }, + 'severity' => \%debbugs::gSeverityDisplay, +); + +my $common_version; +my $common_dist; +my $common_arch; my $debug = 0; +sub array_option($) { + my ($val) = @_; + my @vals; + @vals = ( $val ) if (ref($val) eq "" && $val ); + @vals = ( $$val ) if (ref($val) eq "SCALAR" && $$val ); + @vals = @{$val} if (ref($val) eq "ARRAY" ); + return @vals; +} + +sub filter_include_exclude($\%) { + my ($val, $filter_map) = @_; + my @vals = array_option($val); + my @data = map { + if (/^([^:]*):(.*)$/) { if ($1 eq 'subj') { ['subject', $2]; } else { [$1, $2] } } else { ['tags', $_] } + } split /[\s,]+/, join ',', @vals; + foreach my $data (@data) { + &quitcgi("Invalid filter key: '$data->[0]'") if (!exists($field_match{$data->[0]})); + push @{$filter_map->{$data->[0]}}, $data->[1]; + } +} + +sub filter_option($$\%) { + my ($key, $val, $filter_map) = @_; + my @vals = array_option($val); + foreach $val (@vals) { + push @{$filter_map->{$key}}, $val; + } +} + sub set_option { my ($opt, $val) = @_; + if ($opt =~ m/^show_list_(foot|head)er$/) { $common{$opt} = $val; } if ($opt eq "archive") { $common_archive = $val; } if ($opt eq "repeatmerged") { $common_repeatmerged = $val; } if ($opt eq "exclude") { - my @vals; - @vals = ( $val ) if (ref($val) eq "" && $val ); - @vals = ( $$val ) if (ref($val) eq "SCALAR" && $$val ); - @vals = @{$val} if (ref($val) eq "ARRAY" ); - %common_exclude = map { - if (/^(.*):(.*)$/) { ($1, $2) } else { ($_, 1) } - } split /[\s,]+/, join ',', @vals; + filter_include_exclude($val, %common_exclude); } if ($opt eq "include") { - my @vals; - @vals = ( $val, ) if (ref($val) eq "" && $val ); - @vals = ( $$val, ) if (ref($val) eq "SCALAR" && $$val ); - @vals = @{$val} if (ref($val) eq "ARRAY" ); - %common_include = map { - if (/^(.*):(.*)$/) { ($1, $2) } else { ($_, 1) } - } split /[\s,]+/, join ',', @vals; + filter_include_exclude($val, %common_include); } if ($opt eq "raw") { $common_raw_sort = $val; } if ($opt eq "bug-rev") { $common_bug_reverse = $val; } - if ($opt eq "pend-rev") { $common_pending_reverse = $val; } - if ($opt eq "sev-rev") { $common_severity_reverse = $val; } + if ($opt eq "pend-rev") { $common_reverse{pending} = $val; } + if ($opt eq "sev-rev") { $common_reverse{severity} = $val; } if ($opt eq "pend-exc") { - my @vals; - @vals = ( $val ) if (ref($val) eq "" && $val ); - @vals = ( $$val ) if (ref($val) eq "SCALAR" && $$val ); - @vals = @{$val} if (ref($val) eq "ARRAY" ); - @common_pending_exclude = @vals if (@vals); + filter_option('pending', $val, %common_exclude); } if ($opt eq "pend-inc") { - my @vals; - @vals = ( $val, ) if (ref($val) eq "" && $val ); - @vals = ( $$val, ) if (ref($val) eq "SCALAR" && $$val ); - @vals = @{$val} if (ref($val) eq "ARRAY" ); - @common_pending_include = @vals if (@vals); + filter_option('pending', $val, %common_include); } if ($opt eq "sev-exc") { - my @vals; - @vals = ( $val ) if (ref($val) eq "" && $val ); - @vals = ( $$val ) if (ref($val) eq "SCALAR" && $$val ); - @vals = @{$val} if (ref($val) eq "ARRAY" ); - @common_severity_exclude = @vals if (@vals); + filter_option('severity', $val, %common_exclude); } if ($opt eq "sev-inc") { - my @vals; - @vals = ( $val ) if (ref($val) eq "" && $val ); - @vals = ( $$val ) if (ref($val) eq "SCALAR" && $$val ); - @vals = @{$val} if (ref($val) eq "ARRAY" ); - @common_severity_include = @vals if (@vals); + filter_option('severity', $val, %common_include); } + if ($opt eq "version") { $common_version = $val; } + if ($opt eq "dist") { $common_dist = $val; } + if ($opt eq "arch") { $common_arch = $val; } } sub readparse { @@ -129,7 +211,16 @@ sub quitcgi { sub splitpackages { my $pkgs = shift; return unless defined $pkgs; - return split /[ \t?,()]+/, $pkgs; + return map lc, split /[ \t?,()]+/, $pkgs; +} + +my %_parsedaddrs; +sub getparsedaddrs { + my $addr = shift; + return () unless defined $addr; + return @{$_parsedaddrs{$addr}} if exists $_parsedaddrs{$addr}; + @{$_parsedaddrs{$addr}} = Mail::Address->parse($addr); + return @{$_parsedaddrs{$addr}}; } # Generate a comma-separated list of HTML links to each package given in @@ -153,6 +244,34 @@ sub htmlpackagelinks { ) . ";\n"; } +# Generate a comma-separated list of HTML links to each address given in +# $addresses, which should be a comma-separated list of RFC822 addresses. +# $urlfunc should be a reference to a function like mainturl or submitterurl +# which returns the URL for each individual address. +sub htmladdresslinks { + my ($prefixfunc, $urlfunc, $addresses) = @_; + if (defined $addresses and $addresses ne '') { + my @addrs = getparsedaddrs($addresses); + my $prefix = (ref $prefixfunc) ? $prefixfunc->(scalar @addrs) + : $prefixfunc; + return $prefix . + join ', ', map { sprintf '%s', + $urlfunc->($_->address), + htmlsanit($_->format) || '(unknown)' + } @addrs; + } else { + my $prefix = (ref $prefixfunc) ? $prefixfunc->(1) : $prefixfunc; + return sprintf '%s(unknown)', $prefix, $urlfunc->(''); + } +} + +# Generate a comma-separated list of HTML links to each maintainer given in +# $maints, which should be a comma-separated list of RFC822 addresses. +sub htmlmaintlinks { + my ($prefixfunc, $maints) = @_; + return htmladdresslinks($prefixfunc, \&mainturl, $maints); +} + sub htmlindexentry { my $ref = shift; my %status = %{getbugstatus($ref)}; @@ -168,7 +287,7 @@ sub htmlindexentrystatus { if ($status{severity} eq 'normal') { $showseverity = ''; - } elsif (grep($status{severity} eq $_, @debbugs::gStrongSeverities)) { + } elsif (isstrongseverity($status{severity})) { $showseverity = "Severity: $status{severity};\n"; } else { $showseverity = "Severity: $status{severity};\n"; @@ -176,8 +295,10 @@ sub htmlindexentrystatus { $result .= htmlpackagelinks($status{"package"}, 1); $result .= $showseverity; - $result .= "Reported by: " . htmlsanit($status{originator}) . ""; + $result .= htmladdresslinks("Reported by: ", \&submitterurl, + $status{originator}); + $result .= ";\nOwned by: " . htmlsanit($status{owner}) + if length $status{owner}; $result .= ";\nTags: " . htmlsanit(join(", ", sort(split(/\s+/, $status{tags})))) . "" @@ -190,9 +311,32 @@ sub htmlindexentrystatus { $mseparator= ", "; } - if (length($status{done})) { + if (@{$status{found_versions}}) { + $result .= ";\nfound in "; + $result .= (@{$status{found_versions}} == 1) ? 'version ' + : 'versions '; + $result .= join ', ', map htmlsanit($_), @{$status{found_versions}}; + } + + if (@{$status{fixed_versions}}) { + $result .= ";\nfixed in "; + $result .= (@{$status{fixed_versions}} == 1) ? 'version ' + : 'versions '; + $result .= join ', ', map htmlsanit($_), @{$status{fixed_versions}}; + if (length($status{done})) { + $result .= ' by ' . htmlsanit($status{done}); + } + } elsif (length($status{done})) { $result .= ";\nDone: " . htmlsanit($status{done}); - } else { + $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"; + } + } + + unless (length($status{done})) { if (length($status{forwarded})) { $result .= ";\nForwarded to " . maybelink($status{forwarded}); @@ -225,42 +369,55 @@ sub htmlindexentrystatus { return $result; } +sub urlargs { + my $args = ''; + $args .= "&archive=yes" if $common_archive; + $args .= "&repeatmerged=no" unless $common_repeatmerged; + $args .= "&version=$common_version" if defined $common_version; + $args .= "&dist=$common_dist" if defined $common_dist; + $args .= "&arch=$common_arch" if defined $common_arch; + return $args; +} + sub submitterurl { my $ref = shift || ""; my $params = "submitter=" . emailfromrfc822($ref); - $params .= "&archive=yes" if ($common_archive); - $params .= "&repeatmerged=no" unless ($common_repeatmerged); + $params .= urlargs(); return urlsanit("pkgreport.cgi" . "?" . $params); } sub mainturl { my $ref = shift || ""; my $params = "maint=" . emailfromrfc822($ref); - $params .= "&archive=yes" if ($common_archive); - $params .= "&repeatmerged=no" unless ($common_repeatmerged); + $params .= urlargs(); return urlsanit("pkgreport.cgi" . "?" . $params); } sub pkgurl { my $ref = shift; my $params = "pkg=$ref"; - $params .= "&archive=yes" if ($common_archive); - $params .= "&repeatmerged=no" unless ($common_repeatmerged); - + $params .= urlargs(); return urlsanit("pkgreport.cgi" . "?" . "$params"); } sub srcurl { my $ref = shift; my $params = "src=$ref"; - $params .= "&archive=yes" if ($common_archive); - $params .= "&repeatmerged=no" unless ($common_repeatmerged); + $params .= urlargs(); + return urlsanit("pkgreport.cgi" . "?" . "$params"); +} + +sub tagurl { + my $ref = shift; + my $params = "tag=$ref"; + $params .= urlargs(); return urlsanit("pkgreport.cgi" . "?" . "$params"); } sub urlsanit { my $url = shift; $url =~ s/%/%25/g; + $url =~ s/#/%23/g; $url =~ s/\+/%2b/g; my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot'); $url =~ s/([<>&"])/\&$saniarray{$1};/g; @@ -320,18 +477,39 @@ sub allbugs { return @{getbugs(sub { 1 })}; } +sub bugmatches(\%\%) { + my ($hash, $status) = @_; + foreach my $key( keys( %$hash ) ) { + my $value = $hash->{$key}; + my $sub = $field_match{$key}; + return 1 if ($sub->($key, $value, $status)); + } + return 0; +} +sub bugfilter($%) { + my ($bug, %status) = @_; + our (%seenmerged); + if (%common_include) { + return 1 if (!bugmatches(%common_include, %status)); + } + if (%common_exclude) { + return 1 if (bugmatches(%common_exclude, %status)); + } + my @merged = sort {$a<=>$b} $bug, split(/ /, $status{mergedwith}); + return 1 unless ($common_repeatmerged || !$seenmerged{$merged[0]}); + $seenmerged{$merged[0]} = 1; + return 0; +} + sub htmlizebugs { $b = $_[0]; my @bugs = @$b; - my @rawsort; - - my %section = (); + my $anydone = 0; - my %displayshowpending = ("pending", "outstanding", - "pending-fixed", "pending upload", - "fixed", "fixed in NMU", - "done", "resolved", - "forwarded", "forwarded to upstream software authors"); + my @status = (); + my %count; + my $header = ''; + my $footer = ''; if (@bugs == 0) { return "

No reports found!

\n"; @@ -346,87 +524,96 @@ sub htmlizebugs { foreach my $bug (@bugs) { my %status = %{getbugstatus($bug)}; next unless %status; - if (%common_include) { - my $okay = 0; - foreach my $t (split /\s+/, $status{tags}) { - $okay = 1, last if (defined $common_include{$t}); - } - if (defined $common_include{subj}) { - if (index($status{subject}, $common_include{subj}) > -1) { - $okay = 1; - } - } - next unless ($okay); - } - if (%common_exclude) { - my $okay = 1; - foreach my $t (split /\s+/, $status{tags}) { - $okay = 0, last if (defined $common_exclude{$t}); - } - if (defined $common_exclude{subj}) { - if (index($status{subject}, $common_exclude{subj}) > -1) { - $okay = 0; - } - } - next unless ($okay); - } - next if @common_pending_include and - not grep { $_ eq $status{pending} } @common_pending_include; - next if @common_severity_include and - not grep { $_ eq $status{severity} } @common_severity_include; - next if grep { $_ eq $status{pending} } @common_pending_exclude; - next if grep { $_ eq $status{severity} } @common_severity_exclude; - - my @merged = sort {$a<=>$b} ($bug, split(/ /, $status{mergedwith})); - next unless ($common_repeatmerged || !$seenmerged{$merged[0]}); - $seenmerged{$merged[0]} = 1; + next if bugfilter($bug, %status); my $html = sprintf "
  • #%d: %s\n
    ", bugurl($bug), $bug, htmlsanit($status{subject}); $html .= htmlindexentrystatus(\%status) . "\n"; - $section{$status{pending} . "_" . $status{severity}} .= $html; - push @rawsort, $html if $common_raw_sort; + my $key = join( '_', map( {$status{$_}} @common_grouping ) ); + $section{$key} .= $html; + $count{"_$key"}++; + foreach my $grouping ( @common_grouping ) { + $count{"${grouping}_$status{$grouping}"}++; + } + $anydone = 1 if $status{pending} eq 'done'; + push @status, [ $bug, \%status, $html ]; } my $result = ""; - my $anydone = 0; if ($common_raw_sort) { - $result .= "\n"; + $result .= "\n"; } else { - my @pendingList = qw(pending forwarded pending-fixed fixed done); - @pendingList = reverse @pendingList if $common_pending_reverse; -#print STDERR join(",",@pendingList)."\n"; -#print STDERR join(",",@common_pending_include).":$#common_pending_include\n"; - foreach my $pending (@pendingList) { - my @severityList = @debbugs::gSeverityList; - @severityList = reverse @severityList if $common_severity_reverse; -#print STDERR join(",",@severityList)."\n"; - -# foreach my $severity(@debbugs::gSeverityList) { - foreach my $severity(@severityList) { - $severity = $debbugs::gDefaultSeverity if ($severity eq ''); - next unless defined $section{${pending} . "_" . ${severity}}; - $result .= "

    $debbugs::gSeverityDisplay{$severity} - $displayshowpending{$pending}

    \n"; - #$result .= "(A list of all such bugs is available).\n"; - #$result .= "(A list of all such bugs used to be available).\n"; - $result .= "