#=============================================================================
# Doloforge::Command::Cron : doloforge cron scheduling command-line tool
#
# This module executes cron jobs for each client/project, if the service
# is enabled, and if the date matches.
#
# Full help :
#   doloforge cron --man
#
# Debug run :
#   sudo perl ./src/doloforge --verbose --verbose --verbose --config ./t/doloforge.yaml cron --run --interval 'daily' --date '20/08/2008'
#   sudo perl ./src/doloforge --verbose --verbose --verbose --config ./t/doloforge.yaml cron --maintenance --interval 'hourly'
#=============================================================================


package Doloforge::Command::Cron;

use strict;
use warnings;

# This base class implements the constructor and help methods in a generic way.
use base qw(Doloforge::Command);

use Date::Calc qw(:all);
use Doloforge::Service;
#use File::Touch;


#=============================================================================
=encoding utf8

=head1 NAME

Doloforge::Command::Cron - doloforge cron scheduling command-line tool

=head1 SYNOPSIS

    # Run the daily cron jobs at a specific date
    doloforge cron --maintenance cron --run --interval 'daily' --date '20/08/2008'

    # Add the cron service to an existing project
    doloforge project --add --client internal --name sandbox --allowmod --services 'cron'

=head1 DESCRIPTION

Todo

The cron.d script dropped by the package install will take care of calling every
needed cron command. Usual runs are the project run, and the maintenance runs specific
for each role of the servers.

=cut


#=============================================================================
# Method getOptions
#
# Accepted arguments from the command-line, in the form accepted by Getopt::Long.
# Options with no value that match method names of that package will be called as
# methods, with the decoded options as parameters.

sub getOptions {
    return (
        # actions :
        'run',                  # run de cron jobs listed in the --interval parameter
        'maintenance',          # run the maintenance jobs, internally coded for each server role and service
        # parameters :
        'interval|i=s',         # define the intervals to run cron jobs defined for (intervals [.,:/] separated)
        'date|d=s',             # override the current date for interval matching evaluation (formated as DD/MM/YYYY as in `date +'%d/%m/%Y'`)
    );
}


#=============================================================================
# Method run
#
# Run the defined cron jobs, following these rules:
#   - the command is meant to be called everyday in the morning by cron, and in the /etc/cron.hourly system pool
#   - the specified date, if provided, overrides the current date
#   - a lock is taken on a directory shared by application servers, allowing only one server to run the cron jobs
#   - the hourly and daily intervals always execute the corresponding jobs
#   - all other intervals are checked with the date
#       + weekly jobs are only run when day of week is sunday (morning)
#       + monthly jobs are only run when this is the first day of the month (1st in the morning)
#   - running a jobs is done the following way :
#       + setup a proper environment, after reading the project configuration
#       + environment variables are cleanly defined
#       + redirect stdout/err to a temporary file, close stdin
#       + set working directory to the project's main directory
#       + run the script and mail the output to the project contact email

sub run {
    my $self = shift;

    my ($option) = @_;

    $self->error("run: must be run as root (try su, sudo, etc.)")
        unless ($self->check_uid('root'));
    unless ($self->has_role('appserv_role')) {
        $self->info("run: must run on active application servers only");
        return; # This is a non-fatal error message, since test.doloforge.com is built on an active/standby AP+NFS server
    }

    # Get the passed date, or the current one if not defined. Send an error if the date is not parsable.
    # @date == ($year,$month,$day)
    my @date = Today();
    if (defined($option->{date})) {
        (@date = Decode_Date_EU($option->{date}))
        or (@date = Parse_Date($option->{date}))
        or $self->error("Cannot parse date parameter '$option->{date}' (see Date::Calc Decode_Date_EU and Parse_Date)");
    }
    # Format the date as a proper partial ISO-8601 date (YYYY-MM-DD)
    my $date = sprintf('%04d-%02d-%02d', @date);

    # Separate (split) and validate (grep) the passed interval(s), which is a mandatory parameter.
    $self->error("Missing interval definition") unless (exists($option->{interval}));
    my @interval = grep(/^(test|hourly|daily|weekly|monthly)$/, split(/[\.,:\/]/, $option->{interval}));
    $self->error("Wrong interval definition '$option->{interval}'") unless ($#interval >= 0);

    # From now on, the messages will be prefixed by a relative timestamp...
    $self->show_timestamps();

    # Get the lock on the shared directory. The lock is created on NFS, but we do not need to actually use the file/dir.
    # It's just a lock...
    # Remember the date at which the lock is created, in order to wait a bit to be sure other hosts won't re-execute the cron later...
    # Since host must be synchronized with NTP, the wait needn't be longer than a minute.
    # The lock name depends on the list of intervals passed. We can't get an independant lock for each interval, because we don't know when each interval will run.
    # The lock will be destroyed at the end of this run (method).
    my $lock = $self->acquire_lock('run.'.join('_', @interval));

    # Even if we didn't get the lock, we have to run "cron/${interval}/nolock" jobs. This will run some jobs on every application server...
    #return unless $lock;

    # Keep trace of the time the lock was acquired, to add a delay at the end...
    my $locked = time;

    # Before all the project job runs, we must make sure the corresponding maintenance work on all hosts for the same interval is finished.
    # Wait for all these "cron --maintenance" lock to release, then run the regular jobs. Do only this on hourly single-runs, because the inner loop @interval would be locked too long (or should be moved around the client/project loop)...
    # Since "cron --maintenance" runs on front-end servers, while this "cron --run" runs on virtual machines, we may not even see the lock, but we're sure it's actually finished.
    $self->wait_lock('maintenance.hourly.*') if ($lock and grep(/hourly/, @interval));

    # List all active projects (beware: an active project can be owned by an inactive client, and will still be listed)
    my $clients = (&Doloforge::Command::Factory('Client', $self->{global}))->_list();
    my $projects = (&Doloforge::Command::Factory('Project', $self->{global}))->_list();
    foreach (sort(keys(%{$projects}))) {
        my $project = $projects->{$_};
        my $client = $clients->{$project->{client}};

        # If the client is inactive, or the project, just don't run anything
        next unless ($client->{active} and $project->{active});

        $self->debug("Running ".join(', ', @interval)." jobs for $project->{client}/$project->{name}\@$self->{global}->{stage}.$self->{global}->{host} $date".($lock ? '' : ' (nolock only)'));

        # We try to launch the cron_run method for each service of the project; some won't do anything, some will...
        foreach my $service (sort(keys(%{$project->{services}}))) {
            $self->debug("Running $service jobs for $project->{client}/$project->{name}\@$self->{global}->{stage}.$self->{global}->{host} $date".($lock ? '' : ' (nolock only)'));

            # Run jobs pertaining to the appropriate intervals
            foreach my $interval (@interval) {
                next unless (($interval eq 'test')                                  # always run the special test run
                          or ($interval eq 'hourly')                                # always run hourly jobs from /etc/cron.hourly
                          or ($interval eq 'daily')                                 # always run daily jobs from the daily morning run
                         or (($interval eq 'weekly') and (Day_of_Week(@date) == 7)) # run the weekly jobs on sunday
                         or (($interval eq 'monthly') and ($date[2] == 1)));        # run the monthly jobs on the 1st of the month

                # Call the service method with the project context
                $self->{service_instance}->{$service} ||= &Doloforge::Service::Factory($service, $self->{global});
                # Run the [interval]/nolock jobs on every application server, then the [interval] jobs only if the lock was acquired
                #   cron runs ./cron/daily/nolock/*
                #   DBs only backup when interval eq 'daily', not 'daily/nolock'
                $self->{service_instance}->{$service}->cron_run($client, $project, $date, "$interval/nolock");
                $self->{service_instance}->{$service}->cron_run($client, $project, $date, $interval) if $lock;
            }
        }
    }

    # After all these daily project job runs, we must run the log analysis, which must happen AFTER all maintenance work on all hosts.
    # Wait for all these "cron --maintenance" lock to release, then run the analysis. Do only this on daily/weekly/monthly all-in-one runs...
    # Since "cron --maintenance" is spawn from crontab BEFORE and separately from this "cron --run", we're sure it's actually finished, even if we do not even see the lock.
    if ($lock and grep(/daily/, @interval) and $self->wait_lock('maintenance.daily.*')) {
        $self->info("Starting report subcommand for $self->{global}->{stage} log analysis...");
        (&Doloforge::Command::Factory('report', $self->{global}))->run({date => $option->{date}});
    }

    # Check if the overall time taken for the run was higher than the "normal"/"expected" duration set in the conf file
    my $max_seconds = $self->{config}->{excessive_run}->{join(',', @interval)} if (exists($self->{config}->{excessive_run}->{join(',', @interval)}));
    if ($max_seconds and ((time - $locked) > $max_seconds)) {
        $self->warn("Interval '$option->{interval}' run time excessive (>${max_seconds}s): please investigate!");
    }

    # Wait some time to allow every other hosts to abort their run (they must not get the lock, ie. the lock must last long enough)
    # Actual time remaining until the duration of the current run is the minimum allowed
    #   (120 - (123456789 - 123456000 = 789) = -669)
    #   (120 - (123456789 - 123456700 = 89) = 31)
    #   (120 - (123456789 - 123456789 = 0) = 120)
    #   (120 - (123456789 - 0 = 123456789) = -123456669)
    my $remaining = 30 - (time - $locked);
    # If the duration was less than the minimum, wait a bit further until the minimum has passed...
    if ($remaining > 0) {
        $self->info("Sleeping for the remaining $remaining seconds...");
        sleep($remaining);
    }

    # We make sure the lock directory is removed, or it will prevent future runs of the same intervals...
    # Do not do this in the DESTROY method, which is called for each forked process, which is way before when we intend to actually release the lock...
    # Release the lock even if it was not actually acquired: this is harmless...
    $self->release_lock($lock);
}


#=============================================================================
# Methods maintenance
#
# Called by the cron.d script, this method will trigger maintenance tasks for
# each server role (APP, NFS and DB servers).
# Maintenance is called via a separate crontab entry, that MUST occur BEFORE
# the daily cron --run, because we NEED log rotation, merge, etc. to be finished
# before running the log analysis (happenning at the end of "cron --run").

sub maintenance {
    my $self = shift;

    my ($option) = @_;

    $self->error("run: must be run as root (try su, sudo, etc.)")
        unless ($self->check_uid('root'));

    # Separate (split) and validate (grep) the passed interval(s), which is a mandatory parameter.
    # The "maintenance" mode allows a single interval at each call, and only a few interval names (see "run" mode for more).
    $self->error("Missing interval definition") unless (exists($option->{interval}));
    my @interval = grep(/^(hourly|daily)$/, split(/[\.,:\/]/, $option->{interval}));
    $self->error("Wrong interval definition '$option->{interval}'") unless ($#interval == 0);
#    my $interval = $interval[0];

    # From now on, the messages will be prefixed by a proper timestamp...
    $self->show_timestamps();

    foreach my $interval (@interval) {
        # Set a semaphore-like lock, to inform the "cron --run" crontab entry when we have finished these tasks (log analyses will run AFTER all the maintenance)
        my $lock = $self->acquire_lock("maintenance.$interval.$self->{global}->{host}");

        # Get the list of maintenance services for this interval
        my $services = $self->{config}->{maintenance}->{$interval};

        if ($lock) {
            # Get the single NFS lock as soon as possible, to ensure a single host gets it, in case the NFS storage is served by many hosts (CephFS)
            # FIXME ajouter un délais de "pénalité" pour priviliéger les serveurs inactifs par ailleurs (datacenter sans ticket, serveurs non gateway, load 15 minutes, etc.)
            my $lock_nfs = $self->acquire_lock("maintenance_nfs.$interval");

            # Call the correct maintenance methods, depending on the server role.
            # Roles are not exclusive, so we may run all of them on a single instance.
            # The order is important, since APP will first send logs to NFS, which will
            # then merge them. This will happen correctly in every setup, whether a single
            # host cumulates all the roles, or roles are separated on various hosts.
            $self->_maintenance_on_appserv($interval, $services) if ($self->has_role('appserv_role'));
            $self->_maintenance_on_mail($interval, $services) if ($self->has_role('mail_role'));
            $self->_maintenance_on_nfs($interval, $services) if ($self->has_role('nfs_role') and $lock_nfs);

            # Release the NFS lock, which should never be too early
            $self->release_lock($lock_nfs);
        }

        # Remove the lock, which will unleash the "cron --run" jobs (log analysis)
        $self->release_lock($lock);

        # These maintenance tasks are outside of the locked block, because...
        # ...DB server will not be able to lock on the NFS shared tree, unless the host have both roles...
#        $self->_maintenance_on_db($interval, $services) if ($self->has_role('db_role'));
    }
#    if ($interval eq 'daily') {
#        # Set a semaphore-like lock, to inform the "cron --run" crontab entry when we have finished these tasks (log analyses will run AFTER all the maintenance)
#        my $lock = $self->acquire_lock("maintenance.$self->{global}->{host}");
#
#        if ($lock) {
#            # Get the single NFS lock as soon as possible, to ensure a single host gets it, in case the NFS storage is served by many hosts (CephFS)
#            # FIXME ajouter un délais de "pénalité" pour priviliéger les serveurs inactifs par ailleurs (datacenter sans ticket, serveurs non gateway, load 15 minutes, etc.)
#            my $lock_nfs = $self->acquire_lock('maintenance_nfs');
#
#            # Call the correct maintenance methods, depending on the server role.
#            # Roles are not exclusive, so we may run all of them on a single instance.
#            # The order is important, since APP will first send logs to NFS, which will
#            # then merge them. This will happen correctly in every setup, whether a single
#            # host cumulates all the roles, or roles are separated on various hosts.
#            $self->_maintenance_on_appserv() if ($self->has_role('appserv_role'));
#            $self->_maintenance_on_nfs() if ($self->has_role('nfs_role') and $lock_nfs);
#
#            # Release the NFS lock, which should never be too early
#            $self->release_lock($lock_nfs);
#        }
#
#        # Remove the lock, which will unleash the "cron --run" jobs (log analysis)
#        $self->release_lock($lock);
#
#        # These maintenance tasks are outside of the locked block, because...
#        # ...DB server will not be able to lock on the NFS shared tree, unless the host have both roles...
#        $self->_maintenance_on_db() if ($self->has_role('db_role'));
#
#    } elsif ($interval eq 'hourly') {
#        # ...the central mail server may have no relation whatsoever to the other hosts (including not being able to lock at all)
#        $self->_maintenance_on_mail() if ($self->has_role('mail_role') and ($interval eq 'hourly'));
#    }
}


#=============================================================================
# Methods _maintenance_*
#
# Called by the run methods, in order to run Doloforge daily maintenance tasks.
# Instead of coding various small scripts and put them in cron.daily, we benefit
# here from the doloforge environment, logging, etc.
# There is no arguments for this method : it is simply called daily, before the
# projects jobs, on each and every application server.
# All methods are executed under the root ID, and must take care to change to
# specific IDs, before doing risky things like removing files, etc...
# See Doloforge::Base::run_sub to change uid/gid.

sub _maintenance_on_appserv {
    my $self = shift;

    my ($interval, $services) = @_;
    return unless ($services and ref($services) eq 'ARRAY' and scalar(@{$services}) > 0);

    $self->info("Starting maintenance jobs for $self->{global}->{stage} appserv server");

    # Set a semaphore-like lock, to prevent other server roles to continue before we finish everything (notably NFS)
    my $lock = $self->acquire_lock("maintenance_appserv.$interval.$self->{global}->{host}");

    if ($lock) {
        # Get an object (and cache it) for every service that we know need some maintenance...
        foreach my $service (@{$services}) {
            $self->{service_instance}->{$service} ||= &Doloforge::Service::Factory($service, $self->{global});
            $self->{service_instance}->{$service}->maintenance_on_appserv($interval);
        }
    }

    # Remove the lock, which will unleash the NFS server task
    $self->release_lock($lock);
}

sub _maintenance_on_nfs {
    my $self = shift;

    my ($interval, $services) = @_;
    return unless ($services and ref($services) eq 'ARRAY' and scalar(@{$services}) > 0);

    $self->info("Starting maintenance jobs for $self->{global}->{stage} nfs server");

    # For various reasons, we must make sure the maintenance process have already started and finished on application server,
    # so the order in which processes run on each server role is deterministic.
    # Servers will raise semaphores to synchronise themselves. The starting state is defined here...
    # (it would be bad if we start working on log files that are being transfered to the shared disk space, between this point and the next one below)
    # This is abviously only important in the case roles are separated on several hosts. A single-host setup won't have sync problems here...
    if ($self->wait_lock("maintenance_appserv.$interval.*")) {

        # Get an object (and cache it) for every service that we know need some maintenance...
        foreach my $service (@{$services}) {
            $self->{service_instance}->{$service} ||= &Doloforge::Service::Factory($service, $self->{global});
            $self->{service_instance}->{$service}->maintenance_on_nfs($interval);
        }
    }
}

#sub _maintenance_on_db {
#    my $self = shift;
#
#    $self->info("Starting maintenance jobs for $self->{global}->{stage} db server");
#
#    # Get an object (and cache it) for every service that we know need some maintenance...
#    # DB backup is NOT part of the maintenance on the DB server, because it need access to
#    # file storage, and should run once per project (not once per server), which is the
#    # role of the application servers' cron_run()
##    foreach my $service ('mysql', 'postgres7', 'postgres8') {
##        $self->{service_instance}->{$service} ||= &Doloforge::Service::Factory($service, $self->{global});
##        $self->{service_instance}->{$service}->maintenance_on_db();
##    }
#}

sub _maintenance_on_mail {
    my $self = shift;

    my ($interval, $services) = @_;
    return unless ($services and ref($services) eq 'ARRAY' and scalar(@{$services}) > 0);

    $self->info("Starting maintenance jobs for $self->{global}->{stage} mail server");

    # Get an object (and cache it) for every service that we know need some maintenance...
    # Mail maintenance mainly consist of parsing the /var/log/mail.log file to extract Delivery Status Notifications
    foreach my $service (@{$services}) {
        $self->{service_instance}->{$service} ||= &Doloforge::Service::Factory($service, $self->{global});
        $self->{service_instance}->{$service}->maintenance_on_mail($interval);
    }
}


#=============================================================================
# Lock management methods, used to synchronize tasks
# These are all based on directory creation (atomic NFS call) in the shared tree.
# FIXME : inclure $stage dans le nom des locks, supprimer ".lock" dans les appels
# FIXME : attention : les locks sont dans $shared, donc dépendant du stage !!!
# FIXME : ajouter un lock sur db-role et nfs-role
# FIXME : paralléliser les runs sur les différents étages (pour conserver la synchro)

# Acquire a lock by name, returning the name if actually acquired, or undef if not acquired.
# Do not wait for lock acquisition. Just fail.
sub acquire_lock {
    my $self = shift;
    my ($name) = @_;

    my $lock = "$self->{global}->{dir}->{shared}/.doloforge/$self->{name}/lock/$name";
    my $locked = time if mkdir($lock);
    $self->info("Lock $name ".($locked ? "acquired at $locked" : 'NOT acquired')." ($lock)");

    # If the lock was not acquired, it may happen that it was left locked by a very old process
    # (which probably died without unlocking, because, yes, unlocking is not fail-safe)
    # Checks for lock older than roughly 15min, which is the delay between the logcheck run (H:02) and the next hourly cron run (H:17)
    # (I want to be warned as soon as possible, but avoid false alarms about normally held lock)
    if (not $locked and (-d $lock) and ((stat($lock))[9] < time - 10*60)) { # if mtime is older than that many minutes...
        $self->warn("Lock $name seems too old to be reliable ($lock): please investigate!");
    }

    return ($locked ? $name : undef);
}

# Release an acquired lock. Just give it's name as returned by acquire_lock().
sub release_lock {
    my $self = shift;
    my ($name) = @_;

    if ($name) {
        my $lock = "$self->{global}->{dir}->{shared}/.doloforge/$self->{name}/lock/$name";
        $self->info("Releasing lock $name at ".time." ($lock)");
        rmdir($lock);
    }
}

# Wait for a lock to be released, polling for it, after an initial delay.
# Internal delay is fixed, but suitable for NTP-synchronized hosts.
# A lock name can contain a wildcard, to check for a set of lock to release.
sub wait_lock {
    my $self = shift;
    my ($name) = @_;

    my $locks = "$self->{global}->{dir}->{shared}/.doloforge/$self->{name}/lock/$name";
    $self->info("Waiting for lock $name to be released ($locks)");
    do {
        # Wait a bit between each check...
        sleep(30); # seconds
    } while (grep {-d} glob($locks));
    $self->info("Continuing after lock $name released ($locks)");

    # In case we want to return a "I've been waiting too long, aborting" someday...
    return 1;
}



1;
__END__

=head1 AUTHOR

Nicolas Huillard <F<nicolas@huillard.net>>, Dolomède

=head1 SEE ALSO

doloforge(1)

=cut
