File Coverage

blib/lib/HTTP/Daemon/App.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package HTTP::Daemon::App;

use strict;
use warnings;

use version;our $VERSION = qv('0.0.9');

use HTTP::Daemon;
use HTTP::Daemon::SSL;
use HTTP::Response;
use Acme::Spork;
use Unix::PID;
use File::Spec;

use base 'Exporter';
our @EXPORT_OK = qw(run decode_basic_auth send_basic_auth_request);

sub send_basic_auth_request {
	my ($c, $realm)      = @_;
	$realm               = 'Restricted Area' if !$realm;
	my $auth_request_res = HTTP::Response->new(401, 'Unauthorized');
	$auth_request_res->header('WWW-Authenticate' => qq{Basic realm="$realm"});
	$auth_request_res->is_error(1);
    $auth_request_res->error_as_HTML(1);
	$c->send_response($auth_request_res);
}

sub decode_basic_auth {
	my ($auth) = @_;
	no warnings 'uninitialized';
    $auth = ( split /\s+/, $auth->header('Authorization') )[1] if ref $auth;
    require MIME::Base64;
    return split(/:/, MIME::Base64::decode( $auth ), 2);
}

sub run {
    my($daemons_hashref, $conf) = @_;

    $conf              = {} if ref $conf ne 'CODE';
    $conf->{'pid_dir'} = File::Spec->catdir(qw(/ var run)) if !$conf->{'pid_dir'};
    $conf->{'pid_ext'} = '.pid' if !$conf->{'pid_ext'};
    $conf->{'self'}    = "perl $0" if !$conf->{'self'};

    my $additional = '';
    for my $opt (sort keys %{ $conf->{'opts'} }) {
        if($opt eq '--start' || $opt eq '--stop' || $opt eq '--restart') {
            delete $conf->{'opts'}{$opt};
            next;
        }
        $additional .= "|$opt";
    }

    $ARGV[0] = '--help' if !defined $ARGV[0]; # no uninit warnings and logical visual clue to coders of what will happen if its not specified...
    if($ARGV[0] eq '--restart') {
        system qq($conf->{'self'} --stop $$);
        sleep 1;
        system qq($conf->{'self'} --start);
        exit;
    }

    if($ARGV[0] eq '--start') {
    	for my $daemon (sort keys %{ $daemons_hashref }) {
            next if ref $daemons_hashref->{$daemon}{'handler'} ne 'CODE';
    	    next if ref $daemons_hashref->{$daemon}{'daemon'} ne 'HASH';

            my $pidfile = File::Spec->catfile($conf->{'pid_dir'}, "$daemon$conf->{'pid_ext'}");

    	    my $objkt = $daemons_hashref->{$daemon}{'ssl'}
    	                ? HTTP::Daemon::SSL->new( %{ $daemons_hashref->{$daemon}{'daemon'} } )
    	                : HTTP::Daemon->new( %{ $daemons_hashref->{$daemon}{'daemon'} } )
    	                ;
            if(!$objkt) {
                print "$daemon: $!\n";
    	        next;
            }

    	    print "Starting $daemons_hashref->{$daemon}{'label'}: url . ">\n"
    	        if defined $daemons_hashref->{$daemon}{'label'};

    		my $http_pid = spork(
    		    sub {
    		        my($handler, $d, $name, $pidfile, $conf) = @_;
                    local $0 = $name;
                	while (my $c = $d->accept) {
                	    $conf->{'pre_fork'}->(@_) if ref $conf->{'pre_fork'} eq 'CODE';

	                    if(my $kid = fork()) {
		                    $c->can('get_cipher') ? $c->close('SSL_no_shutdown' => 1) : $c->close;
	                	    undef($c);
	                    }
	                    else {
	                        $conf->{'get_tmpfile'} = sub { return } if ref $conf->{'get_tmpfile'} ne 'CODE';
		               	    while (my $r = $c->get_request( $conf->{'get_tmpfile'}->( $conf ) )) {
                	            $handler->($d, $c, $r, $conf);
                            }
                            # $c->can('get_cipher') ? $c->close('SSL_no_shutdown' => 1) : $c->close;
	                        # undef($c);
	                        exit 0;
                	    }

                	    $conf->{'pst_fork'}->(@_) if ref $conf->{'pst_fork'} eq 'CODE';
                	}
		        }, $daemons_hashref->{$daemon}{'handler'}, $objkt, $daemon, $pidfile, $conf,
    		);

    		Unix::PID->new()->pid_file_no_unlink($pidfile, $http_pid)
    		    or die "The PID in $pidfile is still running.";
    	}
    }
    elsif($ARGV[0] eq '--stop') {
    	for my $daemon (sort keys %{ $daemons_hashref }) {
    	    my $pidfile = File::Spec->catfile($conf->{'pid_dir'}, "$daemon$conf->{'pid_ext'}");

            my $uxp = Unix::PID->new();
    	    my $pid = $uxp->kill_pid_file($pidfile);

    	    if($pid == 1) {
    	        print "$daemon is not running\n";
    	    }
    	    elsif($pid eq '-1') {
                print "$daemon pidfile: $!\n";
            }
            else {
    	        print "$daemon ($pid) was stopped\n";
    	    }

            print "\tCollecting $daemon children...\n";
            for my $kid ($uxp->get_pidof($daemon) ) {
	            next if defined $ARGV[1] && $kid eq $ARGV[1];
	            $uxp->kill( $kid ) or print "\t\tCould not kill $daemon child $kid: $!\n";
            }
    	}
    }
    elsif(exists $conf->{'opts'}{$ARGV[0]}) {
        $conf->{'opts'}->{$ARGV[0]}->(@_);
    }
    else {
    	print "Useage: $0 [--start|--stop||--restart$additional]\n";
    	print "$conf->{'help'}\n" if $conf->{'help'};
    }
}

1;

__END__