+ 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}";
+\$gTemplateDir = "$options{template_dir}";
+\$gWebHost = 'localhost:$options{port}';
+\$gPackageSource = '$options{mirror_location}/sources';
+\$gPseudoDescFile = '';
+\$gPseudoMaintFile = '';
+\$gMaintainerFile = '$options{mirror_location}/Maintainers';
+\$gMaintainerFileOverride = '';
+\$config{source_maintainer_file} = '$options{mirror_location}/Source_maintainers';
+\$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 File::Basename qw(dirname);
+ 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)}) {
+ my @exec_options = "$options{cgi_bin}/$1";
+ if ($options{git_mode}) {
+ unshift @exec_options,
+ 'perl','-I',$options{base_dir},'-T';
+ }
+ open(my $fh,'-|',@exec_options) 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);