cgi/bugreport.cgi

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 # Sanitize environent for taint
   7 BEGIN{
   8     delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
   9 }
  10
  11
  12 use POSIX qw(strftime);
  13 use MIME::Parser;
  14 use MIME::Decoder;
  15 use IO::Scalar;
  16 use IO::File;
  17
  18 # if we're running out of git, we want to use the git base directory as the
  19 # first INC directory. If you're not running out of git, don't do that.
  20 use File::Basename qw(dirname);
  21 use Cwd qw(abs_path);
  22 our $debbugs_dir;
  23 BEGIN {
  24     $debbugs_dir =
  25         abs_path(dirname(abs_path(__FILE__)) . '/../');
  26     # clear the taint; we'll assume that the absolute path to __FILE__ is the
  27     # right path if there's a .git directory there
  28     ($debbugs_dir) = $debbugs_dir =~ /([[:print:]]+)/;
  29     if (defined $debbugs_dir and
  30         -d $debbugs_dir . '/.git/') {
  31     } else {
  32         undef $debbugs_dir;
  33     }
  34     # if the first directory in @INC is not an absolute directory, assume that
  35     # someone has overridden us via -I.
  36     if ($INC[0] !~ /^\//) {
  37         undef $debbugs_dir;
  38     }
  39     if (defined $debbugs_dir) {
  40         unshift @INC, $debbugs_dir.'/lib/';
  41     }
  42 }
  43
  44 use Debbugs::Config qw(:globals :text :config);
  45
  46 # for read_log_records
  47 use Debbugs::Log qw(:read);
  48 use Debbugs::Log::Spam;
  49 use Debbugs::CGI qw(:url :html :util :cache :usertags);
  50 use Debbugs::CGI::Bugreport qw(:all);
  51 use Debbugs::Common qw(buglog getmaintainers make_list bug_status package_maintainer);
  52 use Debbugs::Packages qw(binary_to_source);
  53 use Debbugs::DB;
  54 use Debbugs::Status qw(splitpackages split_status_fields get_bug_status isstrongseverity);
  55 use Debbugs::Bug;
  56
  57 use Scalar::Util qw(looks_like_number);
  58
  59 use Debbugs::Text qw(:templates);
  60 use URI::Escape qw(uri_escape_utf8);
  61 use List::AllUtils qw(max);
  62
  63 my $s;
  64 my @schema_arg = ();
  65 if (defined $config{database}) {
  66     $s = Debbugs::DB->connect($config{database}) or
  67         die "Unable to connect to DB";
  68     @schema_arg = ('schema',$s);
  69 }
  70
  71 use CGI::Simple;
  72 my $q = CGI::Simple->new();
  73 # STDOUT should be using the utf8 io layer
  74 binmode(STDOUT,':raw:encoding(UTF-8)');
  75
  76 my %param = cgi_parameters(query => $q,
  77                            single => [qw(bug msg att boring terse),
  78                                       qw(reverse mbox mime trim),
  79                                       qw(mboxstat mboxmaint archive),
  80                                       qw(repeatmerged avatars),
  81                                      ],
  82                            default => {# msg       => '',
  83                                        boring    => 'no',
  84                                        terse     => 'no',
  85                                        reverse   => 'no',
  86                                        mbox      => 'no',
  87                                        mime      => 'no',
  88                                        mboxstat  => 'no',
  89                                        mboxmaint => 'no',
  90                                        archive   => 'no',
  91                                        repeatmerged => 'yes',
  92                                        avatars   => 'yes',
  93                                       },
  94                           );
  95 # This is craptacular.
  96
  97 my $ref = $param{bug} or quitcgi("No bug number", '400 Bad Request');
  98 $ref =~ /(\d+)/ or quitcgi("Invalid bug number", '400 Bad Request');
  99 $ref = $1;
 100 my $short = "#$ref";
 101 my ($msg) = $param{msg} =~ /^(\d+)$/ if exists $param{msg};
 102 my ($att) = $param{att} =~ /^(\d+)$/ if exists $param{att};
 103 my $boring = $param{'boring'} eq 'yes';
 104 my $terse = $param{'terse'} eq 'yes';
 105 my $reverse = $param{'reverse'} eq 'yes';
 106 my $mbox = $param{'mbox'} eq 'yes';
 107 my $mime = $param{'mime'} eq 'yes';
 108 my $avatars = $param{avatars} eq 'yes';
 109
 110 my $trim_headers = ($param{trim} || ((defined $msg and $msg)?'no':'yes')) eq 'yes';
 111
 112 my $mbox_status_message = $param{mboxstat} eq 'yes';
 113 my $mbox_maint = $param{mboxmaint} eq 'yes';
 114 $mbox = 1 if $mbox_status_message or $mbox_maint;
 115
 116 # Not used by this script directly, but fetch these so that pkgurl() and
 117 # friends can propagate them correctly.
 118 my $archive = $param{'archive'} eq 'yes';
 119 my $repeatmerged = $param{'repeatmerged'} eq 'yes';
 120
 121 my %bugusertags;
 122 my %ut;
 123 my %seen_users;
 124
 125 my $buglog = buglog($ref);
 126 my $bug_status = bug_status($ref);
 127 if (not defined $buglog or not defined $bug_status) {
 128     no_such_bug($q,$ref);
 129 }
 130
 131 sub no_such_bug {
 132     my ($q,$ref) = @_;
 133     print $q->header(-status => 404,
 134                      -content_type => "text/html",
 135                      -charset => 'utf-8',
 136                      -cache_control => 'public, max-age=600',
 137                     );
 138     print fill_in_template(template=>'cgi/no_such_bug',
 139                            variables => {modify_time => strftime('%a, %e %b %Y %T UTC', gmtime),
 140                                          bug_num     => $ref,
 141                                         },
 142                           );
 143     exit 0;
 144 }
 145
 146 ## calculate etag for this bugreport.cgi call
 147 my $etag;
 148 ## identify the files that we need to look at; if someone just wants the mbox,
 149 ## they don't need to see anything but the buglog; otherwise, track what is
 150 ## necessary for the usertags and things to calculate status.
 151
 152 my @dependent_files = ($buglog);
 153 my $need_status = 0;
 154 if (not (($mbox and not $mbox_status_message) or
 155          (defined $att and defined $msg))) {
 156     $need_status = 1;
 157     push @dependent_files,
 158         $bug_status,
 159         defined $config{version_index} ? $config{version_index}:(),
 160         defined $config{binary_source_map} ? $config{binary_source_map}:();
 161 }
 162
 163 ## Identify the users required
 164 for my $user (map {split /[\s*,\s*]+/} make_list($param{users}||[])) {
 165     next unless length($user);
 166     push @dependent_files,Debbugs::User::usertag_file_from_email($user);
 167 }
 168 if (defined $param{usertag}) {
 169     for my $usertag (make_list($param{usertag})) {
 170         my ($user, $tag) = split /:/, $usertag, 2;
 171         push @dependent_files,Debbugs::User::usertag_file_from_email($user);
 172     }
 173 }
 174 $etag =
 175     etag_does_not_match(cgi => $q,
 176                         additional_data => [grep {defined $_ ? $_ :()}
 177                                             values %param
 178                                            ],
 179                         files => [@dependent_files,
 180                                  ],
 181                        );
 182 if (not $etag) {
 183     print $q->header(-status => 304,
 184                      -cache_control => 'public, max-age=600',
 185                      -etag => $etag,
 186                      -charset => 'utf-8',
 187                      -content_type => 'text/html',
 188                     );
 189     print "304: Not modified\n";
 190     exit 0;
 191 }
 192
 193 ## if they're just asking for the head, stop here.
 194 if ($q->request_method() eq 'HEAD' and not defined($att) and not $mbox) {
 195     print $q->header(-status => 200,
 196                      -cache_control => 'public, max-age=600',
 197                      -etag => $etag,
 198                      -charset => 'utf-8',
 199                      -content_type => 'text/html',
 200                     );
 201      exit 0;
 202 }
 203
 204 for my $user (map {split /[\s*,\s*]+/} make_list($param{users}||[])) {
 205     next unless length($user);
 206     add_user($user,\%ut,\%bugusertags,\%seen_users);
 207 }
 208
 209 if (defined $param{usertag}) {
 210      for my $usertag (make_list($param{usertag})) {
 211           my %select_ut = ();
 212           my ($u, $t) = split /:/, $usertag, 2;
 213           Debbugs::User::read_usertags(\%select_ut, $u);
 214           unless (defined $t && $t ne "") {
 215                $t = join(",", keys(%select_ut));
 216           }
 217           add_user($u,\%ut,\%bugusertags,\%seen_users);
 218           push @{$param{tag}}, split /,/, $t;
 219      }
 220 }
 221
 222 my $bug = Debbugs::Bug->new(bug => $ref,
 223                             @schema_arg,
 224                            );
 225
 226 my %status;
 227 if ($need_status) {
 228     %status = %{split_status_fields(get_bug_status(bug=>$ref,
 229                                                    bugusertags => \%bugusertags,
 230                                                    @schema_arg,
 231                                                   ))}
 232 }
 233
 234 my @records;
 235 eval{
 236     @records = $bug->log_records();
 237 };
 238 if ($@) {
 239      quitcgi("Bad bug log for $gBug $ref. Unable to read records: $@");
 240 }
 241
 242 my $log='';
 243 my $msg_num = 0;
 244 my $skip_next = 0;
 245 if (defined($msg) and ($msg-1) <= $#records) {
 246      @records = ($records[$msg-1]);
 247      $msg_num = $msg - 1;
 248 }
 249 my @log;
 250 if ( $mbox ) {
 251      binmode(STDOUT,":raw");
 252      my $date = strftime "%a %b %d %T %Y", localtime;
 253      if (@records > 1) {
 254          print $q->header(-type => "application/mbox",
 255                           -cache_control => 'public, max-age=600',
 256                           -etag => $etag,
 257                           content_disposition => qq(attachment; filename="bug_${ref}.mbox"),
 258                          );
 259      }
 260      else {
 261           $msg_num++;
 262           print $q->header(-type => "message/rfc822",
 263                            -cache_control => 'public, max-age=86400',
 264                            -etag => $etag,
 265                            content_disposition => qq(attachment; filename="bug_${ref}_message_${msg_num}.mbox"),
 266                           );
 267      }
 268      if ($mbox_status_message and @records > 1) {
 269           my $status_message='';
 270           my @status_fields = (retitle   => 'subject',
 271                                package   => 'package',
 272                                submitter => 'originator',
 273                                severity  => 'severity',
 274                                tag       => 'tags',
 275                                owner     => 'owner',
 276                                blocks    => 'blocks',
 277                                forward   => 'forward',
 278                               );
 279           my ($key,$value);
 280           while (($key,$value) = splice(@status_fields,0,2)) {
 281                if (defined $status{$value} and length $status{$value}) {
 282                     $status_message .= qq($key $ref $status{$value}\n);
 283                }
 284           }
 285           print STDOUT qq(From unknown $date\n),
 286                create_mime_message([From       => "$gBug#$ref <$ref\@$gEmailDomain>",
 287                                     To         => "$gBug#$ref <$ref\@$gEmailDomain>",
 288                                     Subject    => "Status: $status{subject}",
 289                                     "Reply-To" => "$gBug#$ref <$ref\@$gEmailDomain>",
 290                                    ],
 291                                    <<END,);
 292 $status_message
 293 thanks
 294
 295
 296 END
 297      }
 298      my $message_number=0;
 299      my %seen_message_ids;
 300      for my $record (@records) {
 301           next if $record->{type} !~ /^(?:recips|incoming-recv)$/;
 302           my $wanted_type = $mbox_maint?'recips':'incoming-recv';
 303           # we want to include control messages anyway
 304           my $record_wanted_anyway = 0;
 305           my ($msg_id) = record_regex($record,qr/^Message-Id:\s+<(.+)>/im);
 306           next if defined $msg_id and exists $seen_message_ids{$msg_id};
 307           next if defined $msg_id and $msg_id =~/handler\..+\.ack(?:info|done)?\@/;
 308           $record_wanted_anyway = 1 if record_regex($record,qr/^Received: \(at control\)/);
 309           next if not $boring and not $record->{type} eq $wanted_type and not $record_wanted_anyway and @records > 1;
 310           $seen_message_ids{$msg_id} = 1 if defined $msg_id;
 311           # skip spam messages if we're outputting more than one message
 312           next if @records > 1 and $bug->is_spam($msg_id);
 313       my @lines;
 314       if ($record->{inner_file}) {
 315           push @lines, scalar $record->{fh}->getline;
 316           push @lines, scalar $record->{fh}->getline;
 317           chomp $lines[0];
 318           chomp $lines[1];
 319       } else {
 320           @lines = split( "\n", $record->{text}, -1 );
 321       }
 322           if ( $lines[ 1 ] =~ m/^From / ) {
 323           @lines = reverse @lines;
 324           }
 325           if ( !( $lines[ 0 ] =~ m/^From / ) ) {
 326                unshift @lines, "From unknown $date";
 327        }
 328       print $lines[0]."\n";
 329           print map { s/^(>*From )/>$1/; $_."\n" } @lines[ 1 .. $#lines ];
 330       if ($record->{inner_file}) {
 331           my $fh = $record->{fh};
 332           local $/;
 333           while (<$fh>) {
 334               s/^(>*From )/>$1/gm;
 335               print $_;
 336           }
 337       }
 338      }
 339      exit 0;
 340 }
 341
 342 else {
 343      if (defined $att and defined $msg and @records) {
 344          binmode(STDOUT,":raw");
 345          $msg_num++;
 346          ## allow this to be cached for a week
 347          print "Status: 200 OK\n";
 348          print "Cache-Control: public, max-age=604800\n";
 349          print "Etag: $etag\n";
 350           print handle_email_message($records[0],
 351                                      ref => $ref,
 352                                      msg_num => $msg_num,
 353                                      att => $att,
 354                                      msg => $msg,
 355                                      trim_headers => $trim_headers,
 356                                     );
 357           exit 0;
 358      }
 359      my %seen_msg_ids;
 360      for my $record (@records) {
 361           $msg_num++;
 362           if ($skip_next) {
 363                $skip_next = 0;
 364                next;
 365           }
 366           $skip_next = 1 if $record->{type} eq 'html' and not $boring;
 367           push @log, handle_record($record,$ref,$msg_num,
 368                                    \%seen_msg_ids,
 369                                    trim_headers => $trim_headers,
 370                                    avatars => $avatars,
 371                                    terse => $terse,
 372                                    # if we're only looking at one record, allow
 373                                    # spam to be output
 374                                    spam  => (@records > 1)?$bug:undef,
 375                                   );
 376      }
 377 }
 378
 379 @log = reverse @log if $reverse;
 380 $log = join("\n",@log);
 381
 382
 383 # All of the below should be turned into a template
 384
 385 my $indexentry;
 386 my $showseverity;
 387
 388 unless (%status) {
 389     no_such_bug($q,$ref);
 390 }
 391
 392 my @packages = make_list($status{package});
 393
 394
 395 print $q->header(-type => "text/html",
 396                  -charset => 'utf-8',
 397                  -cache_control => 'public, max-age=300',
 398                  -etag => $etag,
 399                 );
 400
 401 print fill_in_template(template => 'cgi/bugreport',
 402                        variables => {bug => $bug,
 403                                      log           => $log,
 404                                      msg           => $msg,
 405                                      isstrongseverity => \&Debbugs::Status::isstrongseverity,
 406                                      html_escape   => \&Debbugs::CGI::html_escape,
 407                                      uri_escape    => \&URI::Escape::uri_escape_utf8,
 408                                      looks_like_number => \&Scalar::Util::looks_like_number,
 409                                      make_list        => \&Debbugs::Common::make_list,
 410                                     },
 411                        hole_var  => {'&package_links' => \&Debbugs::CGI::package_links,
 412                                      '&bug_links'     => \&Debbugs::CGI::bug_links,
 413                                      '&version_url'   => \&Debbugs::CGI::version_url,
 414                                      '&strftime'      => \&POSIX::strftime,
 415                                      '&maybelink'     => \&Debbugs::CGI::maybelink,
 416                                     },
 417                       );
 418
 419 __END__
 420
 421 # Local Variables:
 422 # indent-tabs-mode: nil
 423 # cperl-indent-level: 4
 424 # End: