cgi/bugreport.cgi

   1 #!/usr/bin/perl -wT
   2
   3 use warnings;
   4 use strict;
   5
   6 use POSIX qw(strftime tzset);
   7 use MIME::Parser;
   8 use MIME::Decoder;
   9 use IO::Scalar;
  10 use IO::File;
  11
  12 use Debbugs::Config qw(:globals :text);
  13
  14 # for read_log_records
  15 use Debbugs::Log qw(read_log_records);
  16 use Debbugs::MIME qw(convert_to_utf8 decode_rfc1522 create_mime_message);
  17 use Debbugs::CGI qw(:url :html :util);
  18 use Debbugs::CGI::Bugreport qw(:all);
  19 use Debbugs::Common qw(buglog getmaintainers);
  20 use Debbugs::Packages qw(getpkgsrc);
  21 use Debbugs::Status qw(splitpackages get_bug_status isstrongseverity);
  22
  23 use Scalar::Util qw(looks_like_number);
  24 use CGI::Simple;
  25 my $q = new CGI::Simple;
  26
  27 my %param = cgi_parameters(query => $q,
  28                            single => [qw(bug msg att boring terse),
  29                                       qw(reverse mbox mime trim),
  30                                       qw(mboxstat mboxmaint archive),
  31                                       qw(repeatmerged)
  32                                      ],
  33                            default => {msg       => '',
  34                                        boring    => 'no',
  35                                        terse     => 'no',
  36                                        reverse   => 'no',
  37                                        mbox      => 'no',
  38                                        mime      => 'no',
  39                                        mboxstat  => 'no',
  40                                        mboxmaint => 'no',
  41                                        archive   => 'no',
  42                                        repeatmerged => 'yes',
  43                                       },
  44                           );
  45 # This is craptacular.
  46
  47 my $tail_html;
  48
  49 my $ref = $param{bug} or quitcgi("No bug number");
  50 $ref =~ /(\d+)/ or quitcgi("Invalid bug number");
  51 $ref = $1;
  52 my $short = "#$ref";
  53 my $msg = $param{'msg'};
  54 my $att = $param{'att'};
  55 my $boring = $param{'boring'} eq 'yes';
  56 my $terse = $param{'terse'} eq 'yes';
  57 my $reverse = $param{'reverse'} eq 'yes';
  58 my $mbox = $param{'mbox'} eq 'yes';
  59 my $mime = $param{'mime'} eq 'yes';
  60
  61 my $trim_headers = ($param{trim} || ($msg?'no':'yes')) eq 'yes';
  62
  63 my $mbox_status_message = $param{mboxstat} eq 'yes';
  64 my $mbox_maint = $param{mboxmaint} eq 'yes';
  65 $mbox = 1 if $mbox_status_message or $mbox_maint;
  66
  67
  68 # Not used by this script directly, but fetch these so that pkgurl() and
  69 # friends can propagate them correctly.
  70 my $archive = $param{'archive'} eq 'yes';
  71 my $repeatmerged = $param{'repeatmerged'} eq 'yes';
  72
  73 my $buglog = buglog($ref);
  74
  75 if (defined $ENV{REQUEST_METHOD} and $ENV{REQUEST_METHOD} eq 'HEAD' and not defined($att) and not $mbox) {
  76     print "Content-Type: text/html; charset=utf-8\n";
  77     my @stat = stat $buglog;
  78     if (@stat) {
  79         my $mtime = strftime '%a, %d %b %Y %T GMT', gmtime($stat[9]);
  80         print "Last-Modified: $mtime\n";
  81     }
  82     print "\n";
  83     exit 0;
  84 }
  85
  86
  87 my $buglogfh;
  88 if ($buglog =~ m/\.gz$/) {
  89     my $oldpath = $ENV{'PATH'};
  90     $ENV{'PATH'} = '/bin:/usr/bin';
  91     $buglogfh = new IO::File "zcat $buglog |" or &quitcgi("open log for $ref: $!");
  92     $ENV{'PATH'} = $oldpath;
  93 } else {
  94     $buglogfh = new IO::File "<$buglog" or &quitcgi("open log for $ref: $!");
  95 }
  96
  97
  98 my @records;
  99 eval{
 100      @records = read_log_records($buglogfh);
 101 };
 102 if ($@) {
 103      quitcgi("Bad bug log for $gBug $ref. Unable to read records: $@");
 104 }
 105 undef $buglogfh;
 106
 107
 108 my $log='';
 109 my $msg_num = 0;
 110 my $skip_next = 0;
 111 if (looks_like_number($msg) and ($msg-1) <= $#records) {
 112      @records = ($records[$msg-1]);
 113      $msg_num = $msg - 1;
 114 }
 115 my @log;
 116 if ( $mbox ) {
 117      my $date = strftime "%a %b %d %T %Y", localtime;
 118      if (@records > 1) {
 119           print qq(Content-Disposition: attachment; filename="bug_${ref}.mbox"\n);
 120           print "Content-Type: text/plain\n\n";
 121      }
 122      else {
 123           $msg_num++;
 124           print qq(Content-Disposition: attachment; filename="bug_${ref}_message_${msg_num}.mbox"\n);
 125           print "Content-Type: message/rfc822\n\n";
 126      }
 127      if ($mbox_status_message and @records > 1) {
 128           my $status_message='';
 129           my @status_fields = (retitle   => 'subject',
 130                                package   => 'package',
 131                                submitter => 'originator',
 132                                severity  => 'severity',
 133                                tag       => 'tags',
 134                                owner     => 'owner',
 135                                blocks    => 'blocks',
 136                                forward   => 'forward',
 137                               );
 138           my ($key,$value);
 139           while (($key,$value) = splice(@status_fields,0,2)) {
 140                if (defined $status{$value} and length $status{$value}) {
 141                     $status_message .= qq($key $ref $status{$value}\n);
 142                }
 143           }
 144           print STDOUT qq(From unknown $date\n),
 145                create_mime_message([From       => "$gBug#$ref <$ref\@$gEmailDomain>",
 146                                     To         => "$gBug#$ref <$ref\@$gEmailDomain>",
 147                                     Subject    => "Status: $status{subject}",
 148                                     "Reply-To" => "$gBug#$ref <$ref\@$gEmailDomain>",
 149                                    ],
 150                                    <<END,);
 151 $status_message
 152 thanks
 153
 154
 155 END
 156      }
 157      my $message_number=0;
 158      my %seen_message_ids;
 159      for my $record (@records) {
 160           next if $record->{type} !~ /^(?:recips|incoming-recv)$/;
 161           my $wanted_type = $mbox_maint?'recips':'incoming-recv';
 162           # we want to include control messages anyway
 163           my $record_wanted_anyway = 0;
 164           my ($msg_id) = $record->{text} =~ /^Message-Id:\s+<(.+)>/im;
 165           next if exists $seen_message_ids{$msg_id};
 166           next if $msg_id =~/handler\..+\.ack(?:info|done)?\@/;
 167           $record_wanted_anyway = 1 if $record->{text} =~ /^Received: \(at control\)/;
 168           next if not $boring and not $record->{type} eq $wanted_type and not $record_wanted_anyway and @records > 1;
 169           $seen_message_ids{$msg_id} = 1;
 170           my @lines = split( "\n", $record->{text}, -1 );
 171           if ( $lines[ 1 ] =~ m/^From / ) {
 172                my $tmp = $lines[ 0 ];
 173                $lines[ 0 ] = $lines[ 1 ];
 174                $lines[ 1 ] = $tmp;
 175           }
 176           if ( !( $lines[ 0 ] =~ m/^From / ) ) {
 177                unshift @lines, "From unknown $date";
 178           }
 179           map { s/^(>*From )/>$1/ } @lines[ 1 .. $#lines ];
 180           print join( "\n", @lines ) . "\n";
 181      }
 182      exit 0;
 183 }
 184
 185 else {
 186      my %seen_msg_ids;
 187      for my $record (@records) {
 188           $msg_num++;
 189           if ($skip_next) {
 190                $skip_next = 0;
 191                next;
 192           }
 193           $skip_next = 1 if $record->{type} eq 'html' and not $boring;
 194           push @log, handle_record($record,$ref,$msg_num,\%seen_msg_ids);
 195      }
 196 }
 197
 198 @log = reverse @log if $reverse;
 199 $log = join("\n",@log);
 200
 201
 202 # All of the below should be turned into a template
 203
 204 my %maintainer = %{getmaintainers()};
 205 my %pkgsrc = %{getpkgsrc()};
 206
 207 my $indexentry;
 208 my $showseverity;
 209
 210 my $tpack;
 211 my $tmain;
 212
 213 my $dtime = strftime "%a, %e %b %Y %T UTC", gmtime;
 214 $tail_html = $gHTMLTail;
 215 $tail_html =~ s/SUBSTITUTE_DTIME/$dtime/;
 216
 217 my %status = %{get_bug_status(bug=>$ref)};
 218 unless (%status) {
 219     print "Content-Type: text/html; charset=utf-8\n\n";
 220     print fill_in_template(template=>'cgi/no_such_bug',
 221                            variables => {modify_time => $dtime,
 222                                          bug_num     => $ref,
 223                                         },
 224                           )
 225     exit 0;
 226 }
 227
 228 $|=1;
 229
 230 $tpack = lc $status{'package'};
 231 my @tpacks = splitpackages($tpack);
 232
 233 if  ($status{severity} eq 'normal') {
 234         $showseverity = '';
 235 } elsif (isstrongseverity($status{severity})) {
 236         $showseverity = "Severity: <em class=\"severity\">$status{severity}</em>;\n";
 237 } else {
 238         $showseverity = "Severity: $status{severity};\n";
 239 }
 240
 241 if (@{$status{found_versions}} or @{$status{fixed_versions}}) {
 242      $indexentry.= q(<div style="float:right"><a href=").
 243           html_escape(version_url(package => $status{package},
 244                                   found => $status{found_versions},
 245                                   fixed => $status{fixed_versions},
 246                                  )).
 247           q("><img alt="version graph" src=").
 248                html_escape(version_url(package => $status{package},
 249                                        found => $status{found_versions},
 250                                        fixed => $status{fixed_versions},
 251                                        width => 2,
 252                                        height => 2,
 253                                       )).qq{"></a></div>};
 254 }
 255
 256
 257 $indexentry .= "<div class=\"msgreceived\">\n";
 258 $indexentry .= htmlize_packagelinks($status{package}, 0) . ";\n";
 259
 260 foreach my $pkg (@tpacks) {
 261     my $tmaint = defined($maintainer{$pkg}) ? $maintainer{$pkg} : '(unknown)';
 262     my $tsrc = defined($pkgsrc{$pkg}) ? $pkgsrc{$pkg} : '(unknown)';
 263
 264     $indexentry .=
 265             htmlize_maintlinks(sub { $_[0] == 1 ? "Maintainer for $pkg is\n"
 266                                             : "Maintainers for $pkg are\n" },
 267                            $tmaint);
 268     $indexentry .= ";\nSource for $pkg is\n".
 269             '<a href="'.html_escape(pkg_url(src=>$tsrc))."\">$tsrc</a>" if ($tsrc ne "(unknown)");
 270     $indexentry .= ".\n";
 271 }
 272
 273 $indexentry .= "<br>";
 274 $indexentry .= htmlize_addresslinks("Reported by: ", \&submitterurl,
 275                                 $status{originator}) . ";\n";
 276 $indexentry .= sprintf "Date: %s.\n",
 277                 (strftime "%a, %e %b %Y %T UTC", localtime($status{date}));
 278
 279 $indexentry .= "<br>Owned by: " . html_escape($status{owner}) . ".\n"
 280               if length $status{owner};
 281
 282 $indexentry .= "</div>\n";
 283
 284 my @descstates;
 285
 286 $indexentry .= "<h3>$showseverity";
 287 $indexentry .= sprintf "Tags: %s;\n",
 288                 html_escape(join(", ", sort(split(/\s+/, $status{tags}))))
 289                         if length($status{tags});
 290 $indexentry .= "<br>" if (length($showseverity) or length($status{tags}));
 291
 292 my @merged= split(/ /,$status{mergedwith});
 293 if (@merged) {
 294         my $descmerged = 'Merged with ';
 295         my $mseparator = '';
 296         for my $m (@merged) {
 297                 $descmerged .= $mseparator."<a href=\"" . html_escape(bug_url($m)) . "\">#$m</a>";
 298                 $mseparator= ",\n";
 299         }
 300         push @descstates, $descmerged;
 301 }
 302
 303 if (@{$status{found_versions}}) {
 304     my $foundtext = 'Found in ';
 305     $foundtext .= (@{$status{found_versions}} == 1) ? 'version ' : 'versions ';
 306     $foundtext .= join ', ', map html_escape($_), @{$status{found_versions}};
 307     push @descstates, $foundtext;
 308 }
 309 if (@{$status{fixed_versions}}) {
 310     my $fixedtext = '<strong>Fixed</strong> in ';
 311     $fixedtext .= (@{$status{fixed_versions}} == 1) ? 'version ' : 'versions ';
 312     $fixedtext .= join ', ', map html_escape($_), @{$status{fixed_versions}};
 313     if (length($status{done})) {
 314         $fixedtext .= ' by ' . html_escape(decode_rfc1522($status{done}));
 315     }
 316     push @descstates, $fixedtext;
 317 }
 318
 319 if (@{$status{found_versions}} or @{$status{fixed_versions}}) {
 320      push @descstates, '<a href="'.
 321           html_escape(version_url($status{package},
 322                                   $status{found_versions},
 323                                   $status{fixed_versions},
 324                                  )).qq{">Version Graph</a>};
 325 }
 326
 327 if (length($status{done})) {
 328     push @descstates, "<strong>Done:</strong> ".html_escape(decode_rfc1522($status{done}));
 329 }
 330
 331 if (length($status{forwarded})) {
 332     my $forward_link = html_escape($status{forwarded});
 333     $forward_link =~ s,((ftp|http|https)://[\S~-]+?/?)((\&gt\;)?[)]?[']?[:.\,]?(\s|$)),<a href="$1">$1</a>$3,go;
 334     push @descstates, "<strong>Forwarded</strong> to $forward_link";
 335 }
 336
 337
 338 my @blockedby= split(/ /, $status{blockedby});
 339 if (@blockedby && $status{"pending"} ne 'fixed' && ! length($status{done})) {
 340     for my $b (@blockedby) {
 341         my %s = %{get_bug_status($b)};
 342         next if $s{"pending"} eq 'fixed' || length $s{done};
 343         push @descstates, "Fix blocked by <a href=\"" . html_escape(bug_url($b)) . "\">#$b</a>: ".html_escape($s{subject});
 344     }
 345 }
 346
 347 my @blocks= split(/ /, $status{blocks});
 348 if (@blocks && $status{"pending"} ne 'fixed' && ! length($status{done})) {
 349     for my $b (@blocks) {
 350         my %s = %{get_bug_status($b)};
 351         next if $s{"pending"} eq 'fixed' || length $s{done};
 352         push @descstates, "Blocking fix for <a href=\"" . html_escape(bug_url($b)) . "\">#$b</a>: ".html_escape($s{subject});
 353     }
 354 }
 355
 356 if ($buglog !~ m#^\Q$gSpoolDir/db#) {
 357     push @descstates, "Bug is archived. No further changes may be made";
 358 }
 359
 360 $indexentry .= join(";\n<br>", @descstates) . ".\n" if @descstates;
 361 $indexentry .= "</h3>\n";
 362
 363 my $descriptivehead = $indexentry;
 364
 365 print "Content-Type: text/html; charset=utf-8\n";
 366
 367 my @stat = stat $buglog;
 368 if (@stat) {
 369      my $mtime = strftime '%a, %d %b %Y %T GMT', gmtime($stat[9]);
 370      print "Last-Modified: $mtime\n";
 371 }
 372
 373 print "\n";
 374
 375 my $title = html_escape($status{subject});
 376
 377 my $dummy2 = $gWebHostBugDir;
 378
 379 print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">\n";
 380 print <<END;
 381 <HTML><HEAD>
 382 <TITLE>$short - $title - $gProject $gBug report logs</TITLE>
 383 <meta http-equiv="Content-Type" content="text/html;charset=utf-8">
 384 <link rel="stylesheet" href="$gWebHostBugDir/css/bugs.css" type="text/css">
 385 <script type="text/javascript">
 386 <!--
 387 function toggle_infmessages()
 388 {
 389         allDivs=document.getElementsByTagName("div");
 390         for (var i = 0 ; i < allDivs.length ; i++ )
 391         {
 392                 if (allDivs[i].className == "infmessage")
 393                 {
 394                         allDivs[i].style.display=(allDivs[i].style.display == 'none' | allDivs[i].style.display == '') ? 'block' : 'none';
 395                 }
 396         }
 397 }
 398 -->
 399 </script>
 400 </HEAD>
 401 <BODY>
 402 END
 403 print "<H1>" . "$gProject $gBug report logs - <A HREF=\"mailto:$ref\@$gEmailDomain\">$short</A>" .
 404       "<BR>" . $title . "</H1>\n";
 405 print "$descriptivehead\n";
 406
 407 if (looks_like_number($msg)) {
 408      printf qq(<p><a href="%s">Full log</a></p>),html_escape(bug_url($ref));
 409 }
 410 else {
 411      print qq(<p><a href="mailto:$ref\@$gEmailDomain">Reply</a> ),
 412           qq(or <a href="mailto:$ref-subscribe\@$gEmailDomain">subscribe</a> ),
 413                qq(to this bug.</p>\n);
 414      print qq(<p><a href="javascript:toggle_infmessages();">Toggle useless messages</a></p>);
 415      printf qq(<div class="msgreceived"><p>View this report as an <a href="%s">mbox folder</a>, ).
 416           qq(<a href="%s">status mbox</a>, <a href="%s">maintainer mbox</a></p></div>\n),
 417                html_escape(bug_url($ref, mbox=>'yes')),
 418                     html_escape(bug_url($ref, mbox=>'yes',mboxstatus=>'yes')),
 419                          html_escape(bug_url($ref, mbox=>'yes',mboxmaint=>'yes'));
 420 }
 421 print "$log";
 422 print "<HR>";
 423 print "<p class=\"msgreceived\">Send a report that <a href=\"/cgi-bin/bugspam.cgi?bug=$ref\">this bug log contains spam</a>.</p>\n<HR>\n";
 424 print $tail_html;
 425
 426 print "</BODY></HTML>\n";
 427
 428 exit 0;