#!/usr/bin/perl -wT use warnings; use strict; use POSIX qw(strftime tzset); use MIME::Parser; use MIME::Decoder; use IO::Scalar; use IO::File; use Debbugs::Config qw(:globals :text); # for read_log_records use Debbugs::Log qw(read_log_records); use Debbugs::MIME qw(convert_to_utf8 decode_rfc1522 create_mime_message); use Debbugs::CGI qw(:url :html :util); use Debbugs::Common qw(buglog getmaintainers); use Debbugs::Packages qw(getpkgsrc); use Debbugs::Status qw(splitpackages get_bug_status isstrongseverity); use Scalar::Util qw(looks_like_number); use CGI::Simple; my $q = new CGI::Simple; my %param = cgi_parameters(query => $q, single => [qw(bug msg att boring terse), qw(reverse mbox mime trim), qw(mboxstat mboxmaint archive), qw(repeatmerged) ], default => {msg => '', boring => 'no', terse => 'no', reverse => 'no', mbox => 'no', mime => 'no', mboxstat => 'no', mboxmaint => 'no', archive => 'no', repeatmerged => 'yes', }, ); # This is craptacular. my $tail_html; my $ref = $param{bug} or 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'} eq 'yes'; my $terse = $param{'terse'} eq 'yes'; my $reverse = $param{'reverse'} eq 'yes'; my $mbox = $param{'mbox'} eq 'yes'; my $mime = $param{'mime'} eq 'yes'; my $trim_headers = ($param{trim} || ($msg?'no':'yes')) eq 'yes'; my $mbox_status_message = $param{mboxstat} eq 'yes'; my $mbox_maint = $param{mboxmaint} eq 'yes'; $mbox = 1 if $mbox_status_message or $mbox_maint; # Not used by this script directly, but fetch these so that pkgurl() and # friends can propagate them correctly. my $archive = $param{'archive'} eq 'yes'; my $repeatmerged = $param{'repeatmerged'} eq 'yes'; 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($_: ) . html_escape(decode_rfc1522($head_field)); } $$this .= join(qq(), @headers) unless $terse; } else { $$this .= html_escape(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 == $#$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 = html_escape($body); # Attempt to deal with format=flowed if ($content_type =~ m/format\s*=\s*\"?flowed\"?/i) { $body =~ s{^\ }{}mgo; # we ignore the other things that you can do with # flowed e-mails cause they don't really matter. } # 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; my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime; $tail_html = $gHTMLTail; $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/; my %status = %{get_bug_status(bug=>$ref)}; unless (%status) { print <
There is no record of $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"; } if (@{$status{found_versions}} or @{$status{fixed_versions}}) { $indexentry.= q(}; } $indexentry .= "\n); $output .= 'View this message in rfc822 format
'; $output .= handle_email_message($record->{text}, ref => $bug_number, msg_number => $msg_number, ); } elsif (/autocheck/) { # Do nothing } elsif (/incoming-recv/) { my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im; if (defined $msg_id and exists $$seen_msg_ids{$msg_id}) { return (); } elsif (defined $msg_id) { $$seen_msg_ids{$msg_id} = 1; } # Incomming Mail Message my ($received,$hostname) = $record->{text} =~ m/Received: \(at (\S+)\) by (\S+)\;/; $output .= qq|Message received at |. html_escape("$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 ) { my $date = strftime "%a %b %d %T %Y", localtime; 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"; } if ($mbox_status_message and @records > 1) { my $status_message=''; my @status_fields = (retitle => 'subject', package => 'package', submitter => 'originator', severity => 'severity', tag => 'tags', owner => 'owner', blocks => 'blocks', forward => 'forward', ); my ($key,$value); while (($key,$value) = splice(@status_fields,0,2)) { if (defined $status{$value} and length $status{$value}) { $status_message .= qq($key $ref $status{$value}\n); } } print STDOUT qq(From unknown $date\n), create_mime_message([From => "$gBug#$ref <$ref\@$gEmailDomain>", To => "$gBug#$ref <$ref\@$gEmailDomain>", Subject => "Status: $status{subject}", "Reply-To" => "$gBug#$ref <$ref\@$gEmailDomain>", ], <Reply ), qq(or subscribe ), qq(to this bug.
\n); print qq(); printf qq(View this report as an mbox folder, ). qq(status mbox, maintainer mbox
Send a report that this bug log contains spam.
\n