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>.
11 use Getopt::Long qw(:config no_ignore_case);
16 local-debbugs - use a local mirror of debbugs
23 --mirror, -M update local mirror
24 --daemon, -D start the daemon
25 --search, -S run a search
27 --debug, -d debugging level (Default 0)
28 --help, -h display this help
29 --man, -m display manual
37 Update the local mirror of debbugs bugs
41 Start up the daemon on the configured local port to serve bugs which
42 have been previously retrieved.
46 Cause the running daemon to show the pkgreport.cgi page corresponding
47 to the search by invoking sensible-browser and an appropriate url.
51 Cause the running daemon to show the bugreport.cgi page corresponding
52 to the bug by invoking sensible-browser and an appropriate url.
56 The port that the daemon is running on (or will be running on.)
58 Defaults to the value of the currently running daemon, the value in
59 the configuration file, or 8080 if nothing is set.
61 =item B<--bugs-to-get>
63 File which contains the set of bugs to get.
64 Defaults to ~/.debbugs/bugs_to_get
68 Hostname for a site which is running a debbugs install.
69 Defaults to bugs.debian.org
73 Hostname for a site which is running an rsyncable mirror of the
74 debbugs install above.
75 Defaults to bugs-mirror.debian.org
83 Display brief useage information.
95 =item Update the local mirror
97 local-debbugs --mirror
99 =item Start up the local-debbugs daemon
101 local-debbugs --daemon
103 =item Search for bugs with severity serious
105 local-debbugs --search severity:serious
116 use File::Temp qw(tempdir);
117 use Params::Validate qw(validate_with :types);
119 use Debbugs::Common qw(checkpid lockpid get_hashname);
120 use Debbugs::Mail qw(get_addresses);
126 my %options = (debug => 0,
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',
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',
144 GetOptions(\%options,
145 'daemon|D','show|s','search|select|S','mirror|M', 'stop',
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');
153 pod2usage() if $options{help};
154 pod2usage({verbose=>2}) if $options{man};
156 $DEBUG = $options{debug};
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";
163 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
165 # munge in local configuration
167 local_config(\%options);
169 mkpath($options{mirror_location});
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";
178 if (-e $options{mirror_location}.'/local-debbugs.pid' and
180 print STDERR "Unable to determine if daemon is running: $!\n";
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';
196 $ENV{DEBBUGS_CONFIG_FILE} = $options{mirror_location}.'/debbugs_config_local';
197 # ok, now lets daemonize
199 # XXX make sure that all paths have been turned into absolute
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: $!";
209 setsid or die "Can't start a new session: $!";
210 open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
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
217 package local_debbugs::server;
219 use HTTP::Server::Simple;
220 use base qw(HTTP::Server::Simple::CGI HTTP::Server::Simple::CGI::Environment);
224 return 'Net::Server::Fork';
229 print "HTTP/1.1 302 Found\r\n";
230 print "Location: $url\r\n";
233 # here we want to call cgi-bin/pkgreport or cgi-bin/bugreport
235 my ($self,$cgi) = @_;
237 my $base_uri = 'http://'.$cgi->virtual_host;
238 if ($cgi->virtual_port ne 80) {
239 $base_uri .= ':'.$cgi->virtual_port;
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");
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");
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");
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");
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");
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");
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");
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");
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";
279 print "HTTP/1.1 200 OK\n";
280 exec("$options{cgi_bin}/$1") or
281 die "Unable to execute $options{cgi_bin}/$1";
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";
291 elsif ($path =~ m{^/?$}) {
292 redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?package=put%20package%20here");
295 print "HTTP/1.1 404 Not Found\n";
296 print "Content-Type: text/html\n";
298 print "<h1>That which you were seeking, found I have not.</h1>\n";
300 # RewriteRule ^/$ /Bugs/ [L,R,NE]
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';
308 elsif ($options{stop}) {
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";
315 exit !(kill(15,$pid) == 1);
317 elsif ($options{mirror}) {
318 # run the mirror jobies
319 # figure out which bugs we need
320 my $bugs = select_bugs(\%options);
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});
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,
334 '--files-from',"$tempdir/unarchived_bug_list",
335 'rsync://'.$options{bug_mirror}.'/bts-spool-db/',
336 $options{mirror_location}.'/db-h/']
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,
343 '--files-from',"$tempdir/archived_bug_list",
344 'rsync://'.$options{bug_mirror}.'/bts-spool-archive/',
345 $options{mirror_location}.'/archive/',
348 print "Rsyncing indexes\n" if $options{verbose};
349 run_rsync(log => $mirror_log,
350 ($options{debug}?(debug => \*STDERR):()),
351 options => [@common_rsync_options,
354 '--exclude','by-reverse*',
355 'rsync://'.$options{bug_mirror}.'/bts-spool-index/',
356 $options{mirror_location}.'/',
359 print "Rsyncing versions\n" if $options{verbose};
360 run_rsync(log => $mirror_log,
361 ($options{debug}?(debug => \*STDERR):()),
362 options => [@common_rsync_options,
366 'rsync://'.$options{bug_mirror}.'/bts-versions/',
367 $options{mirror_location}.'/versions/',
371 elsif ($options{show}) {
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";
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?)";
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";
397 exec('/usr/bin/sensible-browser',$url) or
398 die "Unable to run sensible-browser (Maybe chorizo is required?)";
401 # you get here, you were an idiot in checking for @USAGE_ERRORS
403 die "No option that we understand was passed (the first check for this is now buggy, so shoot your maintainer)"
407 # determine the local configuration
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: $!";
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: '.$!;
419 for (keys %option_defaults) {
420 if (exists $config->{$_} and not defined $options->{$_}) {
421 $options->{$_} = $config->{$_};
423 if (not defined $options->{$_}) {
424 $options->{$_} = $option_defaults{$_};
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: $!";
439 die "Unable to close $file: $!";
442 # actually run rsync with the passed options
444 my %param = validate_with(params => \@_,
445 spec => {log => {type => HANDLE,
447 debug => {type => HANDLE,
450 options => {type => ARRAYREF,
454 my ($output,$error) = ('','');
455 my $h = IPC::Run::start(['rsync',@{$param{options}}],
456 \undef,$param{log},$param{log});
458 #print {$param{debug}} $error if defined $param{debug};
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";
471 # select a set of bugs
475 my %valid_keys = (package => 'package',
480 maintainer => 'maint',
481 submitter => 'submitter',
490 distribution => 'dist',
492 archive => 'archive',
493 severity => 'severity',
494 correspondent => 'correspondent',
495 affects => 'affects',
498 my $soap = SOAP::Lite
499 -> uri('Debbugs/SOAP/V1')
500 -> proxy("http://$options{bug_site}/cgi-bin/soap.cgi");
502 my @bug_selections = ();
503 if (not -e $options{bugs_to_get}) {
504 my ($addr) = get_addresses(exists $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
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",
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: $!";
527 push @bug_selections, $_;
531 # Split archive:both into archive:1 and archive:0
534 if (m/archive:both/) {
537 $y_archive =~ s/archive:both/archive:1/;
538 $n_archive =~ s/archive:both/archive:0/;
539 ($y_archive,$n_archive);
546 for my $selection (@bug_selections) {
547 my $archived_bugs = "unarchived";
548 if ($selection =~ /archive:(\S+)/ and $1) {
549 $archived_bugs = "archived";
551 my @subselects = split /\s+/,$selection;
552 my %search_parameters;
554 for my $subselect (@subselects) {
555 my ($key,$value) = split /:/, $subselect, 2;
557 if (exists $valid_keys{$key}) {
558 push @{$search_parameters{$valid_keys{$key}}},
560 } elsif ($key =~/users?$/) {
561 $users{$value} = 1 if $value;
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}},
573 my $bugs = $soap->get_bugs(%search_parameters,
574 (keys %usertags)?(usertags=>\%usertags):()
576 if (defined $bugs and @{$bugs}) {
577 $bugs{$archived_bugs}{$_} = 1 for @{$bugs};