4 use Fcntl qw/O_RDONLY/;
5 $config_path = '/etc/debbugs';
6 $lib_path = '/usr/lib/debbugs';
7 require "$lib_path/errorlib";
9 my $common_archive = 0;
10 my $common_repeatmerged = 1;
11 my %common_include = ();
12 my %common_exclude = ();
13 my $common_raw_sort = 0;
14 my $common_bug_reverse = 0;
15 my $common_pending_reverse = 0;
16 my $common_severity_reverse = 0;
18 my @common_pending_include = ();
19 my @common_pending_exclude = ();
20 my @common_severity_include = ();
21 my @common_severity_exclude = ();
27 if ($opt eq "archive") { $common_archive = $val; }
28 if ($opt eq "repeatmerged") { $common_repeatmerged = $val; }
29 if ($opt eq "exclude") {
31 @vals = ( $val ) if (ref($val) eq "" && $val );
32 @vals = ( $$val ) if (ref($val) eq "SCALAR" && $$val );
33 @vals = @{$val} if (ref($val) eq "ARRAY" );
34 %common_exclude = map {
35 if (/^(.*):(.*)$/) { ($1, $2) } else { ($_, 1) }
36 } split /[\s,]+/, join ',', @vals;
38 if ($opt eq "include") {
40 @vals = ( $val, ) if (ref($val) eq "" && $val );
41 @vals = ( $$val, ) if (ref($val) eq "SCALAR" && $$val );
42 @vals = @{$val} if (ref($val) eq "ARRAY" );
43 %common_include = map {
44 if (/^(.*):(.*)$/) { ($1, $2) } else { ($_, 1) }
45 } split /[\s,]+/, join ',', @vals;
47 if ($opt eq "raw") { $common_raw_sort = $val; }
48 if ($opt eq "bug-rev") { $common_bug_reverse = $val; }
49 if ($opt eq "pend-rev") { $common_pending_reverse = $val; }
50 if ($opt eq "sev-rev") { $common_severity_reverse = $val; }
51 if ($opt eq "pend-exc") {
53 @vals = ( $val ) if (ref($val) eq "" && $val );
54 @vals = ( $$val ) if (ref($val) eq "SCALAR" && $$val );
55 @vals = @{$val} if (ref($val) eq "ARRAY" );
56 @common_pending_exclude = @vals if (@vals);
58 if ($opt eq "pend-inc") {
60 @vals = ( $val, ) if (ref($val) eq "" && $val );
61 @vals = ( $$val, ) if (ref($val) eq "SCALAR" && $$val );
62 @vals = @{$val} if (ref($val) eq "ARRAY" );
63 @common_pending_include = @vals if (@vals);
65 if ($opt eq "sev-exc") {
67 @vals = ( $val ) if (ref($val) eq "" && $val );
68 @vals = ( $$val ) if (ref($val) eq "SCALAR" && $$val );
69 @vals = @{$val} if (ref($val) eq "ARRAY" );
70 @common_severity_exclude = @vals if (@vals);
72 if ($opt eq "sev-inc") {
74 @vals = ( $val ) if (ref($val) eq "" && $val );
75 @vals = ( $$val ) if (ref($val) eq "SCALAR" && $$val );
76 @vals = @{$val} if (ref($val) eq "ARRAY" );
77 @common_severity_include = @vals if (@vals);
82 my ($in, $key, $val, %ret);
83 if (defined $ENV{"QUERY_STRING"} && $ENV{"QUERY_STRING"} ne "") {
84 $in=$ENV{QUERY_STRING};
85 } elsif(defined $ENV{"REQUEST_METHOD"}
86 && $ENV{"REQUEST_METHOD"} eq "POST")
88 read(STDIN,$in,$ENV{CONTENT_LENGTH});
92 foreach (split(/[&;]/,$in)) {
94 ($key, $val) = split(/=/,$_,2);
95 $key=~s/%(..)/pack("c",hex($1))/ge;
96 $val=~s/%(..)/pack("c",hex($1))/ge;
97 if ( exists $ret{$key} ) {
98 if ( !exists $ret{"&$key"} ) {
99 $ret{"&$key"} = [ $ret{$key} ];
101 push @{$ret{"&$key"}},$val;
105 $debug = 1 if (defined $ret{"debug"} && $ret{"debug"} eq "aj");
111 print "Content-Type: text/html\n\n";
112 print "<HTML><HEAD><TITLE>Error</TITLE></HEAD><BODY>\n";
113 print "An error occurred. Dammit.\n";
114 print "Error was: $msg.\n";
115 print "</BODY></HTML>\n";
121 # my $Archive = $common_archive ? "archive" : "";
122 # print header . start_html("Sorry");
123 # print "Sorry bug #$msg doesn't seem to be in the $Archive database.\n";
128 # Split a package string from the status file into a list of package names.
131 return unless defined $pkgs;
132 return split /[ \t?,()]+/, $pkgs;
135 # Generate a comma-separated list of HTML links to each package given in
136 # $pkgs. $pkgs may be empty, in which case an empty string is returned, or
137 # it may be a comma-separated list of package names.
138 sub htmlpackagelinks {
140 return unless defined $pkgs and $pkgs ne '';
142 my @pkglist = splitpackages($pkgs);
144 my $openstrong = $strong ? '<strong>' : '';
145 my $closestrong = $strong ? '</strong>' : '';
147 return 'Package' . (@pkglist > 1 ? 's' : '') . ': ' .
150 '<a href="' . pkgurl($_) . '">' .
151 $openstrong . htmlsanit($_) . $closestrong . '</a>'
158 my %status = %{getbugstatus($ref)};
159 return htmlindexentrystatus(%status) if (%status);
163 sub htmlindexentrystatus {
169 if ($status{severity} eq 'normal') {
171 } elsif (grep($status{severity} eq $_, @debbugs::gStrongSeverities)) {
172 $showseverity = "<strong>Severity: $status{severity}</strong>;\n";
174 $showseverity = "Severity: <em>$status{severity}</em>;\n";
177 $result .= htmlpackagelinks($status{"package"}, 1);
178 $result .= $showseverity;
179 $result .= "Reported by: <a href=\"" . submitterurl($status{originator})
180 . "\">" . htmlsanit($status{originator}) . "</a>";
181 $result .= ";\nTags: <strong>"
182 . htmlsanit(join(", ", sort(split(/\s+/, $status{tags}))))
184 if (length($status{tags}));
186 my @merged= split(/ /,$status{mergedwith});
187 my $mseparator= ";\nmerged with ";
188 for my $m (@merged) {
189 $result .= $mseparator."<A href=\"" . bugurl($m) . "\">#$m</A>";
193 if (length($status{done})) {
194 $result .= ";\n<strong>Done:</strong> " . htmlsanit($status{done});
196 if (length($status{forwarded})) {
197 $result .= ";\n<strong>Forwarded</strong> to "
198 . maybelink($status{forwarded});
200 my $daysold = int((time - $status{date}) / 86400); # seconds to days
204 $font = "em" if ($daysold > 30);
205 $font = "strong" if ($daysold > 60);
206 $efont = "</$font>" if ($font);
207 $font = "<$font>" if ($font);
209 my $yearsold = int($daysold / 365);
210 $daysold -= $yearsold * 365;
212 $result .= ";\n $font";
214 push @age, "1 year" if ($yearsold == 1);
215 push @age, "$yearsold years" if ($yearsold > 1);
216 push @age, "1 day" if ($daysold == 1);
217 push @age, "$daysold days" if ($daysold > 1);
218 $result .= join(" and ", @age);
219 $result .= " old$efont";
229 my $ref = shift || "";
230 my $params = "submitter=" . emailfromrfc822($ref);
231 $params .= "&archive=yes" if ($common_archive);
232 $params .= "&repeatmerged=no" unless ($common_repeatmerged);
233 return urlsanit("pkgreport.cgi" . "?" . $params);
237 my $ref = shift || "";
238 my $params = "maint=" . emailfromrfc822($ref);
239 $params .= "&archive=yes" if ($common_archive);
240 $params .= "&repeatmerged=no" unless ($common_repeatmerged);
241 return urlsanit("pkgreport.cgi" . "?" . $params);
246 my $params = "pkg=$ref";
247 $params .= "&archive=yes" if ($common_archive);
248 $params .= "&repeatmerged=no" unless ($common_repeatmerged);
250 return urlsanit("pkgreport.cgi" . "?" . "$params");
255 my $params = "src=$ref";
256 $params .= "&archive=yes" if ($common_archive);
257 $params .= "&repeatmerged=no" unless ($common_repeatmerged);
258 return urlsanit("pkgreport.cgi" . "?" . "$params");
265 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
266 $url =~ s/([<>&"])/\&$saniarray{$1};/g;
271 my %saniarray = ('<','lt', '>','gt', '&','amp', '"','quot');
272 my $in = shift || "";
273 $in =~ s/([<>&"])/\&$saniarray{$1};/g;
279 if ($in =~ /^[a-zA-Z0-9+.-]+:/) { # RFC 1738 scheme
280 return qq{<a href="$in">} . htmlsanit($in) . '</a>';
282 return htmlsanit($in);
288 my $params = "bug=$ref";
289 foreach my $val (@_) {
290 $params .= "\&msg=$1" if ($val =~ /^msg=([0-9]+)/);
291 $params .= "\&archive=yes" if (!$common_archive && $val =~ /^archive.*$/);
293 $params .= "&archive=yes" if ($common_archive);
294 $params .= "&repeatmerged=no" unless ($common_repeatmerged);
296 return urlsanit("bugreport.cgi" . "?" . "$params");
301 my $params = "bug=$ref";
303 foreach my $val (@_) {
304 $params .= "\&$1=$2" if ($val =~ /^(msg|att)=([0-9]+)/);
305 $filename = $1 if ($val =~ /^filename=(.*)$/);
307 $params .= "&archive=yes" if ($common_archive);
309 return urlsanit("bugreport.cgi/$filename?$params");
314 return urlsanit("bugreport.cgi" . "?" . "bug=$ref&mbox=yes");
320 opendir(D, "$debbugs::gSpoolDir/db") or &quitcgi("opendir db: $!");
321 @bugs = sort {$a<=>$b} grep s/\.status$//,
322 (grep m/^[0-9]+\.status$/,
336 my %displayshowpending = ("pending", "outstanding",
337 "pending-fixed", "pending upload",
338 "fixed", "fixed in NMU",
340 "forwarded", "forwarded to upstream software authors");
343 return "<HR><H2>No reports found!</H2></HR>\n";
346 if ( $common_bug_reverse ) {
347 @bugs = sort {$b<=>$a} @bugs;
349 @bugs = sort {$a<=>$b} @bugs;
352 foreach my $bug (@bugs) {
353 my %status = %{getbugstatus($bug)};
355 if (%common_include) {
357 foreach my $t (split /\s+/, $status{tags}) {
358 $okay = 1, last if (defined $common_include{$t});
360 if (defined $common_include{subj}) {
361 if (index($status{subject}, $common_include{subj}) > -1) {
367 if (%common_exclude) {
369 foreach my $t (split /\s+/, $status{tags}) {
370 $okay = 0, last if (defined $common_exclude{$t});
372 if (defined $common_exclude{subj}) {
373 if (index($status{subject}, $common_exclude{subj}) > -1) {
379 next if @common_pending_include and
380 not grep { $_ eq $status{pending} } @common_pending_include;
381 next if @common_severity_include and
382 not grep { $_ eq $status{severity} } @common_severity_include;
383 next if grep { $_ eq $status{pending} } @common_pending_exclude;
384 next if grep { $_ eq $status{severity} } @common_severity_exclude;
386 my @merged = sort {$a<=>$b} ($bug, split(/ /, $status{mergedwith}));
387 next unless ($common_repeatmerged || !$seenmerged{$merged[0]});
388 $seenmerged{$merged[0]} = 1;
390 my $html = sprintf "<li><a href=\"%s\">#%d: %s</a>\n<br>",
391 bugurl($bug), $bug, htmlsanit($status{subject});
392 $html .= htmlindexentrystatus(\%status) . "\n";
393 $section{$status{pending} . "_" . $status{severity}} .= $html;
394 push @rawsort, $html if $common_raw_sort;
399 if ($common_raw_sort) {
400 $result .= "<UL>\n" . join("", @rawsort ) . "</UL>\n";
402 my @pendingList = qw(pending forwarded pending-fixed fixed done);
403 @pendingList = reverse @pendingList if $common_pending_reverse;
404 #print STDERR join(",",@pendingList)."\n";
405 #print STDERR join(",",@common_pending_include).":$#common_pending_include\n";
406 foreach my $pending (@pendingList) {
407 my @severityList = @debbugs::gSeverityList;
408 @severityList = reverse @severityList if $common_severity_reverse;
409 #print STDERR join(",",@severityList)."\n";
411 # foreach my $severity(@debbugs::gSeverityList) {
412 foreach my $severity(@severityList) {
413 $severity = $debbugs::gDefaultSeverity if ($severity eq '');
414 next unless defined $section{${pending} . "_" . ${severity}};
415 $result .= "<HR><H2>$debbugs::gSeverityDisplay{$severity} - $displayshowpending{$pending}</H2>\n";
416 #$result .= "(A list of <a href=\"http://${debbugs::gWebDomain}/db/si/$pending$severity\">all such bugs</a> is available).\n";
417 #$result .= "(A list of all such bugs used to be available).\n";
419 $result .= $section{$pending . "_" . $severity};
420 $result .= "</UL>\n";
421 $anydone = 1 if ($pending eq "done");
426 $result .= $debbugs::gHTMLExpireNote if ($anydone);
432 if ($common_archive) {
433 open I, "<$debbugs::gSpoolDir/index.archive" or &quitcgi("bugindex: $!");
435 open I, "<$debbugs::gSpoolDir/index.db" or &quitcgi("bugindex: $!");
441 if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) {
442 my @x = $bugfunc->(pkg => $1, bug => $2, status => $4,
443 submitter => $5, severity => $6, tags => $7);
445 $count{$_}++ foreach @x;
458 if (!$common_archive && defined $opt &&
459 -e "$debbugs::gSpoolDir/by-$opt.idx")
462 print STDERR "optimized\n" if ($debug);
463 tie %lookup, DB_File => "$debbugs::gSpoolDir/by-$opt.idx", O_RDONLY
464 or die "$0: can't open $debbugs::gSpoolDir/by-$opt.idx ($!)\n";
465 while ($key = shift) {
466 my $bugs = $lookup{$key};
468 push @result, (unpack 'N*', $bugs);
472 print STDERR "done optimized\n" if ($debug);
474 if ( $common_archive ) {
475 open I, "<$debbugs::gSpoolDir/index.archive"
476 or &quitcgi("bugindex: $!");
478 open I, "<$debbugs::gSpoolDir/index.db"
479 or &quitcgi("bugindex: $!");
482 if (m/^(\S+)\s+(\d+)\s+(\d+)\s+(\S+)\s+\[\s*([^]]*)\s*\]\s+(\w+)\s+(.*)$/) {
483 if ($bugfunc->(pkg => $1, bug => $2, status => $4,
484 submitter => $5, severity => $6, tags => $7))
492 @result = sort {$a <=> $b} @result;
496 sub emailfromrfc822 {
498 $email =~ s/\s*\(.*\)\s*//;
499 $email = $1 if ($email =~ m/<(.*)>/);
507 while ($input =~ m/\W/) {
508 $encoded.=$`.sprintf("-%02x_",unpack("C",$&));
513 $encoded =~ s/-2e_/\./g;
514 $encoded =~ s/^([^,]+)-20_-3c_(.*)-40_(.*)-3e_/$1,$2,$3,/;
515 $encoded =~ s/^(.*)-40_(.*)-20_-28_([^,]+)-29_$/,$1,$2,$3/;
516 $encoded =~ s/-20_/_/g;
517 $encoded =~ s/-([^_]+)_-/-$1/g;
523 return $_maintainer if $_maintainer;
526 open(MM,"$gMaintainerFile") or &quitcgi("open $gMaintainerFile: $!");
528 next unless m/^(\S+)\s+(\S.*\S)\s*$/;
534 open(MM,"$gMaintainerFileOverride") or &quitcgi("open $gMaintainerFileOverride: $!");
536 next unless m/^(\S+)\s+(\S.*\S)\s*$/;
542 $_maintainer = \%maintainer;
549 return $_pkgsrc if $_pkgsrc;
553 open(MM,"$gPackageSource") or &quitcgi("open $gPackageSource: $!");
555 next unless m/^(\S+)\s+(\S+)\s+(\S.*\S)\s*$/;
556 ($a,$b,$c)=($1,$2,$3);
559 $pkgcomponent{$a}= $b;
563 $_pkgcomponent = \%pkgcomponent;
567 sub getpkgcomponent {
568 return $_pkgcomponent if $_pkgcomponent;
570 return $_pkgcomponent;
575 return $_pseudodesc if $_pseudodesc;
578 open(PSEUDO, "< $gPseudoDescFile") or &quitcgi("open $gPseudoDescFile: $!");
580 next unless m/^(\S+)\s+(\S.*\S)\s*$/;
581 $pseudodesc{lc $1} = $2;
584 $_pseudodesc = \%pseudodesc;
593 my $location = getbuglocation( $bugnum, "status" );
594 return {} if ( !$location );
595 %status = %{ readbug( $bugnum, $location ) };
597 $status{tags} = $status{keywords};
599 $status{"package"} =~ s/\s*$//;
600 $status{"package"} = 'unknown' if ($status{"package"} eq '');
601 $status{"severity"} = 'normal' if ($status{"severity"} eq '');
603 $status{"pending"} = 'pending';
604 $status{"pending"} = 'forwarded' if (length($status{"forwarded"}));
605 $status{"pending"} = 'pending-fixed' if ($status{"tags"} =~ /\bpending\b/);
606 $status{"pending"} = 'fixed' if ($status{"tags"} =~ /\bfixed\b/);
607 $status{"pending"} = 'done' if (length($status{"done"}));
615 my %pkgsrc = %{getpkgsrc()};
617 foreach ( keys %pkgsrc ) {
618 push @pkgs, $_ if $pkgsrc{$_} eq $src;
626 my $dir = getlocationpath( getbuglocation( $bugnum, "log" ) );
627 my $hash = get_hashname( $bugnum );
628 return "" if ( !$dir );
629 return "$dir/$hash/$bugnum.log";