From c4948908851c2e62e2c6aa6f7da50ac18a07cabc Mon Sep 17 00:00:00 2001 From: don <> Date: Mon, 25 Jul 2005 22:30:22 -0800 Subject: [PATCH] [project @ 2005-07-25 23:30:22 by don] * Change bugreport.cgi to use Debbugs::Log and greately simplify the process of outputing the bug log. * All RFC1522 subject lines are decoded, both in the html information and the message headers. All messages are converted to UTF-8 whereever possible; all bugreport.cgi pages are now completely in UTF-8 to the degree possible. (closes: #46848, #238984) * Add a convert_to_utf8 function to Debbugs::Mime to make the above possible; abstracts functionality that was already present in the decode_rfc1522 fucntionality. * Individual messages can now be downloaded from each bug report (closes: #95373) * Uninteresting headers are now hidden by default, can be renabled with &trim=no (closes: #188561) --- Debbugs/MIME.pm | 24 ++-- cgi/bugreport.cgi | 357 +++++++++++++++++++++------------------------- debian/changelog | 13 ++ 3 files changed, 191 insertions(+), 203 deletions(-) diff --git a/Debbugs/MIME.pm b/Debbugs/MIME.pm index d65a69b..4519776 100644 --- a/Debbugs/MIME.pm +++ b/Debbugs/MIME.pm @@ -8,7 +8,7 @@ use vars qw($VERSION @EXPORT_OK); BEGIN { $VERSION = 1.00; - @EXPORT_OK = qw(parse decode_rfc1522 encode_rfc1522); + @EXPORT_OK = qw(parse decode_rfc1522 encode_rfc1522 convert_to_utf8); } use File::Path; @@ -105,6 +105,17 @@ sub parse ($) # Bug #61342 et al. +sub convert_to_utf8 { + my ($data, $charset) = @_; + $charset =~ s/^(UTF)\-(\d+)/$1$2/i; + return $data unless utf8_supported_charset($charset); + return to_utf8({ + -string => $data, + -charset => $charset, + }); +} + + =head2 decode_rfc1522 decode_rfc1522('=?iso-8859-1?Q?D=F6n_Armstr=F3ng?= ') @@ -117,15 +128,8 @@ BEGIN { # Set up the default RFC1522 decoder, which turns all charsets that # are supported into the appropriate UTF-8 charset. MIME::WordDecoder->default(new MIME::WordDecoder( - ['*' => sub { - my ($data, $charset) = @_; - $charset =~ s/^(UTF)\-(\d+)/$1$2/i; - return $data unless utf8_supported_charset($charset); - return to_utf8({ - -string => $data, - -charset => $charset, - }); - }])); + ['*' => \&convert_to_utf8, + ])); } sub decode_rfc1522 ($) diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi index 2514b6d..9ca45e0 100755 --- a/cgi/bugreport.cgi +++ b/cgi/bugreport.cgi @@ -8,6 +8,7 @@ use MIME::Parser; use MIME::Decoder; use IO::Scalar; use IO::Lines; +use IO::File; #require '/usr/lib/debbugs/errorlib'; require './common.pl'; @@ -17,6 +18,12 @@ 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; @@ -33,6 +40,8 @@ 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'; @@ -71,9 +80,21 @@ sub display_entity ($$$$\$\@) { $filename = decode_rfc1522($filename); if ($top) { - $$this .= htmlsanit(decode_rfc1522($entity->stringify_header)) - unless ($terse); - $$this .= "\n"; + my $header = $entity->head; + if ($trim_headers and not $terse) { + my @headers; + foreach (qw(From To 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; + $$this .= qq(\n); + } + elsif (not $terse) { + $$this .= htmlsanit(decode_rfc1522($entity->head->stringify)); + $$this .= qq(\n); + } } unless (($top and $type =~ m[^text(?:/plain)?(?:;|$)]) or @@ -128,7 +149,13 @@ sub display_entity ($$$$\$\@) { } $$this .= "\n"; } else { - $$this .= htmlsanit($entity->bodyhandle->as_string) unless ($terse); + if (not $terse) { + my $content_type = $entity->head->get('Content-Type:'); + 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; + $$this .= htmlsanit($body); + } } } @@ -221,11 +248,11 @@ if (@{$status{fixed_versions}}) { $fixedtext .= (@{$status{fixed_versions}} == 1) ? 'version ' : 'versions '; $fixedtext .= join ', ', map htmlsanit($_), @{$status{fixed_versions}}; if (length($status{done})) { - $fixedtext .= ' by ' . htmlsanit($status{done}); + $fixedtext .= ' by ' . htmlsanit(decode_rfc1522($status{done})); } push @descstates, $fixedtext; } elsif (length($status{done})) { - push @descstates, "Done: ".htmlsanit($status{done}); + push @descstates, "Done: ".htmlsanit(decode_rfc1522($status{done})); } elsif (length($status{forwarded})) { push @descstates, "Forwarded to ".maybelink($status{forwarded}); } @@ -246,210 +273,153 @@ foreach my $pkg (@tpacks) { $descriptivehead .= ".\n
"; } +my $buglogfh; if ($buglog =~ m/\.gz$/) { my $oldpath = $ENV{'PATH'}; $ENV{'PATH'} = '/bin:/usr/bin'; - open L, "zcat $buglog |" or &quitcgi("open log for $ref: $!"); + $buglogfh = new IO::File "zcat $buglog |" or &quitcgi("open log for $ref: $!"); $ENV{'PATH'} = $oldpath; } else { - open L, "<$buglog" or &quitcgi("open log for $ref: $!"); + $buglogfh = new IO::File "<$buglog" or &quitcgi("open log for $ref: $!"); } if ($buglog !~ m#^\Q$gSpoolDir/db#) { $descriptivehead .= "\n

Bug is archived. No further changes may be made.

"; } -my $log=''; -my $xmessage = 1; -my $suppressnext = 0; -my $found_msgid = 0; -my %seen_msgid = (); - -my $thisheader = ''; -my $this = ''; - -my $cmsg = 1; - -my $normstate= 'kill-init'; -my $linenum = 0; -my @mail = (); -my @mails = (); -while(my $line = ) { - $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$/) - { - &quitcgi("$ref: Transition from $normstate to $newstate at $linenum disallowed"); - } - -#$this .= "\n
states: $normstate $newstate
\n"; - -# if ($newstate eq 'go') { -# $this .= "
\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, join( '', @mail ) if ( $mbox && @mail );
-			if ($show) {
-				if (not $mime and @mail) {
-					$this .= htmlsanit(join '', @mail);
-				} elsif (@mail) {
-					my $parser = new MIME::Parser;
-					$parser->tmp_to_core(1);
-					$parser->output_to_core(1);
-#					$parser->output_under("/tmp");
-					my $entity = $parser->parse( new IO::Lines \@mail );
-					# TODO: make local subdir, clean it ourselves
-					# the following does NOT delete the msg dirs in /tmp
-					END { if ( $entity ) { $entity->purge; } if ( $parser ) { $parser->filer->purge; } }
-					my @attachments = ();
-					display_entity($entity, $ref, 1, $xmessage, $this, @attachments);
-				}
-#				if ($normstate eq 'go' || $normstate eq 'go-nox') {
-				if ($normstate ne 'html') {
-					$this = "
\n$this
\n";
-				}
-				if ($normstate eq 'html') {
-					$this = "$this  Full text available.";
-				}
-				$this = "$thisheader$this" if $thisheader && !( $normstate eq 'html' );;
-				$thisheader = '';
-				my $delim = $terse ? "
" : "
";
-				if ($reverse) {
-					$log = "$this\n$delim$log";
-				} else {
-					$log .= "$this\n$delim\n";
-				}
-			}
-
-			$xmessage++ if ($normstate ne 'html');
-
-			$suppressnext = $normstate eq 'html';
-			$found_msgid = 0;
-		}
-		
-		$normstate = $newstate;
-		@mail = ();
-		next;
-	}
+my @records = read_log_records($buglogfh);
+undef $buglogfh;
 
-	$_ = $line;
-	if ($normstate eq 'incoming-recv') {
-		my $pl= $_;
-		$pl =~ s/\n+$//;
-		m/^Received: \(at (\S+)\) by (\S+)\;/
-			|| &quitcgi("bad line \`$pl' in state incoming-recv");
-		$thisheader = "
"
-			. "Message received at ".htmlsanit("$1\@$2")
-			. ":
\n";
-		$this = '';
-		$normstate= 'go';
-		push @mail, $_;
-	} elsif ($normstate eq 'html') {
-		$this .= $_;
-	} elsif ($normstate eq 'go') {
-		s/^\030//;
-		if (!$suppressnext && !$found_msgid &&
-		    /^Message-ID: <(.*)>/i) {
-			my $msgid = $1;
-			$found_msgid = 1;
-			if ($seen_msgid{$msgid}) {
-				$suppressnext = 1;
-			} else {
-				$seen_msgid{$msgid} = 1;
-			}
-		}
-		if (@mail) {
-			push @mail, $_;
-		} else {
-			$this .= htmlsanit($_);
-		}
-	} elsif ($normstate eq 'go-nox') {
-		next if !s/^X//;
-		if (!$suppressnext && !$found_msgid &&
-		    /^Message-ID: <(.*)>/i) {
-			my $msgid = $1;
-			$found_msgid = 1;
-			if ($seen_msgid{$msgid}) {
-				$suppressnext = 1;
-			} else {
-				$seen_msgid{$msgid} = 1;
-			}
-		}
-		if (@mail) {
-			push @mail, $_;
-		} else {
-			$this .= htmlsanit($_);
-		}
-        } elsif ($normstate eq 'recips') {
-		if (m/^-t$/) {
-			$thisheader = "
Message sent:
\n";
-		} else {
-			s/\04/, /g; s/\n$//;
-			$thisheader = "
Message sent to ".htmlsanit($_).":
\n";
-		}
-		$this = "";
-		$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 = '';
-		push @mail, $_;
-	} elsif ($normstate eq 'autowait') {
-		next if !m/^$/;
-		$normstate= 'go-nox';
-	} else {
-		&quitcgi("$ref state $normstate line \`$_'");
-	}
+=head2 handle_email_message
+
+     handle_email_message($record->{text},
+			  ref        => $bug_number,
+			  msg_number => $msg_number,
+			 );
+
+Returns a decoded e-mail message and displays entities/attachments as
+appropriate.
+
+
+=cut
+
+sub handle_email_message{
+     my ($email,%options) = @_;
+
+     my $output = '';
+     my $parser = new MIME::Parser;
+     $parser->tmp_to_core(1);
+     $parser->output_to_core(1);
+     # $parser->output_under("/tmp");
+     my $entity = $parser->parse_data( $email);
+     # TODO: make local subdir, clean it ourselves
+     # the following does NOT delete the msg dirs in /tmp
+     END { if ( $entity ) { $entity->purge; } if ( $parser ) { $parser->filer->purge; } }
+     my @attachments = ();
+     display_entity($entity, $options{ref}, 1, $options{msg_number}, $output, @attachments);
+     return $output;
+
+}
+
+=head2 handle_record
+
+     push @log, handle_record($record,$ref,$msg_num);
+
+Deals with a record in a bug log as returned by
+L; returns the log information that
+should be output to the browser.
+
+=cut
+
+sub handle_record{
+     my ($record,$bug_number,$msg_number) = @_;
+
+     my $output = '';
+     local $_ = $record->{type};
+     if (/html/) {
+	  $output .= decode_rfc1522($record->{text});
+	  $output .= 'Full text and rfc822 format available.';
+     }
+     elsif (/recips/) {
+	  $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/) {
+	  # Incomming Mail Message
+	  my ($received,$hostname) = $record->{text} =~ m/Received: \(at (\S+)\) by (\S+)\;/;
+	  $output .= qq|
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;
 }
-&quitcgi("$ref state $normstate at end") unless $normstate eq 'kill-end';
-close(L);
 
+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 ) {
-	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 / ) ) {
-			my $date = strftime "%a %b %d %T %Y", localtime;
-			unshift @lines, "From unknown $date";
-		}
-		map { s/^(>*From )/>$1/ } @lines[ 1 .. $#lines ];
-		$_ = join( "\n", @lines ) . "\n";
+     if (@records > 1) {
+	  print qq(Content-Disposition: attachment; filename="bug_${ref}.mbox"\n);
+	  print "Content-Type: text/plain\n\n";
+     }
+     else {
+	  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)$/;
+	     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";
 	}
-	print join("", @mails );
 	exit 0;
 }
+
+else {
+     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);
+     }
+}
+
+@log = reverse @log if $reverse;
+$log = join('
',@log);
+
+
 print "Content-Type: text/html; charset=utf-8\n\n";
 
 my $title = htmlsanit($status{subject});
@@ -457,8 +427,9 @@ my $title = htmlsanit($status{subject});
 print "\n";
 print "\n" . 
     "$debbugs::gProject $debbugs::gBug report logs - $short - $title\n" .
+#    "" .
     "\n" .
-    '' .
+    '' .
     "\n";
 print "
" . "$debbugs::gProject $debbugs::gBug report logs - $short" .
       "
" . $title . "
\n";
diff --git a/debian/changelog b/debian/changelog
index 1bc7b59..9755cc3 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -59,6 +59,19 @@ debbugs (2.4.2) UNRELEASED; urgency=low
     - Added per bug subscription support to debbugs, which relies on an
       external MLM to actually deal with the requests; currently works with
       eoc and sends messages to bugnum\@$gListDomain. (closes: #34071)
+    - Change bugreport.cgi to use Debbugs::Log and greately simplify the
+      process of outputing the bug log.
+    - All RFC1522 subject lines are decoded, both in the html information
+      and the message headers. All messages are converted to UTF-8 whereever
+      possible; all bugreport.cgi pages are now completely in UTF-8 to the
+      degree possible. (closes: #46848, #238984)
+    - Add a convert_to_utf8 function to Debbugs::Mime to make the above
+      possible; abstracts functionality that was already present in the
+      decode_rfc1522 fucntionality.
+    - Individual messages can now be downloaded from each bug report
+      (closes: #95373)
+    - Uninteresting headers are now hidden by default, can be renabled
+      with &trim=no (closes: #188561)
 
  -- Colin Watson   Fri, 20 Jun 2003 18:57:25 +0100
 
-- 
2.39.2