#!/usr/bin/env perl
#
# Written by Martin Bartosch for the OpenXPKI project 2006
# Copyright (c) 2006 by The OpenXPKI Project
# $Revision: 913 $
#

our $VERSION = "[% deployment.version %]";

use strict;
use warnings;
use English;
use Getopt::Long;
use Pod::Usage;
use POSIX ":sys_wait_h";
use Errno;
use File::Spec;
use Proc::ProcessTable;

# use Smart::Comments;

use OpenXPKI::VERSION;
use OpenXPKI::Debug;

# settings determined by openxpki-metaconf
# not really needed...
# my $prefix          = "[% dir.prefix %]";
# my $exec_prefix     = "[% dir.exec_prefix %]";
# my $template_prefix = "[% dir.templatedir %]";
# my $sysconfdir      = "[% dir.sysconfdir %]";

my $openxpkiconfdir = "[% dir.openxpkiconfdir %]";
my $configfile      = "$openxpkiconfdir/config.xml";

our $QUIET = 0;

sub slurp {
    my $arg = shift;

    ### ref $arg
    my $content = do {
	local $INPUT_RECORD_SEPARATOR;

	my $HANDLE;
	# allow passing file handles

	if (ref $arg eq '') {
	    open $HANDLE, "<", $arg or return;
	} elsif (ref $arg eq 'GLOB') {
	    $HANDLE = $arg;
	} else {
	    die "slurp(): invalid data type " . ref $arg . ". Stopped";
	}
	<$HANDLE>;
    };
    return $content;
}

sub __get_processgroup_pids {
    # returns a list of PIDs that belong to a given process group
    my $process_group = shift;
    my @result;

    my $pt = new Proc::ProcessTable;
    foreach my $process (@{$pt->table}) {
        if (getpgrp($process->pid) == $process_group) {
            push @result, $process->pid;
        }
    } 
    return @result;
}

sub connect_openxpki_daemon {
    my $socketfile = shift;

    my $client;
    eval {
        ## do not make a use statement from this
        ## a use would disturb the server initialization
        require OpenXPKI::Client;
	$client = OpenXPKI::Client->new(
	    {
		SOCKETFILE => $socketfile,
	    });
    };

    return unless defined $client;

    return 1;
}



###########################################################################

sub do_status {
    my $arg = shift;

    if (exists $arg->{SLEEP} and $arg->{SLEEP} > 0)
    {
        ## this helps to give the server some reaction time
        sleep $arg->{SLEEP};
    }

    my $socketfile = $arg->{SOCKETFILE};

    if (! connect_openxpki_daemon($socketfile)) {
        if (not exists $arg->{SLEEP})
        {
            ## wait for a starting server ...
            return do_status ({SOCKETFILE => $arg->{SOCKETFILE}, SLEEP => 5});
        }
	return;
    }
    return 1;
}

sub do_start {
    my $arg = shift;

    my $pid        = $arg->{PID};
    my $pidfile    = $arg->{PIDFILE};
    my $socketfile = $arg->{SOCKETFILE};
    my $foreground = $arg->{FOREGROUND};

    if (defined $pid && kill(0, $pid)) {
	if (! do_status(
		  {
		      SOCKETFILE => $socketfile,
		  })) {
	    return;
	}
	print STDERR "OpenXPKI Server already running. PID: $pid\n";

	return 1;
    }
    ## this is only an informal message and not an error - so do not use STDERR
    print STDOUT "Starting OpenXPKI...\n" if (not $QUIET);
    unlink $pidfile;

    # fork off server launcher
    my $redo_count = 0;
    my $READ_FROM_KID;
    if (! $foreground) {
        # fork server away to background
      FORK:
        do {
            # this open call efectively does a fork and attaches the child's
            # STDOUT to $READ_FROM_KID, allowing the child to send us data.
            $pid = open($READ_FROM_KID, "-|");
            if (! defined $pid) {
                if ($!{EAGAIN}) {
                # recoverable fork error
                    if ($redo_count > 5) {
                                ## the first message is part of the informal daemon startup message
                                ## the second message is a real error message
                        print STDOUT "FAILED.\n" if (not $QUIET);
                        print STDERR "Could not fork process\n";
                        return;
                    }
                            ## this is only an informal message and not an error - so do not use STDERR
                    print STDOUT '.' if (not $QUIET);
                    sleep 5;
                    $redo_count++;
                    redo FORK;
                }

                # other fork error
                    ## the first message is part of the informal daemon startup message
                    ## the second message is a real error message
                print STDOUT "FAILED.\n" if (not $QUIET);
                print STDERR "Could not fork process: $ERRNO\n";
                return;
            }
        } until defined $pid;

        if ($pid) {
            # parent here
            # child process pid is available in $pid

            my $kid;
            do {
                $kid = waitpid(-1, WNOHANG);
            } until $kid > 0;

            # check if child noticed a startup error
            my $msg = slurp $READ_FROM_KID;

            if (length $msg)
            {
                    ## the first message is part of the informal daemon startup message
                    ## the second message is a real error message
                print STDOUT "FAILED.\n" if (not $QUIET);
                print STDERR "$msg\n";
                return;
            }

            # find out if the server is REALLY running properly
            if (! do_status(
                  {
                      SOCKETFILE => $socketfile,
                  })) {
                return;
            }
            
                ## this is only an informal message and not an error - so do not use STDERR
            print STDOUT "DONE.\n" if (not $QUIET);
        } else {
            # child here
            # parent process pid is available with getppid
            
            # everything printed to STDOUT here will be available to the
            # parent on its $READ_FROM_KID file descriptor
            
            eval
            {
                    ## SILENT is required to work correctly with start-stop-daemons
                    ## during a normal System V init
                    my $silent = 0;
                    $silent = 1 if ($QUIET);
                OpenXPKI::Server->new ("CONFIG" => $configfile, "SILENT" => $silent);
            };
            if ($EVAL_ERROR)
            {
                print STDERR $EVAL_ERROR;
                return;
            }
        }
    }
    else {
        # foreground requested, do not fork
        eval {
            my $silent = 0;
            $silent = 1 if ($QUIET);
            OpenXPKI::Server->new(
                'CONFIG' => $configfile,
                'SILENT' => $silent,
                'TYPE'   => 'Simple',
            );
        };
        if ($EVAL_ERROR) {
            print STDERR $EVAL_ERROR;
            return;
        }
    }
    return 1;
}

sub do_stop {
    my $arg = shift;

    my $pid        = $arg->{PID};
    my $pidfile    = $arg->{PIDFILE};
    my $socketfile = $arg->{SOCKETFILE};

    if (! defined $pid || (kill(0, $pid) == 0)) {
	print STDERR "OpenXPKI Server is not running.\n";
	return 1;
    }
    my $process_group = getpgrp($pid);

    print STDOUT "Stopping OpenXPKI\n" if (not $QUIET);

    my @signals = (2, 2, 3, 3, 9);

    # get all PIDs which belong to the current process group
    my @pids = __get_processgroup_pids($process_group);
    foreach my $p (@pids) {
        print STDOUT "[$p] " if (not $QUIET);
        TERMINATE:
        foreach my $sig (@signals) {
	    print STDOUT '.' if (not $QUIET);
    	    kill($sig, $p);
	    sleep 1;
	    last TERMINATE if (kill(0, $p) == 0);
        }
        print STDOUT "\n" if (not $QUIET);
        if (kill(0, $p)) {
            print STDOUT "FAILED.\n" if (not $QUIET);
            print STDERR "Could not terminate OpenXPKI process $p.\n";
            return;
        }
    }
    print STDOUT "DONE.\n" if (not $QUIET);
    return 1;
}


###########################################################################


my %params;
GetOptions(\%params,
	   qw(
	      help|?
	      man
	      cfg|cfgfile|conf|config=s
              version
              debug=s@
              quiet
              fg|foreground
	      )) or pod2usage(-verbose => 0);

if ($params{version}) {
    my ($vol, $dir, $file) = File::Spec->splitpath($0);
    print "OpenXPKI Core Version: $OpenXPKI::VERSION::VERSION\n";
    print "$file Version: $VERSION\n";
    exit 0;
}

pod2usage(-exitstatus => 0, -verbose => 2) if $params{man};
pod2usage(-verbose => 1) if ($params{help});
if (scalar @ARGV != 1) {
    print STDERR "Usage: openxpkictl [OPTIONS] start|stop\n";
    exit 0;
}

if (defined $params{debug}) {
    @{$params{debug}} = split(m{,}, join(',', @{$params{debug}}));
    
    foreach my $param (@{$params{debug}}) {
        my ($module, $level) = ($param =~ m{ \A (.*?):?(\d*) \z }xms);
        if ($level eq '') {
            $level = 1;
        }
        if ($module eq '') {
            # if modules are not specified, debug everything except for
            # XML::Cache and XML::Config (if you really want to debug these,
            # just use --debug .*:<debug level>)
            $OpenXPKI::Debug::LEVEL{'.*'} = $level;
            $OpenXPKI::Debug::LEVEL{'OpenXPKI::XML::Cache'}  = 0;
            $OpenXPKI::Debug::LEVEL{'OpenXPKI::XML::Config'} = 0;
        }
        else {
            print STDERR "Debug level for module '$module': $level\n";
            $OpenXPKI::Debug::LEVEL{$module} = $level;
        }
    }
}

if ($params{quiet})
{
    $QUIET = 1;
}

## do not migrate this to use statements
## this disturbs the debugging
require OpenXPKI::XML::Config;
require OpenXPKI::Server;

if (defined $params{cfg}) {
    $configfile = $params{cfg};
}

my $foreground;
if (defined $params{fg}) {
    $foreground = 1;
}

$configfile = File::Spec->rel2abs($configfile);

my $config = OpenXPKI::XML::Config->new(CONFIG => $configfile);

if (! defined $config) {
    print STDERR "ERROR: Could not read configuration file $configfile\n";
    exit 1;
}

my $pidfile;
eval {
    $pidfile = $config->get_xpath (
	XPATH   => ["common", "server", "pid_file"],
	COUNTER => [0, 0, 0],
	);
};
if ($EVAL_ERROR)
{
    print STDERR "ERROR: Could not determine PID file from configuration: " . $EVAL_ERROR->as_string() . "\n";
    exit 1;
}

### $pidfile

my $socketfile;
eval {
    $socketfile = $config->get_xpath (
	XPATH   => ["common", "server", "socket_file"],
	COUNTER => [0, 0, 0],
	);
};
if ($EVAL_ERROR)
{
    print STDERR "ERROR: Could not determine socket file from configuration: " . $EVAL_ERROR->as_string() . "\n";
    exit 1;
}

### $socketfile

my $pid;
if (-r $pidfile) {
    $pid = slurp($pidfile);
    chomp $pid if defined $pid;
}

my $command_table = {
    start   => \&do_start,
    stop    => \&do_stop,
    restart => sub {
	do_stop(@_); 
	do_start(@_);
    },
    status  => sub { 
	if (do_status(@_)) {
	    print "OpenXPKI Server is running and accepting requests.\n";
	} else {
	    print "OpenXPKI server is not running or does not accept requests.\n";
	}
    },
};

my $cmd = shift;

if (exists $command_table->{$cmd}) {
    if (! $command_table->{$cmd}->(
	      {
		  PID        => $pid,
		  PIDFILE    => $pidfile,
		  SOCKETFILE => $socketfile,
		  FOREGROUND => $foreground,
	      })) {
	exit 1;
    }
    exit 0;
}

print STDERR "Unknown command: $cmd.\n";
exit 1;

__END__

=head1 NAME

openxpkictl - start/stop script for OpenXPKI server

=head1 USAGE

openxpkictl [options] COMMAND

 Options:
   --help                brief help message
   --man                 full documentation
   --config FILE         use configuration from FILE
   --debug  MODULE:LEVEL set MODULE debug level to LEVEL 
                         (positive integer value).
                         MODULE defaults to '.*'
                         LEVEL defaults to 1
   --foreground          Uses a non-forking server. This is only
                         useful for debugging or profiling.

 Commands:
   start            Start OpenXPKI daemon
   stop             Stop OpenXPKI daemon
   restart          Restart OpenXPKI daemon
   status           Get OpenXPKI daemon status


=head1 ARGUMENTS

Available commands:

=over 8

=item B<start>

Starts the OpenXPKI daemon.

=item B<stop>

Stops the OpenXPKI daemon.

=item B<restart>

Restarts the OpenXPKI daemon.

=item B<status>

Checks the OpenXPKI daemon status.

=back

=head1 OPTIONS

=over 8

=item B<--help>

Print a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=item B<--config FILE>

Read configuration file FILE. Uses built-in default if not specified.

=item B<--version>

Print program version and exit.

=item B<--debug MODULE:LEVEL>

Set specific module debug level to LEVEL (must be a positive integer). Higher
values mean more debug output. Multiple --debug options can be specified.
It is also possible to specify multiple debug settings in one --debug
option by separating them with a comma.
MODULE must be a module specification (e. g. OpenXPKI::Server) and may
contain Perl Regular expressions.

MODULE defaults to '.*' if not specified. LEVEL defaults to 1 if not specified.

Examples:

  --debug
 (equivalent to --debug .*:1)

  --debug OpenPKI::Server
  (equivalent to --debug OpenXPKI::Server:1)

  --debug OpenPKI::Server:100
  (equivalent to --debug OpenXPKI::Server:100)

  --debug OpenPKI::Server:10 --debug OpenXPKI::Crypto::.*:20
  --debug OpenXPKI::Server:10,OpenXPKI::Crypto::.*:20
  (these two are equivalent)

=item B<--foreground>

Does not fork program away and uses a non-forking server. Pretty much
useful only for debugging and profiling.

=back

=head1 DESCRIPTION

B<openxpkictl> is the start script for the OpenXPKI server process. 

=over 8

NOTE: This script was customized to the paths specified during 
installation.
You will have to modify this script to reflect any changes to the 
installation directories.

The openxpkictl script returns a 0 exit value on success, and >0 if  an
error occurs.

=back