#!/usr/bin/perl -w
my $common_archive = 0;
my $common_repeatmerged = 1;
my %common_include = ();
my %common_exclude = ();
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}; }
}
sub readparse {
my ($in, $key, $val, %ret);
if (defined $ENV{"QUERY_STRING"} && $ENV{"QUERY_STRING"} ne "") {
$in=$ENV{QUERY_STRING};
} elsif(defined $ENV{"REQUEST_METHOD"}
&& $ENV{"REQUEST_METHOD"} eq "POST")
{
read(STDIN,$in,$ENV{CONTENT_LENGTH});
} else {
return;
}
foreach (split(/&/,$in)) {
s/\+/ /g;
($key, $val) = split(/=/,$_,2);
$key=~s/%(..)/pack("c",hex($1))/ge;
$val=~s/%(..)/pack("c",hex($1))/ge;
$ret{$key}=$val;
}
return %ret;
}
sub quit {
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;
}
#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;
#}
sub htmlindexentry {
my $ref = shift;
my %status = getbugstatus($ref);
return htmlindexentrystatus(%status) if (%status);
return "";
}
sub htmlindexentrystatus {
my $s = shift;
my %status = %{$s};
my $result = "";
if ($status{severity} eq 'normal') {
$showseverity = '';
} elsif (grep($status{severity} eq $_, @debbugs::gStrongSeverities)) {
$showseverity = "Severity: $status{severity};\n";
} else {
$showseverity = "Severity: $status{severity};\n";
}
$result .= "Package: "
. "" . htmlsanit($status{"package"}) . ";\n"
if (length($status{"package"}));
$result .= $showseverity;
$result .= "Reported by: " . htmlsanit($status{originator});
$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) {
$result .= $mseparator."#$m";
$mseparator= ", ";
}
if (length($status{done})) {
$result .= ";\nDone: " . htmlsanit($status{done});
} elsif (length($status{forwarded})) {
$result .= ";\nForwarded to "
. htmlsanit($status{forwarded});
} else {
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 = "" if ($font);
$font = "<$font>" if ($font);
my $yearsold = int($daysold / 364);
$daysold = $daysold - $yearsold * 364;
$result .= ";\n $font";
$result .= "1 year and " if ($yearsold == 1);
$result .= "$yearsold years and " if ($yearsold > 1);
$result .= "1 day old" if ($daysold == 1);
$result .= "$daysold days old" if ($daysold != 1);
$result .= "$efont";
}
}
$result .= ".";
return $result;
}
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);
}
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);
}
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");
}
sub urlsanit {
my $url = shift;
$url =~ s/%/%25/g;
$url =~ s/\+/%2b/g;
return $url;
}
sub htmlsanit {
my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
my $in = shift || "";
my $out;
while ($in =~ m/[<>&"]/) {
$out .= $`. '&'. $saniarray{$&}. ';';
$in = $';
}
$out .= $in;
return $out;
}
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=yes" if ($common_repeatmerged);
return $debbugs::gCGIDomain . "bugreport.cgi" . "?" . "$params";
}
sub packageurl {
my $ref = shift;
return $debbugs::gCGIDomain . "package.cgi" . "?" . "package=$ref";
}
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;
}
sub htmlizebugs {
my @bugs = @_;
my %section = ();
my %displayshowpending = ("pending", "outstanding",
"done", "resolved",
"forwarded", "forwarded to upstream software authors");
if (@bugs == 0) {
return "
No reports found!
\n";
}
foreach my $bug (sort {$a<=>$b} @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}) {
$okay = 1, last if (defined $common_include{$t});
}
next unless ($okay);
}
if (%common_exclude) {
my $okay = 1;
foreach my $t (split /\s+/, $status{tags}) {
$okay = 0, last if (defined $comon_exclude{$t});
}
next unless ($okay);
}
$section{$status{pending} . "_" . $status{severity}} .=
sprintf "#%d: %s\n
",
bugurl($bug), $bug, htmlsanit($status{subject});
$section{$status{pending} . "_" . $status{severity}} .=
htmlindexentrystatus(\%status) . "\n";
}
my $result = "";
my $anydone = 0;
foreach my $pending (qw(pending forwarded done)) {
foreach my $severity(@debbugs::gSeverityList) {
$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 .= "\n";
$result .= $section{$pending . "_" . $severity};
$result .= "
\n";
$anydone = 1 if ($pending eq "done");
}
}
$result .= $debbugs::gHTMLExpireNote if ($anydone);
return $result;
}
sub submitterbugs {
my $submitter = shift;
my $chk = sub {
my %d = @_;
($subemail = $d{"submitter"}) =~ s/\s*\(.*\)\s*//;
if ($subemail =~ m/<(.*)>/) { $subemail = $1 }
return $subemail eq $submitter;
};
return getbugs($chk);
}
sub severitybugs {
my $status = shift;
my $severity = shift;
my $chk = sub {
my %d = @_;
return ($d{"severity"} eq $severity) && ($d{"status"} eq $status);
};
return getbugs($chk);
}
sub maintbugs {
my $maint = shift;
my %maintainers = getmaintainers();
my $chk = sub {
my %d = @_;
($maintemail = $maintainers{$d{"pkg"}} || "") =~ s/\s*\(.*\)\s*//;
if ($maintemail =~ m/<(.*)>/) { $maintemail = $1 }
return $maintemail eq $maint;
};
return getbugs($chk);
}
sub maintencbugs {
my $maintenc = shift;
my %maintainers = getmaintainers();
return getbugs(sub {my %d=@_; return maintencoded($maintainers{$d{"pkg"}} || "") eq $maintenc});
}
sub pkgbugs {
my $inpkg = shift;
return getbugs( sub { my %d = @_; return $inpkg eq $d{"pkg"} });
}
sub countbugs {
my $bugfunc = shift;
if ($common_archive) {
open I, "<$debbugs::gSpoolDir/index.archive" or &quit("bugindex: $!");
} else {
open I, "<$debbugs::gSpoolDir/index.db" or &quit("bugindex: $!");
}
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);
$count{$x}++;
}
}
close I;
return %count;
}
sub getbugs {
my $bugfunc = shift;
if ( $common_archive ) {
open I, "<$debbugs::gSpoolDir/index.archive" or &quit("bugindex: $!");
} else {
open I, "<$debbugs::gSpoolDir/index.db" or &quit("bugindex: $!");
}
my @result = ();
while()
{
if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) {
if ($bugfunc->(pkg => $1, bug => $2, status => $4, submitter => $5,
severity => $6, tags => $7))
{
push (@result, $2);
#last if (@result > 400);
}
}
}
close I;
return sort {$a <=> $b} @result;
}
sub pkgbugsindex {
my %descstr = ();
if ( $common_archive ) {
open I, "<$debbugs::gSpoolDir/index.archive" or &quit("bugindex: $!");
} else {
open I, "<$debbugs::gSpoolDir/index.db" or &quit("bugindex: $!");
}
while() {
$descstr{ $1 } = 1 if (m/^(\S+)/);
}
close(I);
return %descstr;
}
sub emailfromrfc822 {
my $email = shift;
$email =~ s/\s*\(.*\)\s*//;
$email = $1 if ($email =~ m/<(.*)>/);
return $email;
}
sub maintencoded {
my $input = shift;
my $encoded = '';
while ($input =~ m/\W/) {
$encoded.=$`.sprintf("-%02x_",unpack("C",$&));
$input= $';
}
$encoded.= $input;
$encoded =~ s/-2e_/\./g;
$encoded =~ s/^([^,]+)-20_-3c_(.*)-40_(.*)-3e_/$1,$2,$3,/;
$encoded =~ s/^(.*)-40_(.*)-20_-28_([^,]+)-29_$/,$1,$2,$3/;
$encoded =~ s/-20_/_/g;
$encoded =~ s/-([^_]+)_-/-$1/g;
return $encoded;
}
sub getmaintainers {
my %maintainer;
open(MM,"$gMaintainerFile") or &quit("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);
return %maintainer;
}
sub getbugstatus {
my $bugnum = shift;
my %status;
unless (open(S,"$gSpoolDir/db/$bugnum.status")) {
my $archdir = sprintf "%02d", $bugnum % 100;
open(S,"$gSpoolDir/archive/$archdir/$bugnum.status" ) or return ();
}
my @lines = qw(originator date subject msgid package tags done
forwarded mergedwith severity);
while() {
chomp;
$status{shift @lines} = $_;
}
close(S);
$status{shift @lines} = '' while(@lines);
$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"} = 'done' if (length($status{"done"}));
return %status;
}
sub buglog {
my $bugnum = shift;
my $res;
$res = "$gSpoolDir/db/$bugnum.log";
return $res if ( -e $res );
my $archdir = sprintf "%02d", $bugnum % 100;
$res = "$gSpoolDir/archive/$archdir/$bugnum.log";
return $res if ( -e $res );
return "";
}
1