--- /dev/null
+#!/usr/bin/perl -w
+
+package debbugs;
+
+use strict;
+use CGI qw/:standard/;
+
+require '/usr/lib/debbugs/errorlib';
+require '/debian/home/ajt/ajbug/common.pl';
+
+require '/etc/debbugs/config';
+require '/etc/debbugs/text';
+
+my $dtime;
+my $tail_html;
+
+my %maintainer = getmaintainers();
+
+my $ref= param('bug') || die("No bug number");
+my %status = getbugstatus($ref);
+
+my $msg = param('msg') || "";
+my $boring = (param('boring') || 'no') eq 'yes';
+my $reverse = (param('reverse') || 'no') eq 'yes';
+
+my $indexentry;
+my $descriptivehead;
+my $submitted;
+my $showseverity;
+
+my $tpack;
+my $tmain;
+
+$dtime=`date -u '+%H:%M:%S GMT %a %d %h'`;
+chomp($dtime);
+
+$tail_html = $debbugs::gHTMLTail;
+$tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
+
+$|=1;
+
+$tpack = lc $status{package};
+$tpack =~ s/[^-+._a-z0-9()].*$//;
+
+if ($status{severity} eq 'normal') {
+ $showseverity = '';
+#} elsif (grep($status{severity} eq $_, @strongseverities)) {
+# $showseverity = "<strong>Severity: $status{severity}</strong>;\n";
+} else {
+ $showseverity = "Severity: <em>$status{severity}</em>;\n";
+}
+
+$indexentry .= $showseverity;
+$indexentry .= "Reported by: ".&sani($status{originator});
+$indexentry .= ";\nKeywords: ".&sani($status{keywords})
+ if length($status{keywords});
+
+my @merged= split(/ /,$status{mergedwith});
+if (@merged) {
+ my $mseparator= ";\nmerged with ";
+ for my $m (@merged) {
+ $indexentry .= $mseparator."<A href=\"" . bugurl($m) . "\">#$m</A>";
+ $mseparator= ",\n";
+ }
+}
+
+$submitted = `TZ=GMT LANG=C \\
+ date -d '1 Jan 1970 00:00:00 + $status{date} seconds' \\
+ '+ %a, %d %b %Y %T %Z'`;
+
+if (length($status{done})) {
+ $indexentry .= ";\n<strong>Done:</strong> ".&sani($status{done});
+} elsif (length($status{forwarded})) {
+ $indexentry .= ";\n<strong>Forwarded</strong> to ".&sani($status{forwarded});
+}
+
+my ($short, $tmaint);
+$short = $ref; $short =~ s/^\d+/#$&/;
+$tmaint = defined($maintainer{$tpack}) ? $maintainer{$tpack} : '(unknown)';
+$descriptivehead= $indexentry.$submitted.";\nMaintainer for $status{package} is\n".
+ '<A href="../ma/l'.&maintencoded($tmaint).'.html">'.&sani($tmaint).'</A>.';
+
+my $buglog = buglog($ref);
+open L, "<$buglog" || &quit("open log for $ref: $!");
+
+my $log='';
+
+my $xmessage = 1;
+my $suppressnext = 0;
+
+my $this = '';
+
+my $cmsg = 1;
+
+my $normstate= 'kill-init';
+my $linenum = 0;
+while(my $line = <L>) {
+ $linenum++;
+ if ($line =~ m/^.$/ and 1 <= ord($line) && ord($line) <= 7) {
+ # state transitions
+ my $newstate;
+ my $statenum = ord($line);
+
+ $newstate = 'autocheck' if ($statenum == 1);
+ $newstate = 'recips' if ($statenum == 2);
+ $newstate = 'kill-end' if ($statenum == 3);
+ $newstate = 'go' if ($statenum == 5);
+ $newstate = 'html' if ($statenum == 6);
+ $newstate = 'incoming-recv' if ($statenum == 7);
+
+ # disallowed transitions:
+ $_ = "$normstate $newstate";
+ unless (m/^(go|go-nox|html) kill-end$/
+ || m/^(kill-init|kill-end) (incoming-recv|autocheck|recips|html)$/
+ || m/^kill-body go$/)
+ {
+ &quit("$ref: Transition from $normstate to $newstate at $linenum disallowed");
+ }
+
+ if ($newstate eq 'go') {
+ $this .= "<pre>\n";
+ }
+
+ if ($newstate eq 'html') {
+ $this = '';
+ }
+
+ if ($newstate eq 'kill-end') {
+
+ $this .= "</pre>\n"
+ if $normstate eq 'go' || $normstate eq 'go-nox';
+
+ if ($normstate eq 'html') {
+ $this .= " <em><A href=\"" . bugurl($ref,"msg=$xmessage") . "\">Full text</A> available.</em>";
+ }
+
+ my $show = 1;
+ $show = $boring
+ if ($suppressnext && $normstate ne 'html');
+
+ $show = ($xmessage == $msg) if ($msg);
+
+ if ($show) {
+ if ($reverse) {
+ $log = "$this\n<hr>$log";
+ } else {
+ $log .= "$this\n<hr>\n";
+ }
+ }
+
+ $xmessage++ if ($normstate ne 'html');
+
+ $suppressnext = $normstate eq 'html';
+ }
+
+ $normstate = $newstate;
+ next;
+ }
+
+ $_ = $line;
+ if ($normstate eq 'incoming-recv') {
+ my $pl= $_;
+ $pl =~ s/\n+$//;
+ m/^Received: \(at (\S+)\) by (\S+)\;/
+ || &quit("bad line \`$pl' in state incoming-recv");
+ $this = "<h2>Message received at ".&sani("$1\@$2")
+ . ":</h2><br>\n<pre>\n$_";
+ $normstate= 'go';
+ } elsif ($normstate eq 'html') {
+ $this .= $_;
+ } elsif ($normstate eq 'go') {
+ $this .= &sani($_);
+ } elsif ($normstate eq 'go-nox') {
+ next if !s/^X//;
+ $this .= &sani($_);
+ } elsif ($normstate eq 'recips') {
+ if (m/^-t$/) {
+ $this = "<h2>Message sent:</h2><br>\n";
+ } else {
+ s/\04/, /g; s/\n$//;
+ $this = "<h2>Message sent to ".&sani($_).":</h2><br>\n";
+ }
+ $normstate= 'kill-body';
+ } elsif ($normstate eq 'autocheck') {
+ next if !m/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/;
+ $normstate= 'autowait';
+ $this = "<h2>Message received at $2:</h2><br>\n";
+ } elsif ($normstate eq 'autowait') {
+ next if !m/^$/;
+ $normstate= 'go-nox';
+ $this .= "<pre>\n";
+ } else {
+ &quit("$ref state $normstate line \`$_'");
+ }
+}
+&quit("$ref state $normstate at end") unless $normstate eq 'kill-end';
+close(L);
+
+print header;
+print start_html("$debbugs::gProject $debbugs::gBug report logs - $short");
+
+print h1("$debbugs::gProject $debbugs::gBug report logs - $short<br>\n"
+ . sani($status{subject}));
+
+print "$descriptivehead\n";
+print hr;
+print "$log";
+print $tail_html;
+
+print end_html;
+
+sub maintencoded {
+ return "";
+}
+
+exit 0;
--- /dev/null
+#!/usr/bin/perl -w
+
+sub quit {
+ my $msg = shift;
+ print header . start_html("Error");
+ print "An error occurred. Dammit.\n";
+ print "Error was: $msg.\n";
+ print end_html;
+ exit 0;
+}
+
+sub htmlindexentry {
+ my $ref = shift;
+
+ my %status = getbugstatus($ref);
+ my $result = "";
+
+ if ($status{severity} eq 'normal') {
+ $showseverity = '';
+ } elsif (grep($status{severity} eq $_, @debbugs::gStrongSeverities)) {
+ $showseverity = "<strong>Severity: $status{severity}</strong>;\n";
+ } else {
+ $showseverity = "Severity: <em>$status{severity}</em>;\n";
+ }
+
+ $result .= "Package: <a href=\"" . pkgurl($status{package}) . "\"><strong>"
+ . htmlsanit($status{package}) . "</strong></a>;\n"
+ if (length($status{package}));
+ $result .= $showseverity;
+ $result .= "Reported by: " . htmlsanit($status{originator});
+ $result .= ";\nKeywords: " . htmlsanit($status{keywords})
+ if (length($status{keywords}));
+
+ my @merged= split(/ /,$status{mergedwith});
+ if (@merged) {
+ my $mseparator= ";\nmerged with ";
+ for my $m (@merged) {
+ $result .= $mseparator."<A href=\"" . bugurl($m) . "\">#$m</A>";
+ $mseparator= ", ";
+ }
+ }
+
+ if (length($status{done})) {
+ $result .= ";\n<strong>Done:</strong> " . htmlsanit($status{done});
+ } elsif (length($status{forwarded})) {
+ $result .= ";\n<strong>Forwarded</strong> 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 = "</$font>" 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 pkgurl {
+ my $ref = shift;
+ my $params = "pkg=$ref";
+ foreach my $val (@_) { 1 }
+
+ return $debbugs::gCGIDomain . "pkgreport.cgi" . "?" . "$params";
+}
+
+%saniarray= ('<','lt', '>','gt', '&','amp', '"','quot');
+
+sub htmlsanit {
+ 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]+)$/);
+ }
+
+ 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) || &quit("opendir db: $!");
+ @bugs = sort { $a <=> $b }
+ grep s/\.status$//,
+ (grep m/^[0-9]+\.status$/,
+ (readdir(D)));
+ closedir(D);
+
+ return @bugs;
+}
+
+sub pkgbugs {
+ my $pkg = shift;
+ my @bugs = ();
+ open I, "<$gAJIndex" || &quit("bugindex: $!");
+ while(<I>) {
+ push @bugs, $1 if (/^([0-9]+) $pkg$/);
+ }
+ @bugs = sort { $a <=> $b } @bugs;
+ return @bugs;
+}
+
+sub getmaintainers {
+ my %maintainer;
+
+ open(MM,"$gMaintainerFile") || &quit("open $gMaintainerFile: $!");
+ while(<MM>) {
+ m/^(\S+)\s+(\S.*\S)\s*$/ || &quit("$gMaintainerFile: \`$_'");
+ ($a,$b)=($1,$2);
+ $a =~ y/A-Z/a-z/;
+ $maintainer{$a}= $b;
+ }
+ close(MM);
+
+ return %maintainer;
+}
+
+sub getbugstatus {
+ my $bugnum = shift;
+
+ my %status;
+
+ open(S,"$gSpoolDir/db/$bugnum.status") || &quit("open $bugnum.status: $!");
+ my @lines = qw(originator date subject msgid package keywords done
+ forwarded mergedwith severity);
+ while(<S>) {
+ 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;
+ return "$gSpoolDir/db/$bugnum.log";
+}
+
+1
projects / debbugs.git / commitdiff