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