#! /usr/bin/perl
# local-debbugs is part of debbugs, and is released
# under the terms of the GPL version 2, or any later version, at your
# option. See the file README and COPYING for more information.
# Copyright 2008 by Don Armstrong <don@donarmstrong.com>.


use warnings;
use strict;

use Getopt::Long qw(:config no_ignore_case);
use Pod::Usage;

=head1 NAME

local-debbugs - use a local mirror of debbugs

=head1 SYNOPSIS

 [options]

 Options:
  --mirror, -M update local mirror
  --daemon, -D start the daemon
  --search, -S run a search
  --show, -s show a bug
  --debug, -d debugging level (Default 0)
  --help, -h display this help
  --man, -m display manual

=head1 OPTIONS

=over

=item B<--mirror, -M>

Update the local mirror of debbugs bugs

=item B<--daemon, -D>

Start up the daemon on the configured local port to serve bugs which
have been previously retrieved.

=item B<--search, -S>

Cause the running daemon to show the pkgreport.cgi page corresponding
to the search by invoking sensible-browser and an appropriate url.

=item B<--show, -s>

Cause the running daemon to show the bugreport.cgi page corresponding
to the bug by invoking sensible-browser and an appropriate url.

=item B<--port, -p>

The port that the daemon is running on (or will be running on.)

Defaults to the value of the currently running daemon, the value in
the configuration file, or 8080 if nothing is set.

=item B<--bugs-to-get>

File which contains the set of bugs to get.
Defaults to ~/.debbugs/bugs_to_get

=item B<--bug-site>

Hostname for a site which is running a debbugs install.
Defaults to bugs.debian.org

=item B<--bug-mirror>

Hostname for a site which is running an rsyncable mirror of the
debbugs install above.
Defaults to bugs-mirror.debian.org

=item B<--debug, -d>

Debug verbosity.

=item B<--help, -h>

Display brief useage information.

=item B<--man, -m>

Display this manual.

=back

=head1 EXAMPLES

=over

=item Update the local mirror

 local-debbugs --mirror

=item Start up the local-debbugs daemon

 local-debbugs --daemon

=item Search for bugs with severity serious

 local-debbugs --search severity:serious

=back

=cut


use vars qw($DEBUG);

use User;
use Config::Simple;
use File::Temp qw(tempdir);
use Params::Validate qw(validate_with :types);
use POSIX 'setsid';
use Debbugs::Common qw(checkpid lockpid get_hashname);
use Debbugs::Mail qw(get_addresses);
use SOAP::Lite;
use IPC::Run;
use IO::File;
use File::Path;


my %options = (debug           => 0,
	       help            => 0,
	       man             => 0,
	       verbose         => 0,
	       quiet           => 0,
	       detach          => 1,
	       cgi_bin         => '/var/lib/debbugs/www/cgi',
	       css             => '/var/lib/debbugs/www/bugs.css',
	       bug_site        => 'bugs.debian.org',
	       bug_mirror      => 'bugs-mirror.debian.org',
	       );

my %option_defaults = (port => 8080,
		       debbugs_config => User->Home.'/.debbugs/debbugs_config',
		       mirror_location => User->Home.'/.debbugs/mirror',
		       bugs_to_get => User->Home.'/.debbugs/bugs_to_get',
		      );

GetOptions(\%options,
	   'daemon|D','show|s','search|select|S','mirror|M', 'stop|exit|quit',
	   'detach!',
	   'css=s','cgi_bin|cgi-bin|cgi=s',
	   'verbose|v+','quiet|q+',
	   'bug_site|bug-site=s',
	   'bug_mirror|bug-mirror=s',
	   'debug|d+','help|h|?','man|m');

pod2usage() if $options{help};
pod2usage({verbose=>2}) if $options{man};

$DEBUG = $options{debug};

my @USAGE_ERRORS;
if (1 != grep {exists $options{$_}} qw(daemon show search mirror stop)) {
     push @USAGE_ERRORS,"You must pass one (and only one) of --daemon --show --search --mirror or --stop";
}
$options{verbose} = $options{verbose} - $options{quiet};

pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;


# munge in local configuration

local_config(\%options);

mkpath($options{mirror_location});

if ($options{daemon}) {
     # daemonize, do stuff
     my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
     if (defined $pid and $pid != 0) {
	  print STDERR "Unable to start daemon; it's already running\n";
	  exit 1;
     }
     if (-e $options{mirror_location}.'/local-debbugs.pid' and
	 not defined $pid) {
	  print STDERR "Unable to determine if daemon is running: $!\n";
	  exit 1;
     }
     my $conf = IO::File->new($options{mirror_location}.'/debbugs_config_local','w') or
	 die "Unable to open $options{mirror_location}/debbugs_config_local for writing: $!";
     print {$conf} <<"EOF";
\$gConfigDir = "$options{mirror_location}";
\$gSpoolDir = "$options{mirror_location}";
\$gWebHost = 'localhost:$options{port}';
\$gPackageSource = '';
\$gPseudoDescFile = '';
\$gPseudoMaintFile = '';
\$gMaintainerFile = '';
\$gMaintainerFileOverride = '';
\$config{source_maintainer_file} = '';
\$config{source_maintainer_file_override} = '';
\$gProject = 'Local Debbugs';
1;
EOF
     close $conf;
     $ENV{DEBBUGS_CONFIG_FILE} = $options{mirror_location}.'/debbugs_config_local';
     # ok, now lets daemonize

     # XXX make sure that all paths have been turned into absolute
     # paths
     chdir '/' or die "Can't chdir to /: $!";
     # allow us not to detach for debugging
     if ($options{detach}) {
          open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
	  open STDOUT, '>/dev/null'
	       or die "Can't write to /dev/null: $!";
	  defined(my $pid = fork) or die "Can't fork: $!";
	  exit if $pid;
	  setsid or die "Can't start a new session: $!";
	  open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
     }
     lockpid($options{mirror_location}.'/local-debbugs.pid') or
	  die "Unable to deal with the pidfile";
     # this is the subclass of HTTP::Server::Simple::CGI which handles
     # the "hard" bits of actually running a tiny webserver for us
     {
	  package local_debbugs::server;
	  use IO::File;
	  use HTTP::Server::Simple;
	  use base qw(HTTP::Server::Simple::CGI HTTP::Server::Simple::CGI::Environment);

	  sub net_server {
	       return 'Net::Server::Fork';
	  }

	  sub redirect {
	       my ($cgi,$url) = @_;
	       print "HTTP/1.1 302 Found\r\n";
	       print "Location: $url\r\n";
	  }

	  # here we want to call cgi-bin/pkgreport or cgi-bin/bugreport
	  sub handle_request {
	       my ($self,$cgi) = @_;

	       $ENV{DEBBUGS_CONFIG_FILE} = $options{mirror_location}.'/debbugs_config_local';
	       my $base_uri = 'http://'.$cgi->virtual_host;
	       if ($cgi->virtual_port ne 80) {
		    $base_uri .= ':'.$cgi->virtual_port;
	       }
	       my $path = $cgi->path_info();
	       # RewriteRule ^/[[:space:]]*#?([[:digit:]][[:digit:]][[:digit:]]+)([;&].+)?$ /cgi-bin/bugreport.cgi?bug=$1$2 [L,R,NE]
	       if ($path =~ m{^/?\s*\#?(\d+)((?:[;&].+)?)$}) {
		    redirect($cgi,$base_uri."/cgi-bin/bugreport.cgi?bug=$1$2");
	       }
	       # RewriteRule ^/[Ff][Rr][Oo][Mm]:([^/]+\@.+)$ /cgi-bin/pkgreport.cgi?submitter=$1 [L,R,NE]
	       elsif ($path =~ m{^/?\s*from:([^/]+\@.+)$}i) {
		    redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?submitter=$1");
	       }
	       # RewriteRule ^/([^/]+\@.+)$ /cgi-bin/pkgreport.cgi?maint=$1 [L,R,NE]
	       elsif ($path =~ m{^/?\s*([^/]+\@.+)$}i) {
		    redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?maint=$1");
	       }
	       # RewriteRule ^/mbox:([[:digit:]][[:digit:]][[:digit:]]+)([;&].+)?$ /cgi-bin/bugreport.cgi?mbox=yes&bug=$1$2 [L,R,NE]
	       elsif ($path =~ m{^/?\s*mbox:\#?(\d+)((?:[;&].+)?)$}i) {
		    redirect($cgi,$base_uri."/cgi-bin/bugreport.cgi?mbox=yes;bug=$1$2");
	       }
	       # RewriteRule ^/src:([^/]+)$ /cgi-bin/pkgreport.cgi?src=$1 [L,R,NE]
	       elsif ($path =~ m{^/?src:([^/]+)$}i) {
		    redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?src=$1");
	       }
	       # RewriteRule ^/severity:([^/]+)$ /cgi-bin/pkgreport.cgi?severity=$1 [L,R,NE]
	       elsif ($path =~ m{^/?severity:([^/]+)$}i) {
		    redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?severity=$1");
	       }
	       # RewriteRule ^/tag:([^/]+)$ /cgi-bin/pkgreport.cgi?tag=$1 [L,R,NE]
	       elsif ($path =~ m{^/?tag:([^/]+)$}i) {
		    redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?tag=$1");
	       }
	       # RewriteRule ^/([^/]+)$ /cgi-bin/pkgreport.cgi?pkg=$1 [L,R,NE]
	       elsif ($path =~ m{^/?([^/]+)$}i) {
		    redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?pkg=$1");
	       }
	       elsif ($path =~ m{^/?cgi(?:-bin)?/((?:(?:bug|pkg)report|version)\.cgi)}) {
		    # dispatch to pkgreport.cgi
		    #print "HTTP/1.1 200 OK\n";
		    open(my $fh,'-|',"$options{cgi_bin}/$1") or
			die "Unable to execute $options{cgi_bin}/$1";
		    my $status;
		    my $cache = '';
		    while (<$fh>) {
			if (/Status: (\d+\s+.+?)\n?$/) {
			    $status = $1;
			    print "HTTP/1.1 $status\n";
			    print STDERR "'$status'\n";
			    last;
			}
			$cache .= $_;
			if (/^$/) {
			    print "HTTP/1.1 200 OK\n";
			    last;
			}
		    }
		    print $cache;
		    print <$fh>;
		    close($fh) or die "Unable to close";
		}
	       elsif ($path =~ m{^/?css/bugs.css}) {
		    my $fh = IO::File->new($options{css},'r') or
			 die "Unable to open $options{css} for reading: $!";
		    print "HTTP/1.1 200 OK\n";
		    print "Content-type: text/css\n";
		    print "\n";
		    print <$fh>;
	       }
	       elsif ($path =~ m{^/?$}) {
		    redirect($cgi,$base_uri."/cgi-bin/pkgreport.cgi?package=put%20package%20here");
	       }
	       else {
		    print "HTTP/1.1 404 Not Found\n";
		    print "Content-Type: text/html\n";
		    print "\n";
		    print "<h1>That which you were seeking, found I have not.</h1>\n";
	       }
	       # RewriteRule ^/$ /Bugs/ [L,R,NE]
	  }
     }
     my $debbugs_server = local_debbugs::server->new($options{port}) or
	  die "Unable to create debbugs server";
     $debbugs_server->run() or
	  die 'Unable to run debbugs server';
}
elsif ($options{stop}) {
     # stop the daemon
     my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
     if (not defined $pid or $pid == 0) {
	  print STDERR "Unable to open pidfile or daemon not running: $!\n";
	  exit 1;
     }
     exit !(kill(15,$pid) == 1);
}
elsif ($options{mirror}) {
     # run the mirror jobies
     # figure out which bugs we need
     my $bugs = select_bugs(\%options);
     # get them
     my $tempdir = tempdir();#CLEANUP => 1);
     my $mirror_log = IO::File->new($options{mirror_location}.'/mirror.log','>') or
	  die "Unable to open $options{mirror_location}/mirror.log for writing: $!";
     write_bug_list("$tempdir/unarchived_bug_list",$bugs->{unarchived});
     write_bug_list("$tempdir/archived_bug_list",$bugs->{archived});
     my ($wrf,$rfh,$efh);
     my @common_rsync_options = ('-avz','--partial');
     print "Rsyncing bugs\n" if not $options{quiet};
     run_rsync(log => $mirror_log,
	       ($options{debug}?(debug => \*STDERR):()),
	       options => [@common_rsync_options,
			   '--delete-after',
			   '--files-from',"$tempdir/unarchived_bug_list",
			   'rsync://'.$options{bug_mirror}.'/bts-spool-db/',
			   $options{mirror_location}.'/db-h/']
	      );
     print "Rsyncing archived bugs\n" if $options{verbose};
     run_rsync(log => $mirror_log,
	       ($options{debug}?(debug => \*STDERR):()),
	       options => [@common_rsync_options,
			   '--delete-after',
			   '--files-from',"$tempdir/archived_bug_list",
			   'rsync://'.$options{bug_mirror}.'/bts-spool-archive/',
			   $options{mirror_location}.'/archive/',
			  ],
	      );
     print "Rsyncing indexes\n" if $options{verbose};
     run_rsync(log => $mirror_log,
	       ($options{debug}?(debug => \*STDERR):()),
	       options => [@common_rsync_options,
			   '--exclude','*old',
			   '--exclude','*.bak',
			   '--exclude','by-reverse*',
			   'rsync://'.$options{bug_mirror}.'/bts-spool-index/',
			   $options{mirror_location}.'/',
			  ],
	      );
     print "Rsyncing versions\n" if $options{verbose};
     run_rsync(log => $mirror_log,
	       ($options{debug}?(debug => \*STDERR):()),
	       options => [@common_rsync_options,
			   '--delete-after',
			   '--exclude','*old',
			   '--exclude','*.bak',
			   'rsync://'.$options{bug_mirror}.'/bts-versions/',
			   $options{mirror_location}.'/versions/',
			  ],
	      );
}
elsif ($options{show}) {
     # figure out the url
     # see if the daemon is running
     my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
     if (not defined $pid or $pid == 0) {
	  print STDERR "Unable to open pidfile or daemon not running: $!\n";
	  print STDERR qq(Mr. T: "I pity da fool who tries to show a bug without a running daemon"\n);
	  print STDERR "Hint: try the --daemon option first\n";
	  exit 1;
     }
     # twist and shout
     my $url = qq(http://localhost:$options{port}/$ARGV[0]);
     exec('/usr/bin/sensible-browser',$url) or
	  die "Unable to run sensible-browser (try feeding me cheetos?)";
}
elsif ($options{search}) {
     my $url = qq(http://localhost:$options{port}/cgi-bin/pkgreport.cgi?).
	  join(';',map {if (/:/) {s/:/=/; $_;} else {qq(pkg=$_);}} @ARGV);
     my $pid = checkpid($options{mirror_location}.'/local-debbugs.pid');
     if (not defined $pid or $pid == 0) {
	  print STDERR "Unable to open pidfile or daemon not running: $!\n";
	  print STDERR qq(Mr. T: "I pity da fool who tries to search for bugs without a running daemon"\n);
	  print STDERR "Hint: try the --daemon option first\n";
	  exit 1;
     }
     # twist and shout
     exec('/usr/bin/sensible-browser',$url) or
	  die "Unable to run sensible-browser (Maybe chorizo is required?)";
}
else {
     # you get here, you were an idiot in checking for @USAGE_ERRORS
     # above
     die "No option that we understand was passed (the first check for this is now buggy, so shoot your maintainer)"
}


# determine the local configuration
sub local_config{
     my ($options) = @_;
     my $config = {};
     if (-e '/etc/debbugs/local_debbugs.conf') {
	  Config::Simple->import_from('/etc/debbugs/local_debbugs.conf', $config) or
		    die "Unable to read configuration from /etc/debbugs/local_debbugs.conf: $!";
     }
     if (-e User->Home.'/.debbugs/local_debbugs.conf') {
	  Config::Simple->import_from(User->Home.'/.debbugs/local_debbugs.conf', $config) or
		    die "Unable to read configuration from ".User->Home.'/.debbugs/local_debbugs.conf: '.$!;
     }
     for (keys %option_defaults) {
	  if (exists $config->{$_} and not defined $options->{$_}) {
	       $options->{$_} = $config->{$_};
	  }
	  if (not defined $options->{$_}) {
	       $options->{$_} = $option_defaults{$_};
	  }
     }
}

sub write_bug_list {
    my ($file,$bug_list) = @_;
    my $inc_fh = IO::File->new($file,'w') or
	die "Unable to open $file for writing: $!";
    foreach my $bug (keys %{$bug_list}) {
	my $file_loc = get_hashname($bug).'/'.$bug;
	print {$inc_fh} map {$file_loc.'.'.$_.qq(\n)} qw(log summary report status) or
	    die "Unable to write to $file: $!";
    }
    close $inc_fh or
	die "Unable to close $file: $!";
}

# actually run rsync with the passed options
sub run_rsync{
     my %param = validate_with(params => \@_,
			       spec   => {log => {type => HANDLE,
						 },
					  debug => {type => HANDLE,
						    optional => 1,
						   },
					  options => {type => ARRAYREF,
						     },
					 }
			      );
     my ($output,$error) = ('','');
     my $h = IPC::Run::start(['rsync',@{$param{options}}],
			     \undef,$param{log},$param{log});
     while ($h->pump) {
	 #print {$param{debug}} $error if defined $param{debug};
     }
     $h->finish();
     my $exit = $h->result(0);
     # this is suboptimal, but we currently don't know whether we've
     # selected an archive or unarchived bug, so..
     if (defined $exit and not ($exit == 0 or $exit == 3 or $exit == 23)) {
	 print STDERR "Rsync exited with non-zero status: $exit\n";
     }
}



# select a set of bugs
sub select_bugs{
     my ($options) = @_;

     my %valid_keys = (package => 'package',
                       pkg     => 'package',
                       src     => 'src',
                       source  => 'src',
                       maint   => 'maint',
                       maintainer => 'maint',
                       submitter => 'submitter',
                       from => 'submitter',
                       status    => 'status',
                       tag       => 'tag',
                       tags      => 'tag',
                       usertag   => 'tag',
                       usertags  => 'tag',
                       owner     => 'owner',
                       dist      => 'dist',
                       distribution => 'dist',
                       bugs       => 'bugs',
                       archive    => 'archive',
                       severity   => 'severity',
		       correspondent => 'correspondent',
		       affects       => 'affects',
                      );

     my $soap = SOAP::Lite
	  -> uri('Debbugs/SOAP/V1')
	       -> proxy("http://$options{bug_site}/cgi-bin/soap.cgi");
     my @bugs;
     my @bug_selections = ();
     if (not -e $options{bugs_to_get}) {
	  my ($addr) = get_addresses(exists $ENV{DEBEMAIL}?
				     $ENV{DEBEMAIL} :
				     (User->Login . '@' . qx(hostname --fqdn)));
	  # by default include bugs talked to by this user packages
	  # maintained by this user, submitted by this user, and rc
	  # bugs
	  push @bug_selections,
	       ("correspondent:$addr archive:0",
		"maint:$addr archive:0",
		"submitter:$addr archive:0",
		"severity:serious severity:grave severity:critical archive:0",
	       );
     }
     else {
	  my $btg_fh = IO::File->new($options{bugs_to_get},'r') or
	       die "unable to open bugs to get file '$options{bugs_to_get}' for reading: $!";
	  while (<$btg_fh>) {
	       chomp;
	       next if /^\s*#/;
	       if (/^\d+$/) {
		    push @bugs,$_;
	       }
	       elsif (/\s\w+\:/) {
		    push @bug_selections, $_;
	       }
	  }
     }
     # Split archive:both into archive:1 and archive:0
     @bug_selections =
	 map {
	     if (m/archive:both/) {
		 my $y_archive = $_;
		 my $n_archive = $_;
		 $y_archive =~ s/archive:both/archive:1/;
		 $n_archive =~ s/archive:both/archive:0/;
		 ($y_archive,$n_archive);
	     }
	     else {
		 $_;
	     }
	 } @bug_selections;
     my %bugs;
     for my $selection (@bug_selections) {
	 my $archived_bugs = "unarchived";
	 if ($selection =~ /archive:(\S+)/ and $1) {
	     $archived_bugs = "archived";
	 }
	 my @subselects = split /\s+/,$selection;
	 my %search_parameters;
	 my %users;
	 for my $subselect (@subselects) {
	     my ($key,$value) = split /:/, $subselect, 2;
	     next unless $key;
	     if (exists $valid_keys{$key}) {
		 push @{$search_parameters{$valid_keys{$key}}},
		     $value if $value;
	     } elsif ($key =~/users?$/) {
		 $users{$value} = 1 if $value;
	     }
	 }
	 my %usertags;
	 for my $user (keys %users) {
	     my $ut = $soap->get_usertag($user)->result();
	     next unless defined $ut and $ut ne "";
	     for my $tag (keys %{$ut}) {
		 push @{$usertags{$tag}},
		     @{$ut->{$tag}};
	     }
	 }
	 my $bugs = $soap->get_bugs(%search_parameters,
				    (keys %usertags)?(usertags=>\%usertags):()
				   )->result();
	 if (defined $bugs and @{$bugs}) {
	     $bugs{$archived_bugs}{$_} = 1 for @{$bugs};
	 }
     }
     return \%bugs;
}


__END__