#!/usr/bin/env perl

use 5.14.2;
use warnings;

use Zonemaster::Backend::TestAgent;
use Zonemaster::Backend::Config;

use Parallel::ForkManager;
use Daemon::Control;
use Log::Any qw( $log );
use Log::Any::Adapter;
use Log::Dispatch;

use English;
use Pod::Usage;
use Getopt::Long;
use POSIX;
use Time::HiRes qw[time sleep];
use sigtrap qw(die normal-signals);

###
### Compile-time stuff.
###

BEGIN {
	$ENV{PERL_JSON_BACKEND} = 'JSON::PP';
}

# Enable immediate flush to stdout and stderr
$|++;

###
### More global variables, and initialization.
###

my $pidfile;
my $user;
my $group;
my $logfile;
my $loglevel;
my $opt_outfile;
my $opt_help;
GetOptions(
    'help!'      => \$opt_help,
    'pidfile=s'  => \$pidfile,
    'user=s'     => \$user,
    'group=s'    => \$group,
    'logfile=s'  => \$logfile,
    'loglevel=s' => \$loglevel,
    'outfile=s'  => \$opt_outfile,
) or pod2usage( "Try '$0 --help' for more information." );

pod2usage( -verbose => 1 ) if $opt_help;

$pidfile     //= '/tmp/zonemaster_backend_testagent.pid';
$logfile     //= '/var/log/zonemaster/zonemaster_backend_testagent.log';
$opt_outfile //= '/var/log/zonemaster/zonemaster_backend_testagent.out';
$loglevel    //= 'info';
$loglevel = lc $loglevel;

$loglevel =~ /^(?:trace|debug|info|inform|notice|warning|warn|error|err|critical|crit|fatal|alert|emergency)$/ or die "Error: Unrecognized --loglevel $loglevel\n";

# Returns a Log::Dispatch object logging to STDOUT
#
# This procedure duplicates the STDOUT file descriptor to make sure that it keeps
# logging to the same place even if STDOUT is later redirected.
sub log_dispatcher_dup_stdout {
    my $min_level = shift;

    open( my $fd, '>&', \*STDOUT ) or die "Can't dup STDOUT: $!";
    my $handle = IO::Handle->new_from_fd( $fd, "w" ) or die "Can't fdopen duplicated STDOUT: $!";
    $handle->autoflush(1);

    return Log::Dispatch->new(
        outputs => [
            [
                'Handle',
                handle    => $handle,
                min_level => $min_level,
                callbacks => sub {
                    my %args = @_;
                    $args{message} = sprintf "%s: %s\n", uc $args{level}, $args{message};
                },
            ],
        ]
    );
}

# Returns a Log::Dispatch object logging to a file
sub log_dispatcher_file {
    my $min_level = shift;
    my $log_file  = shift;

    return Log::Dispatch->new(
        outputs => [
            [
                'File',
                filename  => $log_file,
                mode      => '>>',
                min_level => $min_level,
                callbacks => sub {
                    my %args = @_;
                    $args{message} = sprintf "%s [%d] %s - %s\n", strftime( "%FT%TZ", gmtime ), $PID, uc $args{level}, $args{message};
                },
            ],
        ]
    );
}

###
### Actual functionality
###

sub main {
    my $self = shift;

    my $caught_sigterm = 0;
    my $catch_sigterm;
    $catch_sigterm = sub {
        $SIG{TERM} = $catch_sigterm;
        $caught_sigterm = 1;
        $log->notice( "Daemon caught SIGTERM" );
        return;
    };
    local $SIG{TERM} = $catch_sigterm;

    while ( !$caught_sigterm ) {
        $self->pm->reap_finished_children();    # Reaps terminated child processes
        $self->pm->on_wait();                   # Sends SIGKILL to overdue child processes

        my $id = $self->db->get_test_request();
        $self->db->process_unfinished_tests();

        if ( $id ) {
            $log->info( "Test found: $id" );
            if ( $self->pm->start( $id ) == 0 ) {    # Forks off child process
                $log->info( "Test starting: $id" );
                my $ta = Zonemaster::Backend::TestAgent->new( { config => $self->config } );
                eval { $ta->run( $id ) };
                if ( $@ ) {
                    chomp $@;
                    $log->error( "Test died: $id: $@" );
                }
                else {
                    $log->info( "Test completed: $id" );
                }
                $ta->reset();
                $self->pm->finish;                   # Terminates child process
            }
        }
        else {
            sleep $self->config->PollingInterval();
        }
    }

    $log->notice( "Daemon entered graceful shutdown" );

    $self->pm->wait_all_children();    # Includes SIGKILLing overdue child processes

    return;
}


# Make sure the environment is alright before forking
my $initial_config;
eval {
    # Initialize logging
    my $dispatcher;
    if ( $logfile eq '-' ) {
        $dispatcher = log_dispatcher_dup_stdout( $loglevel );
    }
    else {
        $dispatcher = log_dispatcher_file( $loglevel, $logfile );
        print STDERR "zonemaster-testagent logging to file $logfile\n";
    }
    Log::Any::Adapter->set( 'Dispatch', dispatcher => $dispatcher );

    # Make sure we can load the configuration file
    $log->debug("Starting pre-flight check");
    $initial_config = Zonemaster::Backend::Config->load_config();

    # Validate the Zonemaster-Engine profile
    Zonemaster::Backend::TestAgent->new( { config => $initial_config } );

    # Connect to the database
    $initial_config->new_DB();
    $log->debug("Completed pre-flight check");
};
if ( $@ ) {
    print STDERR "Aborting startup: $@";
    exit 1;
}

###
### Daemon Control stuff.
###

my $daemon = Daemon::Control->with_plugins( qw( +Zonemaster::Backend::Config::DCPlugin ) )->new(
    {
        name    => 'zonemaster-testagent',
        program => sub {
            my $self = shift;
            $log->notice( "Daemon spawned" );

            $self->init_backend_config( $initial_config );
            undef $initial_config;

            eval { main( $self ) };
            if ( $@ ) {
                chomp $@;
                $log->critical( $@ );
            }
            $log->notice( "Daemon terminating" );
        },
        pid_file    => $pidfile,
        stderr_file => $opt_outfile,
        stdout_file => $opt_outfile,
    }
);

$daemon->init_config( $ENV{PERLBREW_ROOT} . '/etc/bashrc' ) if ( $ENV{PERLBREW_ROOT} );
$daemon->user($user) if $user;
$daemon->group($group) if $group;

exit $daemon->run;

=head1 NAME

zonemaster_backend_testagent - Init script for Zonemaster Test Agent.

=head1 SYNOPSIS

    zonemaster_backend_testagent [OPTIONS] [COMMAND]

=head1 OPTIONS

=over 4

=item B<--help>

Print a brief help message and exits.

=item B<--user=USER>

When specified the daemon will drop to the user with this username when forked.

=item B<--group=GROUP>

When specified the daemon will drop to the group with this groupname when forked.

=item B<--pidfile=FILE>

The location of the PID file to use.

=item B<--logfile=FILE>

The location of the log file to use.

When FILE is -, the log is written to standard output.

=item B<--loglevel=LEVEL>

The location of the log level to use.

The allowed values are specified at L<Log::Any/LOG-LEVELS>.

=item B<COMMAND>

One of the following:

=over 4

=item start

=item foreground

=item stop

=item restart

=item reload

=item status

=item get_init_file

=back

=back

=cut
