X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=sidebyside;f=cgi%2Fcommon.pl;h=b3656c87f31490f3b69390e34c3686063aaca499;hb=3e8c3591fe26e59a2b7dab968f7246756f738005;hp=ba944a0ffb15c3a0f5f79253f05b0c93ec2aeea2;hpb=e3b26e5ffed8738c1a3e3e393add9a6eac5347f9;p=debbugs.git diff --git a/cgi/common.pl b/cgi/common.pl index ba944a0..b3656c8 100644 --- a/cgi/common.pl +++ b/cgi/common.pl @@ -3,17 +3,28 @@ use DB_File; use Fcntl qw/O_RDONLY/; use Mail::Address; -use MLDBM qw/DB_File/; +use MLDBM qw(DB_File Storable); use POSIX qw/ceil/; +use URI::Escape; + $config_path = '/etc/debbugs'; $lib_path = '/usr/lib/debbugs'; require "$lib_path/errorlib"; +use Debbugs::Packages qw(:versions :mapping); use Debbugs::Versions; +use Debbugs::MIME qw(decode_rfc1522); +use Debbugs::Common qw(:util); +use Debbugs::Status qw(:read :versions); +use Debbugs::CGI qw(:all); +use Debbugs::Config qw(:globals); $MLDBM::RemoveTaint = 1; +my %common_bugusertags; +my $common_mindays = 0; +my $common_maxdays = -1; my $common_archive = 0; my $common_repeatmerged = 1; my %common_include = (); @@ -21,6 +32,8 @@ my %common_exclude = (); my $common_raw_sort = 0; my $common_bug_reverse = 0; +my $common_leet_urls = 0; + my %common_reverse = ( 'pending' => 0, 'severity' => 0, @@ -46,6 +59,7 @@ sub contains_field_match { 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,); @@ -53,6 +67,7 @@ sub detect_user_agent { return { 'name' => 'ie' } if ( $userAgent =~ m,^.*MSIE.*,); return { 'name' => 'unknown' }; } + my %field_match = ( 'subject' => \&contains_field_match, 'tags' => sub { @@ -72,7 +87,7 @@ my %field_match = ( my @common_grouping = ( 'severity', 'pending' ); my %common_grouping_order = ( 'pending' => [ qw( pending forwarded pending-fixed fixed done absent ) ], - 'severity' => \@debbugs::gSeverityList, + 'severity' => \@gSeverityList, ); my %common_grouping_display = ( 'pending' => 'Status', @@ -87,7 +102,7 @@ my %common_headers = ( "forwarded" => "forwarded to upstream software authors", "absent" => "not applicable to this version", }, - 'severity' => \%debbugs::gSeverityDisplay, + 'severity' => \%gSeverityDisplay, ); my $common_version; @@ -95,6 +110,8 @@ my $common_dist; my $common_arch; my $debug = 0; +my $use_bug_idx = 0; +my %bugidx; sub array_option($) { my ($val) = @_; @@ -127,6 +144,17 @@ sub filter_option($$\%) { sub set_option { my ($opt, $val) = @_; + if ($opt eq "use-bug-idx") { + $use_bug_idx = $val; + if ( $val ) { + $common_headers{pending}{open} = $common_headers{pending}{pending}; + my $bugidx = tie %bugidx, MLDBM => "$gSpoolDir/realtime/bug.idx", O_RDONLY + or quitcgi( "$0: can't open $gSpoolDir/realtime/bug.idx ($!)\n" ); + $bugidx->RemoveTaint(1); + } else { + untie %bugidx; + } + } 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; } @@ -155,19 +183,37 @@ sub set_option { if ($opt eq "version") { $common_version = $val; } if ($opt eq "dist") { $common_dist = $val; } if ($opt eq "arch") { $common_arch = $val; } + if ($opt eq "maxdays") { $common_maxdays = $val; } + if ($opt eq "mindays") { $common_mindays = $val; } + if ($opt eq "bugusertags") { %common_bugusertags = %{$val}; } } sub readparse { - my ($in, $key, $val, %ret); + my ($key, $val, %ret); + my $in = ""; + if ($#ARGV >= 0) { + $in .= ";" . join("&", map { s/&/%26/g; s/;/%3b/g; $_ } @ARGV); + } if (defined $ENV{"QUERY_STRING"} && $ENV{"QUERY_STRING"} ne "") { - $in=$ENV{QUERY_STRING}; - } elsif(defined $ENV{"REQUEST_METHOD"} - && $ENV{"REQUEST_METHOD"} eq "POST") + $in .= ";" . $ENV{QUERY_STRING}; + } + if (defined $ENV{"REQUEST_METHOD"} && $ENV{"REQUEST_METHOD"} eq "POST" + && defined $ENV{"CONTENT_TYPE"} + && $ENV{"CONTENT_TYPE"} eq "application/x-www-form-urlencoded") { - read(STDIN,$in,$ENV{CONTENT_LENGTH}); - } else { - return; + my $inx; + read(STDIN,$inx,$ENV{CONTENT_LENGTH}); + $in .= ";" . $inx; + } + return unless ($in ne ""); + + if (defined $ENV{"HTTP_COOKIE"}) { + my $x = $ENV{"HTTP_COOKIE"}; + $x =~ s/;\s+/;/g; + $in = "$x;$in"; } + $in =~ s/&/;/g; + $in =~ s/;;+/;/g; $in =~ s/^;//; $in =~ s/;$//; foreach (split(/[&;]/,$in)) { s/\+/ /g; ($key, $val) = split(/=/,$_,2); @@ -181,7 +227,12 @@ sub readparse { } $ret{$key}=$val; } + $debug = 1 if (defined $ret{"debug"} && $ret{"debug"} eq "aj"); + + $common_leet_urls = 1 + if (defined $ret{"leeturls"} && $ret{"leeturls"} eq "yes"); + return %ret; } @@ -211,53 +262,26 @@ sub splitpackages { 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 # $pkgs. $pkgs may be empty, in which case an empty string is returned, or # it may be a comma-separated list of package names. sub htmlpackagelinks { - my $pkgs = shift; - return unless defined $pkgs and $pkgs ne ''; - my $strong = shift; - my @pkglist = splitpackages($pkgs); - - my $openstrong = $strong ? '' : ''; - my $closestrong = $strong ? '' : ''; + return htmlize_packagelinks(@_); +} - return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' . - join(', ', - map { - '' . - $openstrong . htmlsanit($_) . $closestrong . '' - } @pkglist - ) . ";\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 { + htmlize_addresslinks(@_); } # 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) = @_; - if (defined $maints and $maints ne '') { - my @maintaddrs = getparsedaddrs($maints); - my $prefix = (ref $prefixfunc) ? $prefixfunc->(scalar @maintaddrs) - : $prefixfunc; - return $prefix . - join ', ', map { sprintf '%s', - mainturl($_->address), - htmlsanit($_->format) || '(unknown)' - } @maintaddrs; - } else { - my $prefix = (ref $prefixfunc) ? $prefixfunc->(1) : $prefixfunc; - return sprintf '%s(unknown)', $prefix, mainturl(''); - } + return htmladdresslinks($prefixfunc, \&mainturl, $maints); } sub htmlindexentry { @@ -282,16 +306,34 @@ sub htmlindexentrystatus { } $result .= htmlpackagelinks($status{"package"}, 1); + + my $showversions = ''; + if (@{$status{found_versions}}) { + my @found = @{$status{found_versions}}; + local $_; + s{/}{ } foreach @found; + $showversions .= join ', ', map htmlsanit($_), @found; + } + if (@{$status{fixed_versions}}) { + $showversions .= '; ' if length $showversions; + $showversions .= 'fixed: '; + my @fixed = @{$status{fixed_versions}}; + local $_; + s{/}{ } foreach @fixed; + $showversions .= join ', ', map htmlsanit($_), @fixed; + } + $result .= " ($showversions)" if length $showversions; + $result .= ";\n"; + $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})))) . "" if (length($status{tags})); - my @merged= split(/ /,$status{mergedwith}); my $mseparator= ";\nmerged with "; for my $m (@merged) { @@ -299,25 +341,14 @@ sub htmlindexentrystatus { $mseparator= ", "; } - 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})) { + if (length($status{done})) { $result .= ";\nDone: " . htmlsanit($status{done}); - $days = ceil($debbugs::gRemoveAge - -M buglog($status{id})); - $result .= ";\nWill Be Archived:" . ( $days == 0 ? " today" : $days == 1 ? " in $days day" : " in $days days" ); + $days = ceil($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})) { @@ -355,52 +386,41 @@ sub htmlindexentrystatus { 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; + $args .= ";archive=yes" if $common_archive; + $args .= ";repeatmerged=no" unless $common_repeatmerged; + $args .= ";mindays=${common_mindays}" unless $common_mindays == 0; + $args .= ";maxdays=${common_maxdays}" unless $common_maxdays == -1; + $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 .= urlargs(); - return urlsanit("pkgreport.cgi" . "?" . $params); -} - -sub mainturl { - my $ref = shift || ""; - my $params = "maint=" . emailfromrfc822($ref); - $params .= urlargs(); - return urlsanit("pkgreport.cgi" . "?" . $params); -} +sub submitterurl { pkg_url(submitter => emailfromrfc822($_[0] || "")); } +sub mainturl { pkg_url(maint => emailfromrfc822($_[0] || "")); } +sub pkgurl { pkg_url(pkg => $_[0] || ""); } +sub srcurl { pkg_url(src => $_[0] || ""); } +sub tagurl { pkg_url(tag => $_[0] || ""); } -sub pkgurl { +sub pkg_etc_url { my $ref = shift; - my $params = "pkg=$ref"; - $params .= urlargs(); - return urlsanit("pkgreport.cgi" . "?" . "$params"); -} - -sub srcurl { - my $ref = shift; - my $params = "src=$ref"; - $params .= urlargs(); - return urlsanit("pkgreport.cgi" . "?" . "$params"); -} - -sub tagurl { - my $ref = shift; - my $params = "tag=$ref"; - $params .= urlargs(); - return urlsanit("pkgreport.cgi" . "?" . "$params"); + my $code = shift; + if ($common_leet_urls) { + $code = "package" if ($code eq "pkg"); + $code = "source" if ($code eq "src"); + return urlsanit("/x/$code/$ref"); + } else { + my $addurlargs = shift || 1; + my $params = "$code=$ref"; + $params .= urlargs() if $addurlargs; + 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; @@ -414,47 +434,48 @@ sub htmlsanit { return $in; } -sub maybelink { - my $in = shift; - if ($in =~ /^[a-zA-Z0-9+.-]+:/) { # RFC 1738 scheme - return qq{} . htmlsanit($in) . ''; - } else { - return htmlsanit($in); - } -} - sub bugurl { my $ref = shift; my $params = "bug=$ref"; - foreach my $val (@_) { - $params .= "\&msg=$1" if ($val =~ /^msg=([0-9]+)/); - $params .= "\&archive=yes" if (!$common_archive && $val =~ /^archive.*$/); - } - $params .= "&archive=yes" if ($common_archive); - $params .= "&repeatmerged=no" unless ($common_repeatmerged); + my $filename = ''; - return urlsanit("bugreport.cgi" . "?" . "$params"); -} + if ($common_leet_urls) { + my $msg = ""; + my $mbox = ""; + my $att = ""; + foreach my $val (@_) { + $mbox = "/mbox" if ($val eq "mbox"); + $msg = "/$1" if ($val =~ /^msg=([0-9]+)/); + $att = "/$1" if ($val =~ /^att=([0-9]+)/); + $filename = "/$1" if ($val =~ /^filename=(.*)$/); + } + my $ext = ""; + if ($mbox ne "") { + $ext = $mbox; + } elsif ($att ne "") { + $ext = "$att$filename"; + } + return urlsanit("/x/$ref$msg$ext"); + } else { + foreach my $val (@_) { + $params .= ";mbox=yes" if ($val eq "mbox"); + $params .= ";msg=$1" if ($val =~ /^msg=([0-9]+)/); + $params .= ";att=$1" if ($val =~ /^att=([0-9]+)/); + $filename = $1 if ($val =~ /^filename=(.*)$/); + $params .= ";archive=yes" if (!$common_archive && $val =~ /^archive.*$/); + } + $params .= ";archive=yes" if ($common_archive); + $params .= ";repeatmerged=no" unless ($common_repeatmerged); -sub dlurl { - my $ref = shift; - my $params = "bug=$ref"; - my $filename = ''; - foreach my $val (@_) { - $params .= "\&$1=$2" if ($val =~ /^(msg|att)=([0-9]+)/); - $filename = $1 if ($val =~ /^filename=(.*)$/); - } - $params .= "&archive=yes" if ($common_archive); - my $pathinfo = ''; - $pathinfo = "/$filename" if $filename ne ''; + my $pathinfo = ''; + $pathinfo = '/'.uri_escape($filename) if $filename ne ''; - return urlsanit("bugreport.cgi$pathinfo?$params"); + return urlsanit("bugreport.cgi" . $pathinfo . "?" . $params); + } } -sub mboxurl { - my $ref = shift; - return urlsanit("bugreport.cgi" . "?" . "bug=$ref&mbox=yes"); -} +sub dlurl { bugurl(@_); } +sub mboxurl { return bugurl($ref, "mbox"); } sub allbugs { return @{getbugs(sub { 1 })}; @@ -462,7 +483,8 @@ sub allbugs { sub bugmatches(\%\%) { my ($hash, $status) = @_; - while ((my ($key, $value) = each(%$hash))) { + foreach my $key( keys( %$hash ) ) { + my $value = $hash->{$key}; my $sub = $field_match{$key}; return 1 if ($sub->($key, $value, $status)); } @@ -470,7 +492,7 @@ sub bugmatches(\%\%) { } sub bugfilter($%) { my ($bug, %status) = @_; - local (%seenmerged); + our (%seenmerged); if (%common_include) { return 1 if (!bugmatches(%common_include, %status)); } @@ -478,6 +500,9 @@ sub bugfilter($%) { return 1 if (bugmatches(%common_exclude, %status)); } my @merged = sort {$a<=>$b} $bug, split(/ /, $status{mergedwith}); + my $daysold = int((time - $status{date}) / 86400); # seconds to days + return 1 unless ($common_mindays <= $daysold); + return 1 unless ($common_maxdays == -1 || $daysold <= $common_maxdays); return 1 unless ($common_repeatmerged || !$seenmerged{$merged[0]}); $seenmerged{$merged[0]} = 1; return 0; @@ -490,7 +515,8 @@ sub htmlizebugs { my @status = (); my %count; - my ($header, $footer); + my $header = ''; + my $footer = ''; if (@bugs == 0) { return "

No reports found!

\n"; @@ -555,9 +581,13 @@ sub htmlizebugs { for ( my $i = 0; $i < @order; $i++ ) { my $order = $order[ $i ]; next unless defined $section{$order}; - my $count = $count{"_$order"}; - my $bugs = $count == 1 ? "bug" : "bugs"; - $result .= "

$headers[$i] ($count $bugs)

\n"; + if ($common{show_list_header}) { + my $count = $count{"_$order"}; + my $bugs = $count == 1 ? "bug" : "bugs"; + $result .= "

$headers[$i] ($count $bugs)

\n"; + } else { + $result .= "

$headers[$i]

\n"; + } $result .= "\n"; @@ -578,19 +608,19 @@ sub htmlizebugs { } $result = $header . $result if ( $common{show_list_header} ); - $result .= $debbugs::gHTMLExpireNote if $gRemoveAge and $anydone; - $result .= $footer if ( $common{show_list_footer} ); + $result .= $gHTMLExpireNote if $gRemoveAge and $anydone; + $result .= "
" . $footer if ( $common{show_list_footer} ); return $result; } sub countbugs { my $bugfunc = shift; if ($common_archive) { - open I, "<$debbugs::gSpoolDir/index.archive" - or &quitcgi("$debbugs::gSpoolDir/index.archive: $!"); + open I, "<$gSpoolDir/index.archive" + or &quitcgi("$gSpoolDir/index.archive: $!"); } else { - open I, "<$debbugs::gSpoolDir/index.db" - or &quitcgi("$debbugs::gSpoolDir/index.db: $!"); + open I, "<$gSpoolDir/index.db" + or &quitcgi("$gSpoolDir/index.db: $!"); } my %count = (); @@ -613,28 +643,35 @@ sub getbugs { my @result = (); - if (!$common_archive && defined $opt && - -e "$debbugs::gSpoolDir/by-$opt.idx") - { + my $fastidx; + if (!defined $opt) { + # leave $fastidx undefined; + } elsif (!$common_archive) { + $fastidx = "$gSpoolDir/by-$opt.idx"; + } else { + $fastidx = "$gSpoolDir/by-$opt-arc.idx"; + } + + if (defined $fastidx && -e $fastidx) { my %lookup; print STDERR "optimized\n" if ($debug); - tie %lookup, DB_File => "$debbugs::gSpoolDir/by-$opt.idx", O_RDONLY - or die "$0: can't open $debbugs::gSpoolDir/by-$opt.idx ($!)\n"; + tie %lookup, MLDBM => $fastidx, O_RDONLY + or die "$0: can't open $fastidx ($!)\n"; while ($key = shift) { my $bugs = $lookup{$key}; if (defined $bugs) { - push @result, (unpack 'N*', $bugs); + push @result, keys %{$bugs}; } } untie %lookup; print STDERR "done optimized\n" if ($debug); } else { if ( $common_archive ) { - open I, "<$debbugs::gSpoolDir/index.archive" - or &quitcgi("$debbugs::gSpoolDir/index.archive: $!"); + open I, "<$gSpoolDir/index.archive" + or &quitcgi("$gSpoolDir/index.archive: $!"); } else { - open I, "<$debbugs::gSpoolDir/index.db" - or &quitcgi("$debbugs::gSpoolDir/index.db: $!"); + open I, "<$gSpoolDir/index.db" + or &quitcgi("$gSpoolDir/index.db: $!"); } while() { if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) { @@ -703,34 +740,6 @@ sub getmaintainers { return $_maintainer; } -my $_pkgsrc; -my $_pkgcomponent; -sub getpkgsrc { - return $_pkgsrc if $_pkgsrc; - return {} unless defined $gPackageSource; - my %pkgsrc; - my %pkgcomponent; - - open(MM,"$gPackageSource") or &quitcgi("open $gPackageSource: $!"); - while() { - next unless m/^(\S+)\s+(\S+)\s+(\S.*\S)\s*$/; - ($a,$b,$c)=($1,$2,$3); - $a =~ y/A-Z/a-z/; - $pkgsrc{$a}= $c; - $pkgcomponent{$a}= $b; - } - close(MM); - $_pkgsrc = \%pkgsrc; - $_pkgcomponent = \%pkgcomponent; - return $_pkgsrc; -} - -sub getpkgcomponent { - return $_pkgcomponent if $_pkgcomponent; - getpkgsrc(); - return $_pkgcomponent; -} - my $_pseudodesc; sub getpseudodesc { return $_pseudodesc if $_pseudodesc; @@ -751,29 +760,24 @@ sub getbugstatus { my %status; + if ( $use_bug_idx eq 1 && exists( $bugidx{ $bugnum } ) ) { + %status = %{ $bugidx{ $bugnum } }; + $status{ pending } = $status{ status }; + $status{ id } = $bugnum; + return \%status; + } + my $location = getbuglocation( $bugnum, 'summary' ); return {} if ( !$location ); %status = %{ readbug( $bugnum, $location ) }; $status{ id } = $bugnum; - $status{found_versions} = []; - $status{fixed_versions} = []; - if (defined $gVersionBugsDir and - (defined $common_version or defined $common_dist)) { - my $bughash = get_hashname($bugnum); - if (open BUGVER, "< $gVersionBugsDir/$bughash/$bugnum.versions") { - local $_; - while () { - if (/^Found-in: (.*)/i) { - $status{found_versions} = [split ' ', $1]; - } elsif (/^Fixed-in: (.*)/i) { - $status{fixed_versions} = [split ' ', $1]; - } - } - close BUGVER; - } - } + if (defined $common_bugusertags{$bugnum}) { + $status{keywords} = "" unless defined $status{keywords}; + $status{keywords} .= " " unless $status{keywords} eq ""; + $status{keywords} .= join(" ", @{$common_bugusertags{$bugnum}}); + } $status{tags} = $status{keywords}; my %tags = map { $_ => 1 } split ' ', $status{tags}; @@ -786,48 +790,55 @@ sub getbugstatus { $status{"pending"} = 'pending-fixed' if ($tags{pending}); $status{"pending"} = 'fixed' if ($tags{fixed}); - my $version; + my @versions; if (defined $common_version) { - $version = $common_version; + @versions = ($common_version); } elsif (defined $common_dist) { - $version = getversion($status{package}, $common_dist, $common_arch); - } - - if (defined $version) { - my $buggy = buggyversion($bugnum, $version, \%status); - if ($buggy eq 'absent') { + @versions = getversions($status{package}, $common_dist, $common_arch); + } + + # TODO: This should probably be handled further out for efficiency and + # for more ease of distinguishing between pkg= and src= queries. + my @sourceversions = makesourceversions($status{package}, $common_arch, + @versions); + + if (@sourceversions) { + # Resolve bugginess states (we might be looking at multiple + # architectures, say). Found wins, then fixed, then absent. + my $maxbuggy = 'absent'; + for my $version (@sourceversions) { + my $buggy = buggyversion($bugnum, $version, \%status); + if ($buggy eq 'found') { + $maxbuggy = 'found'; + last; + } elsif ($buggy eq 'fixed' and $maxbuggy ne 'found') { + $maxbuggy = 'fixed'; + } + } + if ($maxbuggy eq 'absent') { $status{"pending"} = 'absent'; - } elsif ($buggy eq 'fixed') { + } elsif ($maxbuggy eq 'fixed') { $status{"pending"} = 'done'; } } if (length($status{done}) and - (not defined $version or not @{$status{fixed_versions}})) { + (not @sourceversions or not @{$status{fixed_versions}})) { $status{"pending"} = 'done'; } return \%status; } -sub getsrcpkgs { - my $src = shift; - return () if !$src; - my %pkgsrc = %{getpkgsrc()}; - my @pkgs; - foreach ( keys %pkgsrc ) { - push @pkgs, $_ if $pkgsrc{$_} eq $src; - } - return @pkgs; -} - sub buglog { my $bugnum = shift; my $location = getbuglocation($bugnum, 'log'); - return undef unless defined $location; - return getbugcomponent($bugnum, 'log', $location); + return getbugcomponent($bugnum, 'log', $location) if ($location); + $location = getbuglocation($bugnum, 'log.gz'); + return getbugcomponent($bugnum, 'log.gz', $location); } + my %_versionobj; sub buggyversion { my ($bug, $ver, $status) = @_; @@ -840,30 +851,40 @@ sub buggyversion { $tree = $_versionobj{$src}; } else { $tree = Debbugs::Versions->new(\&DpkgVer::vercmp); - if (open VERFILE, "< $gVersionPackagesDir/$src") { + my $srchash = substr $src, 0, 1; + if (open VERFILE, "< $gVersionPackagesDir/$srchash/$src") { $tree->load(\*VERFILE); close VERFILE; } $_versionobj{$src} = $tree; } - return $tree->buggy($ver, $status->{found_versions}, - $status->{fixed_versions}); + my @found = makesourceversions($status->{package}, undef, + @{$status->{found_versions}}); + my @fixed = makesourceversions($status->{package}, undef, + @{$status->{fixed_versions}}); + + return $tree->buggy($ver, \@found, \@fixed); } -my %_versions; -sub getversion { - my ($pkg, $dist, $arch) = @_; - return undef unless defined $gVersionIndex; - $dist = 'unstable' unless defined $dist; - $arch = 'i386' unless defined $arch; - unless (tied %_versions) { - tie %_versions, 'MLDBM', $gVersionIndex, O_RDONLY - or die "can't open versions index: $!"; +sub getversiondesc { + my $pkg = shift; + + if (defined $common_version) { + return "version $common_version"; + } elsif (defined $common_dist) { + my @distvers = getversions($pkg, $common_dist, $common_arch); + @distvers = sort @distvers; + local $" = ', '; + if (@distvers > 1) { + return "versions @distvers"; + } elsif (@distvers == 1) { + return "version @distvers"; + } } - return $_versions{$pkg}{$dist}{$arch}; + return undef; } 1;