bin/local-debbugs

   1 #! /usr/bin/perl
   2 # local-debbugs is part of debbugs, and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2008 by Don Armstrong <don@donarmstrong.com>.
   6
   7
   8 use warnings;
   9 use strict;
  10
  11 use Getopt::Long qw(:config no_ignore_case);
  12 use Pod::Usage;
  13
  14 =head1 NAME
  15
  16 local-debbugs - use a local mirror of debbugs
  17
  18 =head1 SYNOPSIS
  19
  20  [options]
  21
  22  Options:
  23   --mirror, -M update local mirror
  24   --daemon, -D start the daemon
  25   --search, -S run a search
  26   --show, -s show a bug
  27   --debug, -d debugging level (Default 0)
  28   --help, -h display this help
  29   --man, -m display manual
  30
  31 =head1 OPTIONS
  32
  33 =over
  34
  35 =item B<--mirror, -M>
  36
  37 Update the local mirror of debbugs bugs
  38
  39 =item B<--daemon, -D>
  40
  41 Start up the daemon on the configured local port to serve bugs which
  42 have been previously retrieved.
  43
  44 =item B<--search, -S>
  45
  46 Cause the running daemon to show the pkgreport.cgi page corresponding
  47 to the search by invoking sensible-browser and an appropriate url.
  48
  49 =item B<--show, -s>
  50
  51 Cause the running daemon to show the bugreport.cgi page corresponding
  52 to the bug by invoking sensible-browser and an appropriate url.
  53
  54 =item B<--port, -p>
  55
  56 The port that the daemon is running on (or will be running on.)
  57
  58 Defaults to the value of the currently running daemon, the value in
  59 the configuration file, or 8080 if nothing is set.
  60
  61 =item B<--bugs-to-get>
  62
  63 File which contains the set of bugs to get.
  64 Defaults to ~/.debbugs/bugs_to_get
  65
  66 =item B<--bug-site>
  67
  68 Hostname for a site which is running a debbugs install.
  69 Defaults to bugs.debian.org
  70
  71 =item B<--bug-mirror>
  72
  73 Hostname for a site which is running an rsyncable mirror of the
  74 debbugs install above.
  75 Defaults to bugs-mirror.debian.org
  76
  77 =item B<--debug, -d>
  78
  79 Debug verbosity.
  80
  81 =item B<--help, -h>
  82
  83 Display brief useage information.
  84
  85 =item B<--man, -m>
  86
  87 Display this manual.
  88
  89 =back
  90
  91 =head1 EXAMPLES
  92
  93 =over
  94
  95 =item Update the local mirror
  96
  97  local-debbugs --mirror
  98
  99 =item Start up the local-debbugs daemon
 100
 101  local-debbugs --daemon
 102
 103 =item Search for bugs with severity serious
 104
 105  local-debbugs --search severity:serious
 106
 107 =back
 108
 109 =cut
 110
 111
 112 use vars qw($DEBUG);
 113
 114 use User;
 115 use Config::Simple;
 116 use File::Temp qw(tempdir);
 117 use Params::Validate qw(validate_with :types);
 118 use POSIX 'setsid';
 119 use Debbugs::Common qw(checkpid lockpid get_hashname);
 120 use Debbugs::Mail qw(get_addresses);
 121 use SOAP::Lite;
 122 use IPC::Run;
 123 use IO::File;
 124 use File::Path;
 125
 126
 127 my %options = (debug           => 0,
 128                help            => 0,
 129                man             => 0,
 130                verbose         => 0,
 131                quiet           => 0,
 132                detach          => 1,
 133                cgi_bin         => '/var/lib/debbugs/www/cgi',
 134                css             => '/var/lib/debbugs/www/bugs.css',
 135                bug_site        => 'bugs.debian.org',
 136                bug_mirror      => 'bugs-mirror.debian.org',
 137                );
 138
 139 my %option_defaults = (port => 8080,
 140                        debbugs_config => User->Home.'/.debbugs/debbugs_config',
 141                        mirror_location => User->Home.'/.debbugs/mirror',
 142                        bugs_to_get => User->Home.'/.debbugs/bugs_to_get',
 143                       );
 144
 145 GetOptions(\%options,
 146            'daemon|D','show|s','search|select|S','mirror|M', 'stop|exit|quit',
 147            'detach!',
 148            'css=s','cgi_bin|cgi-bin|cgi=s',
 149            'verbose|v+','quiet|q+',
 150            'bug_site|bug-site=s',
 151            'bug_mirror|bug-mirror=s',
 152            'debug|d+','help|h|?','man|m');
 153
 154 pod2usage() if $options{help};
 155 pod2usage({verbose=>2}) if $options{man};
 156
 157 $DEBUG = $options{debug};
 158
 159 my @USAGE_ERRORS;
 160 if (1 != grep {exists $options{$_}} qw(daemon show search mirror stop)) {
 161      push @USAGE_ERRORS,"You must pass one (and only one) of --daemon --show --search --mirror or --stop";
 162 }
 163 $options{verbose} = $options{verbose} - $options{quiet};
 164
 165 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 166
 167
 168 # munge in local configuration
 169
 170 local_config(\%options);
 171
 172 mkpath($options{mirror_location});
 173
 174 if ($options{daemon}) {
 175      # daemonize, do stuff
 176      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 177      if (defined $pid and $pid != 0) {
 178           print STDERR "Unable to start daemon; it's already running\n";
 179           exit 1;
 180      }
 181      if (-e $options{mirror_location}.'/local-debbugs.pid' and
 182          not defined $pid) {
 183           print STDERR "Unable to determine if daemon is running: $!\n";
 184           exit 1;
 185      }
 186      my $conf = IO::File->new($options{mirror_location}.'/debbugs_config_local','w') or
 187          die "Unable to open $options{mirror_location}/debbugs_config_local for writing: $!";
 188      print {$conf} <<"EOF";
 189 \$gConfigDir = "$options{mirror_location}";
 190 \$gSpoolDir = "$options{mirror_location}";
 191 \$gWebHost = 'localhost:$options{port}';
 192 \$gPackageSource = '';
 193 \$gPseudoDescFile = '';
 194 \$gPseudoMaintFile = '';
 195 \$gMaintainerFile = '';
 196 \$gMaintainerFileOverride = '';
 197 \$config{source_maintainer_file} = '';
 198 \$config{source_maintainer_file_override} = '';
 199 \$gProject = 'Local Debbugs';
 200 1;
 201 EOF
 202      close $conf;
 203      $ENV{DEBBUGS_CONFIG_FILE} = $options{mirror_location}.'/debbugs_config_local';
 204      # ok, now lets daemonize
 205
 206      # XXX make sure that all paths have been turned into absolute
 207      # paths
 208      chdir '/' or die "Can't chdir to /: $!";
 209      # allow us not to detach for debugging
 210      if ($options{detach}) {
 211           open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
 212           open STDOUT, '>/dev/null'
 213                or die "Can't write to /dev/null: $!";
 214           defined(my $pid = fork) or die "Can't fork: $!";
 215           exit if $pid;
 216           setsid or die "Can't start a new session: $!";
 217           open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
 218      }
 219      lockpid($options{mirror_location}.'/local-debbugs.pid') or
 220           die "Unable to deal with the pidfile";
 221      # this is the subclass of HTTP::Server::Simple::CGI which handles
 222      # the "hard" bits of actually running a tiny webserver for us
 223      {
 224           package local_debbugs::server;
 225           use IO::File;
 226           use HTTP::Server::Simple;
 227           use base qw(HTTP::Server::Simple::CGI);
 228
 229           sub net_server {
 230                return 'Net::Server::Fork';
 231           }
 232
 233           sub redirect {
 234                my ($cgi,$url) = @_;
 235                print "HTTP/1.1 302 Found\r\n";
 236                print "Location: $url\r\n";
 237           }
 238
 239           # here we want to call cgi-bin/pkgreport or cgi-bin/bugreport
 240           sub handle_request {
 241                my ($self,$cgi) = @_;
 242
 243                $ENV{DEBBUGS_CONFIG_FILE} = $options{mirror_location}.'/debbugs_config_local';
 244                my $base_uri = 'http://'.$cgi->virtual_host;
 245                if ($cgi->virtual_port ne 80) {
 246                     $base_uri .= ':'.$cgi->virtual_port;
 247                }
 248                my $path = $cgi->path_info();
 249                # RewriteRule ^/[[:space:]]*#?([[:digit:]][[:digit:]][[:digit:]]+)([;&].+)?$ /cgi-bin/bugreport.cgi?bug=$1$2 [L,R,NE]
 250                if ($path =~ m{^/?\s*\#?(\d+)((?:[;&].+)?)$}) {
 251                     redirect($cgi,$base_uri."/cgi-bin/bugreport.cgi?bug=$1$2");
 252                }
 253                # RewriteRule ^/[Ff][Rr][Oo][Mm]:([^/]+\@.+)$ /cgi-bin/pkgreport.cgi?submitter=$1 [L,R,NE]
 254                elsif ($path =~ m{^/?\s*from:([^/]+\@.+)$}i) {
 255                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?submitter=$1");
 256                }
 257                # RewriteRule ^/([^/]+\@.+)$ /cgi-bin/pkgreport.cgi?maint=$1 [L,R,NE]
 258                elsif ($path =~ m{^/?\s*([^/]+\@.+)$}i) {
 259                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?maint=$1");
 260                }
 261                # RewriteRule ^/mbox:([[:digit:]][[:digit:]][[:digit:]]+)([;&].+)?$ /cgi-bin/bugreport.cgi?mbox=yes&bug=$1$2 [L,R,NE]
 262                elsif ($path =~ m{^/?\s*mbox:\#?(\d+)((?:[;&].+)?)$}i) {
 263                     redirect($cgi,$base_uri."/cgi-bin/bugreport.cgi?mbox=yes;bug=$1$2");
 264                }
 265                # RewriteRule ^/src:([^/]+)$ /cgi-bin/pkgreport.cgi?src=$1 [L,R,NE]
 266                elsif ($path =~ m{^/?src:([^/]+)$}i) {
 267                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?src=$1");
 268                }
 269                # RewriteRule ^/severity:([^/]+)$ /cgi-bin/pkgreport.cgi?severity=$1 [L,R,NE]
 270                elsif ($path =~ m{^/?severity:([^/]+)$}i) {
 271                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?severity=$1");
 272                }
 273                # RewriteRule ^/tag:([^/]+)$ /cgi-bin/pkgreport.cgi?tag=$1 [L,R,NE]
 274                elsif ($path =~ m{^/?tag:([^/]+)$}i) {
 275                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?tag=$1");
 276                }
 277                # RewriteRule ^/([^/]+)$ /cgi-bin/pkgreport.cgi?pkg=$1 [L,R,NE]
 278                elsif ($path =~ m{^/?([^/]+)$}i) {
 279                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?pkg=$1");
 280                }
 281                elsif ($path =~ m{^/?cgi(?:-bin)?/((?:(?:bug|pkg)report|version)\.cgi)}) {
 282                     # dispatch to pkgreport.cgi
 283                     print "HTTP/1.1 200 OK\n";
 284                     exec("$options{cgi_bin}/$1") or
 285                          die "Unable to execute $options{cgi_bin}/$1";
 286                }
 287                elsif ($path =~ m{^/?css/bugs.css}) {
 288                     my $fh = IO::File->new($options{css},'r') or
 289                          die "Unable to open $options{css} for reading: $!";
 290                     print "HTTP/1.1 200 OK\n";
 291                     print "Content-type: text/css\n";
 292                     print "\n";
 293                     print <$fh>;
 294                }
 295                elsif ($path =~ m{^/?$}) {
 296                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?package=put%20package%20here");
 297                }
 298                else {
 299                     print "HTTP/1.1 404 Not Found\n";
 300                     print "Content-Type: text/html\n";
 301                     print "\n";
 302                     print "<h1>That which you were seeking, found I have not.</h1>\n";
 303                }
 304                # RewriteRule ^/$ /Bugs/ [L,R,NE]
 305           }
 306      }
 307      my $debbugs_server = local_debbugs::server->new($options{port}) or
 308           die "Unable to create debbugs server";
 309      $debbugs_server->run() or
 310           die 'Unable to run debbugs server';
 311 }
 312 elsif ($options{stop}) {
 313      # stop the daemon
 314      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 315      if (not defined $pid or $pid == 0) {
 316           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 317           exit 1;
 318      }
 319      exit !(kill(15,$pid) == 1);
 320 }
 321 elsif ($options{mirror}) {
 322      # run the mirror jobies
 323      # figure out which bugs we need
 324      my $bugs = select_bugs(\%options);
 325      # get them
 326      my $tempdir = tempdir();#CLEANUP => 1);
 327      my $mirror_log = IO::File->new($options{mirror_location}.'/mirror.log','>') or
 328           die "Unable to open $options{mirror_location}/mirror.log for writing: $!";
 329      write_bug_list("$tempdir/unarchived_bug_list",$bugs->{unarchived});
 330      write_bug_list("$tempdir/archived_bug_list",$bugs->{archived});
 331      my ($wrf,$rfh,$efh);
 332      my @common_rsync_options = ('-avz','--partial');
 333      print "Rsyncing bugs\n" if not $options{quiet};
 334      run_rsync(log => $mirror_log,
 335                ($options{debug}?(debug => \*STDERR):()),
 336                options => [@common_rsync_options,
 337                            '--delete-after',
 338                            '--files-from',"$tempdir/unarchived_bug_list",
 339                            'rsync://'.$options{bug_mirror}.'/bts-spool-db/',
 340                            $options{mirror_location}.'/db-h/']
 341               );
 342      print "Rsyncing archived bugs\n" if $options{verbose};
 343      run_rsync(log => $mirror_log,
 344                ($options{debug}?(debug => \*STDERR):()),
 345                options => [@common_rsync_options,
 346                            '--delete-after',
 347                            '--files-from',"$tempdir/archived_bug_list",
 348                            'rsync://'.$options{bug_mirror}.'/bts-spool-archive/',
 349                            $options{mirror_location}.'/archive/',
 350                           ],
 351               );
 352      print "Rsyncing indexes\n" if $options{verbose};
 353      run_rsync(log => $mirror_log,
 354                ($options{debug}?(debug => \*STDERR):()),
 355                options => [@common_rsync_options,
 356                            '--exclude','*old',
 357                            '--exclude','*.bak',
 358                            '--exclude','by-reverse*',
 359                            'rsync://'.$options{bug_mirror}.'/bts-spool-index/',
 360                            $options{mirror_location}.'/',
 361                           ],
 362               );
 363      print "Rsyncing versions\n" if $options{verbose};
 364      run_rsync(log => $mirror_log,
 365                ($options{debug}?(debug => \*STDERR):()),
 366                options => [@common_rsync_options,
 367                            '--delete-after',
 368                            '--exclude','*old',
 369                            '--exclude','*.bak',
 370                            'rsync://'.$options{bug_mirror}.'/bts-versions/',
 371                            $options{mirror_location}.'/versions/',
 372                           ],
 373               );
 374 }
 375 elsif ($options{show}) {
 376      # figure out the url
 377      # see if the daemon is running
 378      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 379      if (not defined $pid or $pid == 0) {
 380           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 381           print STDERR qq(Mr. T: "I pity da fool who tries to show a bug without a running daemon"\n);
 382           print STDERR "Hint: try the --daemon option first\n";
 383           exit 1;
 384      }
 385      # twist and shout
 386      my $url = qq(http://localhost:$options{port}/$ARGV[0]);
 387      exec('/usr/bin/sensible-browser',$url) or
 388           die "Unable to run sensible-browser (try feeding me cheetos?)";
 389 }
 390 elsif ($options{search}) {
 391      my $url = qq(http://localhost:$options{port}/cgi-bin/pkgreport.cgi?).
 392           join(';',map {if (/:/) {s/:/=/; $_;} else {qq(pkg=$_);}} @ARGV);
 393      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 394      if (not defined $pid or $pid == 0) {
 395           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 396           print STDERR qq(Mr. T: "I pity da fool who tries to search for bugs without a running daemon"\n);
 397           print STDERR "Hint: try the --daemon option first\n";
 398           exit 1;
 399      }
 400      # twist and shout
 401      exec('/usr/bin/sensible-browser',$url) or
 402           die "Unable to run sensible-browser (Maybe chorizo is required?)";
 403 }
 404 else {
 405      # you get here, you were an idiot in checking for @USAGE_ERRORS
 406      # above
 407      die "No option that we understand was passed (the first check for this is now buggy, so shoot your maintainer)"
 408 }
 409
 410
 411 # determine the local configuration
 412 sub local_config{
 413      my ($options) = @_;
 414      my $config = {};
 415      if (-e '/etc/debbugs/local_debbugs.conf') {
 416           Config::Simple->import_from('/etc/debbugs/local_debbugs.conf', $config) or
 417                     die "Unable to read configuration from /etc/debbugs/local_debbugs.conf: $!";
 418      }
 419      if (-e User->Home.'/.debbugs/local_debbugs.conf') {
 420           Config::Simple->import_from(User->Home.'/.debbugs/local_debbugs.conf', $config) or
 421                     die "Unable to read configuration from ".User->Home.'/.debbugs/local_debbugs.conf: '.$!;
 422      }
 423      for (keys %option_defaults) {
 424           if (exists $config->{$_} and not defined $options->{$_}) {
 425                $options->{$_} = $config->{$_};
 426           }
 427           if (not defined $options->{$_}) {
 428                $options->{$_} = $option_defaults{$_};
 429           }
 430      }
 431 }
 432
 433 sub write_bug_list {
 434     my ($file,$bug_list) = @_;
 435     my $inc_fh = IO::File->new($file,'w') or
 436         die "Unable to open $file for writing: $!";
 437     foreach my $bug (keys %{$bug_list}) {
 438         my $file_loc = get_hashname($bug).'/'.$bug;
 439         print {$inc_fh} map {$file_loc.'.'.$_.qq(\n)} qw(log summary report status) or
 440             die "Unable to write to $file: $!";
 441     }
 442     close $inc_fh or
 443         die "Unable to close $file: $!";
 444 }
 445
 446 # actually run rsync with the passed options
 447 sub run_rsync{
 448      my %param = validate_with(params => \@_,
 449                                spec   => {log => {type => HANDLE,
 450                                                  },
 451                                           debug => {type => HANDLE,
 452                                                     optional => 1,
 453                                                    },
 454                                           options => {type => ARRAYREF,
 455                                                      },
 456                                          }
 457                               );
 458      my ($output,$error) = ('','');
 459      my $h = IPC::Run::start(['rsync',@{$param{options}}],
 460                              \undef,$param{log},$param{log});
 461      while ($h->pump) {
 462          #print {$param{debug}} $error if defined $param{debug};
 463      }
 464      $h->finish();
 465      my $exit = $h->result(0);
 466      # this is suboptimal, but we currently don't know whether we've
 467      # selected an archive or unarchived bug, so..
 468      if (defined $exit and not ($exit == 0 or $exit == 3 or $exit == 23)) {
 469          print STDERR "Rsync exited with non-zero status: $exit\n";
 470      }
 471 }
 472
 473
 474
 475 # select a set of bugs
 476 sub select_bugs{
 477      my ($options) = @_;
 478
 479      my %valid_keys = (package => 'package',
 480                        pkg     => 'package',
 481                        src     => 'src',
 482                        source  => 'src',
 483                        maint   => 'maint',
 484                        maintainer => 'maint',
 485                        submitter => 'submitter',
 486                        from => 'submitter',
 487                        status    => 'status',
 488                        tag       => 'tag',
 489                        tags      => 'tag',
 490                        usertag   => 'tag',
 491                        usertags  => 'tag',
 492                        owner     => 'owner',
 493                        dist      => 'dist',
 494                        distribution => 'dist',
 495                        bugs       => 'bugs',
 496                        archive    => 'archive',
 497                        severity   => 'severity',
 498                        correspondent => 'correspondent',
 499                        affects       => 'affects',
 500                       );
 501
 502      my $soap = SOAP::Lite
 503           -> uri('Debbugs/SOAP/V1')
 504                -> proxy("http://$options{bug_site}/cgi-bin/soap.cgi");
 505      my @bugs;
 506      my @bug_selections = ();
 507      if (not -e $options{bugs_to_get}) {
 508           my ($addr) = get_addresses(exists $ENV{DEBEMAIL}?
 509                                      $ENV{DEBEMAIL} :
 510                                      (User->Login . '@' . qx(hostname --fqdn)));
 511           # by default include bugs talked to by this user packages
 512           # maintained by this user, submitted by this user, and rc
 513           # bugs
 514           push @bug_selections,
 515                ("correspondent:$addr archive:0",
 516                 "maint:$addr archive:0",
 517                 "submitter:$addr archive:0",
 518                 "severity:serious severity:grave severity:critical archive:0",
 519                );
 520      }
 521      else {
 522           my $btg_fh = IO::File->new($options{bugs_to_get},'r') or
 523                die "unable to open bugs to get file '$options{bugs_to_get}' for reading: $!";
 524           while (<$btg_fh>) {
 525                chomp;
 526                next if /^\s*#/;
 527                if (/^\d+$/) {
 528                     push @bugs,$_;
 529                }
 530                elsif (/\s\w+\:/) {
 531                     push @bug_selections, $_;
 532                }
 533           }
 534      }
 535      # Split archive:both into archive:1 and archive:0
 536      @bug_selections =
 537          map {
 538              if (m/archive:both/) {
 539                  my $y_archive = $_;
 540                  my $n_archive = $_;
 541                  $y_archive =~ s/archive:both/archive:1/;
 542                  $n_archive =~ s/archive:both/archive:0/;
 543                  ($y_archive,$n_archive);
 544              }
 545              else {
 546                  $_;
 547              }
 548          } @bug_selections;
 549      my %bugs;
 550      for my $selection (@bug_selections) {
 551          my $archived_bugs = "unarchived";
 552          if ($selection =~ /archive:(\S+)/ and $1) {
 553              $archived_bugs = "archived";
 554          }
 555          my @subselects = split /\s+/,$selection;
 556          my %search_parameters;
 557          my %users;
 558          for my $subselect (@subselects) {
 559              my ($key,$value) = split /:/, $subselect, 2;
 560              next unless $key;
 561              if (exists $valid_keys{$key}) {
 562                  push @{$search_parameters{$valid_keys{$key}}},
 563                      $value if $value;
 564              } elsif ($key =~/users?$/) {
 565                  $users{$value} = 1 if $value;
 566              }
 567          }
 568          my %usertags;
 569          for my $user (keys %users) {
 570              my $ut = $soap->get_usertag($user)->result();
 571              next unless defined $ut and $ut ne "";
 572              for my $tag (keys %{$ut}) {
 573                  push @{$usertags{$tag}},
 574                      @{$ut->{$tag}};
 575              }
 576          }
 577          my $bugs = $soap->get_bugs(%search_parameters,
 578                                     (keys %usertags)?(usertags=>\%usertags):()
 579                                    )->result();
 580          if (defined $bugs and @{$bugs}) {
 581              $bugs{$archived_bugs}{$_} = 1 for @{$bugs};
 582          }
 583      }
 584      return \%bugs;
 585 }
 586
 587
 588 __END__