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