Subversion Repositories DevTools

#! /usr/bin/perl
########################################################################
# Copyright (C) 2011 Vix-ERG Limited, All rights reserved
#
# Module name   : pl
# Compiler(s)   : Perl
#
# Description   : Start up the package blat system
#
# Usage         : blat 'tag' opr args
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;

use Getopt::Long;                               # Option processing
use Pod::Usage;                                 # Required for help support

use POSIX qw(setsid strftime);
use POSIX ":sys_wait_h";
use File::Basename;
use File::Spec::Functions qw(rel2abs);
use Cwd;

use FindBin;                                    # Determine the current directory
use lib "$FindBin::Bin/lib";                    # Allow local libraries

use Utils;
use StdLogger;                                  # Log to sdtout
use Logger;                                     # Log to file

#
#   Globals
#
my $rootDir = $FindBin::Bin;
my $configFile = "/blat.cfg";
my $configPath = "${rootDir}/config${configFile}";
my $logger = StdLogger->new();
my %children;
my %dead;
my $conf;
my $mtimeConfig = 0;

#
#   Options
#
my $opt_help = 0;
my $opt_verbose = 0;
my $opt_nodaemonise = 0;
my $opt_config;
my $opt_basedir = $rootDir;
my $opt_pid;

#
#   Describe configuration parameters
#
my %cdata = (
    '.ignore'         => {'env\.(.+)'   => 'envVars', 'path\.(.+)'   => 'envPath'},
    'pidfile'         => {'mandatory' => 0    , 'fmt' => 'vfile'},
    'logfile'         => {'mandatory' => 1    , 'fmt' => 'vfile'},
    'logfile.size'    => {'default'   => '1M' , 'fmt' => 'size'},
    'logfile.count'   => {'default'   => 9    , 'fmt' => 'int'},
    'config'          => {'mandatory' => 1    , 'fmt' => 'dir'},
    'verbose'         => {'default'   => 0    , 'fmt' => 'int'},
    'configpoll'      => {'default'   => 10   , 'fmt' => 'period'},
);

#-------------------------------------------------------------------------------
# Function        : Mainline Entry Point
#
# Description     :
#
# Inputs          :
#
my $result = GetOptions (
                "help|h:+"      => \$opt_help,
                "manual:3"      => \$opt_help,
                "verbose:+"     => \$opt_verbose,
                "D"             => \$opt_nodaemonise,
                "config=s"      => \$opt_config,
                "dir=s"         => \$opt_basedir,
                "pid=s"         => \$opt_pid,
                );

                #
                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
                #

#
#   Process help and manual options
#
pod2usage(-verbose => 0, -message => "dpkg_blat") if ($opt_help == 1 || ! $result || $#ARGV >= 0);
pod2usage(-verbose => 1) if ($opt_help == 2 );
pod2usage(-verbose => 2) if ($opt_help > 2);

#
#   Process options
#
chdir ($opt_basedir) || die ("Cannot 'cd' to $opt_basedir: $!\n");
print "Current Directory: ", getcwd() , "\n";

if ( $opt_config )
{
    $configPath = rel2abs( $opt_config );
    my($filename, $directories, $suffix) = fileparse($configPath);
    $configFile = '/' . $filename;
}

#-------------------------------------------------------------------------------
#   Read in the basic configuration
readConfig();

#
#   Only one instance
#
die "No PID file provided or configured" unless ( $conf->{pidfile} );
Utils::checkpid($conf);

#
#   Daemonise myself
#
unless ( $opt_nodaemonise )
{
    $logger->logmsg('Daemonizing...');

    my $msg = 'Can\'t read /dev/null:';
    open STDIN, '>/dev/null' or $logger->err("$msg $!");
    open STDOUT, '>/dev/null' or $logger->err("$msg $!");
    open STDERR, '>/dev/null' or $logger->err("$msg $!");
    defined (my $pid = fork) or $logger->err("Can't fork: $!");
    exit if $pid;
    
    setsid or $logger->err("Can't start a new session: $!");
    $logger->logmsg('Writing pid');
}

#
#   Locate and start up new transfer targets
#
Utils::writepid($conf);
sighandlers();
while ( 1 )
{
    readConfig();

    #
    #   Process all the configured transfer targets
    #
    for my $target ( glob($conf->{'config'} . '/*.conf') )
    {
        #
        #   Known entries are tested
        #   If the child is dead, then it will be restarted
        #
        if ( exists $children{$target} )
        {
            my $pid = $children{$target}{pid};
            next unless ( exists $dead{$pid} );
            delete $dead{$pid};
            delete $children{$target};
        }

        #
        #   Fork then exec
        #
        $logger->logmsg("Starting $target");
        defined (my $pid = fork) or $logger->err("Can't fork: $!");
        if ( $pid )
        {
            #
            #   Parent process. Save PID for dead child testing
            #
            $children{$target}{pid} = $pid;
            next;
        }

        #
        #   Child process at this point
        #
#        setsid or $logger->err("Can't start a new session: $!");
        $logger->logmsg("Started $target");

        #
        #   Determine the daemon to run
        #   Based on the name of the config file
        #       Use the basename of the config file
        #       Uppercase the first letter
        #       If there is a perl file of this name in the rootDir then use it
        #       Otherwise use the default of blatDaemon
        #   
        $target =~ m~.*/(.*)\.conf$~;
        my $daemon = $rootDir . '/blat' . ucfirst($1) . '.pl';
        unless (-f $daemon) {
            $daemon = "$rootDir/blatDaemon.pl";
        }
        $logger->verbose("Start: $daemon $target");
        exec 'perl',$daemon, $target or $logger->err ("Can't exec $daemon");
    }

    #
    #   What a bit and try again
    #
    sleep $conf->{'configpoll'};

    #
    #   Reap child processes
    #   Remember the dead ones - they will be restarted
    #
    #...
    my $kid;
    do {
        if ( ($kid = waitpid(-1, WNOHANG)) > 0 )
        {
            $dead{$kid} = 1;
            $logger->logmsg("Child Process terminated: $kid");
        }
    } while ( $kid > 0 );
}

#-------------------------------------------------------------------------------
# Function        : readConfig
#
# Description     : Re read the config file if it modification time has changed
#                   Not much happens if the config is re-read
#                   Only a few of the attributes are used
#
# Inputs          : Nothing
#
# Returns         : Nothing
#
sub readConfig
{
    my ($mtime) = Utils::mtime($configPath);
    if ( $mtimeConfig != $mtime )
    {
        $logger->logmsg("Reading config file: $configPath");
        $mtimeConfig = $mtime;
        my $errors;
        ($conf, $errors) = Utils::readconf ( $configPath, \%cdata );
        if ( scalar @{$errors} > 0 )
        {
            warn "$_\n" foreach (@{$errors});
            die ("Config contained errors\n");
        }

        #
        #   Reset some information
        #   Create a new logger
        #
        $logger = Logger->new($conf);
        $conf->{logger} = $logger;
        $logger->verbose("Log Levl: $conf->{verbose}");

        #
        #   Some command line options will override config
        #
        $conf->{pidfile} = $opt_pid if ( defined $opt_pid );
        $conf->{verbose} = $opt_verbose if ( $opt_verbose > 0 );

        #
        #   Scan the configuration and export specified environment values
        #   Simplfies the process of passing data to children
        #
        while (my($key, $data) = each ( %{$conf->{envVars}} ))
        {
            $ENV{$key} = $data;
            $logger->verbose("Env: $key -> $data");
    
        }

        #   Extend the path
        my @extraPath;
        while (my($key, $data) = each ( %{$conf->{envPath}} ))
        {
            push @extraPath, $data;
            $logger->verbose("Path: $key -> $data");
    
        }
        if ( @extraPath )
        {
            $ENV{PATH} = join( ':', $ENV{PATH} , @extraPath );
        }
        $logger->verbose("PATH: $ENV{PATH}");
    }
}



#-------------------------------------------------------------------------------
# Function        : sighandlers
#
# Description     : Install signal handlers
#
# Inputs          : None
#
# Returns         : Nothing
#
sub sighandlers
{
    $SIG{TERM} = sub {
        # On shutdown
        $logger->logmsg('Received SIGTERM. Shutting down....' );
        foreach my $entry ( keys %children )
        {
            my $pid = $children{$entry}{pid};
            $logger->logmsg('Terminate child: ' . $pid);
            kill 15, $pid;
        }

        unlink $conf->{'pidfile'} if -f $conf->{'pidfile'};
        exit 0;
    };

    $SIG{HUP} = sub {
        # On logrotate
        $logger->logmsg('Received SIGHUP.');
        $logger->rotatelog();
        foreach my $entry ( keys %children )
        {
            my $pid = $children{$entry}{pid};
            $logger->logmsg('Signal HUP to child: ' . $pid);
            kill 1, $pid;
        }
    };

    $SIG{USR1} = sub {
        # On Force Archive Sync
        $logger->logmsg('Received SIGUSR1.');
        foreach my $entry ( keys %children )
        {
            my $pid = $children{$entry}{pid};
            $logger->logmsg('Signal USR1 to child: ' . $pid);
            kill 'USR1', $pid;
        }
    };
}