375 lines
8.8 KiB
Perl
Executable File
375 lines
8.8 KiB
Perl
Executable File
#!/usr/bin/perl -wT
|
|
#
|
|
# 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.
|
|
#
|
|
|
|
# ==========================================================================
|
|
#
|
|
# User config
|
|
#
|
|
# ==========================================================================
|
|
|
|
use constant DAEMON_PATH => '@prefix@/bin/';
|
|
use constant DC_SOCK_FILE => '/tmp/zmdc.sock';
|
|
|
|
# ==========================================================================
|
|
#
|
|
# Don't change anything from here on down
|
|
#
|
|
# ==========================================================================
|
|
|
|
use strict;
|
|
use POSIX;
|
|
use Socket;
|
|
use IO::Handle;
|
|
use Data::Dumper;
|
|
|
|
$| = 1;
|
|
|
|
my @daemons = ( 'zmc', 'zma', 'zmf.pl' );
|
|
|
|
my $command = shift @ARGV;
|
|
die( "No command given" ) unless( $command );
|
|
my $needs_daemon = $command !~ /(?:shutdown|check)/;
|
|
my $daemon = shift( @ARGV );
|
|
die( "No daemon given" ) unless( !$needs_daemon || $daemon );
|
|
my @args;
|
|
|
|
my $daemon_patt = '('.join( '|', @daemons ).')';
|
|
if ( $needs_daemon )
|
|
{
|
|
if ( $daemon =~ /^${daemon_patt}$/ )
|
|
{
|
|
$daemon = $1;
|
|
}
|
|
else
|
|
{
|
|
die( "Invalid daemon '$daemon' specified" );
|
|
}
|
|
}
|
|
|
|
foreach my $arg ( @ARGV )
|
|
{
|
|
# Detaint arguments, if they look ok
|
|
if ( $arg =~ /^(-?[\w\d]+)/ )
|
|
{
|
|
push( @args, $1 );
|
|
}
|
|
else
|
|
{
|
|
die( "Bogus argument '$arg' found" );
|
|
}
|
|
}
|
|
|
|
|
|
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
|
|
|
my $saddr = sockaddr_un( DC_SOCK_FILE );
|
|
|
|
if ( !connect( CLIENT, $saddr ) )
|
|
{
|
|
# The server isn't there
|
|
print( "Unable to connect, starting server\n" );
|
|
close( CLIENT );
|
|
|
|
if ( my $cpid = fork() )
|
|
{
|
|
# Parent process just sleep and fall through
|
|
sleep( 2 );
|
|
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
|
connect( CLIENT, $saddr ) or die( "Can't connect: $!" );
|
|
}
|
|
elsif ( defined($cpid) )
|
|
{
|
|
setpgrp();
|
|
|
|
dprint( "Server starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
|
|
socket( SERVER, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
|
unlink( DC_SOCK_FILE );
|
|
bind( SERVER, $saddr ) or die( "Can't bind: $!" );
|
|
listen( SERVER, SOMAXCONN ) or die( "Can't listen: $!" );
|
|
|
|
$SIG{CHLD} = \&reaper;
|
|
$SIG{INT} = \&shutdown_all;
|
|
$SIG{TERM} = \&shutdown_all;
|
|
$SIG{ABRT} = \&shutdown_all;
|
|
$SIG{HUP} = \✓
|
|
( $ENV{PATH} ) = ( $ENV{PATH} =~ /^(.*)$/ );
|
|
|
|
my %cmd_hash;
|
|
my %pid_hash;
|
|
|
|
sub dprint
|
|
{
|
|
if ( fileno(CLIENT) )
|
|
{
|
|
print CLIENT @_
|
|
}
|
|
else
|
|
{
|
|
print @_;
|
|
}
|
|
}
|
|
sub start
|
|
{
|
|
my $daemon = shift;
|
|
my @args = @_;
|
|
|
|
my $command = join( ' ', ( $daemon, @args ) );
|
|
my $process = $cmd_hash{$command};
|
|
|
|
if ( !$process )
|
|
{
|
|
$process = { daemon=>$daemon, args=>\@args, command=>$command, keepalive=>!undef };
|
|
}
|
|
elsif ( $process->{pid} && $pid_hash{$process->{pid}} )
|
|
{
|
|
dprint( "'$process->{command}' already running at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{started}) ).", pid = $process->{pid}\n" );
|
|
return();
|
|
}
|
|
|
|
if ( my $cpid = fork() )
|
|
{
|
|
$process->{pid} = $cpid;
|
|
$process->{started} = time();
|
|
delete( $process->{pending} );
|
|
|
|
dprint( "'$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;
|
|
}
|
|
elsif ( defined($cpid ) )
|
|
{
|
|
# Child process
|
|
$SIG{CHLD} = 'DEFAULT';
|
|
$SIG{INT} = 'DEFAULT';
|
|
$SIG{TERM} = 'DEFAULT';
|
|
$SIG{ABRT} = 'DEFAULT';
|
|
$SIG{HUP} = 'DEFAULT';
|
|
dprint( "'".join( ' ', ( $daemon, @args ) )."' started at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
|
|
if ( $daemon =~ /^${daemon_patt}$/ )
|
|
{
|
|
$daemon = DAEMON_PATH.$1;
|
|
}
|
|
else
|
|
{
|
|
die( "Invalid daemon '$daemon' specified" );
|
|
}
|
|
|
|
exec( $daemon, @args ) or die( "Can't exec: $!" );
|
|
}
|
|
else
|
|
{
|
|
die( "Can't fork: $!" );
|
|
}
|
|
}
|
|
sub _stop
|
|
{
|
|
my $final = shift;
|
|
my $daemon = shift;
|
|
my @args = @_;
|
|
|
|
my $command = "$daemon ".join( ' ', @args );
|
|
my $process = $cmd_hash{$command};
|
|
|
|
if ( !$process )
|
|
{
|
|
dprint( "Can't find process with command of '$command'\n" );
|
|
return();
|
|
}
|
|
if ( !$pid_hash{$process->{pid}} )
|
|
{
|
|
dprint( "No process with command of '$command' is running\n" );
|
|
return();
|
|
}
|
|
|
|
print( "'$daemon ".join( ' ', @args )."' stopping at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
$process->{keepalive} = !$final;
|
|
kill( 'TERM', $process->{pid} );
|
|
delete( $cmd_hash{$command} );
|
|
}
|
|
sub stop
|
|
{
|
|
_stop( 1, @_ );
|
|
}
|
|
sub restart
|
|
{
|
|
_stop( 0, @_ );
|
|
}
|
|
sub reaper
|
|
{
|
|
my $cpid = wait;
|
|
|
|
$SIG{CHLD} = \&reaper;
|
|
|
|
my $process = $pid_hash{$cpid};
|
|
delete( $pid_hash{$cpid} );
|
|
|
|
die( "Can't find child with pid of '$cpid'\n" ) unless( $process );
|
|
|
|
$process->{stopped} = time();
|
|
$process->{runtime} = ($process->{stopped}-$process->{started});
|
|
delete( $process->{pid} );
|
|
|
|
my $exit_status = $?>>8;
|
|
my $exit_signal = $?&0xfe;
|
|
my $core_dumped = $?&0x01;
|
|
|
|
if ( $exit_status == 0 )
|
|
{
|
|
print( "'$process->{daemon} ".join( ' ', @{$process->{args}} )."' died at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{stopped} ) ) );
|
|
}
|
|
else
|
|
{
|
|
print( "'$process->{daemon} ".join( ' ', @{$process->{args}} )."' crashed at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{stopped} ) ) );
|
|
}
|
|
print( ", exit status $exit_status" ) if ( $exit_status );
|
|
print( ", signal $exit_signal" ) if ( $exit_signal );
|
|
print( ", core dumped" ) if ( $core_dumped );
|
|
print( "\n" );
|
|
|
|
if ( $process->{keepalive} )
|
|
{
|
|
if ( !$process->{delay} || $process->{runtime} > $process->{delay} )
|
|
{
|
|
start( $process->{daemon}, @{$process->{args}} );
|
|
$process->{delay} = 5;
|
|
}
|
|
else
|
|
{
|
|
$process->{pending} = $process->{stopped}+$process->{delay};
|
|
$process->{delay} *= 2;
|
|
}
|
|
}
|
|
}
|
|
sub shutdown_all()
|
|
{
|
|
foreach my $process ( values( %pid_hash ) )
|
|
{
|
|
stop( $process->{daemon}, @{$process->{args}} );
|
|
}
|
|
dprint( "Server shutdown at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
unlink( DC_SOCK_FILE );
|
|
close( CLIENT );
|
|
close( SERVER );
|
|
exit();
|
|
}
|
|
sub check
|
|
{
|
|
foreach my $process ( values(%pid_hash) )
|
|
{
|
|
dprint( "'$process->{command}' running at ".strftime( '%y/%m/%d %H:%M:%S', localtime( $process->{started}) ).", pid = $process->{pid}" );
|
|
dprint( ", valid" ) if ( kill( 0, $process->{pid} ) );
|
|
dprint( "\n" );
|
|
}
|
|
}
|
|
|
|
my $rin = '';
|
|
vec( $rin, fileno(SERVER),1) = 1;
|
|
my $win = $rin;
|
|
my $ein = $win;
|
|
my $timeout = 1;
|
|
#my ( $nfound, $timeleft) = select( $rin, $win, $ein, $timeout );
|
|
#print( "F:".fileno(SERVER)."\n" );
|
|
while( 1 )
|
|
{
|
|
my $nfound = select( my $rout = $rin, undef, my $eout = $ein, $timeout );
|
|
#print( "Off select, NF:$nfound, ER:$!\n" );
|
|
#print( vec( $rout, fileno(SERVER),1)."\n" );
|
|
#print( vec( $eout, fileno(SERVER),1)."\n" );
|
|
#print( "C:".fileno(CLIENT)."S:".fileno(SERVER)."\n" );
|
|
if ( $nfound > 0 )
|
|
{
|
|
if ( vec( $rout, fileno(SERVER),1) )
|
|
{
|
|
my $paddr = accept( CLIENT, SERVER );
|
|
my $message = <CLIENT>;
|
|
|
|
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 'shutdown' )
|
|
{
|
|
shutdown_all();
|
|
}
|
|
elsif ( $command eq 'check' )
|
|
{
|
|
check();
|
|
}
|
|
else
|
|
{
|
|
dprint( "Invalid command '$command'\n" );
|
|
}
|
|
close( CLIENT );
|
|
}
|
|
else
|
|
{
|
|
die( "Bogus descriptor" );
|
|
}
|
|
}
|
|
elsif ( $nfound < 0 )
|
|
{
|
|
if ( $! == EINTR )
|
|
{
|
|
# Dead child, will be reaped
|
|
#print( "Probable dead child\n" );
|
|
}
|
|
else
|
|
{
|
|
die( "Can't select: $!" );
|
|
}
|
|
}
|
|
else
|
|
{
|
|
#print( "Select timed out\n" );
|
|
foreach my $process ( values( %cmd_hash ) )
|
|
{
|
|
if ( $process->{pending} && $process->{pending} <= time() )
|
|
{
|
|
dprint( "Starting pending process, $process->{command}\n" );
|
|
start( $process->{daemon}, @{$process->{args}} );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
dprint( "Server exiting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
exit();
|
|
}
|
|
else
|
|
{
|
|
die( "Can't fork: $!" );
|
|
}
|
|
}
|
|
# 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" );
|