#!/usr/bin/env perl

use 5.14.2;
use warnings;

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

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 gettimeofday tv_interval];
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,
                newline   => 1,
                callbacks => sub {
                    my %args = @_;
                    $args{message} = sprintf "%s [%d] %s - %s", strftime( "%FT%TZ", gmtime ), $PID, 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,
                newline   => 1,
                callbacks => sub {
                    my %args = @_;
                    $args{message} = sprintf "%s [%d] %s - %s", strftime( "%FT%TZ", gmtime ), $PID, uc $args{level}, $args{message};
                },
            ],
        ]
    );
}

$SIG{__WARN__} = sub {
    $log->warning(map s/^\s+|\s+$//gr, map s/\n/ /gr, @_);
};

###
### 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;

    my $agent = Zonemaster::Backend::TestAgent->new( { config => $self->config } );
    # Disconnect from database in parent to avoid sharing the connection between children
    $agent->{_db}->dbh->disconnect;

    while ( !$caught_sigterm ) {
        my $cleanup_timer = [ gettimeofday ];

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

        Zonemaster::Backend::Metrics::gauge("zonemaster.testagent.maximum_processes", $self->pm->max_procs);
        Zonemaster::Backend::Metrics::gauge("zonemaster.testagent.running_processes", scalar($self->pm->running_procs));

        Zonemaster::Backend::Metrics::timing("zonemaster.testagent.cleanup_duration_seconds", tv_interval($cleanup_timer) * 1000);

        my $fetch_test_timer = [ gettimeofday ];

        my $id = $self->db->get_test_request( $self->config->ZONEMASTER_lock_on_queue );
        $self->db->process_unfinished_tests(
            $self->config->ZONEMASTER_lock_on_queue,
            $self->config->ZONEMASTER_max_zonemaster_execution_time,
        );

        Zonemaster::Backend::Metrics::timing("zonemaster.testagent.fetchtests_duration_seconds", tv_interval($fetch_test_timer) * 1000);

        if ( $id ) {
            $log->info( "Test found: $id" );
            if ( $self->pm->start( $id ) == 0 ) {    # Forks off child process
                $log->info( "Test starting: $id" );
                Zonemaster::Backend::Metrics::increment("zonemaster.testagent.tests_started");
                my $start_time = [ gettimeofday ];
                eval { $agent->run( $id ) };
                if ( $@ ) {
                    chomp $@;
                    Zonemaster::Backend::Metrics::increment("zonemaster.testagent.tests_died");
                    $log->error( "Test died: $id: $@" );
                    $self->db->process_dead_test( $id )
                }
                else {
                    Zonemaster::Backend::Metrics::increment("zonemaster.testagent.tests_completed");
                    $log->info( "Test completed: $id" );
                }
                Zonemaster::Backend::Metrics::timing("zonemaster.testagent.tests_duration_seconds", tv_interval($start_time) * 1000);
                $agent->reset();
                $self->pm->finish;                   # Terminates child process
            }
        }
        else {
            sleep $self->config->DB_polling_interval;
        }
    }

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

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

    return;
}


# 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 the environment is alright before forking
my $initial_config;
eval {
    # Make sure we can load the configuration file
    $log->debug("Starting pre-flight check");
    $initial_config = Zonemaster::Backend::Config->load_config();

    Zonemaster::Backend::Metrics->setup($initial_config->METRICS_statsd_host, $initial_config->METRICS_statsd_port);

    # 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 ( $@ ) {
    $log->critical( "Aborting startup: $@" );
    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
