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