#!/usr/bin/perl -wT package debbugs; use strict; use POSIX qw(strftime tzset); use MIME::Parser; use MIME::Decoder; use IO::Scalar; use IO::File; #require '/usr/lib/debbugs/errorlib'; require './common.pl'; require '/etc/debbugs/config'; require '/etc/debbugs/text'; use vars(qw($gEmailDomain $gHTMLTail $gSpoolDir $gWebDomain)); # for read_log_records use Debbugs::Log; use Debbugs::MIME qw(convert_to_utf8 decode_rfc1522); use Scalar::Util qw(looks_like_number); my %param = readparse(); my $tail_html; my $ref = $param{'bug'} || quitcgi("No bug number"); $ref =~ /(\d+)/ or quitcgi("Invalid bug number"); $ref = $1; my $short = "#$ref"; my $msg = $param{'msg'} || ""; my $att = $param{'att'}; my $boring = ($param{'boring'} || 'no') eq 'yes'; my $terse = ($param{'terse'} || 'no') eq 'yes'; my $reverse = ($param{'reverse'} || 'no') eq 'yes'; my $mbox = ($param{'mbox'} || 'no') eq 'yes'; my $mime = ($param{'mime'} || 'yes') eq 'yes'; my $trim_headers = ($param{trim} || ($msg?'no':'yes')) eq 'yes'; # Not used by this script directly, but fetch these so that pkgurl() and # friends can propagate them correctly. my $archive = ($param{'archive'} || 'no') eq 'yes'; my $repeatmerged = ($param{'repeatmerged'} || 'yes') eq 'yes'; set_option('archive', $archive); set_option('repeatmerged', $repeatmerged); my $buglog = buglog($ref); if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD' and not defined($att) and not $mbox) { print "Content-Type: text/html; charset=utf-8\n"; my @stat = stat $buglog; if (@stat) { my $mtime = strftime '%a, %d %b %Y %T GMT', gmtime($stat[9]); print "Last-Modified: $mtime\n"; } print "\n"; exit 0; } sub display_entity ($$$$\$\@); sub display_entity ($$$$\$\@) { my $entity = shift; my $ref = shift; my $top = shift; my $xmessage = shift; my $this = shift; my $attachments = shift; my $head = $entity->head; my $disposition = $head->mime_attr('content-disposition'); $disposition = 'inline' if not defined $disposition or $disposition eq ''; my $type = $entity->effective_type; my $filename = $entity->head->recommended_filename; $filename = '' unless defined $filename; $filename = decode_rfc1522($filename); if ($top and not $terse) { my $header = $entity->head; $$this .= "
\n"; if ($trim_headers) { my @headers; foreach (qw(From To Cc Subject Date)) { my $head_field = $head->get($_); next unless defined $head_field and $head_field ne ''; push @headers, qq($_: ) . htmlsanit(decode_rfc1522($head_field)); } $$this .= join(qq(), @headers) unless $terse; } else { $$this .= htmlsanit(decode_rfc1522($entity->head->stringify)); } $$this .= "\n"; } unless (($top and $type =~ m[^text(?:/plain)?(?:;|$)]) or ($type =~ m[^multipart/])) { push @$attachments, $entity; my @dlargs = ($ref, "msg=$xmessage", "att=$#$attachments"); push @dlargs, "filename=$filename" if $filename ne ''; my $printname = $filename; $printname = 'Message part ' . ($#$attachments + 1) if $filename eq ''; $$this .= '
[$printname } . "($type, $disposition)]\n"; if ($msg and defined($att) and $att eq $#$attachments) { my $head = $entity->head; chomp(my $type = $entity->effective_type); my $body = $entity->stringify_body; print "Content-Type: $type"; my ($charset) = $head->get('Content-Type:') =~ m/charset\s*=\s*\"?([\w-]+)\"?/i; print qq(; charset="$charset") if defined $charset; print "\n"; if ($filename ne '') { my $qf = $filename; $qf =~ s/"/\\"/g; $qf =~ s[.*/][]; print qq{Content-Disposition: inline; filename="$qf"\n}; } print "\n"; my $decoder = new MIME::Decoder($head->mime_encoding); $decoder->decode(new IO::Scalar(\$body), \*STDOUT); exit(0); } } return if not $top and $disposition eq 'attachment' and not defined($att); return unless ($type =~ m[^text/?] and $type !~ m[^text/(?:html|enriched)(?:;|$)]) or $type =~ m[^application/pgp(?:;|$)] or $entity->parts; if ($entity->is_multipart) { my @parts = $entity->parts; foreach my $part (@parts) { display_entity($part, $ref, 0, $xmessage, $$this, @$attachments); $$this .= "\n"; } } elsif ($entity->parts) { # We must be dealing with a nested message. $$this .= "
\n"; my @parts = $entity->parts; foreach my $part (@parts) { display_entity($part, $ref, 1, $xmessage, $$this, @$attachments); $$this .= "\n"; } $$this .= "\n"; } else { if (not $terse) { my $content_type = $entity->head->get('Content-Type:') || "text/html"; my ($charset) = $content_type =~ m/charset\s*=\s*\"?([\w-]+)\"?/i; my $body = $entity->bodyhandle->as_string; $body = convert_to_utf8($body,$charset) if defined $charset; $body = htmlsanit($body); # Add links to URLs $body =~ s,((ftp|http|https)://[\S~-]+?/?)((\>\;)?[)]?[']?[:.\,]?(\s|$)),$1$3,go; # Add links to bug closures $body =~ s[(closes:\s*(?:bug)?\#?\s?\d+(?:,?\s*(?:bug)?\#?\s?\d+)*) ][my $temp = $1; $temp =~ s{(\d+)}{qq($1)}ge; $temp;]gxie; $$this .= qq( \n); } } } my %maintainer = %{getmaintainers()}; my %pkgsrc = %{getpkgsrc()}; my $indexentry; 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/; my %status = %{getbugstatus($ref)}; unless (%status) { print <
There is no record of $debbugs::gBug $short. Try the search page instead.
$tail_html EOF exit 0; } $|=1; $tpack = lc $status{'package'}; my @tpacks = splitpackages($tpack); if ($status{severity} eq 'normal') { $showseverity = ''; } elsif (isstrongseverity($status{severity})) { $showseverity = "Severity: $status{severity};\n"; } else { $showseverity = "Severity: $status{severity};\n"; } $indexentry .= "Message received at |. htmlsanit("$received\@$hostname") . q| (full text'.q|, mbox)'.":
\n"; $output .= handle_email_message($record->{text}, ref => $bug_number, msg_number => $msg_number, ); } else { die "Unknown record type $_"; } return $output; } my $log=''; my $msg_num = 0; my $skip_next = 0; if (looks_like_number($msg) and ($msg-1) <= $#records) { @records = ($records[$msg-1]); $msg_num = $msg - 1; } my @log; if ( $mbox ) { if (@records > 1) { print qq(Content-Disposition: attachment; filename="bug_${ref}.mbox"\n); print "Content-Type: text/plain\n\n"; } else { $msg_num++; print qq(Content-Disposition: attachment; filename="bug_${ref}_message_${msg_num}.mbox"\n); print "Content-Type: message/rfc822\n\n"; } for my $record (@records) { next if $record->{type} !~ /^(?:recips|incoming-recv)$/; next if not $boring and $record->{type} eq 'recips' and @records > 1; my @lines = split( "\n", $record->{text}, -1 ); if ( $lines[ 1 ] =~ m/^From / ) { my $tmp = $lines[ 0 ]; $lines[ 0 ] = $lines[ 1 ]; $lines[ 1 ] = $tmp; } if ( !( $lines[ 0 ] =~ m/^From / ) ) { my $date = strftime "%a %b %d %T %Y", localtime; unshift @lines, "From unknown $date"; } map { s/^(>*From )/>$1/ } @lines[ 1 .. $#lines ]; print join( "\n", @lines ) . "\n"; } exit 0; } else { my %seen_msg_ids; for my $record (@records) { $msg_num++; if ($skip_next) { $skip_next = 0; next; } $skip_next = 1 if $record->{type} eq 'html' and not $boring; push @log, handle_record($record,$ref,$msg_num,\%seen_msg_ids); } } @log = reverse @log if $reverse; $log = join('Reply ), qq(or subscribe ), qq(to this bug.
\n); printf "View this report as an mbox folder.
Send a report that this bug log contains spam.
\n