From c768b2faebc3e56f8e519e6ea3661c79d954defe Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Mon, 19 May 2008 17:12:07 +0200 Subject: [PATCH] move the function from bugreport.cgi out to a separate module --- Debbugs/CGI/Bugreport.pm | 376 +++++++++++++++++++++++++++++++++++++++ cgi/bugreport.cgi | 224 +---------------------- 2 files changed, 379 insertions(+), 221 deletions(-) create mode 100644 Debbugs/CGI/Bugreport.pm diff --git a/Debbugs/CGI/Bugreport.pm b/Debbugs/CGI/Bugreport.pm new file mode 100644 index 0000000..28bc63f --- /dev/null +++ b/Debbugs/CGI/Bugreport.pm @@ -0,0 +1,376 @@ +# This module is part of debbugs, and is released +# under the terms of the GPL version 2, or any later version. See the +# file README and COPYING for more information. +# +# [Other people have contributed to this file; their copyrights should +# be listed here too.] +# Copyright 2008 by Don Armstrong . + + +package Debbugs::CGI::Bugreport; + +=head1 NAME + +Debbugs::CGI::Bugreport -- specific routines for the bugreport cgi script + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +use IO::Scalar; + +BEGIN{ + ($VERSION) = q$Revision: 494 $ =~ /^Revision:\s+([^\s+])/; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (); + @EXPORT_OK = (qw(display_entities handle_record handle_email_message)); + Exporter::export_ok_tags(keys %EXPORT_TAGS); + $EXPORT_TAGS{all} = [@EXPORT_OK]; +} + + + +=head2 display_entity + + display_entity(entity => $entity, + bug_num => $ref, + outer => 1, + msg_num => $msg_num, + attachments => \@attachments, + output => \$output); + + +=over + +=item entity -- MIME::Parser entity + +=item bug_num -- Bug number + +=item outer -- Whether this is the outer entity; defaults to 1 + +=item msg_num -- message number in the log + +=item attachments -- arrayref of attachments + +=item output -- scalar reference for output + +=back + +=cut + +sub display_entity { + my %param = valid_with(params => \@_, + spec => {entity => {type => OBJECT, + }, + bug_num => {type => SCALAR, + regex => qr/^\d+$/, + }, + outer => {type => BOOLEAN, + default => 1, + }, + msg_num => {type => SCALAR, + }, + attachments => {type => ARRAYREF, + default => [], + }, + output => {type => SCALARREF|HANDLE, + default => \*STDOUT, + }, + terse => {type => BOOLEAN, + default => 0, + }, + msg => {type => SCALAR, + optional => 1, + }, + attachment => {type => SCALAR, + optional => 1, + }, + } + ); + + my $entity = $param{entity}; + my $ref = $param{bug_num}; + my $top = $param{outer} + my $xmessage = $param{msg_num}; + if (defined ref($options) and + ref($param{output}) eq 'SCALAR' and + not UNIVERSAL::isa($param{output},'GLOB')) { + $param{output} = IO::Scalar->new($param{output}); + } + my $attachments = $param{attachments}; + + 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 $param{terse}) { + my $header = $entity->head; + print {$param{output}} "
\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));
+	      }
+	      print {$param{output}} join(qq(), @headers);
+	 } else {
+	      print {$param{output}} html_escape(decode_rfc1522($entity->head->stringify));
+	 }
+	 print {$param{output}} "
\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 ''; + print {$param{output}} '
[$printname } .
+		  "($type, $disposition)]
\n"; + + if (exists $param{msg} and exists $param{att} and + $att == $#$attachments) { + my $head = $entity->head; + chomp(my $type = $entity->effective_type); + my $body = $entity->stringify_body; + print {$param{output}} "Content-Type: $type"; + my ($charset) = $head->get('Content-Type:') =~ m/charset\s*=\s*\"?([\w-]+)\"?/i; + print {$param{output}} qq(; charset="$charset") if defined $charset; + print {$param{output}}"\n"; + if ($filename ne '') { + my $qf = $filename; + $qf =~ s/"/\\"/g; + $qf =~ s[.*/][]; + print {$param{output}} qq{Content-Disposition: inline; filename="$qf"\n}; + } + print {$param{output}} "\n"; + my $decoder = MIME::Decoder->new($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(entity => $part, + bug_num => $ref, + outer => 0, + msg_num => $xmessage, + output => $param{output}, + attachments => $attachments, + terse => $param{terse}, + exists $param{msg}?(msg=>$param{msg}):(), + exists $param{attachment}?(attachment=>$param{attachment}):(), + ); + print {$param{output}} "\n"; + } + } elsif ($entity->parts) { + # We must be dealing with a nested message. + print {$param{output}} "
\n"; + my @parts = $entity->parts; + foreach my $part (@parts) { + display_entity(entity => $part, + bug_num => $ref, + outer => 1, + msg_num => $xmessage, + ouput => $param{output}, + attachments => $attachments, + terse => $param{terse}, + exists $param{msg}?(msg=>$param{msg}):(), + exists $param{attachment}?(attachment=>$param{attachment}):(), + ); + print {$param{output}} "\n"; + } + print {$param{output}} "
\n"; + } elsif (not $param{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 + # We don't html escape here because we escape above + $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; + print {$param{output}} qq(
$body
\n); + } +} + + +=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; + # Because we are using memory, not tempfiles, there's no need to + # clean up here like in Debbugs::MIME + $parser->tmp_to_core(1); + $parser->output_to_core(1); + my $entity = $parser->parse_data( $email); + my @attachments = (); + display_entity(entity => $entity, + bug_num => $options{ref}, + outer => 1, + msg_number => $options{msg_number}, + ouput => $output, + attachments => \@attachments, + terse => $params{terse}, + exists $param{msg}?(msg=>$param{msg}):(), + exists $param{att}?(attachment=>$param{att}):(), + ); + 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,$seen_msg_ids) = @_; + + my $output = ''; + local $_ = $record->{type}; + if (/html/) { + my ($time) = $record->{text} =~ //; + my $class = $record->{text} =~ /^(?:Acknowledgement|Reply|Information|Report|Notification)/ ? 'infmessage':'msgreceived'; + $output .= decode_rfc1522($record->{text}); + # Link to forwarded http:// urls in the midst of the report + # (even though these links already exist at the top) + $output =~ s,((?:ftp|http|https)://[\S~-]+?/?)([\)\'\:\.\,]?(?:\s|\.<|$)),$1$2,go; + # Add links to the cloned bugs + $output =~ s{(Bug )(\d+)( cloned as bugs? )(\d+)(?:\-(\d+)|)}{$1.bug_links($2).$3.bug_links($4,$5)}eo; + # Add links to merged bugs + $output =~ s{(?<=Merged )([\d\s]+)(?=\.)}{join(' ',map {bug_links($_)} (split /\s+/, $1))}eo; + # Add links to blocked bugs + $output =~ s{(?<=Blocking bugs)(?:( of )(\d+))?( (?:added|set to|removed):\s+)([\d\s\,]+)} + {(defined $2?$1.bug_links($2):'').$3. + join(' ',map {bug_links($_)} (split /\,?\s+/, $4))}eo; + # Add links to reassigned packages + $output =~ s{(Bug reassigned from package \`)([^']+?)((?:'|\&\#39;) to \`)([^']+?)((?:'|\&\#39;))} + {$1.q($2).$3.q($4).$5}eo; + if (defined $time) { + $output .= ' ('.strftime('%a, %d %b %Y %T GMT',gmtime($time)).') '; + } + $output .= 'Full text and rfc822 format available.'; + + $output = qq(
\n\n) . $output . "
\n"; + } + elsif (/recips/) { + 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; + } + $output .= qq(

\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 #$msg_number 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; +} + + + +1; + + +__END__ + + + + + + diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi index 72b84ea..dcb6482 100755 --- a/cgi/bugreport.cgi +++ b/cgi/bugreport.cgi @@ -15,6 +15,7 @@ use Debbugs::Config qw(:globals :text); 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::CGI::Bugreport qw(:all); use Debbugs::Common qw(buglog getmaintainers); use Debbugs::Packages qw(getpkgsrc); use Debbugs::Status qw(splitpackages get_bug_status isstrongseverity); @@ -82,115 +83,6 @@ if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD' and not defi exit 0; } -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(
$body
\n); - } - } -} my $buglogfh; if ($buglog =~ m/\.gz$/) { @@ -212,118 +104,6 @@ if ($@) { } undef $buglogfh; -=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; - # Because we are using memory, not tempfiles, there's no need to - # clean up here like in Debbugs::MIME - $parser->tmp_to_core(1); - $parser->output_to_core(1); - my $entity = $parser->parse_data( $email); - 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,$seen_msg_ids) = @_; - - my $output = ''; - local $_ = $record->{type}; - if (/html/) { - my ($time) = $record->{text} =~ //; - my $class = $record->{text} =~ /^(?:Acknowledgement|Reply|Information|Report|Notification)/ ? 'infmessage':'msgreceived'; - $output .= decode_rfc1522($record->{text}); - # Link to forwarded http:// urls in the midst of the report - # (even though these links already exist at the top) - $output =~ s,((?:ftp|http|https)://[\S~-]+?/?)([\)\'\:\.\,]?(?:\s|\.<|$)),$1$2,go; - # Add links to the cloned bugs - $output =~ s{(Bug )(\d+)( cloned as bugs? )(\d+)(?:\-(\d+)|)}{$1.bug_links($2).$3.bug_links($4,$5)}eo; - # Add links to merged bugs - $output =~ s{(?<=Merged )([\d\s]+)(?=\.)}{join(' ',map {bug_links($_)} (split /\s+/, $1))}eo; - # Add links to blocked bugs - $output =~ s{(?<=Blocking bugs)(?:( of )(\d+))?( (?:added|set to|removed):\s+)([\d\s\,]+)} - {(defined $2?$1.bug_links($2):'').$3. - join(' ',map {bug_links($_)} (split /\,?\s+/, $4))}eo; - # Add links to reassigned packages - $output =~ s{(Bug reassigned from package \`)([^']+?)((?:'|\&\#39;) to \`)([^']+?)((?:'|\&\#39;))} - {$1.q($2).$3.q($4).$5}eo; - if (defined $time) { - $output .= ' ('.strftime('%a, %d %b %Y %T GMT',gmtime($time)).') '; - } - $output .= 'Full text and rfc822 format available.'; - - $output = qq(
\n\n) . $output . "
\n"; - } - elsif (/recips/) { - 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; - } - $output .= qq(

\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 #$msg_number 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; @@ -419,6 +199,8 @@ else { $log = join("\n",@log); +# All of the below should be turned into a template + my %maintainer = %{getmaintainers()}; my %pkgsrc = %{getpkgsrc()}; -- 2.39.2