Subversion Repositories DevTools

Rev

Rev 1038 | Rev 3847 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 1038 Rev 1040
Line 1... Line 1...
1 
########################################################################
 1 
#! /usr/bin/perl
2 
# Copyright (C) 2011 Vix-ERG Limited, All rights reserved
 2 
########################################################################
3 
#
 3 
# Copyright (C) 2011 Vix-ERG Limited, All rights reserved
4 
# Module name   : pl
 4 
#
5 
# Compiler(s)   : Perl
 5 
# Module name   : pl
6 
#
 6 
# Compiler(s)   : Perl
7 
# Description   : Start up the package blat system
 7 
#
8 
#
 8 
# Description   : Start up the package blat system
9 
# Usage         : blat 'tag' opr args
 9 
#
10 
#
 10 
# Usage         : blat 'tag' opr args
11 
#......................................................................#
 11 
#
12 
 
 12 
#......................................................................#
13 
require 5.008_002;
 13 
 
14 
use strict;
 14 
require 5.008_002;
15 
use warnings;
 15 
use strict;
16 
 
 16 
use warnings;
17 
use Getopt::Long;                               # Option processing
 17 
 
18 
use Pod::Usage;                                 # Required for help support
 18 
use Getopt::Long;                               # Option processing
19 
 
 19 
use Pod::Usage;                                 # Required for help support
20 
use POSIX qw(setsid strftime);
 20 
 
21 
use POSIX ":sys_wait_h";
 21 
use POSIX qw(setsid strftime);
22 
use File::Basename;
 22 
use POSIX ":sys_wait_h";
23 
use File::Spec::Functions qw(rel2abs);
 23 
use File::Basename;
24 
use Cwd;
 24 
use File::Spec::Functions qw(rel2abs);
25 
 
 25 
use Cwd;
26 
use FindBin;                                    # Determine the current directory
 26 
 
27 
use lib "$FindBin::Bin/lib";                    # Allow local libraries
 27 
use FindBin;                                    # Determine the current directory
28 
 
 28 
use lib "$FindBin::Bin/lib";                    # Allow local libraries
29 
use Utils;
 29 
 
30 
use StdLogger;                                  # Log to sdtout
 30 
use Utils;
31 
use Logger;                                     # Log to file
 31 
use StdLogger;                                  # Log to sdtout
32 
 
 32 
use Logger;                                     # Log to file
33 
#
 33 
 
34 
#   Globals
 34 
#
35 
#
 35 
#   Globals
36 
my $rootDir = $FindBin::Bin;
 36 
#
37 
my $configFile = "/blat.conf";
 37 
my $rootDir = $FindBin::Bin;
38 
my $configPath = "${rootDir}/config${configFile}";
 38 
my $configFile = "/blat.cfg";
39 
my $logger = StdLogger->new();
 39 
my $configPath = "${rootDir}/config${configFile}";
40 
my %children;
 40 
my $logger = StdLogger->new();
41 
my %dead;
 41 
my %children;
42 
my $conf;
 42 
my %dead;
43 
my $mtimeConfig = 0;
 43 
my $conf;
44 
 
 44 
my $mtimeConfig = 0;
45 
#
 45 
 
46 
#   Options
 46 
#
47 
#
 47 
#   Options
48 
my $opt_help = 0;
 48 
#
49 
my $opt_verbose = 0;
 49 
my $opt_help = 0;
50 
my $opt_daemonise = 1;
 50 
my $opt_verbose = 0;
51 
my $opt_config;
 51 
my $opt_nodaemonise = 0;
52 
my $opt_basedir = $rootDir;
 52 
my $opt_config;
53 
my $opt_pid;
 53 
my $opt_basedir = $rootDir;
54 
 
 54 
my $opt_pid;
55 
#
 55 
 
56 
#   Describe configuration parameters
 56 
#
57 
#
 57 
#   Describe configuration parameters
58 
my %cdata = (
 58 
#
59 
    '.ignore'         => {'env\.(.+)'   => 'envVars', 'path\.(.+)'   => 'envPath'},
 59 
my %cdata = (
60 
    'pidfile'         => {'mandatory' => 0    , 'fmt' => 'vfile'},
 60 
    '.ignore'         => {'env\.(.+)'   => 'envVars', 'path\.(.+)'   => 'envPath'},
61 
    'logfile'         => {'mandatory' => 1    , 'fmt' => 'vfile'},
 61 
    'pidfile'         => {'mandatory' => 0    , 'fmt' => 'vfile'},
62 
    'logfile.size'    => {'default'   => '1M' , 'fmt' => 'size'},
 62 
    'logfile'         => {'mandatory' => 1    , 'fmt' => 'vfile'},
63 
    'logfile.count'   => {'default'   => 9    , 'fmt' => 'int'},
 63 
    'logfile.size'    => {'default'   => '1M' , 'fmt' => 'size'},
64 
    'config'          => {'mandatory' => 1    , 'fmt' => 'dir'},
 64 
    'logfile.count'   => {'default'   => 9    , 'fmt' => 'int'},
65 
    'verbose'         => {'default'   => 0    , 'fmt' => 'int'},
 65 
    'config'          => {'mandatory' => 1    , 'fmt' => 'dir'},
66 
    'configpoll'      => {'default'   => 10   , 'fmt' => 'period'},
 66 
    'verbose'         => {'default'   => 0    , 'fmt' => 'int'},
67 
);
 67 
    'configpoll'      => {'default'   => 10   , 'fmt' => 'period'},
68 
 
 68 
);
69 
#-------------------------------------------------------------------------------
 69 
 
70 
# Function        : Mainline Entry Point
 70 
#-------------------------------------------------------------------------------
71 
#
 71 
# Function        : Mainline Entry Point
72 
# Description     :
 72 
#
73 
#
 73 
# Description     :
74 
# Inputs          :
 74 
#
75 
#
 75 
# Inputs          :
76 
my $result = GetOptions (
 76 
#
77 
                "help|h:+"      => \$opt_help,
 77 
my $result = GetOptions (
78 
                "manual:3"      => \$opt_help,
 78 
                "help|h:+"      => \$opt_help,
79 
                "verbose:+"     => \$opt_verbose,
 79 
                "manual:3"      => \$opt_help,
80 
                "daemon!"       => \$opt_daemonise,
 80 
                "verbose:+"     => \$opt_verbose,
81 
                "config=s"      => \$opt_config,
 81 
                "D"             => \$opt_nodaemonise,
82 
                "dir=s"         => \$opt_basedir,
 82 
                "config=s"      => \$opt_config,
83 
                "pid=s"         => \$opt_pid,
 83 
                "dir=s"         => \$opt_basedir,
84 
                );
 84 
                "pid=s"         => \$opt_pid,
85 
 
 85 
                );
86 
                #
 86 
 
87 
                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
 87 
                #
88 
                #
 88 
                #   UPDATE THE DOCUMENTATION AT THE END OF THIS FILE !!!
89 
 
 89 
                #
90 
#
 90 
 
91 
#   Process help and manual options
 91 
#
92 
#
 92 
#   Process help and manual options
93 
pod2usage(-verbose => 0, -message => "dpkg_blat") if ($opt_help == 1 || ! $result || $#ARGV >= 0);
 93 
#
94 
pod2usage(-verbose => 1) if ($opt_help == 2 );
 94 
pod2usage(-verbose => 0, -message => "dpkg_blat") if ($opt_help == 1 || ! $result || $#ARGV >= 0);
95 
pod2usage(-verbose => 2) if ($opt_help > 2);
 95 
pod2usage(-verbose => 1) if ($opt_help == 2 );
96 
 
 96 
pod2usage(-verbose => 2) if ($opt_help > 2);
97 
#
 97 
 
98 
#   Process options
 98 
#
99 
#
 99 
#   Process options
100 
chdir ($opt_basedir) || die ("Cannot 'cd' to $opt_basedir: $!\n");
 100 
#
101 
print "Current Directory: ", getcwd() , "\n";
 101 
chdir ($opt_basedir) || die ("Cannot 'cd' to $opt_basedir: $!\n");
102 
 
 102 
print "Current Directory: ", getcwd() , "\n";
103 
if ( $opt_config )
 103 
 
104 
{
 104 
if ( $opt_config )
105 
    $configPath = rel2abs( $opt_config );
 105 
{
106 
    my($filename, $directories, $suffix) = fileparse($configPath);
 106 
    $configPath = rel2abs( $opt_config );
107 
    $configFile = '/' . $filename;
 107 
    my($filename, $directories, $suffix) = fileparse($configPath);
108 
}
 108 
    $configFile = '/' . $filename;
109 
 
 109 
}
110 
#-------------------------------------------------------------------------------
 110 
 
111 
#   Read in the basic configuration
 111 
#-------------------------------------------------------------------------------
112 
readConfig();
 112 
#   Read in the basic configuration
113 
 
 113 
readConfig();
114 
#
 114 
 
115 
#   Only one instance
 115 
#
116 
#
 116 
#   Only one instance
117 
die "No PID file provided or configured" unless ( $conf->{pidfile} );
 117 
#
118 
Utils::checkpid($conf);
 118 
die "No PID file provided or configured" unless ( $conf->{pidfile} );
119 
 
 119 
Utils::checkpid($conf);
120 
#
 120 
 
121 
#   Daemonise myself
 121 
#
122 
#   Even if the users says no-daemon we still partially daemonise ourselves
 122 
#   Daemonise myself
123 
#
 123 
#
124 
$logger->logmsg('Daemonizing...');
 124 
unless ( $opt_nodaemonise )
125 
 
 125 
{
126 
#
 126 
    $logger->logmsg('Daemonizing...');
127 
#   Comment out the redirection lines to assist in debugging
 127 
 
128 
#
 128 
    my $msg = 'Can\'t read /dev/null:';
129 
if ( $opt_daemonise )
 129 
    open STDIN, '>/dev/null' or $logger->err("$msg $!");
130 
{
 130 
    open STDOUT, '>/dev/null' or $logger->err("$msg $!");
131 
    my $msg = 'Can\'t read /dev/null:';
 131 
    open STDERR, '>/dev/null' or $logger->err("$msg $!");
132 
    open STDIN, '>/dev/null' or $logger->err("$msg $!");
 132 
    defined (my $pid = fork) or $logger->err("Can't fork: $!");
133 
    open STDOUT, '>/dev/null' or $logger->err("$msg $!");
 133 
    exit if $pid;
134 
    open STDERR, '>/dev/null' or $logger->err("$msg $!");
 134
135 
}
 135 
    setsid or $logger->err("Can't start a new session: $!");
136 
defined (my $pid = fork) or $logger->err("Can't fork: $!");
 136 
    $logger->logmsg('Writing pid');
137 
exit if $pid;
 137 
}
138
138 
 
139 
setsid or $logger->err("Can't start a new session: $!");
 139 
#
140 
$logger->logmsg('Writing pid');
 140 
#   Locate and start up new transfer targets
141 
Utils::writepid($conf);
 141 
#
142 
$logger->logmsg('Daemonizing completed');
 142 
Utils::writepid($conf);
143 
 
 143 
sighandlers($conf);
144 
#
 144 
while ( 1 )
145 
#   Locate and start up new transfer targets
 145 
{
146 
#
 146 
    readConfig();
147 
sighandlers($conf);
 147 
 
148 
while ( 1 )
 148 
    #
149 
{
 149 
    #   Process all the configured transfer targets
150 
    readConfig();
 150 
    #
151 
 
 151 
    for my $target ( glob($conf->{'config'} . '/*.conf') )
152 
    #
 152 
    {
153 
    #   Process all the configured transfer targets
 153 
        #
154 
    #
 154 
        #   Known entries are tested
155 
    for my $target ( glob($conf->{'config'} . '/*.conf') )
 155 
        #   If the child is dead, then it will be restarted
156 
    {
 156 
        #
157 
        #
 157 
        if ( exists $children{$target} )
158 
        #   Ignore my own config file
 158 
        {
159 
        #
 159 
            my $pid = $children{$target}{pid};
160 
        next if ( $target =~ m~$configFile~ );
 160 
            next unless ( exists $dead{$pid} );
161 
 
 161 
            delete $dead{$pid};
162 
        #
 162 
            delete $children{$target};
163 
        #   Known entries are tested
 163 
        }
164 
        #   If the child is dead, then it will be restarted
 164 
 
165 
        #
 165 
        #
166 
        if ( exists $children{$target} )
 166 
        #   Fork then exec
167 
        {
 167 
        #
168 
            my $pid = $children{$target}{pid};
 168 
        $logger->logmsg("Starting $target");
169 
            next unless ( exists $dead{$pid} );
 169 
	    defined (my $pid = fork) or $logger->err("Can't fork: $!");
170 
            delete $dead{$pid};
 170 
        if ( $pid )
171 
            delete $children{$target};
 171 
        {
172 
        }
 172 
            #
173 
 
 173 
            #   Parent process. Save PID for dead child testing
174 
        #
 174 
            #
175 
        #   Fork then exec
 175 
            $children{$target}{pid} = $pid;
176 
        #
 176 
	        next;
177 
        $logger->logmsg("Starting $target");
 177 
        }
178 
	    defined (my $pid = fork) or $logger->err("Can't fork: $!");
 178 
 
179 
        if ( $pid )
 179 
        #
180 
        {
 180 
        #   Child process at this point
181 
            #
 181 
        #
182 
            #   Parent process. Save PID for dead child testing
 182 
#        setsid or $logger->err("Can't start a new session: $!");
183 
            #
 183 
        $logger->logmsg("Started $target");
184 
            $children{$target}{pid} = $pid;
 184 
        exec 'perl',"$rootDir/blatDaemon.pl", $target or $logger->err ("Can't exec");
185 
	        next;
 185 
    }
186 
        }
 186 
 
187 
 
 187 
    #
188 
        #
 188 
    #   What a bit and try again
189 
        #   Child process at this point
 189 
    #
190 
        #
 190 
    sleep $conf->{'configpoll'};
191 
#        setsid or $logger->err("Can't start a new session: $!");
 191 
 
192 
        $logger->logmsg("Started $target");
 192 
    #
193 
        exec 'perl',"$rootDir/blatDaemon.pl", $target or $logger->err ("Can't exec");
 193 
    #   Reap child processes
194 
    }
 194 
    #   Remember the dead ones - they will be restarted
195 
 
 195 
    #
196 
    #
 196 
    #...
197 
    #   What a bit and try again
 197 
    my $kid;
198 
    #
 198 
    do {
199 
    sleep $conf->{'configpoll'};
 199 
        if ( ($kid = waitpid(-1, WNOHANG)) > 0 )
200 
 
 200 
        {
201 
    #
 201 
            $dead{$kid} = 1;
202 
    #   Reap child processes
 202 
            $logger->logmsg("Child Process terminated: $kid");
203 
    #   Remember the dead ones - they will be restarted
 203 
        }
204 
    #
 204 
    } while ( $kid > 0 );
205 
    #...
 205 
}
206 
    my $kid;
 206 
 
207 
    do {
 207 
#-------------------------------------------------------------------------------
208 
        if ( ($kid = waitpid(-1, WNOHANG)) > 0 )
 208 
# Function        : readConfig
209 
        {
 209 
#
210 
            $dead{$kid} = 1;
 210 
# Description     : Re read the config file if it modification time has changed
211 
            $logger->logmsg("Child Process terminated: $kid");
 211 
#                   Not much happens if the cinfig is re-read
212 
        }
 212 
#                   Only a few of the attributes are used
213 
    } while ( $kid > 0 );
 213 
#
214 
}
 214 
# Inputs          : Nothing
215 
 
 215 
#
216 
#-------------------------------------------------------------------------------
 216 
# Returns         : Nothing
217 
# Function        : readConfig
 217 
#
218 
#
 218 
sub readConfig
219 
# Description     : Re read the config file if it modification time has changed
 219 
{
220 
#                   Not much happens if the cinfig is re-read
 220 
    my ($mtime) = Utils::mtime($configPath);
221 
#                   Only a few of the attributes are used
 221 
    if ( $mtimeConfig != $mtime )
222 
#
 222 
    {
223 
# Inputs          : Nothing
 223 
        $logger->logmsg("Reading config file: $configPath");
224 
#
 224 
        $mtimeConfig = $mtime;
225 
# Returns         : Nothing
 225 
        my $errors;
226 
#
 226 
        ($conf, $errors) = Utils::readconf ( $configPath, \%cdata );
227 
sub readConfig
 227 
        if ( scalar @{$errors} > 0 )
228 
{
 228 
        {
229 
    my ($mtime) = Utils::mtime($configPath);
 229 
            warn "$_\n" foreach (@{$errors});
230 
    if ( $mtimeConfig != $mtime )
 230 
            die ("Config contained errors\n");
231 
    {
 231 
        }
232 
        $logger->logmsg("Reading config file: $configPath");
 232 
 
233 
        $mtimeConfig = $mtime;
 233 
        #
234 
        my $errors;
 234 
        #   Reset some information
235 
        ($conf, $errors) = Utils::readconf ( $configPath, \%cdata );
 235 
        #   Create a new logger
236 
        if ( scalar @{$errors} > 0 )
 236 
        #
237 
        {
 237 
        $logger = Logger->new($conf);
238 
            warn "$_\n" foreach (@{$errors});
 238 
        $conf->{logger} = $logger;
239 
            die ("Config contained errors\n");
 239 
        $logger->verbose("Log Levl: $conf->{verbose}");
240 
        }
 240 
 
241 
 
 241 
        #
242 
        #
 242 
        #   Some command line options will override config
243 
        #   Reset some information
 243 
        #
244 
        #   Create a new logger
 244 
        $conf->{pidfile} = $opt_pid if ( defined $opt_pid );
245 
        #
 245 
        $conf->{verbose} = $opt_verbose if ( $opt_verbose > 0 );
246 
        $logger = Logger->new($conf);
 246 
 
247 
        $conf->{logger} = $logger;
 247 
        #
248 
        $logger->verbose("Log Levl: $conf->{verbose}");
 248 
        #   Scan the configuration and export specified environment values
249 
 
 249 
        #   Simplfies the process of passing data to children
250 
        #
 250 
        #
251 
        #   Some command line options will override config
 251 
        while (my($key, $data) = each ( %{$conf->{envVars}} ))
252 
        #
 252 
        {
253 
        $conf->{pidfile} = $opt_pid if ( defined $opt_pid );
 253 
            $ENV{$key} = $data;
254 
        $conf->{verbose} = $opt_verbose if ( $opt_verbose > 0 );
 254 
            $logger->verbose("Env: $key -> $data");
255 
 
 255
256 
        #
 256 
        }
257 
        #   Scan the configuration and export specified environment values
 257 
 
258 
        #   Simplfies the process of passing data to children
 258 
        #   Extend the path
259 
        #
 259 
        my @extraPath;
260 
        while (my($key, $data) = each ( %{$conf->{envVars}} ))
 260 
        while (my($key, $data) = each ( %{$conf->{envPath}} ))
261 
        {
 261 
        {
262 
            $ENV{$key} = $data;
 262 
            push @extraPath, $data;
263 
            $logger->verbose("Env: $key -> $data");
 263 
            $logger->verbose("Path: $key -> $data");
264
264
265 
        }
 265 
        }
266 
 
 266 
        if ( @extraPath )
267 
        #   Extend the path
 267 
        {
268 
        my @extraPath;
 268 
            $ENV{PATH} = join( ':', $ENV{PATH} , @extraPath );
269 
        while (my($key, $data) = each ( %{$conf->{envPath}} ))
 269 
        }
270 
        {
 270 
        $logger->verbose("PATH: $ENV{PATH}");
271 
            push @extraPath, $data;
 271 
    }
272 
            $logger->verbose("Path: $key -> $data");
 272 
}
273
273 
 
274 
        }
 274 
 
275 
        if ( @extraPath )
 275 
 
276 
        {
 276 
#-------------------------------------------------------------------------------
277 
            $ENV{PATH} = join( ':', $ENV{PATH} , @extraPath );
 277 
# Function        : sighandlers
278 
        }
 278 
#
279 
        $logger->verbose("PATH: $ENV{PATH}");
 279 
# Description     : Install signal handlers
280 
    }
 280 
#
281 
}
 281 
# Inputs          : $conf           - System config
282 
 
 282 
#
283 
 
 283 
# Returns         : Nothing
284 
 
 284 
#
285 
#-------------------------------------------------------------------------------
 285 
sub sighandlers
286 
# Function        : sighandlers
 286 
{
287 
#
 287 
	my $conf = shift;
288 
# Description     : Install signal handlers
 288 
	my $logger = $conf->{logger};
289 
#
 289 
 
290 
# Inputs          : $conf           - System config
 290 
	$SIG{TERM} = sub {
291 
#
 291 
		# On shutdown
292 
# Returns         : Nothing
 292 
		$logger->logmsg('Received SIGTERM. Shutting down....' );
293 
#
 293 
        foreach my $entry ( keys %children )
294 
sub sighandlers
 294 
        {
295 
{
 295 
            my $pid = $children{$entry}{pid};
296 
	my $conf = shift;
 296 
    		$logger->logmsg('Terminate child: ' . $pid);
297 
	my $logger = $conf->{logger};
 297 
            kill 15, $pid;
298 
 
 298 
        }
299 
	$SIG{TERM} = sub {
 299 
 
300 
		# On shutdown
 300 
		unlink $conf->{'pidfile'} if -f $conf->{'pidfile'};
301 
		$logger->logmsg('Received SIGTERM. Shutting down....' );
 301 
		exit 0;
302 
        foreach my $entry ( keys %children )
 302 
	};
303 
        {
 303 
 
304 
            my $pid = $children{$entry}{pid};
 304 
	$SIG{HUP} = sub {
305 
    		$logger->logmsg('Terminate child: ' . $pid);
 305 
		# On logrotate
306 
            kill 15, $pid;
 306 
		$logger->logmsg('Received SIGHUP.');
307 
        }
 307 
		$logger->rotatelog();
308 
 
 308 
        foreach my $entry ( keys %children )
309 
		unlink $conf->{'pidfile'} if -f $conf->{'pidfile'};
 309 
        {
310 
		exit 0;
 310 
            my $pid = $children{$entry}{pid};
311 
	};
 311 
    		$logger->logmsg('Signal HUP to child: ' . $pid);
312 
 
 312 
            kill 1, $pid;
313 
	$SIG{HUP} = sub {
 313 
        }
314 
		# On logrotate
 314
315 
		$logger->logmsg('Received SIGHUP.');
 315 
	};
316 
		$logger->rotatelog();
 316 
}
317 
        foreach my $entry ( keys %children )
 317 
 
318 
        {
 - 
 
319 
            my $pid = $children{$entry}{pid};
 - 
 
320 
    		$logger->logmsg('Signal HUP to child: ' . $pid);
 - 
 
321 
            kill 1, $pid;
 - 
 
322 
        }
 - 
 
323
- 
 
324 
	};
 - 
 
325 
}
 - 
 
326 
 
 -