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>.
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 retried
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 Debug verbosity. (Default 0)
72 Display brief useage information.
90 use File::Temp qw(tempdir);
91 use Params::Validate qw(validate_with :types);
93 use Debbugs::Common qw(checkpid lockpid);
95 my %options = (debug => 0,
101 cgi_bin => '/var/lib/debbugs/www/cgi-bin',
102 css => '/var/lib/debbugs/www/bugs.css',
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',
111 GetOptions(\%options,
112 'daemon|D','show|s','search|select|S','mirror|M', 'stop',
114 'css=s','cgi_bin|cgi-bin|cgi=s',
115 'verbose|v+','quiet|q+',
116 'debug|d+','help|h|?','man|m');
118 pod2usage() if $options{help};
119 pod2usage({verbose=>2}) if $options{man};
121 $DEBUG = $options{debug};
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";
127 $options{verbose} = $options{verbose} - $options{quiet};
129 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
132 # munge in local configuration
134 local_config(\%options);
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";
143 if (-e $options{mirror_location}.'/local-debbugs.pid' and
145 print STDERR "Unable to determine if daemon is running: $!\n";
148 # ok, now lets daemonize
150 # XXX make sure that all paths have been turned into absolute
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: $!";
160 setsid or die "Can't start a new session: $!";
161 open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
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
168 package local_debbugs::server;
170 use HTTP::Server::Simple;
171 use base qw(HTTP::Server::Simple::CGI);
174 return 'Net::Server::Fork';
179 print "HTTP/1.1 302 Found\r\n";
180 print "Location: $url\r\n";
183 # here we want to call cgi-bin/pkgreport or cgi-bin/bugreport
185 my ($self,$cgi) = @_;
187 my $base_uri = 'http://'.$cgi->virtual_host;
188 if ($cgi->virtual_port ne 80) {
189 $base_uri .= ':'.$cgi->virtual_port;
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");
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");
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");
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");
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");
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");
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");
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");
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";
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";
238 elsif ($path =~ m{^/?$}) {
239 redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?package=put%20package%20here");
242 print "HTTP/1.1 404 Not Found\n";
243 print "Content-Type: text/html\n";
245 print "<h1>That which you were seeking, found I have not.</h1>\n";
247 # RewriteRule ^/$ /Bugs/ [L,R,NE]
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';
255 elsif ($options{stop}) {
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";
262 exit !(kill(15,$pid) == 1);
264 elsif ($options{mirror}) {
265 # run the mirror jobies
266 # figure out which bugs we need
267 my @bugs = select_bugs(\%options);
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: $!";
279 die "Unable to close $tempdir/include_list: $!";
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,
287 '--include-from',"$tempdir/include_list",
288 # skip things not specifically included
290 # skip the -1,-2,-3.log files
292 'rsync://'.$options{bug_mirror}.'/bts-spool-db/',
293 $options{mirror_location}.'/db-h/']
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,
300 '--include-from',"$tempdir/include_list",
301 # skip things not specifically included
303 # skip the -1,-2,-3.log files
305 'rsync://'.$options{bug_mirror}.'/bts-spool-archive/',
306 $options{mirror_location}.'/archive/',
309 print "Rsyncing indexes\n" if $options{verbose};
310 run_rsync(log => $mirror_log,
311 ($options{debug}?(debug => \*STDERR):()),
312 options => [@common_rsync_options,
315 '--exclude','by-reverse*',
316 'rsync://'.$options{bug_mirror}.'/bts-spool-index/',
317 $options{mirror_location}.'/',
320 print "Rsyncing versions\n" if $options{verbose};
321 run_rsync(log => $mirror_log,
322 ($options{debug}?(debug => \*STDERR):()),
323 options => [@common_rsync_options,
327 'rsync://'.$options{bug_mirror}.'/bts-spool-versions/',
328 $options{mirror_location}.'/versions/',
332 elsif ($options{show}) {
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";
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?)";
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";
358 exec('/usr/bin/sensible-browser',$url) or
359 die "Unable to run sensible-browser (Maybe chorizo is required?)";
362 # you get here, you were an idiot in checking for @USAGE_ERRORS
364 die "No option that we understand was passed (the first check for this is now buggy, so shoot your maintainer)"
368 # determine the local configuration
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: $!";
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: '.$!;
380 for (keys %option_defaults) {
381 if (exists $config->{$_} and not defined $options->{$_}) {
382 $options->{$_} = $config->{$_};
384 if (not defined $options->{$_}) {
385 $options->{$_} = $option_defaults{$_};
390 # actually run rsync with the passed options
392 my %param = validate_with(params => \@_,
393 spec => {log => {type => HANDLE,
395 debug => {type => HANDLE,
398 options => {type => ARRAYREF,
402 my ($output_fh,@rsync_options) = @_;
404 my $pid = open3($wfh,$rfh,
407 ) or die "Unable to start rsync: $!";
408 close $wfh or die "Unable to close the writer filehandle $?";
410 print {$param{log}} $_;
411 if (exists $param{debug}) {
412 print {$param{debug}} $_;
419 # select a set of bugs
423 my %valid_keys = (package => 'package',
428 maintainer => 'maint',
429 submitter => 'submitter',
438 distribution => 'dist',
440 archive => 'archive',
441 severity => 'severity',
442 correspondent => 'correspondent',
443 affects => 'affects',
446 my $soap = SOAP::Lite
447 -> uri('Debbugs/SOAP/V1')
448 -> proxy("http://$options{bug_mirror}/cgi-bin/soap.cgi");
450 my @bug_selections = ();
451 if (not -e $options{bugs_to_get}) {
452 my ($addr) = get_addresses(exists $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
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",
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: $!";
475 push @bug_selections, $_;
479 for my $selection (@bug_selections) {
480 my @subselects = split /\s+/,$selection;
481 my %search_parameters;
483 for my $subselect (@subselects) {
484 my ($key,$value) = split /:/, $subselect, 2;
486 if (exists $valid_keys{$key}) {
487 push @{$search_parameters{$valid_keys{$key}}},
489 } elsif ($key =~/users?$/) {
490 $users{$value} = 1 if $value;
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}},
502 my $bugs = $soap->get_bugs(%search_parameters,
503 (keys %usertags)?(usertags=>\%usertags):()
505 push @bugs,@{$bugs} if defined $bugs and @{$bugs};