744 lines
17 KiB
Prolog
744 lines
17 KiB
Prolog
#!/usr/bin/perl -wT
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# ZoneMinder Daemon Control Script, $Date$, $Revision$
|
|
# Copyright (C) 2001-2008 Philip Coombes
|
|
#
|
|
# This program is free software; you can redistribute it and/or
|
|
# modify it under the terms of the GNU General Public License
|
|
# as published by the Free Software Foundation; either version 2
|
|
# of the License, or (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program; if not, write to the Free Software
|
|
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# This script is the gateway for controlling the various ZoneMinder
|
|
# daemons. All starting, stopping and restarting goes through here.
|
|
# On the first invocation it starts up a server which subsequently
|
|
# records what's running and what's not. Other invocations just
|
|
# connect to the server and pass instructions to it.
|
|
#
|
|
use strict;
|
|
use bytes;
|
|
|
|
# ==========================================================================
|
|
#
|
|
# User config
|
|
#
|
|
# ==========================================================================
|
|
|
|
use constant DBG_ID => "zmdc"; # Tag that appears in debug to identify source
|
|
use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
|
|
|
|
use constant MAX_CONNECT_DELAY => 10;
|
|
|
|
# ==========================================================================
|
|
#
|
|
# Don't change anything from here on down
|
|
#
|
|
# ==========================================================================
|
|
|
|
use ZoneMinder;
|
|
use POSIX;
|
|
use Socket;
|
|
use IO::Handle;
|
|
use Data::Dumper;
|
|
|
|
use constant SOCK_FILE => ZM_PATH_SOCKS.'/zmdc.sock';
|
|
|
|
$| = 1;
|
|
|
|
$ENV{PATH} = '/bin:/usr/bin';
|
|
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
|
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
|
|
|
my @daemons = (
|
|
'zmc',
|
|
'zma',
|
|
'zmf',
|
|
'zmfilter.pl',
|
|
'zmaudit.pl',
|
|
'zmtrigger.pl',
|
|
'zmx10.pl',
|
|
'zmwatch.pl',
|
|
'zmupdate.pl',
|
|
'zmtrack.pl'
|
|
);
|
|
|
|
sub Usage
|
|
{
|
|
print( "
|
|
Usage: zmdc.pl <command> [daemon [options]]
|
|
Parameters are :-
|
|
<command> - One of 'startup|shutdown|status|check|logrot' or
|
|
'start|stop|restart|reload'.
|
|
[daemon [options]] - Daemon name and options, required for second group of commands
|
|
");
|
|
exit( -1 );
|
|
}
|
|
|
|
my $command = shift @ARGV;
|
|
if( !$command )
|
|
{
|
|
print( STDERR "No command given\n" );
|
|
Usage();
|
|
}
|
|
my $needs_daemon = $command !~ /(?:startup|shutdown|status|check|logrot)/;
|
|
my $daemon = shift( @ARGV );
|
|
if( $needs_daemon && !$daemon )
|
|
{
|
|
print( STDERR "No daemon given\n" );
|
|
Usage();
|
|
}
|
|
my @args;
|
|
|
|
my $daemon_patt = '('.join( '|', @daemons ).')';
|
|
if ( $needs_daemon )
|
|
{
|
|
if ( $daemon =~ /^${daemon_patt}$/ )
|
|
{
|
|
$daemon = $1;
|
|
}
|
|
else
|
|
{
|
|
print( STDERR "Invalid daemon '$daemon' specified" );
|
|
Usage();
|
|
}
|
|
}
|
|
|
|
foreach my $arg ( @ARGV )
|
|
{
|
|
# Detaint arguments, if they look ok
|
|
#if ( $arg =~ /^(-{0,2}[\w]+)/ )
|
|
if ( $arg =~ /^(-{0,2}[\w\/?&=.-]+)$/ )
|
|
{
|
|
push( @args, $1 );
|
|
}
|
|
else
|
|
{
|
|
print( STDERR "Bogus argument '$arg' found" );
|
|
exit( -1 );
|
|
}
|
|
}
|
|
|
|
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or Fatal( "Can't open socket: $!" );
|
|
|
|
my $saddr = sockaddr_un( SOCK_FILE );
|
|
my $server_up = connect( CLIENT, $saddr );
|
|
if ( !$server_up )
|
|
{
|
|
if ( $command eq "logrot" )
|
|
{
|
|
exit();
|
|
}
|
|
if ( $command eq "check" )
|
|
{
|
|
print( "stopped\n" );
|
|
exit();
|
|
}
|
|
elsif ( $command ne "startup" )
|
|
{
|
|
print( "Unable to connect to server\n" );
|
|
exit( -1 );
|
|
}
|
|
# The server isn't there
|
|
print( "Starting server\n" );
|
|
close( CLIENT );
|
|
|
|
if ( my $cpid = fork() )
|
|
{
|
|
zmDbgInit( DBG_ID, level=>DBG_LEVEL );
|
|
|
|
# Parent process just sleep and fall through
|
|
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or Fatal( "Can't open socket: $!" );
|
|
my $attempts = 0;
|
|
while (!connect( CLIENT, $saddr ))
|
|
{
|
|
$attempts++;
|
|
Fatal( "Can't connect: $!" ) if ($attempts > MAX_CONNECT_DELAY);
|
|
sleep(1);
|
|
}
|
|
}
|
|
elsif ( defined($cpid) )
|
|
{
|
|
my $fd = 0;
|
|
while( $fd < POSIX::sysconf( &POSIX::_SC_OPEN_MAX ) )
|
|
{
|
|
POSIX::close( $fd++ );
|
|
}
|
|
|
|
setpgrp();
|
|
|
|
zmDbgInit( DBG_ID, level=>DBG_LEVEL );
|
|
|
|
dPrint( DBG_INFO, "Server starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
|
|
if ( open( PID, ">".ZM_PID ) )
|
|
{
|
|
print( PID $$ );
|
|
close( PID );
|
|
}
|
|
|
|
killAll( 1 );
|
|
|
|
socket( SERVER, PF_UNIX, SOCK_STREAM, 0 ) or Fatal( "Can't open socket: $!" );
|
|
unlink( SOCK_FILE );
|
|
bind( SERVER, $saddr ) or Fatal( "Can't bind: $!" );
|
|
listen( SERVER, SOMAXCONN ) or Fatal( "Can't listen: $!" );
|
|
|
|
$SIG{CHLD} = \&reaper;
|
|
$SIG{INT} = \&shutdownAll;
|
|
$SIG{TERM} = \&shutdownAll;
|
|
$SIG{ABRT} = \&shutdownAll;
|
|
$SIG{HUP} = \&logrot;
|
|
|
|
my %cmd_hash;
|
|
my %pid_hash;
|
|
|
|
my $rin = '';
|
|
vec( $rin, fileno(SERVER), 1 ) = 1;
|
|
my $win = $rin;
|
|
my $ein = $win;
|
|
my $timeout = 0.1;
|
|
while( 1 )
|
|
{
|
|
my $nfound = select( my $rout = $rin, undef, undef, $timeout );
|
|
if ( $nfound > 0 )
|
|
{
|
|
if ( vec( $rout, fileno(SERVER), 1 ) )
|
|
{
|
|
my $paddr = accept( CLIENT, SERVER );
|
|
my $message = <CLIENT>;
|
|
|
|
next if ( !$message );
|
|
|
|
my ( $command, $daemon, @args ) = split( ';', $message );
|
|
|
|
if ( $command eq 'start' )
|
|
{
|
|
start( $daemon, @args );
|
|
}
|
|
elsif ( $command eq 'stop' )
|
|
{
|
|
stop( $daemon, @args );
|
|
}
|
|
elsif ( $command eq 'restart' )
|
|
{
|
|
restart( $daemon, @args );
|
|
}
|
|
elsif ( $command eq 'reload' )
|
|
{
|
|
reload( $daemon, @args );
|
|
}
|
|
elsif ( $command eq 'startup' )
|
|
{
|
|
# Do nothing, this is all we're here for
|
|
dPrint( DBG_WARNING, "Already running, ignoring command '$command'\n" );
|
|
}
|
|
elsif ( $command eq 'shutdown' )
|
|
{
|
|
shutdownAll();
|
|
}
|
|
elsif ( $command eq 'check' )
|
|
{
|
|
check( $daemon, @args );
|
|
}
|
|
elsif ( $command eq 'status' )
|
|
{
|
|
if ( $daemon )
|
|
{
|
|
status( $daemon, @args );
|
|
}
|
|
else
|
|
{
|
|
status();
|
|
}
|
|
}
|
|
elsif ( $command eq 'logrot' )
|
|
{
|
|
logrot();
|
|
}
|
|
else
|
|
{
|
|
dPrint( DBG_ERROR, "Invalid command '$command'\n" );
|
|
}
|
|
close( CLIENT );
|
|
}
|
|
else
|
|
{
|
|
Fatal( "Bogus descriptor" );
|
|
}
|
|
}
|
|
elsif ( $nfound < 0 )
|
|
{
|
|
if ( $! == EINTR )
|
|
{
|
|
# Dead child, will be reaped
|
|
#print( "Probable dead child\n" );
|
|
# See if it needs to start up again
|
|
restartPending();
|
|
}
|
|
elsif ( $! == EPIPE )
|
|
{
|
|
Error( "Can't select: $!" );
|
|
}
|
|
else
|
|
{
|
|
Fatal( "Can't select: $!" );
|
|
}
|
|
}
|
|
else
|
|
{
|
|
#print( "Select timed out\n" );
|
|
restartPending();
|
|
}
|
|
}
|
|
dPrint( DBG_INFO, "Server exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
unlink( SOCK_FILE );
|
|
unlink( ZM_PID );
|
|
exit();
|
|
|
|
sub cPrint
|
|
{
|
|
if ( fileno(CLIENT) )
|
|
{
|
|
print CLIENT @_
|
|
}
|
|
}
|
|
sub dPrint
|
|
{
|
|
my $dbg_level = shift;
|
|
if ( fileno(CLIENT) )
|
|
{
|
|
print CLIENT @_
|
|
}
|
|
if ( $dbg_level == DBG_DEBUG )
|
|
{
|
|
Debug( @_ );
|
|
}
|
|
elsif ( $dbg_level == DBG_INFO )
|
|
{
|
|
Info( @_ );
|
|
}
|
|
elsif ( $dbg_level == DBG_WARNING )
|
|
{
|
|
Warning( @_ );
|
|
}
|
|
elsif ( $dbg_level == DBG_ERROR )
|
|
{
|
|
Error( @_ );
|
|
}
|
|
elsif ( $dbg_level == DBG_FATAL )
|
|
{
|
|
Fatal( @_ );
|
|
}
|
|
}
|
|
sub start
|
|
{
|
|
my $daemon = shift;
|
|
my @args = @_;
|
|
|
|
my $command = $daemon;
|
|
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
|
my $process = $cmd_hash{$command};
|
|
|
|
if ( !$process )
|
|
{
|
|
# It's not running, or at least it's not been started by us
|
|
$process = { daemon=>$daemon, args=>\@args, command=>$command, keepalive=>!undef };
|
|
}
|
|
elsif ( $process->{pid} && $pid_hash{$process->{pid}} )
|
|
{
|
|
dPrint( DBG_INFO, "'$process->{command}' already running at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{started}) ).", pid = $process->{pid}\n" );
|
|
return();
|
|
}
|
|
|
|
if ( my $cpid = fork() )
|
|
{
|
|
my $sigset = POSIX::SigSet->new;
|
|
my $blockset = POSIX::SigSet->new( SIGCHLD );
|
|
sigprocmask( SIG_BLOCK, $blockset, $sigset ) or Fatal( "Can't block SIGCHLD: $!" );
|
|
$process->{pid} = $cpid;
|
|
$process->{started} = time();
|
|
delete( $process->{pending} );
|
|
|
|
dPrint( DBG_INFO, "'$command' starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{started}) ).", pid = $process->{pid}\n" );
|
|
|
|
$cmd_hash{$process->{command}} = $pid_hash{$cpid} = $process;
|
|
sigprocmask( SIG_SETMASK, $sigset ) or Fatal( "Can't restore SIGCHLD: $!" );
|
|
}
|
|
elsif ( defined($cpid ) )
|
|
{
|
|
my $fd = 0;
|
|
while( $fd < POSIX::sysconf( &POSIX::_SC_OPEN_MAX ) )
|
|
{
|
|
POSIX::close( $fd++ );
|
|
}
|
|
|
|
# Child process
|
|
$SIG{CHLD} = 'DEFAULT';
|
|
$SIG{INT} = 'DEFAULT';
|
|
$SIG{TERM} = 'DEFAULT';
|
|
$SIG{ABRT} = 'DEFAULT';
|
|
dPrint( DBG_INFO, "'".join( ' ', ( $daemon, @args ) )."' started at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
|
|
if ( $daemon =~ /^${daemon_patt}$/ )
|
|
{
|
|
$daemon = ZM_PATH_BIN.'/'.$1;
|
|
}
|
|
else
|
|
{
|
|
Fatal( "Invalid daemon '$daemon' specified" );
|
|
}
|
|
|
|
my @good_args;
|
|
foreach my $arg ( @args )
|
|
{
|
|
# Detaint arguments, if they look ok
|
|
if ( $arg =~ /^(-{0,2}[\w\/?&=.-]+)$/ )
|
|
{
|
|
push( @good_args, $1 );
|
|
}
|
|
else
|
|
{
|
|
Fatal( "Bogus argument '$arg' found" );
|
|
}
|
|
}
|
|
|
|
exec( $daemon, @good_args ) or Fatal( "Can't exec: $!" );
|
|
}
|
|
else
|
|
{
|
|
Fatal( "Can't fork: $!" );
|
|
}
|
|
}
|
|
sub _stop
|
|
{
|
|
my $final = shift;
|
|
my $daemon = shift;
|
|
my @args = @_;
|
|
|
|
my $command = $daemon;
|
|
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
|
my $process = $cmd_hash{$command};
|
|
if ( !$process )
|
|
{
|
|
dPrint( DBG_WARNING, "Can't find process with command of '$command'\n" );
|
|
return();
|
|
}
|
|
elsif ( $process->{pending} )
|
|
{
|
|
delete( $cmd_hash{$command} );
|
|
dPrint( DBG_INFO, "Command '$command' removed from pending list at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
return();
|
|
}
|
|
|
|
my $cpid = $process->{pid};
|
|
if ( !$pid_hash{$cpid} )
|
|
{
|
|
dPrint( DBG_ERROR, "No process with command of '$command' is running\n" );
|
|
return();
|
|
}
|
|
|
|
dPrint( DBG_INFO, "'$daemon ".join( ' ', @args )."' stopping at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
$process->{keepalive} = !$final;
|
|
kill( 'TERM', $cpid );
|
|
delete( $cmd_hash{$command} );
|
|
|
|
# Now check it has actually gone away, if not kill -9 it
|
|
my $count = 0;
|
|
while( $cpid && kill( 0, $cpid ) )
|
|
{
|
|
if ( $count++ > 5 )
|
|
{
|
|
kill( 'KILL', $cpid );
|
|
}
|
|
sleep( 1 );
|
|
}
|
|
}
|
|
sub stop
|
|
{
|
|
_stop( 1, @_ );
|
|
}
|
|
sub restart
|
|
{
|
|
my $daemon = shift;
|
|
my @args = @_;
|
|
|
|
my $command = $daemon;
|
|
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
|
my $process = $cmd_hash{$command};
|
|
if ( $process )
|
|
{
|
|
if ( $process->{pid} )
|
|
{
|
|
my $cpid = $process->{pid};
|
|
if ( defined($pid_hash{$cpid}) )
|
|
{
|
|
_stop( 0, $daemon, @args );
|
|
return;
|
|
}
|
|
}
|
|
}
|
|
start( $daemon, @args );
|
|
}
|
|
sub reload
|
|
{
|
|
my $daemon = shift;
|
|
my @args = @_;
|
|
|
|
my $command = $daemon;
|
|
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
|
my $process = $cmd_hash{$command};
|
|
if ( $process )
|
|
{
|
|
if ( $process->{pid} )
|
|
{
|
|
kill( 'HUP', $process->{pid} );
|
|
}
|
|
}
|
|
}
|
|
sub logrot
|
|
{
|
|
zmDbgReinit();
|
|
foreach my $process ( values( %pid_hash ) )
|
|
{
|
|
if ( $process->{pid} && $process->{command} =~ /^zm.*\.pl/ )
|
|
{
|
|
kill( 'HUP', $process->{pid} );
|
|
}
|
|
}
|
|
}
|
|
sub reaper
|
|
{
|
|
my $saved_status = $!;
|
|
while ( (my $cpid = waitpid( -1, WNOHANG )) > 0 )
|
|
{
|
|
my $status = $?;
|
|
|
|
my $process = $pid_hash{$cpid};
|
|
delete( $pid_hash{$cpid} );
|
|
|
|
if ( !$process )
|
|
{
|
|
dPrint( DBG_INFO, "Can't find child with pid of '$cpid'\n" );
|
|
next;
|
|
}
|
|
|
|
$process->{stopped} = time();
|
|
$process->{runtime} = ($process->{stopped}-$process->{started});
|
|
delete( $process->{pid} );
|
|
|
|
my $exit_status = $status>>8;
|
|
my $exit_signal = $status&0xfe;
|
|
my $core_dumped = $status&0x01;
|
|
|
|
my $out_str = "'$process->{daemon} ".join( ' ', @{$process->{args}} )."' ";
|
|
$out_str .= $exit_signal?"crashed":("exited ".(($exit_status==0)?"normally":"abnormally"));
|
|
$out_str .= ", exit status $exit_status" if ( $exit_status );
|
|
$out_str .= ", signal $exit_signal" if ( $exit_signal );
|
|
#print( ", core dumped" ) if ( $core_dumped );
|
|
$out_str .= "\n";
|
|
|
|
if ( $exit_status == 0 )
|
|
{
|
|
Info( $out_str );
|
|
}
|
|
else
|
|
{
|
|
Error( $out_str );
|
|
}
|
|
|
|
if ( $process->{keepalive} )
|
|
{
|
|
if ( !$process->{delay} || ($process->{runtime} > ZM_MAX_RESTART_DELAY) )
|
|
{
|
|
#start( $process->{daemon}, @{$process->{args}} );
|
|
# Schedule for immediate restart
|
|
$cmd_hash{$process->{command}} = $process;
|
|
$process->{pending} = $process->{stopped};
|
|
$process->{delay} = 5;
|
|
}
|
|
else
|
|
{
|
|
$cmd_hash{$process->{command}} = $process;
|
|
$process->{pending} = $process->{stopped}+$process->{delay};
|
|
$process->{delay} *= 2;
|
|
# Limit the start delay to 15 minutes max
|
|
if ( $process->{delay} > ZM_MAX_RESTART_DELAY )
|
|
{
|
|
$process->{delay} = ZM_MAX_RESTART_DELAY;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
$SIG{CHLD} = \&reaper;
|
|
$! = $saved_status;
|
|
}
|
|
sub restartPending
|
|
{
|
|
# Restart any pending processes
|
|
foreach my $process ( values( %cmd_hash ) )
|
|
{
|
|
if ( $process->{pending} && $process->{pending} <= time() )
|
|
{
|
|
dPrint( DBG_INFO, "Starting pending process, $process->{command}\n" );
|
|
start( $process->{daemon}, @{$process->{args}} );
|
|
}
|
|
}
|
|
}
|
|
sub shutdownAll
|
|
{
|
|
foreach my $process ( values( %pid_hash ) )
|
|
{
|
|
stop( $process->{daemon}, @{$process->{args}} );
|
|
}
|
|
killAll( 5 );
|
|
dPrint( DBG_INFO, "Server shutdown at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
unlink( SOCK_FILE );
|
|
unlink( ZM_PID );
|
|
close( CLIENT );
|
|
close( SERVER );
|
|
exit();
|
|
}
|
|
sub check
|
|
{
|
|
my $daemon = shift;
|
|
my @args = @_;
|
|
|
|
my $command = $daemon;
|
|
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
|
my $process = $cmd_hash{$command};
|
|
if ( !$process )
|
|
{
|
|
cPrint( "unknown\n" );
|
|
}
|
|
elsif ( $process->{pending} )
|
|
{
|
|
cPrint( "pending\n" );
|
|
}
|
|
else
|
|
{
|
|
my $cpid = $process->{pid};
|
|
if ( !$pid_hash{$cpid} )
|
|
{
|
|
cPrint( "stopped\n" );
|
|
}
|
|
else
|
|
{
|
|
cPrint( "running\n" );
|
|
}
|
|
}
|
|
}
|
|
sub status
|
|
{
|
|
my $daemon = shift;
|
|
my @args = @_;
|
|
|
|
if ( defined($daemon) )
|
|
{
|
|
my $command = $daemon;
|
|
$command .= ' '.join( ' ', ( @args ) ) if ( @args );
|
|
my $process = $cmd_hash{$command};
|
|
if ( !$process )
|
|
{
|
|
dPrint( DBG_DEBUG, "'$command' not running\n" );
|
|
return();
|
|
}
|
|
|
|
if ( $process->{pending} )
|
|
{
|
|
dPrint( DBG_DEBUG, "'$process->{command}' pending at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{pending}) )."\n" );
|
|
}
|
|
else
|
|
{
|
|
my $cpid = $process->{pid};
|
|
if ( !$pid_hash{$cpid} )
|
|
{
|
|
dPrint( DBG_DEBUG, "'$command' not running\n" );
|
|
return();
|
|
}
|
|
}
|
|
dPrint( DBG_DEBUG, "'$process->{command}' running since ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{started}) ).", pid = $process->{pid}" );
|
|
}
|
|
else
|
|
{
|
|
foreach my $process ( values(%pid_hash) )
|
|
{
|
|
my $out_str = "'$process->{command}' running since ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{started}) ).", pid = $process->{pid}";
|
|
$out_str .= ", valid" if ( kill( 0, $process->{pid} ) );
|
|
$out_str .= "\n";
|
|
dPrint( DBG_DEBUG, $out_str );
|
|
}
|
|
foreach my $process ( values( %cmd_hash ) )
|
|
{
|
|
if ( $process->{pending} )
|
|
{
|
|
dPrint( DBG_DEBUG, "'$process->{command}' pending at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{pending}) )."\n" );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
}
|
|
else
|
|
{
|
|
Fatal( "Can't fork: $!" );
|
|
}
|
|
}
|
|
if ( $command eq "check" && !$daemon )
|
|
{
|
|
print( "running\n" );
|
|
exit();
|
|
}
|
|
elsif ( $command eq "startup" )
|
|
{
|
|
# Our work here is done
|
|
exit() if ( !$server_up );
|
|
}
|
|
# The server is there, connect to it
|
|
#print( "Writing commands\n" );
|
|
CLIENT->autoflush();
|
|
my $message = "$command";
|
|
$message .= ";$daemon" if ( $daemon );
|
|
$message .= ";".join( ';', @args ) if ( @args );
|
|
print( CLIENT $message );
|
|
shutdown( CLIENT, 1 );
|
|
while ( my $line = <CLIENT> )
|
|
{
|
|
chomp( $line );
|
|
print( "$line\n" );
|
|
}
|
|
close( CLIENT );
|
|
#print( "Finished writing, bye\n" );
|
|
|
|
exit;
|
|
|
|
sub killAll
|
|
{
|
|
my $delay = shift;
|
|
sleep( $delay );
|
|
foreach my $daemon ( @daemons )
|
|
{
|
|
my $cmd = "killall --quiet --signal TERM $daemon";
|
|
Debug( $cmd );
|
|
qx( $cmd );
|
|
}
|
|
sleep( $delay );
|
|
foreach my $daemon ( @daemons )
|
|
{
|
|
my $cmd = "killall --quiet --signal KILL $daemon";
|
|
Debug( $cmd );
|
|
qx( $cmd );
|
|
}
|
|
}
|