X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fcommon.pl;h=05b8941ac7f84f8a2d2e07b9556ba9c6cabf577c;hb=refs%2Fheads%2Ftravis-ci;hp=6032390b571157301c7dcafe8507333aed7f0f71;hpb=d6adb0abe1288c3950bc7db8b92c816de4b77431;p=debbugs.git diff --git a/cgi/common.pl b/cgi/common.pl index 6032390..05b8941 100644 --- a/cgi/common.pl +++ b/cgi/common.pl @@ -3,20 +3,29 @@ 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; +use Debbugs::Config qw(:globals :text); $config_path = '/etc/debbugs'; $lib_path = '/usr/lib/debbugs'; -require "$lib_path/errorlib"; +#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(:status :read :versions); +use Debbugs::CGI qw(:all); +use Debbugs::Bugs qw(count_bugs); $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 = (); @@ -24,6 +33,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, @@ -77,7 +88,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', @@ -92,7 +103,7 @@ my %common_headers = ( "forwarded" => "forwarded to upstream software authors", "absent" => "not applicable to this version", }, - 'severity' => \%debbugs::gSeverityDisplay, + 'severity' => \%gSeverityDisplay, ); my $common_version; @@ -100,6 +111,8 @@ my $common_dist; my $common_arch; my $debug = 0; +my $use_bug_idx = 0; +my %bugidx; sub array_option($) { my ($val) = @_; @@ -132,6 +145,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; } @@ -160,19 +184,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); @@ -186,64 +228,20 @@ sub readparse { } $ret{$key}=$val; } -$debug = 1 if (defined $ret{"debug"} && $ret{"debug"} eq "aj"); - return %ret; -} -sub quitcgi { - my $msg = shift; - print "Content-Type: text/html\n\n"; - print "Error\n"; - print "An error occurred. Dammit.\n"; - print "Error was: $msg.\n"; - print "\n"; - exit 0; -} +$debug = 1 if (defined $ret{"debug"} && $ret{"debug"} eq "aj"); -#sub abort { -# my $msg = shift; -# my $Archive = $common_archive ? "archive" : ""; -# print header . start_html("Sorry"); -# print "Sorry bug #$msg doesn't seem to be in the $Archive database.\n"; -# print end_html; -# exit 0; -#} - -# Split a package string from the status file into a list of package names. -sub splitpackages { - my $pkgs = shift; - return unless defined $pkgs; - return map lc, split /[ \t?,()]+/, $pkgs; -} + $common_leet_urls = 1 + if (defined $ret{"leeturls"} && $ret{"leeturls"} eq "yes"); -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}}; + return %ret; } # 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 'Package' . (@pkglist > 1 ? 's' : '') . ': ' . - join(', ', - map { - '' . - $openstrong . htmlsanit($_) . $closestrong . '' - } @pkglist - ); + return htmlize_packagelinks(@_); } # Generate a comma-separated list of HTML links to each address given in @@ -251,20 +249,7 @@ sub htmlpackagelinks { # $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->(''); - } + htmlize_addresslinks(@_); } # Generate a comma-separated list of HTML links to each maintainer given in @@ -324,7 +309,6 @@ sub htmlindexentrystatus { . htmlsanit(join(", ", sort(split(/\s+/, $status{tags})))) . "" if (length($status{tags})); - my @merged= split(/ /,$status{mergedwith}); my $mseparator= ";\nmerged with "; for my $m (@merged) { @@ -334,7 +318,7 @@ sub htmlindexentrystatus { if (length($status{done})) { $result .= ";\nDone: " . htmlsanit($status{done}); - $days = ceil($debbugs::gRemoveAge - -M buglog($status{id})); + $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 { @@ -377,47 +361,33 @@ 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 pkgurl { - 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 pkgurl { pkg_url(pkg => $_[0] || ""); } +sub srcurl { pkg_url(src => $_[0] || ""); } +sub tagurl { pkg_url(tag => $_[0] || ""); } -sub tagurl { +sub pkg_etc_url { 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 { @@ -437,53 +407,54 @@ 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 = '/'.uri_escape($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 })}; } -sub bugmatches(\%\%) { +sub bugmatches { my ($hash, $status) = @_; foreach my $key( keys( %$hash ) ) { my $value = $hash->{$key}; @@ -492,16 +463,19 @@ sub bugmatches(\%\%) { } return 0; } -sub bugfilter($%) { - my ($bug, %status) = @_; - our (%seenmerged); - if (%common_include) { - return 1 if (!bugmatches(%common_include, %status)); +sub bugfilter { + my ($bug, $status,$seen_merged,$common_include,$common_exclude,$repeat_merged,) = @_; + #our (%seenmerged); + if ($common_include) { + return 1 if (!bugmatches($common_include, $status)); } - if (%common_exclude) { - return 1 if (bugmatches(%common_exclude, %status)); + if ($common_exclude) { + 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; @@ -607,33 +581,15 @@ sub htmlizebugs { } $result = $header . $result if ( $common{show_list_header} ); - $result .= $debbugs::gHTMLExpireNote if $gRemoveAge and $anydone; + $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: $!"); - } else { - open I, "<$debbugs::gSpoolDir/index.db" - or &quitcgi("$debbugs::gSpoolDir/index.db: $!"); - } - - my %count = (); - while() - { - if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) { - my @x = $bugfunc->(pkg => $1, bug => $2, status => $4, - submitter => $5, severity => $6, tags => $7); - local $_; - $count{$_}++ foreach @x; - } - } - close I; - return %count; + return count_bugs(function=>shift, + archive => $commonarchive, + ); } sub getbugs { @@ -642,28 +598,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+(.*)$/) { @@ -705,248 +668,16 @@ sub maintencoded { return $encoded; } -my $_maintainer; -sub getmaintainers { - return $_maintainer if $_maintainer; - my %maintainer; - - open(MM,"$gMaintainerFile") or &quitcgi("open $gMaintainerFile: $!"); - while() { - next unless m/^(\S+)\s+(\S.*\S)\s*$/; - ($a,$b)=($1,$2); - $a =~ y/A-Z/a-z/; - $maintainer{$a}= $b; - } - close(MM); - if (defined $gMaintainerFileOverride) { - open(MM,"$gMaintainerFileOverride") or &quitcgi("open $gMaintainerFileOverride: $!"); - while() { - next unless m/^(\S+)\s+(\S.*\S)\s*$/; - ($a,$b)=($1,$2); - $a =~ y/A-Z/a-z/; - $maintainer{$a}= $b; - } - close(MM); - } - $_maintainer = \%maintainer; - 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; - my %pseudodesc; - - open(PSEUDO, "< $gPseudoDescFile") or &quitcgi("open $gPseudoDescFile: $!"); - while() { - next unless m/^(\S+)\s+(\S.*\S)\s*$/; - $pseudodesc{lc $1} = $2; - } - close(PSEUDO); - $_pseudodesc = \%pseudodesc; - return $_pseudodesc; -} sub getbugstatus { - my $bugnum = shift; - - my %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; - } - } - - $status{tags} = $status{keywords}; - my %tags = map { $_ => 1 } split ' ', $status{tags}; - - $status{"package"} =~ s/\s*$//; - $status{"package"} = 'unknown' if ($status{"package"} eq ''); - $status{"severity"} = 'normal' if ($status{"severity"} eq ''); - - $status{"pending"} = 'pending'; - $status{"pending"} = 'forwarded' if (length($status{"forwarded"})); - $status{"pending"} = 'pending-fixed' if ($tags{pending}); - $status{"pending"} = 'fixed' if ($tags{fixed}); - - my @versions; - if (defined $common_version) { - @versions = ($common_version); - } elsif (defined $common_dist) { - @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 ($maxbuggy eq 'fixed') { - $status{"pending"} = 'done'; - } - } - - if (length($status{done}) and - (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 getbugcomponent($bugnum, 'log', $location) if ($location); - $location = getbuglocation($bugnum, 'log.gz'); - return getbugcomponent($bugnum, 'log.gz', $location); -} - -# Canonicalize versions into source versions, which have an explicitly -# named source package. This is used to cope with source packages whose -# names have changed during their history, and with cases where source -# version numbers differ from binary version numbers. -sub makesourceversions { - my $pkg = shift; - my $arch = shift; - my %sourceversions; - - for my $version (@_) { - if ($version =~ m[/]) { - # Already a source version. - $sourceversions{$version} = 1; - } else { - my @srcinfo = binarytosource($pkg, $version, $arch); - next unless @srcinfo; - $sourceversions{"$_->[0]/$_->[1]"} = 1 foreach @srcinfo; - } - } - - return sort keys %sourceversions; -} - -my %_versionobj; -sub buggyversion { - my ($bug, $ver, $status) = @_; - return '' unless defined $gVersionPackagesDir; - my $src = getpkgsrc()->{$status->{package}}; - $src = $status->{package} unless defined $src; - - my $tree; - if (exists $_versionobj{$src}) { - $tree = $_versionobj{$src}; - } else { - $tree = Debbugs::Versions->new(\&DpkgVer::vercmp); - my $srchash = substr $src, 0, 1; - if (open VERFILE, "< $gVersionPackagesDir/$srchash/$src") { - $tree->load(\*VERFILE); - close VERFILE; - } - $_versionobj{$src} = $tree; - } - - 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 getversions { - my ($pkg, $dist, $arch) = @_; - return () unless defined $gVersionIndex; - $dist = 'unstable' unless defined $dist; - - unless (tied %_versions) { - tie %_versions, 'MLDBM', $gVersionIndex, O_RDONLY - or die "can't open versions index: $!"; - } - - if (defined $arch) { - my $ver = $_versions{$pkg}{$dist}{$arch}; - return $ver if defined $ver; - return (); - } else { - my %uniq; - for my $ar (keys %{$_versions{$pkg}{$dist}}) { - $uniq{$_versions{$pkg}{$dist}{$ar}} = 1 unless $ar eq 'source'; - } - return keys %uniq; - } + my ($bug) = @_; + return get_bug_status(bug => $bug, + $use_bug_idx?(bug_index => \%bugidx):(), + usertags => \%common_bugusertags, + (defined $common_dist)?(dist => $common_dist):(), + (defined $common_version)?(version => $common_version):(), + (defined $common_arch)?(arch => $common_arch):(), + ); } sub getversiondesc { @@ -968,77 +699,4 @@ sub getversiondesc { return undef; } -# Returns an array of zero or more references to (srcname, srcver) pairs. -# If $binarch is undef, returns results for all architectures. -my %_binarytosource; -sub binarytosource { - my ($binname, $binver, $binarch) = @_; - - # TODO: This gets hit a lot, especially from buggyversion() - probably - # need an extra cache for speed here. - - if (tied %_binarytosource or - tie %_binarytosource, 'MLDBM', $gBinarySourceMap, O_RDONLY) { - # avoid autovivification - if (exists $_binarytosource{$binname} and - exists $_binarytosource{$binname}{$binver}) { - if (defined $binarch) { - my $src = $_binarytosource{$binname}{$binver}{$binarch}; - return () unless defined $src; # not on this arch - # Copy the data to avoid tiedness problems. - return [@$src]; - } else { - # Get (srcname, srcver) pairs for all architectures and - # remove any duplicates. This involves some slightly tricky - # multidimensional hashing; sorry. Fortunately there'll - # usually only be one pair returned. - my %uniq; - for my $ar (keys %{$_binarytosource{$binname}{$binver}}) { - my $src = $_binarytosource{$binname}{$binver}{$ar}; - next unless defined $src; - $uniq{$src->[0]}{$src->[1]} = 1; - } - my @uniq; - for my $sn (sort keys %uniq) { - push @uniq, [$sn, $_] for sort keys %{$uniq{$sn}}; - } - return @uniq; - } - } - } - - # No $gBinarySourceMap, or it didn't have an entry for this name and - # version. Try $gPackageSource (unversioned) instead. - my $pkgsrc = getpkgsrc(); - if (exists $pkgsrc->{$binname}) { - return [$pkgsrc->{$binname}, $binver]; - } else { - return (); - } -} - -# Returns an array of zero or more references to -# (binname, binver[, binarch]) triplets. -my %_sourcetobinary; -sub sourcetobinary { - my ($srcname, $srcver) = @_; - - if (tied %_sourcetobinary or - tie %_sourcetobinary, 'MLDBM', $gSourceBinaryMap, O_RDONLY) { - # avoid autovivification - if (exists $_sourcetobinary{$srcname} and - exists $_sourcetobinary{$srcname}{$srcver}) { - my $bin = $_sourcetobinary{$srcname}{$srcver}; - return () unless defined $bin; - # Copy the data to avoid tiedness problems. - return @$bin; - } - } - - # No $gSourceBinaryMap, or it didn't have an entry for this name and - # version. Try $gPackageSource (unversioned) instead. - my @srcpkgs = getsrcpkgs($srcname); - return map [$_, $srcver], @srcpkgs; -} - 1;