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
  93 my %options = (debug           => 0,
  94                help            => 0,
  95                man             => 0,
  96                verbose         => 0,
  97                quiet           => 0,
  98                );
  99
 100 my %option_defaults = (port => 8080,
 101                        debbugs_config => User->Home.'/.debbugs/debbugs_config',
 102                        mirror_location => User->Home.'/.debbugs/mirror/',
 103                        bugs_to_get => User->Home.'/.debbugs/bugs_to_get',
 104                       );
 105
 106 GetOptions(\%options,
 107            'daemon|D','show|s','search|select|S','mirror|M',
 108            'verbose|v+','quiet|q+',
 109            'debug|d+','help|h|?','man|m');
 110
 111 pod2usage() if $options{help};
 112 pod2usage({verbose=>2}) if $options{man};
 113
 114 $DEBUG = $options{debug};
 115
 116 my @USAGE_ERRORS;
 117 if (1 != scalar @options{qw(daemon show search mirror)}) {
 118      push @USAGE_ERRORS,"You must pass one (and only one) of --daemon --show --search or --mirror";
 119 }
 120 $options{verbose} = $options{verbose} - $options{quiet};
 121
 122 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 123
 124
 125 # munge in local configuration
 126
 127 local_config(\%options);
 128
 129 if ($options{daemon}) {
 130      # daemonize, do stuff
 131 }
 132 elsif ($options{mirror}) {
 133      # run the mirror jobies
 134      # figure out which bugs we need
 135      my @bugs = select_bugs(\%options);
 136      # get them
 137      my $tempdir = tempdir(CLEANUP => 1);
 138      my $mirror_log = IO::File->new($options{mirror_location}.'/mirror.log') or
 139           die "Unable to open $options{mirror_location}/mirror.log for writing: $!";
 140      my $inc_fh = IO::File->new("$tempdir/include_list",'w') or
 141           die "Unable to open $tempdir/include_list for writing: $!";
 142      foreach my $bug (@bugs) {
 143           print {$inc_fh} "*/${bug}.*\n" or
 144                die "Unable to write to $tempdir/include_list: $!";
 145      }
 146      close $inc_fh or
 147           die "Unable to close $tempdir/include_list: $!";
 148      my ($wrf,$rfh);
 149      my @common_rsync_options = ('-avz','--partial');
 150      print "Rsyncing bugs\n" if not $options{quiet};
 151      run_rsync(log => $mirror_log,
 152                ($options{debug}?(debug => \*STDERR):()),
 153                options => [@common_rsync_options,
 154                            '--delete-after',
 155                            '--include-from',"$tempdir/include_list",
 156                            # skip things not specifically included
 157                            '--exclude','*/*',
 158                            # skip the -1,-2,-3.log files
 159                            '--exclude','*.log',
 160                            'rsync://'.$options{bug_mirror}.'/bts-spool-db/',
 161                            $options{mirror_location}.'/db-h/']
 162               );
 163      print "Rsyncing archived bugs\n" if $options{verbose};
 164      run_rsync(log => $mirror_log,
 165                ($options{debug}?(debug => \*STDERR):()),
 166                options => [@common_rsync_options,
 167                            '--delete-after',
 168                            '--include-from',"$tempdir/include_list",
 169                            # skip things not specifically included
 170                            '--exclude','*/*',
 171                            # skip the -1,-2,-3.log files
 172                            '--exclude','*.log',
 173                            'rsync://'.$options{bug_mirror}.'/bts-spool-archive/',
 174                            $options{mirror_location}.'/archive/',
 175                           ],
 176               );
 177      print "Rsyncing indexes\n" if $options{verbose};
 178      run_rsync(log => $mirror_log,
 179                ($options{debug}?(debug => \*STDERR):()),
 180                options => [@common_rsync_options,
 181                            '--exclude','*old',
 182                            '--exclude','*.bak',
 183                            'rsync://'.$options{bug_mirror}.'/bts-spool-index/',
 184                            $options{mirror_location}.'/',
 185                           ],
 186               );
 187      print "Rsyncing versions\n" if $options{verbose};
 188      run_rsync(log => $mirror_log,
 189                ($options{debug}?(debug => \*STDERR):()),
 190                options => [@common_rsync_options,
 191                            '--delete-after',
 192                            '--exclude','*old',
 193                            '--exclude','*.bak',
 194                            'rsync://'.$options{bug_mirror}.'/bts-spool-versions/',
 195                            $options{mirror_location}.'/versions/',
 196                           ],
 197               );
 198 }
 199 elsif ($options{show}) {
 200
 201 }
 202 elsif ($options{search}) {
 203 }
 204 else {
 205      # you get here, you were an idiot in checking for @USAGE_ERRORS
 206      # above
 207      die "No option that we understand was passed (the first check for this is now buggy, so shoot your maintainer)"
 208 }
 209
 210
 211 # determine the local configuration
 212 sub local_config{
 213      my ($options) = @_;
 214      my $config = {};
 215      if (-e '/etc/debbugs/local_debbugs.conf') {
 216           Config::Simple->import_from('/etc/debbugs/local_debbugs.conf', $config) or
 217                     die "Unable to read configuration from /etc/debbugs/local_debbugs.conf: $!";
 218      }
 219      if (-e User->Home.'/.debbugs/local_debbugs.conf') {
 220           Config::Simple->import_from(User->Home.'/.debbugs/local_debbugs.conf', $config) or
 221                     die "Unable to read configuration from ".User->Home.'/.debbugs/local_debbugs.conf: '.$!;
 222      }
 223      for (keys %option_defaults) {
 224           if (exists $config->{$_} and not defined $options->{$_}) {
 225                $options->{$_} = $config->{$_};
 226           }
 227           if (not defined $options->{$_}) {
 228                $options->{$_} = $option_defaults{$_};
 229           }
 230      }
 231 }
 232
 233 # actually run rsync with the passed options
 234 sub run_rsync{
 235      my %param = validate_with(params => \@_,
 236                                spec   => {log => {type => HANDLE,
 237                                                  },
 238                                           debug => {type => HANDLE,
 239                                                     optional => 1,
 240                                                    },
 241                                           options => {type => ARRAYREF,
 242                                                      },
 243                                          }
 244                               );
 245      my ($output_fh,@rsync_options) = @_;
 246      my ($wfh,$rfh);
 247      my $pid = open3($wfh,$rfh,
 248                      'rsync',
 249                      @{$param{options}}
 250                     ) or die "Unable to start rsync: $!";
 251      close $wfh or die "Unable to close the writer filehandle $?";
 252      while (<$rfh>) {
 253           print {$param{log}} $_;
 254           if (exists $param{debug}) {
 255                print {$param{debug}} $_;
 256           }
 257      }
 258 }
 259
 260
 261
 262 # select a set of bugs
 263 sub select_bugs{
 264      my ($options) = @_;
 265
 266      my %valid_keys = (package => 'package',
 267                        pkg     => 'package',
 268                        src     => 'src',
 269                        source  => 'src',
 270                        maint   => 'maint',
 271                        maintainer => 'maint',
 272                        submitter => 'submitter',
 273                        from => 'submitter',
 274                        status    => 'status',
 275                        tag       => 'tag',
 276                        tags      => 'tag',
 277                        usertag   => 'tag',
 278                        usertags  => 'tag',
 279                        owner     => 'owner',
 280                        dist      => 'dist',
 281                        distribution => 'dist',
 282                        bugs       => 'bugs',
 283                        archive    => 'archive',
 284                        severity   => 'severity',
 285                        correspondent => 'correspondent',
 286                        affects       => 'affects',
 287                       );
 288
 289      my $soap = SOAP::Lite
 290           -> uri('Debbugs/SOAP/V1')
 291                -> proxy("http://$options{bug_mirror}/cgi-bin/soap.cgi");
 292      my @bugs;
 293      my @bug_selections = ();
 294      if (not -e $options{bugs_to_get}) {
 295           my ($addr) = get_addresses(exists $ENV{DEBEMAIL}?
 296                                      $ENV{DEBEMAIL} :
 297                                      (User->Login . '@' . qx(hostname --fqdn)));
 298           # by default include bugs talked to by this user packages
 299           # maintained by this user, submitted by this user, and rc
 300           # bugs
 301           push @bug_selections,
 302                ("correspondent:$addr archive:both",
 303                 "maint:$addr archive:both",
 304                 "submitter:$addr archive:both",
 305                 "severity:serious severity:grave severity:critical archive:both",
 306                );
 307      }
 308      else {
 309           my $btg_fh = IO::File->new($options{bugs_to_get},'r') or
 310                die "unable to open bugs to get file '$options{bugs_to_get}' for reading: $!";
 311           while (<$btg_fh>) {
 312                chomp;
 313                next if /^\s*#/;
 314                if (/^\d+$/) {
 315                     push @bugs,$_;
 316                }
 317                elsif (/\s\w+\:/) {
 318                     push @bug_selections, $_;
 319                }
 320           }
 321      }
 322      for my $selection (@bug_selections) {
 323           my @subselects = split /\s+/,$selection;
 324           my %search_parameters;
 325           my %users;
 326           for my $subselect (@subselects) {
 327                my ($key,$value) = split /:/, $subselect, 2;
 328                next unless $key;
 329                if (exists $valid_keys{$key}) {
 330                     push @{$search_parameters{$valid_keys{$key}}},
 331                          $value if $value;
 332                } elsif ($key =~/users?$/) {
 333                     $users{$value} = 1 if $value;
 334                }
 335           }
 336           my %usertags;
 337           for my $user (keys %users) {
 338                my $ut = $soap->get_usertag($user)->result();
 339                next unless defined $ut and $ut ne "";
 340                for my $tag (keys %{$ut}) {
 341                     push @{$usertags{$tag}},
 342                          @{$ut->{$tag}};
 343                }
 344           }
 345           my $bugs = $soap->get_bugs(%search_parameters,
 346                                      (keys %usertags)?(usertags=>\%usertags):()
 347                                     )->result();
 348           push @bugs,@{$bugs} if defined $bugs and @{$bugs};
 349      }
 350      return @bugs;
 351 }
 352
 353
 354 __END__