#!/usr/bin/perl -wT package debbugs; use strict; use POSIX qw(strftime tzset); use MIME::Parser; use MIME::Decoder; use IO::Scalar; #require '/usr/lib/debbugs/errorlib'; require './common.pl'; require '/etc/debbugs/config'; require '/etc/debbugs/text'; use vars(qw($gHTMLTail $gSpoolDir)); my %param = readparse(); my $tail_html; my %maintainer = %{getmaintainers()}; my %pkgsrc = %{getpkgsrc()}; my $ref = $param{'bug'} || quit("No bug number"); $ref =~ /(\d+)/ or quit("Invalid bug number"); $ref = $1; my $msg = $param{'msg'} || ""; my $att = $param{'att'}; my $boring = ($param{'boring'} || 'no') eq 'yes'; my $reverse = ($param{'reverse'} || 'no') eq 'yes'; my $mbox = ($param{'mbox'} || 'no') eq 'yes'; my %status = %{getbugstatus($ref)} or &quit("Couldn't get bug status: $!"); my $indexentry; my $descriptivehead; my $showseverity; my $tpack; my $tmain; $ENV{"TZ"} = 'UTC'; tzset(); my $dtime = strftime "%a, %e %b %Y %T UTC", localtime; $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 = "Severity: $status{severity};\n"; } else { $showseverity = "Severity: $status{severity};\n"; } $indexentry .= "
$showseverity";
$indexentry .= "Package: "
.htmlsanit($status{package}).";\n";
$indexentry .= "Reported by: " . htmlsanit($status{originator}) . ";\n";
my $dummy = strftime "%a, %e %b %Y %T UTC", localtime($status{date});
$indexentry .= "Date: ".$dummy.";\n
";
my @descstates;
push @descstates, "Tags: "
. htmlsanit(join(", ", sort(split(/\s+/, $status{tags}))))
. ""
if length($status{tags});
my @merged= split(/ /,$status{mergedwith});
if (@merged) {
my $descmerged = 'merged with ';
my $mseparator = '';
for my $m (@merged) {
$descmerged .= $mseparator."#$m";
$mseparator= ",\n";
}
push @descstates, $descmerged;
}
if (length($status{done})) {
push @descstates, "Done: ".htmlsanit($status{done});
} elsif (length($status{forwarded})) {
push @descstates, "Forwarded to ".htmlsanit($status{forwarded});
}
$indexentry .= join(";\n", @descstates) . ";\n
" if @descstates;
my ($short, $tmaint, $tsrc);
$short = $ref; $short =~ s/^\d+/#$&/;
$tmaint = defined($maintainer{$tpack}) ? $maintainer{$tpack} : '(unknown)';
$tsrc = defined($pkgsrc{$tpack}) ? $pkgsrc{$tpack} : '(unknown)';
$descriptivehead= $indexentry."Maintainer for $status{package} is\n".
''.htmlsanit($tmaint).'';
$descriptivehead.= ";\nSource for $status{package} is\n".
'$tsrc" if ($tsrc ne "(unknown)");
$descriptivehead.= ".
Bug is archived. No further changes may be made.
"; } my $log=''; my $xmessage = 1; my $suppressnext = 0; my $thisheader = ''; my $this = ''; my $cmsg = 1; my $normstate= 'kill-init'; my $linenum = 0; my $mail = ''; my @mails = (); while(my $line =\n"; } if ($newstate eq 'html') { $this = ''; } if ($newstate eq 'kill-end') { my $show = 1; $show = $boring if ($suppressnext && $normstate ne 'html'); $show = ($xmessage == $msg) if ($msg); push @mails, $mail if ( $mbox && $mail ); if ($show) { my $downloadHtml = ''; if ($mail) { my $parser = new MIME::Parser; $parser->tmp_to_core(1); $parser->output_to_core(1); # $parser->output_under("/tmp"); my $entity = $parser->parse_data($mail); # TODO: make local subdir, clean it outselves # the following does NOT delete the msg dirs in /tmp END { $entity->purge; $parser->filer->purge; } my @attachments = (); if ( $entity->is_multipart ) { my @parts = $entity->parts_DFS; # $this .= htmlsanit($entity->head->stringify); my @keep = (); foreach ( @parts ) { my $head = $_->head; # $head->mime_attr("content-transfer-encoding" => "8bit") # if !$head->mime_attr("content-transfer-encoding"); my ($disposition,$type) = ( $head->mime_attr("content-disposition"), lc $head->mime_attr("content-type") ); #print STDERR "'$type' '$disposition'\n"; if ($disposition && ( $disposition eq "attachment" || $disposition eq "inline" ) && $_->head->recommended_filename ) { push @attachments, $_; my $file = $_->head->recommended_filename; $downloadHtml .= "View Attachment: $file\n"; if ($msg && defined($att) && $att eq $#attachments) { my $head = $_->head; my $type; chomp($type = $head->mime_attr("content-type")); my $body = $_->stringify_body; print "Content-Type: $type; name=$file\n\n"; my $decoder = new MIME::Decoder($head->mime_encoding); $decoder->decode(new IO::Scalar(\$body), \*STDOUT); exit(0); } if ($type eq 'text/plain') { # push @keep, $_; } # $this .= htmlsanit($_->head->stringify); } else { # $this .= htmlsanit($_->head->stringify); # push @keep, $_; } # $this .= "\n" . htmlsanit($_->stringify_body); } # $entity->parts(\@keep) if (!$msg); } $this .= htmlsanit($entity->stringify); } $this = "$downloadHtml\n$this$downloadHtml" if $downloadHtml; $downloadHtml = ''; $this = "\n$this\n" if $normstate eq 'go' || $normstate eq 'go-nox'; $this = "$thisheader$this" if $thisheader && !( $normstate eq 'html' );; $thisheader = ''; if ($normstate eq 'html') { $this .= " Full text available."; } if ($reverse) { $log = "$this\n
$log"; } else { $log .= "$this\n
\n"; } } $xmessage++ if ($normstate ne 'html'); $suppressnext = $normstate eq 'html'; } $normstate = $newstate; $mail = ''; 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"); $thisheader = "Message received at ".htmlsanit("$1\@$2") . ":
\n"; $this = ''; $normstate= 'go'; $mail .= $_; } elsif ($normstate eq 'html') { $this .= $_; } elsif ($normstate eq 'go') { s/^\030//; if ($mail) { $mail .= $_; } else { $this .= htmlsanit($_); } } elsif ($normstate eq 'go-nox') { next if !s/^X//; if ($mail) { $mail .= $_; } else { $this .= htmlsanit($_); } } elsif ($normstate eq 'recips') { if (m/^-t$/) { $this = "Message sent:
\n"; } else { s/\04/, /g; s/\n$//; $this = "Message sent to ".htmlsanit($_).":
\n"; } $normstate= 'kill-body'; } elsif ($normstate eq 'autocheck') { next if !m/^X-Debian-Bugs(-\w+)?: This is an autoforward from (\S+)/; $normstate= 'autowait'; $thisheader = "Message received at $2:
\n"; $this = ''; $mail .= $_; } elsif ($normstate eq 'autowait') { next if !m/^$/; $normstate= 'go-nox'; } else { &quit("$ref state $normstate line \`$_'"); } } &quit("$ref state $normstate at end") unless $normstate eq 'kill-end'; close(L); if ( $mbox ) { print "Content-Type: text/plain\n\n"; foreach ( @mails ) { my @lines = split( "\n", $_, -1 ); if ( $lines[ 1 ] =~ m/^From / ) { my $tmp = $lines[ 0 ]; $lines[ 0 ] = $lines[ 1 ]; $lines[ 1 ] = $tmp; } if ( !( $lines[ 0 ] =~ m/^From / ) ) { $ENV{ PATH } = "/bin:/usr/bin:/usr/local/bin"; my $date = `date "+%a %b %d %T %Y"`; chomp $date; unshift @lines, "From unknown $date"; } map { s/^(>*From )/>$1/ } @lines[ 1 .. $#lines ]; $_ = join( "\n", @lines ) . "\n"; } print join("", @mails ); exit 0; } print "Content-Type: text/html\n\n"; print "\n"; print "\n" . "$debbugs::gProject $debbugs::gBug report logs - $short \n" . "\n" . '' . "\n"; print "" . "$debbugs::gProject $debbugs::gBug report logs - $short" . "
\n"; print "$descriptivehead\n"; printf "
" . htmlsanit($status{subject}) . "View this report as an mbox folder.
", mboxurl($ref); print "
"; print "$log"; print $tail_html; print "\n"; exit 0;