X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=cgi%2Fcommon.pl;h=0e100b6575ed21a28d335b42bc458c0afb5a69c4;hb=2c7d7cd43020f31cb5b9aac6e153df7912d779ae;hp=1e255ee7fae2d7c449fd1567179152d00786f028;hpb=a731a7faf718c1b7d593aac94d75253a11b4de21;p=debbugs.git diff --git a/cgi/common.pl b/cgi/common.pl index 1e255ee..0e100b6 100644 --- a/cgi/common.pl +++ b/cgi/common.pl @@ -2,6 +2,16 @@ use DB_File; use Fcntl qw/O_RDONLY/; +use Mail::Address; +use MLDBM qw/DB_File/; + +$config_path = '/etc/debbugs'; +$lib_path = '/usr/lib/debbugs'; +require "$lib_path/errorlib"; + +use Debbugs::Versions; + +$MLDBM::RemoveTaint = 1; my $common_archive = 0; my $common_repeatmerged = 1; @@ -17,14 +27,34 @@ my @common_pending_exclude = (); my @common_severity_include = (); my @common_severity_exclude = (); +my $common_version; +my $common_dist; +my $common_arch; + my $debug = 0; sub set_option { my ($opt, $val) = @_; if ($opt eq "archive") { $common_archive = $val; } if ($opt eq "repeatmerged") { $common_repeatmerged = $val; } - if ($opt eq "exclude") { %common_exclude = %{$val}; } - if ($opt eq "include") { %common_include = %{$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; + } + 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; + } 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; } @@ -57,6 +87,9 @@ sub set_option { @vals = @{$val} if (ref($val) eq "ARRAY" ); @common_severity_include = @vals if (@vals); } + if ($opt eq "version") { $common_version = $val; } + if ($opt eq "dist") { $common_dist = $val; } + if ($opt eq "arch") { $common_arch = $val; } } sub readparse { @@ -70,7 +103,7 @@ sub readparse { } else { return; } - foreach (split(/&/,$in)) { + foreach (split(/[&;]/,$in)) { s/\+/ /g; ($key, $val) = split(/=/,$_,2); $key=~s/%(..)/pack("c",hex($1))/ge; @@ -87,7 +120,7 @@ $debug = 1 if (defined $ret{"debug"} && $ret{"debug"} eq "aj"); return %ret; } -sub quit { +sub quitcgi { my $msg = shift; print "Content-Type: text/html\n\n"; print "Error\n"; @@ -106,6 +139,62 @@ sub quit { # 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; +} + +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 'Package' . (@pkglist > 1 ? 's' : '') . ': ' . + join(', ', + map { + '' . + $openstrong . htmlsanit($_) . $closestrong . '' + } @pkglist + ) . ";\n"; +} + +# 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(''); + } +} + sub htmlindexentry { my $ref = shift; my %status = %{getbugstatus($ref)}; @@ -127,9 +216,7 @@ sub htmlindexentrystatus { $showseverity = "Severity: $status{severity};\n"; } - $result .= "Package: " - . "" . htmlsanit($status{"package"}) . ";\n" - if (length($status{"package"})); + $result .= htmlpackagelinks($status{"package"}, 1); $result .= $showseverity; $result .= "Reported by: " . htmlsanit($status{originator}) . ""; @@ -145,12 +232,30 @@ 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}); - } elsif (length($status{forwarded})) { - $result .= ";\nForwarded to " - . htmlsanit($status{forwarded}); - } else { + } + + unless (length($status{done})) { + 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 = ""; @@ -160,8 +265,8 @@ sub htmlindexentrystatus { $efont = "" if ($font); $font = "<$font>" if ($font); - my $yearsold = int($daysold / 364); - $daysold = $daysold - $yearsold * 364; + my $yearsold = int($daysold / 365); + $daysold -= $yearsold * 365; $result .= ";\n $font"; my @age; @@ -179,63 +284,74 @@ 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=yes" if ($common_repeatmerged); - return urlsanit($debbugs::gCGIDomain . "pkgreport.cgi" . "?" . $params); + $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=yes" if ($common_repeatmerged); - return urlsanit($debbugs::gCGIDomain . "pkgreport.cgi" . "?" . $params); + $params .= urlargs(); + return urlsanit("pkgreport.cgi" . "?" . $params); } sub pkgurl { my $ref = shift; my $params = "pkg=$ref"; - $params .= "&archive=yes" if ($common_archive); - $params .= "&repeatmerged=yes" if ($common_repeatmerged); - - return urlsanit($debbugs::gCGIDomain . "pkgreport.cgi" . "?" . "$params"); + $params .= urlargs(); + return urlsanit("pkgreport.cgi" . "?" . "$params"); } sub srcurl { my $ref = shift; my $params = "src=$ref"; - $params .= "&archive=yes" if ($common_archive); - $params .= "&repeatmerged=yes" if ($common_repeatmerged); - return urlsanit($debbugs::gCGIDomain . "pkgreport.cgi" . "?" . "$params"); + $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/\+/%2b/g; - my %saniarray = ('<','lt', '>','gt', '"','quot'); - my $out; - while ($url =~ m/[<>"]/) { - $out .= $`. '&'. $saniarray{$&}. ';'; - $url = $'; - } - $out .= $url; - return $out; + my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot'); + $url =~ s/([<>&"])/\&$saniarray{$1};/g; + return $url; } sub htmlsanit { my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot'); my $in = shift || ""; - my $out; - while ($in =~ m/[<>&"]/) { - $out .= $`. '&'. $saniarray{$&}. ';'; - $in = $'; + $in =~ s/([<>&"])/\&$saniarray{$1};/g; + return $in; +} + +sub maybelink { + my $in = shift; + if ($in =~ /^[a-zA-Z0-9+.-]+:/) { # RFC 1738 scheme + return qq{} . htmlsanit($in) . ''; + } else { + return htmlsanit($in); } - $out .= $in; - return $out; } sub bugurl { @@ -246,9 +362,9 @@ sub bugurl { $params .= "\&archive=yes" if (!$common_archive && $val =~ /^archive.*$/); } $params .= "&archive=yes" if ($common_archive); - $params .= "&repeatmerged=yes" if ($common_repeatmerged); + $params .= "&repeatmerged=no" unless ($common_repeatmerged); - return urlsanit($debbugs::gCGIDomain . "bugreport.cgi" . "?" . "$params"); + return urlsanit("bugreport.cgi" . "?" . "$params"); } sub dlurl { @@ -260,25 +376,19 @@ sub dlurl { $filename = $1 if ($val =~ /^filename=(.*)$/); } $params .= "&archive=yes" if ($common_archive); + my $pathinfo = ''; + $pathinfo = "/$filename" if $filename ne ''; - return urlsanit($debbugs::gCGIDomain . "bugreport.cgi/$filename?$params"); + return urlsanit("bugreport.cgi$pathinfo?$params"); } sub mboxurl { my $ref = shift; - return urlsanit($debbugs::gCGIDomain . "bugreport.cgi" . "?" . "bug=$ref&mbox=yes"); + return urlsanit("bugreport.cgi" . "?" . "bug=$ref&mbox=yes"); } sub allbugs { - my @bugs = (); - - opendir(D, "$debbugs::gSpoolDir/db") or &quit("opendir db: $!"); - @bugs = sort {$a<=>$b} grep s/\.status$//, - (grep m/^[0-9]+\.status$/, - (readdir(D))); - closedir(D); - - return @bugs; + return @{getbugs(sub { 1 })}; } sub htmlizebugs { @@ -292,7 +402,8 @@ sub htmlizebugs { "pending-fixed", "pending upload", "fixed", "fixed in NMU", "done", "resolved", - "forwarded", "forwarded to upstream software authors"); + "forwarded", "forwarded to upstream software authors", + "absent", "not applicable to this version"); if (@bugs == 0) { return "

No reports found!

\n"; @@ -303,11 +414,10 @@ sub htmlizebugs { } else { @bugs = sort {$a<=>$b} @bugs; } + my %seenmerged; foreach my $bug (@bugs) { my %status = %{getbugstatus($bug)}; next unless %status; - my @merged = sort {$a<=>$b} ($bug, split(/ /, $status{mergedwith})); - next unless ($common_repeatmerged || $bug == $merged[0]); if (%common_include) { my $okay = 0; foreach my $t (split /\s+/, $status{tags}) { @@ -332,7 +442,17 @@ sub htmlizebugs { } 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; + my $html = sprintf "
  • #%d: %s\n
    ", bugurl($bug), $bug, htmlsanit($status{subject}); $html .= htmlindexentrystatus(\%status) . "\n"; @@ -345,26 +465,22 @@ sub htmlizebugs { if ($common_raw_sort) { $result .= "\n"; } else { - my @pendingList = qw(pending forwarded pending-fixed fixed done); - @pendingList = @common_pending_include if @common_pending_include; + my @pendingList = qw(pending forwarded pending-fixed fixed done absent); @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) { - next if grep( /^$pending$/, @common_pending_exclude); my @severityList = @debbugs::gSeverityList; - @severityList = @common_severity_include if @common_severity_include; @severityList = reverse @severityList if $common_severity_reverse; #print STDERR join(",",@severityList)."\n"; # foreach my $severity(@debbugs::gSeverityList) { foreach my $severity(@severityList) { - next if grep( /^$severity$/, @common_severity_exclude); $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 .= "(A list of all such bugs used to be available).\n"; $result .= "\n"; @@ -373,25 +489,28 @@ sub htmlizebugs { } } - $result .= $debbugs::gHTMLExpireNote if ($anydone); + $result .= $debbugs::gHTMLExpireNote if $gRemoveAge and $anydone; return $result; } sub countbugs { my $bugfunc = shift; if ($common_archive) { - open I, "<$debbugs::gSpoolDir/index.archive" or &quit("bugindex: $!"); + open I, "<$debbugs::gSpoolDir/index.archive" + or &quitcgi("$debbugs::gSpoolDir/index.archive: $!"); } else { - open I, "<$debbugs::gSpoolDir/index.db" or &quit("bugindex: $!"); + 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, + my @x = $bugfunc->(pkg => $1, bug => $2, status => $4, submitter => $5, severity => $6, tags => $7); - $count{$x}++; + local $_; + $count{$_}++ foreach @x; } } close I; @@ -422,10 +541,10 @@ print STDERR "done optimized\n" if ($debug); } else { if ( $common_archive ) { open I, "<$debbugs::gSpoolDir/index.archive" - or &quit("bugindex: $!"); + or &quitcgi("$debbugs::gSpoolDir/index.archive: $!"); } else { open I, "<$debbugs::gSpoolDir/index.db" - or &quit("bugindex: $!"); + or &quitcgi("$debbugs::gSpoolDir/index.db: $!"); } while() { if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) { @@ -472,7 +591,7 @@ sub getmaintainers { return $_maintainer if $_maintainer; my %maintainer; - open(MM,"$gMaintainerFile") or &quit("open $gMaintainerFile: $!"); + open(MM,"$gMaintainerFile") or &quitcgi("open $gMaintainerFile: $!"); while() { next unless m/^(\S+)\s+(\S.*\S)\s*$/; ($a,$b)=($1,$2); @@ -480,14 +599,16 @@ sub getmaintainers { $maintainer{$a}= $b; } close(MM); - open(MM,"$gMaintainerFileOverride") or &quit("open $gMaintainerFileOverride: $!"); - while() { - next unless m/^(\S+)\s+(\S.*\S)\s*$/; - ($a,$b)=($1,$2); - $a =~ y/A-Z/a-z/; - $maintainer{$a}= $b; + 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); } - close(MM); $_maintainer = \%maintainer; return $_maintainer; } @@ -496,10 +617,11 @@ my $_pkgsrc; my $_pkgcomponent; sub getpkgsrc { return $_pkgsrc if $_pkgsrc; + return {} unless defined $gPackageSource; my %pkgsrc; my %pkgcomponent; - open(MM,"$gPackageSource") or &quit("open $gPackageSource: $!"); + open(MM,"$gPackageSource") or &quitcgi("open $gPackageSource: $!"); while() { next unless m/^(\S+)\s+(\S+)\s+(\S.*\S)\s*$/; ($a,$b,$c)=($1,$2,$3); @@ -519,31 +641,49 @@ sub getpkgcomponent { return $_pkgcomponent; } -sub getbugdir { - my ( $bugnum, $ext ) = @_; - my $archdir = sprintf "%02d", $bugnum % 100; - foreach ( ( "$gSpoolDir/db-h/$archdir", "$gSpoolDir/db", "$gSpoolDir/archive/$archdir", "/debian/home/joeyh/tmp/infomagic-95/$archdir" ) ) { - return $_ if ( -r "$_/$bugnum.$ext" ); +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; } - return undef; + close(PSEUDO); + $_pseudodesc = \%pseudodesc; + return $_pseudodesc; } - + sub getbugstatus { my $bugnum = shift; my %status; - my $dir = getbugdir( $bugnum, "status" ); - return {} if ( !$dir ); - open S, "< $dir/$bugnum.status"; - my @lines = qw(originator date subject msgid package tags done - forwarded mergedwith severity); - while() { - chomp; - $status{shift @lines} = $_; + my $location = getbuglocation( $bugnum, "status" ); + return {} if ( !$location ); + %status = %{ readbug( $bugnum, $location ) }; + + $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; + } } - close(S); - $status{shift @lines} = '' while(@lines); + + $status{tags} = $status{keywords}; $status{"package"} =~ s/\s*$//; $status{"package"} = 'unknown' if ($status{"package"} eq ''); @@ -551,9 +691,29 @@ sub getbugstatus { $status{"pending"} = 'pending'; $status{"pending"} = 'forwarded' if (length($status{"forwarded"})); - $status{"pending"} = 'fixed' if ($status{"tags"} =~ /\bfixed\b/); $status{"pending"} = 'pending-fixed' if ($status{"tags"} =~ /\bpending\b/); - $status{"pending"} = 'done' if (length($status{"done"})); + $status{"pending"} = 'fixed' if ($status{"tags"} =~ /\bfixed\b/); + + my $version; + if (defined $common_version) { + $version = $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') { + $status{"pending"} = 'absent'; + } elsif ($buggy eq 'fixed') { + $status{"pending"} = 'done'; + } + } + + if (length($status{done}) and + (not defined $version or not @{$status{fixed_versions}})) { + $status{"pending"} = 'done'; + } return \%status; } @@ -571,10 +731,46 @@ sub getsrcpkgs { sub buglog { my $bugnum = shift; + my $location = getbuglocation($bugnum, 'log'); + return getbugcomponent($bugnum, 'log', $location); +} + +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); + if (open VERFILE, "< $gVersionPackagesDir/$src") { + $tree->load(\*VERFILE); + close VERFILE; + } + $_versionobj{$src} = $tree; + } + + return $tree->buggy($ver, $status->{found_versions}, + $status->{fixed_versions}); +} + +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: $!"; + } - my $dir = getbugdir( $bugnum, "log" ); - return "" if ( !$dir ); - return "$dir/$bugnum.log"; + return $_versions{$pkg}{$dist}{$arch}; } 1;