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',
 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 or --mirror";
 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      # ok, now lets daemonize
 187
 188      # XXX make sure that all paths have been turned into absolute
 189      # paths
 190      chdir '/' or die "Can't chdir to /: $!";
 191      # allow us not to detach for debugging
 192      if ($options{detach}) {
 193           open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
 194           open STDOUT, '>/dev/null'
 195                or die "Can't write to /dev/null: $!";
 196           defined(my $pid = fork) or die "Can't fork: $!";
 197           exit if $pid;
 198           setsid or die "Can't start a new session: $!";
 199           open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
 200      }
 201      lockpid($options{mirror_location}.'/local-debbugs.pid') or
 202           die "Unable to deal with the pidfile";
 203      # this is the subclass of HTTP::Server::Simple::CGI which handles
 204      # the "hard" bits of actually running a tiny webserver for us
 205      {
 206           package local_debbugs::server;
 207           use IO::File;
 208           use HTTP::Server::Simple;
 209           use base qw(HTTP::Server::Simple::CGI);
 210
 211           sub net_server {
 212                return 'Net::Server::Fork';
 213           }
 214
 215           sub redirect {
 216                my ($cgi,$url) = @_;
 217                print "HTTP/1.1 302 Found\r\n";
 218                print "Location: $url\r\n";
 219           }
 220
 221           # here we want to call cgi-bin/pkgreport or cgi-bin/bugreport
 222           sub handle_request {
 223                my ($self,$cgi) = @_;
 224
 225                my $base_uri = 'http://'.$cgi->virtual_host;
 226                if ($cgi->virtual_port ne 80) {
 227                     $base_uri .= ':'.$cgi->virtual_port;
 228                }
 229                my $path = $cgi->path_info();
 230                # RewriteRule ^/[[:space:]]*#?([[:digit:]][[:digit:]][[:digit:]]+)([;&].+)?$ /cgi-bin/bugreport.cgi?bug=$1$2 [L,R,NE]
 231                if ($path =~ m{^/?\s*\#?(\d+)((?:[;&].+)?)$}) {
 232                     redirect($cgi,$base_uri."/cgi-bin/bugreport.cgi?bug=$1$2");
 233                }
 234                # RewriteRule ^/[Ff][Rr][Oo][Mm]:([^/]+\@.+)$ /cgi-bin/pkgreport.cgi?submitter=$1 [L,R,NE]
 235                elsif ($path =~ m{^/?\s*from:([^/]+\@.+)$}i) {
 236                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?submitter=$1");
 237                }
 238                # RewriteRule ^/([^/]+\@.+)$ /cgi-bin/pkgreport.cgi?maint=$1 [L,R,NE]
 239                elsif ($path =~ m{^/?\s*([^/]+\@.+)$}i) {
 240                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?maint=$1");
 241                }
 242                # RewriteRule ^/mbox:([[:digit:]][[:digit:]][[:digit:]]+)([;&].+)?$ /cgi-bin/bugreport.cgi?mbox=yes&bug=$1$2 [L,R,NE]
 243                elsif ($path =~ m{^/?\s*mbox:\#?(\d+)((?:[;&].+)?)$}i) {
 244                     redirect($cgi,$base_uri."/cgi-bin/bugreport.cgi?mbox=yes;bug=$1$2");
 245                }
 246                # RewriteRule ^/src:([^/]+)$ /cgi-bin/pkgreport.cgi?src=$1 [L,R,NE]
 247                elsif ($path =~ m{^/?src:([^/]+)$}i) {
 248                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?src=$1");
 249                }
 250                # RewriteRule ^/severity:([^/]+)$ /cgi-bin/pkgreport.cgi?severity=$1 [L,R,NE]
 251                elsif ($path =~ m{^/?severity:([^/]+)$}i) {
 252                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?severity=$1");
 253                }
 254                # RewriteRule ^/tag:([^/]+)$ /cgi-bin/pkgreport.cgi?tag=$1 [L,R,NE]
 255                elsif ($path =~ m{^/?tag:([^/]+)$}i) {
 256                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?tag=$1");
 257                }
 258                # RewriteRule ^/([^/]+)$ /cgi-bin/pkgreport.cgi?pkg=$1 [L,R,NE]
 259                elsif ($path =~ m{^/?([^/]+)$}i) {
 260                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?pkg=$1");
 261                }
 262                elsif ($path =~ m{^/?cgi(?:-bin)?/((?:(?:bug|pkg)report|version)\.cgi)}) {
 263                     # dispatch to pkgreport.cgi
 264                     print "HTTP/1.1 200 OK\n";
 265                     exec("$options{cgi_bin}/$1") or
 266                          die "Unable to execute $options{cgi_bin}/$1";
 267                }
 268                elsif ($path =~ m{^/?css/bugs.css}) {
 269                     my $fh = IO::File->new($options{css},'r') or
 270                          die "Unable to open $options{css} for reading: $!";
 271                     print "HTTP/1.1 200 OK\n";
 272                     print "Content-type: text/css\n";
 273                     print "\n";
 274                     print <$fh>;
 275                }
 276                elsif ($path =~ m{^/?$}) {
 277                     redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?package=put%20package%20here");
 278                }
 279                else {
 280                     print "HTTP/1.1 404 Not Found\n";
 281                     print "Content-Type: text/html\n";
 282                     print "\n";
 283                     print "<h1>That which you were seeking, found I have not.</h1>\n";
 284                }
 285                # RewriteRule ^/$ /Bugs/ [L,R,NE]
 286           }
 287      }
 288      my $debbugs_server = local_debbugs::server->new($options{port}) or
 289           die "Unable to create debbugs server";
 290      $debbugs_server->run() or
 291           die 'Unable to run debbugs server';
 292 }
 293 elsif ($options{stop}) {
 294      # stop the daemon
 295      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 296      if (not defined $pid or $pid == 0) {
 297           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 298           exit 1;
 299      }
 300      exit !(kill(15,$pid) == 1);
 301 }
 302 elsif ($options{mirror}) {
 303      # run the mirror jobies
 304      # figure out which bugs we need
 305      my $bugs = select_bugs(\%options);
 306      # get them
 307      my $tempdir = tempdir();#CLEANUP => 1);
 308      my $mirror_log = IO::File->new($options{mirror_location}.'/mirror.log','>') or
 309           die "Unable to open $options{mirror_location}/mirror.log for writing: $!";
 310      write_bug_list("$tempdir/unarchived_bug_list",$bugs->{unarchived});
 311      write_bug_list("$tempdir/archived_bug_list",$bugs->{archived});
 312      my ($wrf,$rfh,$efh);
 313      my @common_rsync_options = ('-avz','--partial');
 314      print "Rsyncing bugs\n" if not $options{quiet};
 315      run_rsync(log => $mirror_log,
 316                ($options{debug}?(debug => \*STDERR):()),
 317                options => [@common_rsync_options,
 318                            '--delete-after',
 319                            '--files-from',"$tempdir/unarchived_bug_list",
 320                            'rsync://'.$options{bug_mirror}.'/bts-spool-db/',
 321                            $options{mirror_location}.'/db-h/']
 322               );
 323      print "Rsyncing archived bugs\n" if $options{verbose};
 324      run_rsync(log => $mirror_log,
 325                ($options{debug}?(debug => \*STDERR):()),
 326                options => [@common_rsync_options,
 327                            '--delete-after',
 328                            '--files-from',"$tempdir/archived_bug_list",
 329                            'rsync://'.$options{bug_mirror}.'/bts-spool-archive/',
 330                            $options{mirror_location}.'/archive/',
 331                           ],
 332               );
 333      print "Rsyncing indexes\n" if $options{verbose};
 334      run_rsync(log => $mirror_log,
 335                ($options{debug}?(debug => \*STDERR):()),
 336                options => [@common_rsync_options,
 337                            '--exclude','*old',
 338                            '--exclude','*.bak',
 339                            '--exclude','by-reverse*',
 340                            'rsync://'.$options{bug_mirror}.'/bts-spool-index/',
 341                            $options{mirror_location}.'/',
 342                           ],
 343               );
 344      print "Rsyncing versions\n" if $options{verbose};
 345      run_rsync(log => $mirror_log,
 346                ($options{debug}?(debug => \*STDERR):()),
 347                options => [@common_rsync_options,
 348                            '--delete-after',
 349                            '--exclude','*old',
 350                            '--exclude','*.bak',
 351                            'rsync://'.$options{bug_mirror}.'/bts-versions/',
 352                            $options{mirror_location}.'/versions/',
 353                           ],
 354               );
 355 }
 356 elsif ($options{show}) {
 357      # figure out the url
 358      # see if the daemon is running
 359      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 360      if (not defined $pid or $pid == 0) {
 361           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 362           print STDERR qq(Mr. T: "I pity da fool who tries to show a bug without a running daemon"\n);
 363           print STDERR "Hint: try the --daemon option first\n";
 364           exit 1;
 365      }
 366      # twist and shout
 367      my $url = qq(http://localhost:$options{port}/$ARGV[0]);
 368      exec('/usr/bin/sensible-browser',$url) or
 369           die "Unable to run sensible-browser (try feeding me cheetos?)";
 370 }
 371 elsif ($options{search}) {
 372      my $url = qq(http://localhost:$options{port}/cgi-bin/pkgreport.cgi?).
 373           join(';',map {if (/:/) {s/:/=/; $_;} else {qq(pkg=$_);}} @ARGV);
 374      my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
 375      if (not defined $pid or $pid == 0) {
 376           print STDERR "Unable to open pidfile or daemon not running: $!\n";
 377           print STDERR qq(Mr. T: "I pity da fool who tries to search for bugs without a running daemon"\n);
 378           print STDERR "Hint: try the --daemon option first\n";
 379           exit 1;
 380      }
 381      # twist and shout
 382      exec('/usr/bin/sensible-browser',$url) or
 383           die "Unable to run sensible-browser (Maybe chorizo is required?)";
 384 }
 385 else {
 386      # you get here, you were an idiot in checking for @USAGE_ERRORS
 387      # above
 388      die "No option that we understand was passed (the first check for this is now buggy, so shoot your maintainer)"
 389 }
 390
 391
 392 # determine the local configuration
 393 sub local_config{
 394      my ($options) = @_;
 395      my $config = {};
 396      if (-e '/etc/debbugs/local_debbugs.conf') {
 397           Config::Simple->import_from('/etc/debbugs/local_debbugs.conf', $config) or
 398                     die "Unable to read configuration from /etc/debbugs/local_debbugs.conf: $!";
 399      }
 400      if (-e User->Home.'/.debbugs/local_debbugs.conf') {
 401           Config::Simple->import_from(User->Home.'/.debbugs/local_debbugs.conf', $config) or
 402                     die "Unable to read configuration from ".User->Home.'/.debbugs/local_debbugs.conf: '.$!;
 403      }
 404      for (keys %option_defaults) {
 405           if (exists $config->{$_} and not defined $options->{$_}) {
 406                $options->{$_} = $config->{$_};
 407           }
 408           if (not defined $options->{$_}) {
 409                $options->{$_} = $option_defaults{$_};
 410           }
 411      }
 412 }
 413
 414 sub write_bug_list {
 415     my ($file,$bug_list) = @_;
 416     my $inc_fh = IO::File->new($file,'w') or
 417         die "Unable to open $file for writing: $!";
 418     foreach my $bug (keys %{$bug_list}) {
 419         my $file_loc = get_hashname($bug).'/'.$bug;
 420         print {$inc_fh} map {$file_loc.'.'.$_.qq(\n)} qw(log summary report status) or
 421             die "Unable to write to $file: $!";
 422     }
 423     close $inc_fh or
 424         die "Unable to close $file: $!";
 425 }
 426
 427 # actually run rsync with the passed options
 428 sub run_rsync{
 429      my %param = validate_with(params => \@_,
 430                                spec   => {log => {type => HANDLE,
 431                                                  },
 432                                           debug => {type => HANDLE,
 433                                                     optional => 1,
 434                                                    },
 435                                           options => {type => ARRAYREF,
 436                                                      },
 437                                          }
 438                               );
 439      my ($output,$error) = ('','');
 440      my $h = IPC::Run::start(['rsync',@{$param{options}}],
 441                              \undef,$param{log},$param{log});
 442      while ($h->pump) {
 443          #print {$param{debug}} $error if defined $param{debug};
 444      }
 445      $h->finish();
 446      my $exit = $h->result(0);
 447      # this is suboptimal, but we currently don't know whether we've
 448      # selected an archive or unarchived bug, so..
 449      if (defined $exit and not ($exit == 0 or $exit == 3 or $exit == 23)) {
 450          print STDERR "Rsync exited with non-zero status: $exit\n";
 451      }
 452 }
 453
 454
 455
 456 # select a set of bugs
 457 sub select_bugs{
 458      my ($options) = @_;
 459
 460      my %valid_keys = (package => 'package',
 461                        pkg     => 'package',
 462                        src     => 'src',
 463                        source  => 'src',
 464                        maint   => 'maint',
 465                        maintainer => 'maint',
 466                        submitter => 'submitter',
 467                        from => 'submitter',
 468                        status    => 'status',
 469                        tag       => 'tag',
 470                        tags      => 'tag',
 471                        usertag   => 'tag',
 472                        usertags  => 'tag',
 473                        owner     => 'owner',
 474                        dist      => 'dist',
 475                        distribution => 'dist',
 476                        bugs       => 'bugs',
 477                        archive    => 'archive',
 478                        severity   => 'severity',
 479                        correspondent => 'correspondent',
 480                        affects       => 'affects',
 481                       );
 482
 483      my $soap = SOAP::Lite
 484           -> uri('Debbugs/SOAP/V1')
 485                -> proxy("http://$options{bug_site}/cgi-bin/soap.cgi");
 486      my @bugs;
 487      my @bug_selections = ();
 488      if (not -e $options{bugs_to_get}) {
 489           my ($addr) = get_addresses(exists $ENV{DEBEMAIL}?
 490                                      $ENV{DEBEMAIL} :
 491                                      (User->Login . '@' . qx(hostname --fqdn)));
 492           # by default include bugs talked to by this user packages
 493           # maintained by this user, submitted by this user, and rc
 494           # bugs
 495           push @bug_selections,
 496                ("correspondent:$addr archive:0",
 497                 "maint:$addr archive:0",
 498                 "submitter:$addr archive:0",
 499                 "severity:serious severity:grave severity:critical archive:0",
 500                );
 501      }
 502      else {
 503           my $btg_fh = IO::File->new($options{bugs_to_get},'r') or
 504                die "unable to open bugs to get file '$options{bugs_to_get}' for reading: $!";
 505           while (<$btg_fh>) {
 506                chomp;
 507                next if /^\s*#/;
 508                if (/^\d+$/) {
 509                     push @bugs,$_;
 510                }
 511                elsif (/\s\w+\:/) {
 512                     push @bug_selections, $_;
 513                }
 514           }
 515      }
 516      # Split archive:both into archive:1 and archive:0
 517      @bug_selections =
 518          map {
 519              if (m/archive:both/) {
 520                  my $y_archive = $_;
 521                  my $n_archive = $_;
 522                  $y_archive =~ s/archive:both/archive:1/;
 523                  $n_archive =~ s/archive:both/archive:0/;
 524                  ($y_archive,$n_archive);
 525              }
 526              else {
 527                  $_;
 528              }
 529          } @bug_selections;
 530      my %bugs;
 531      for my $selection (@bug_selections) {
 532          my $archived_bugs = "unarchived";
 533          if ($selection =~ /archive:(\S+)/ and $1) {
 534              $archived_bugs = "archived";
 535          }
 536          my @subselects = split /\s+/,$selection;
 537          my %search_parameters;
 538          my %users;
 539          for my $subselect (@subselects) {
 540              my ($key,$value) = split /:/, $subselect, 2;
 541              next unless $key;
 542              if (exists $valid_keys{$key}) {
 543                  push @{$search_parameters{$valid_keys{$key}}},
 544                      $value if $value;
 545              } elsif ($key =~/users?$/) {
 546                  $users{$value} = 1 if $value;
 547              }
 548          }
 549          my %usertags;
 550          for my $user (keys %users) {
 551              my $ut = $soap->get_usertag($user)->result();
 552              next unless defined $ut and $ut ne "";
 553              for my $tag (keys %{$ut}) {
 554                  push @{$usertags{$tag}},
 555                      @{$ut->{$tag}};
 556              }
 557          }
 558          my $bugs = $soap->get_bugs(%search_parameters,
 559                                     (keys %usertags)?(usertags=>\%usertags):()
 560                                    )->result();
 561          if (defined $bugs and @{$bugs}) {
 562              $bugs{$archived_bugs}{$_} = 1 for @{$bugs};
 563          }
 564      }
 565      return \%bugs;
 566 }
 567
 568
 569 __END__