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;

        }

    };

}