mirror/zoneminder
1
0 Fork 0
mirror of https://github.com/ZoneMinder/zoneminder.git synced 2026-09-23 19:15:38 -04:00
Code Issues Packages Projects Releases Wiki Activity
Files
bdf688eecb2cc4e4979da87bf85a4cebe47118fc
zoneminder/scripts/zmdc.pl.in
T
Steve GilvarryandClaude Opus 5 ba49bbb33c fix: make the Perl scripts' taint-safe PATH configurable 
The scripts run under -T, so they cannot trust the caller's PATH and set
their own. Sixteen of them hardcoded /bin:/usr/bin:/usr/local/bin, which
assumes everything they shell out to lives under /usr or /usr/local.

ZoneMinder::General::findDbCommand looks for a database client on that
PATH, and zmupdate.pl and zmcamtool.pl run what it finds. So an install
whose client sits anywhere else cannot apply schema changes:

  sh: mysql: command not found
  Command 'mysql -u'zmuser' ... ' exited with status: 127

even with the client on the caller's PATH. Homebrew on Apple Silicon is
the case that surfaced it - the client is in /opt/homebrew/bin - but a
--prefix=/opt install on Linux has the same shape, as does anything that
keeps its database client outside the FHS locations.

Replaced the literal with @ZM_SCRIPT_PATH@, defaulting to the same three
directories plus wherever cmake actually found a client, and overridable
for packagers who want to pin it. Warn at configure time when no client
is found at all, since that failure otherwise appears much later and
says something unrelated.

Nothing changes for an install whose client is already under /usr/bin:
the directory is only appended when it is not in the list, so the
default stays exactly as it was.

Memory.pm is deliberately left alone. It has a narrower PATH of
/bin:/usr/bin, and the only command it runs is uname through an absolute
path from ZM_PATH_UNAME, so it does not need widening.

Verified on macOS across the three cases: with the client in
/opt/homebrew/bin the directory is appended; -DZM_SCRIPT_PATH= is
respected verbatim; and pointing detection at /usr/bin/mariadb leaves
the default untouched. Build clean, suite 146 cases.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01B5KL9Xbi7K5aGsauLtd8tG
2026-09-13 13:04:59 +10:00

952 lines
29 KiB
Plaintext
Raw Blame History

#!@PERL_EXECUTABLE@ -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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#
# ==========================================================================
=head1 NAME
zmdc.pl - ZoneMinder Daemon Control script
=head1 SYNOPSIS
zmdc.pl {command} [daemon [options]]
=head1 DESCRIPTION
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.
=head1 OPTIONS
{command} - One of 'startup|shutdown|status|check|logrot' or
'start|stop|restart|reload|version'.
[daemon [options]] - Daemon name and options, required for second group of commands
=cut
use strict;
use warnings;
use bytes;
# ==========================================================================
#
# User config
#
# ==========================================================================
# in useconds, not seconds.
use constant MAX_CONNECT_DELAY => 40;
# ==========================================================================
#
# Don't change anything from here on down
#
# ==========================================================================
@EXTRA_PERL_LIB@
use ZoneMinder;
use ZoneMinder::Server;
use POSIX;
use Socket;
use IO::Handle;
use Time::HiRes qw(usleep);
use autouse 'Pod::Usage'=>qw(pod2usage);
#use Data::Dumper;
use constant SOCK_FILE => $Config{ZM_PATH_SOCKS}.'/zmdc'.($Config{ZM_SERVER_ID}?$Config{ZM_SERVER_ID}:'').'.sock';
$| = 1;
$ENV{PATH} = '@ZM_SCRIPT_PATH@';
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
if ( $Config{ZM_LD_PRELOAD} ) {
Debug("Adding ENV{LD_PRELOAD} = $Config{ZM_LD_PRELOAD}");
$ENV{LD_PRELOAD} = $Config{ZM_LD_PRELOAD};
foreach my $lib ( split(/\s+/, $ENV{LD_PRELOAD} ) ) {
if ( ! -e $lib ) {
Warning("LD_PRELOAD lib $lib does not exist from LD_PRELOAD $ENV{LD_PRELOAD}.");
}
}
}
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
my @daemons = (
'zmc',
'zmfilter.pl',
'zmaudit.pl',
'zmtrigger.pl',
'zmx10.pl',
'zmwatch.pl',
'zmupdate.pl',
'zmstats.pl',
'zmtrack.pl',
'zmcontrol.pl',
'zm_rtsp_server',
'zmtelemetry.pl',
'zmalarm-server.py'
);
if ( $Config{ZM_OPT_USE_EVENTNOTIFICATION} ) {
push @daemons, 'zmeventnotification.pl';
}
my $command = shift @ARGV;
if ( !$command ) {
print(STDERR "No command given\n");
pod2usage(-exitstatus => -1);
}
if ( $command eq 'version' ) {
print ZoneMinder::Base::ZM_VERSION."\n";
exit(0);
}
my $needs_daemon = $command !~ /(?:startup|shutdown|status|check|logrot|version)/;
my $daemon = shift @ARGV;
if ( $needs_daemon && !$daemon ) {
print(STDERR "No daemon given\n");
pod2usage(-exitstatus => -1);
}
my @args;
my $daemon_patt = '('.join('|', @daemons).')';
if ( $needs_daemon ) {
if ( $daemon =~ /^${daemon_patt}$/ ) {
$daemon = $1;
} else {
print(STDERR "Invalid daemon '$daemon' specified");
pod2usage(-exitstatus => -1);
}
}
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);
}
}
my $dbh = zmDbConnect();
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) {
my $server = new ZoneMinder::Server($Config{ZM_SERVER_ID});
if ($server->Id()) {
use Sys::MemInfo qw(totalmem freemem totalswap freeswap);
my ($user_percent, $nice_percent, $sys_percent, $idle_percent, $usage_percent) = $server->CpuUsage();
my @cpuload = $server->CpuLoad();
my $in_transaction = ZoneMinder::Database::start_transaction($dbh);
$server->lock_and_load(); # get fresh other values
if ($_=$server->save({Status=>'NotRunning',
CpuLoad=>$cpuload[0],
TotalMem=>&totalmem, FreeMem=>&freemem, TotalSwap=>&totalswap, FreeSwap=>&freeswap,
CpuUserPercent=>$user_percent, CpuNicePercent=>$nice_percent, CpuSystemPercent=>$sys_percent, CpuIdlePercent=>$idle_percent, CpuUsagePercent=>$usage_percent,
})) {
Error('Failed Updating status of Server record to Not Running for Id='.$Config{ZM_SERVER_ID}.': '.$dbh->errstr());
}
ZoneMinder::Database::end_transaction($dbh, $in_transaction);
}
# Server is not up. Some commands can still be handled
if ( $command eq 'logrot' ) {
# If server is not running, then logrotate doesn't need to do anything.
Debug('Server is not running, logrotate doesn\'t need to do anything');
exit();
}
if ( $command eq 'check' ) {
print("stopped\n");
exit();
} elsif ( $command ne 'startup' ) {
print('Unable to connect to server using socket at '.SOCK_FILE."\n");
exit(-1);
}
# The server isn't there
print("Starting server\n");
close(CLIENT);
if ( my $cpid = fork() ) {
# Parent process just sleep and fall through
# I'm still not sure why we need to re-init the logs
logInit();
socket(CLIENT, PF_UNIX, SOCK_STREAM, 0) or Fatal("Can't open socket: $!");
my $attempts = 0;
while ( !connect(CLIENT, $saddr) ) {
$attempts++;
Debug('Waiting for zmdc.pl server process at '.SOCK_FILE.', attempt '.$attempts);
Fatal('Can\'t connect to zmdc.pl server process at '.SOCK_FILE.': '.$!) if $attempts > MAX_CONNECT_DELAY;
usleep(200000);
} # end while
} elsif ( defined($cpid) ) {
ZMServer::run();
} else {
Fatal("Can't fork: $!");
}
} # end if ! server is up
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
CLIENT->autoflush();
my $message = join(';', $command, ( $daemon ? $daemon : () ), @args);
print(CLIENT $message);
shutdown(CLIENT, 1);
# Read response with timeout to avoid hanging indefinitely
my $client_rin = '';
vec($client_rin, fileno(CLIENT), 1) = 1;
while ( select(my $rout = $client_rin, undef, undef, 30) > 0 ) {
my $line = <CLIENT>;
last if !defined($line);
chomp($line);
print("$line\n");
}
close(CLIENT);
exit;
package ZMServer;
use strict;
use warnings;
use bytes;
@EXTRA_PERL_LIB@
use ZoneMinder;
use POSIX;
use Socket;
use IO::Handle;
use Time::HiRes qw(usleep);
use Sys::MemInfo qw(totalmem freemem totalswap freeswap);
use ZoneMinder::Server;
#use Data::Dumper;
use constant KILL_DELAY => 30; # seconds to wait between sending TERM and sending KILL
# ffmpeg connect can take up to 30 seconds at least and doesn't seem to ack signals
# or get back to zm code so we can exit gracefully
our %cmd_hash;
our %pid_hash;
our %terminating_processes;
our %pids_to_reap;
our $zm_terminate = 0;
# Re-assert the pid file so systemd (PIDFile=) keeps tracking us even if it
# was removed out-of-band (e.g. tmpfiles cleanup of /run, or a partial/aborted
# stop that unlinked the pid but left us running). Cheap: only writes when the
# file is missing or its contents don't match our pid. Shutdown-safe: the
# shutdown unlink runs only after the main loop exits, so this can never
# recreate the pid file after termination has begun.
my $pid_reassert_failed = 0;
sub ensure_pid {
my $current;
if ( open(my $fh, '<', ZM_PID) ) {
$current = <$fh>;
close($fh);
chomp $current if defined $current;
}
return if defined($current) and $current eq "$$";
if ( open(my $PID, '>', ZM_PID) ) {
print($PID $$);
close($PID);
Warning('Re-asserted pid file '.ZM_PID.' (was missing or stale)');
$pid_reassert_failed = 0;
} elsif ( !$pid_reassert_failed ) {
# Warn only on the first failure while the condition persists, so a
# permanently unwritable ZM_PID (e.g. /run/zm removed) does not flood the
# log every loop tick. Reset above once a write succeeds again.
Warning('Unable to (re)write pid file '.ZM_PID.": $!");
$pid_reassert_failed = 1;
}
}
sub run {
# Call this first otherwise stdout/stderror redirects to the pidfile = bad
if ( open(my $PID, '>', ZM_PID) ) {
print($PID $$);
close($PID);
} else {
# Log not initialized at this point so use die instead
die 'Can\'t open pid file at '.ZM_PID."\n";
}
# Redirect stdin/stdout/stderr to /dev/null rather than closing them.
# Closing them causes the FDs to be reused, which led to memory corruption
# when libx264 wrote to a reused stderr FD (66f11435b). Redirecting to
# /dev/null keeps valid FDs that children inherit safely.
open(STDIN, '<', '/dev/null') or die "Can't redirect STDIN: $!";
open(STDOUT, '>', '/dev/null') or die "Can't redirect STDOUT: $!";
open(STDERR, '>', '/dev/null') or die "Can't redirect STDERR: $!";
# Close all remaining FDs (dbh, CLIENT, SERVER, etc.)
my $fd = 3;
while ( $fd < POSIX::sysconf(&POSIX::_SC_OPEN_MAX) ) {
POSIX::close($fd++);
}
# Sets a process group, so that signals to go this and it's children I think
setpgrp();
# dbh got closed with the rest of the fd's above, so need to reconnect.
my $dbh = zmDbConnect(1);
logInit();
dPrint(ZoneMinder::Logger::INFO, 'Server starting at '
.strftime('%y/%m/%d %H:%M:%S', localtime())
."\n"
);
# We don't want to leave killall zombies, so ignore SIGCHLD
$SIG{CHLD} = 'IGNORE';
# Tell any existing processes to die, wait 1 second between TERM and KILL
killAll(1);
dPrint(ZoneMinder::Logger::INFO, 'Socket should be open at ' .main::SOCK_FILE);
socket(SERVER, PF_UNIX, SOCK_STREAM, 0) or Fatal("Can't open socket: $!");
unlink(main::SOCK_FILE) or Error('Unable to unlink ' . main::SOCK_FILE .". Error message was: $!") if -e main::SOCK_FILE;
bind(SERVER, sockaddr_un(main::SOCK_FILE)) or Fatal('Can\'t bind to ' . main::SOCK_FILE . ": $!");
listen(SERVER, SOMAXCONN) or Fatal("Can't listen: $!");
$SIG{CHLD} = \&chld_sig_handler;
$SIG{INT} = \&shutdown_sig_handler;
$SIG{TERM} = \&shutdown_sig_handler;
$SIG{ABRT} = \&shutdown_sig_handler;
$SIG{HUP} = \&logrot;
my $rin = '';
vec($rin, fileno(SERVER), 1) = 1;
my $timeout = 1;
my $secs_count = 0;
my $server = new ZoneMinder::Server($Config{ZM_SERVER_ID});
while ( !$zm_terminate ) {
if ($server->Id()) {
if ( ! ( $secs_count % 60 ) ) {
while ( (!$zm_terminate) and !($dbh and $dbh->ping()) ) {
Warning("Not connected to db ($dbh)".($dbh?' ping('.$dbh->ping().')':''). ($DBI::errstr?" errstr($DBI::errstr)":'').' Reconnecting');
$dbh = zmDbConnect();
sleep 10 if !$dbh;
}
last if $zm_terminate;
my $in_transaction = ZoneMinder::Database::start_transaction($dbh);
$server->lock_and_load(); # get fresh other values
my @cpuload = $server->CpuLoad();
my ($user_percent, $nice_percent, $sys_percent, $idle_percent, $usage_percent) = $server->CpuUsage();
if ($_=$server->save({Status=>'Running',
TotalMem=>&totalmem, FreeMem=>&freemem, TotalSwap=>&totalswap, FreeSwap=>&freeswap, CpuLoad=>$cpuload[0],
CpuUserPercent=>$user_percent, CpuNicePercent=>$nice_percent, CpuSystemPercent=>$sys_percent, CpuIdlePercent=>$idle_percent, CpuUsagePercent=>$usage_percent
})) {
Error('Failed Updating status of Server record to Running for Id='.$Config{ZM_SERVER_ID}.': '.$dbh->errstr());
}
ZoneMinder::Database::end_transaction($dbh, $in_transaction);
}
$secs_count += 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(ZoneMinder::Logger::WARNING, "Already running, ignoring command '$command'\n");
} elsif ( $command eq 'shutdown' ) {
# Break out of while loop
last;
} 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(ZoneMinder::Logger::ERROR, "Invalid command '$command'\n");
}
close(CLIENT);
} else {
Error('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
} elsif ( $! == EPIPE ) {
Error("Can't select: $!");
} else {
Fatal("Can't select: $!");
}
} else {
#print( "Select timed out\n" );
}
restartPending();
check_for_processes_to_kill() if %terminating_processes;
reaper() if %pids_to_reap;
ensure_pid();
} # end while
dPrint(ZoneMinder::Logger::INFO, 'Server exiting at '.strftime('%y/%m/%d %H:%M:%S', localtime())."\n");
if ($Config{ZM_SERVER_ID}) {
$dbh = zmDbConnect() if ! ($dbh and $dbh->ping());
my $server = new ZoneMinder::Server($Config{ZM_SERVER_ID});
my $in_transaction = ZoneMinder::Database::start_transaction($dbh);
$server->lock_and_load(); # get fresh other values
if ($_=$server->save({Status=>'NotRunning'})) {
Error('Failed Updating status of Server record to Not Running for Id='.$Config{ZM_SERVER_ID}.': '.$dbh->errstr());
}
ZoneMinder::Database::end_transaction($dbh, $in_transaction);
}
shutdownAll();
}
sub cPrint {
# One thought here, if no client exists to read these... does it block?
if ( fileno(CLIENT) ) {
print CLIENT @_
}
}
# I think the purpose of this is to echo the logs to the client process so it can then display them.
sub dPrint {
my $logLevel = shift;
cPrint(@_);
if ( $logLevel == ZoneMinder::Logger::DEBUG ) {
Debug(@_);
} elsif ( $logLevel == ZoneMinder::Logger::INFO ) {
Info(@_);
} elsif ( $logLevel == ZoneMinder::Logger::WARNING ) {
Warning(@_);
} elsif ( $logLevel == ZoneMinder::Logger::ERROR ) {
Error(@_);
} elsif ( $logLevel == ZoneMinder::Logger::FATAL ) {
Fatal(@_);
}
}
sub start {
my $daemon = shift;
if ( $daemon !~ /^$daemon_patt$/ ) {
Error("Invalid daemon '$daemon' specified");
return;
}
my @args = @_;
my $command = join(' ', $daemon, @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=>1 };
} elsif ( $process->{pid} && $pid_hash{$process->{pid}} ) {
if ($process->{term_sent_at}) {
dPrint(ZoneMinder::Logger::INFO, "'$process->{command}' was told to term at "
.strftime('%y/%m/%d %H:%M:%S', localtime($process->{term_sent_at}))
.", pid = $process->{pid}\n"
);
$process->{keepalive} = !undef;
$process->{delay} = 0;
delete $terminating_processes{$command};
} else {
dPrint(ZoneMinder::Logger::INFO, "'$process->{command}' already running at "
.strftime('%y/%m/%d %H:%M:%S', localtime($process->{started}))
.", pid = $process->{pid}\n"
);
}
return;
}
# We have to block SIGCHLD during fork to prevent races while we setup our records for it
my $sigset = POSIX::SigSet->new;
my $blockset = POSIX::SigSet->new(SIGCHLD);
sigprocmask(SIG_BLOCK, $blockset, $sigset) or Fatal("Can't block SIGCHLD: $!");
# Apparently the child closing the db connection can affect the parent.
zmDbDisconnect();
if ( my $child_pid = fork() ) {
$dbh = zmDbConnect(1);
# This logReinit is required. Not sure why.
logReinit();
$process->{pid} = $child_pid;
$process->{started} = time();
delete $process->{pending};
dPrint(ZoneMinder::Logger::INFO, "'$command' starting at "
.strftime('%y/%m/%d %H:%M:%S', localtime($process->{started}))
.", pid = $process->{pid}\n"
);
$cmd_hash{$process->{command}} = $pid_hash{$child_pid} = $process;
sigprocmask(SIG_SETMASK, $sigset) or Fatal("Can't restore SIGCHLD: $!");
} elsif ( defined($child_pid) ) {
# Child process
# Force reconnection to the db. $dbh got copied, but isn't really valid anymore.
$dbh = zmDbConnect(1);
logReinit();
dPrint(ZoneMinder::Logger::INFO, "'$command' started at "
.strftime('%y/%m/%d %H:%M:%S', localtime())
."\n"
);
if ( $daemon =~ /^$daemon_patt$/ ) {
$daemon = $Config{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");
}
}
logTerm();
zmDbDisconnect();
my $fd = 3; # leave stdin,stdout,stderr open. Closing them causes problems with libx264
while ( $fd < POSIX::sysconf(&POSIX::_SC_OPEN_MAX) ) {
POSIX::close($fd++);
}
$SIG{CHLD} = 'DEFAULT';
$SIG{HUP} = 'DEFAULT';
$SIG{INT} = 'DEFAULT';
$SIG{TERM} = 'DEFAULT';
$SIG{ABRT} = 'DEFAULT';
exec($daemon, @good_args) or Fatal("Can't exec: $!");
} else {
Fatal("Can't fork: $!");
}
} # end sub start
# Sends the stop signal, without waiting around to see if the process died.
sub send_stop {
my ( $final, $process ) = @_;
my $sigset = POSIX::SigSet->new;
my $blockset = POSIX::SigSet->new(SIGCHLD);
sigprocmask(SIG_BLOCK, $blockset, $sigset) or Fatal("Can't block SIGCHLD: $!");
my $command = $process->{command};
if ( $process->{pending} ) {
delete $cmd_hash{$command};
dPrint(ZoneMinder::Logger::INFO, "Command '$command' removed from pending list at "
.strftime('%y/%m/%d %H:%M:%S', localtime())
."\n"
);
sigprocmask(SIG_UNBLOCK, $blockset) or Fatal("Can't unblock SIGCHLD: $!");
return ();
}
my $pid = $process->{pid};
if ( !$pid ) {
dPrint(ZoneMinder::Logger::ERROR, "No process with command of '$command' is running\n");
sigprocmask(SIG_UNBLOCK, $blockset) or Fatal("Can't unblock SIGCHLD: $!");
return();
}
if ( !$pid_hash{$pid} ) {
dPrint(ZoneMinder::Logger::ERROR, "No process with command of '$command' pid $pid is running\n");
sigprocmask(SIG_UNBLOCK, $blockset) or Fatal("Can't unblock SIGCHLD: $!");
return();
}
dPrint(ZoneMinder::Logger::INFO, "'$command' sending stop to pid $pid at "
.strftime('%y/%m/%d %H:%M:%S', localtime())
."\n"
);
$process->{keepalive} = !$final;
$process->{term_sent_at} = time; # Always update to reset the KILL_DELAY countdown
$process->{pending} = 0;
$terminating_processes{$command} = $process;
kill('TERM', $pid);
sigprocmask(SIG_UNBLOCK, $blockset) or Fatal("Can't unblock SIGCHLD: $!");
return $pid;
} # end sub send_stop
sub check_for_processes_to_kill {
# Turn off SIGCHLD
my $sigset = POSIX::SigSet->new;
my $blockset = POSIX::SigSet->new(SIGCHLD);
sigprocmask(SIG_BLOCK, $blockset, $sigset) or Fatal("Can't block SIGCHLD: $!");
foreach my $command ( keys %terminating_processes ) {
my $process = $cmd_hash{$command};
if ( ! $process ) {
Debug("No process found for $command");
delete $terminating_processes{$command};
next;
}
if ( ! $$process{pid} ) {
Warning("Have no pid for $command.");
delete $terminating_processes{$command};
next;
}
my $now = time;
Debug("Have process $command at pid $$process{pid} $now - $$process{term_sent_at} = " . ( $now - $$process{term_sent_at} ));
if ( $$process{term_sent_at} and ( $now - $$process{term_sent_at} > KILL_DELAY ) ) {
dPrint(ZoneMinder::Logger::WARNING, "'$$process{command}' has not stopped at "
.strftime('%y/%m/%d %H:%M:%S', localtime())
.' after ' . KILL_DELAY . ' seconds.'
." Sending KILL to pid $$process{pid}\n"
);
kill('KILL', $$process{pid});
delete $terminating_processes{$command};
}
}
sigprocmask(SIG_UNBLOCK, $blockset) or Fatal("Can't unblock SIGCHLD: $!");
} # end sub check_for_processes_to_kill
sub stop {
my ( $daemon, @args ) = @_;
my $command = join(' ', $daemon, @args);
my $process = $cmd_hash{$command};
if ( !$process ) {
dPrint(ZoneMinder::Logger::WARNING, "Can't find process with command of '$command'");
return;
}
send_stop(1, $process);
}
# restart is the same as stop, except that we flag the processes for restarting once it dies
# One difference is that if we don't know about the process, then we start it.
sub restart {
my ( $daemon, @args ) = @_;
my $command = join(' ', $daemon, @args);
dPrint(ZoneMinder::Logger::DEBUG, "Restarting $command\n");
my $process = $cmd_hash{$command};
if ( !$process ) {
dPrint(ZoneMinder::Logger::WARNING, "Can't find process with command of '$command'\n");
start($daemon, @args);
return;
}
# If already terminating with keepalive set, restart is already scheduled
if ( $terminating_processes{$command} and $process->{keepalive} ) {
dPrint(ZoneMinder::Logger::DEBUG, "'$command' is already terminating and will restart, ignoring duplicate restart request\n");
return;
}
# Start will be handled by the reaper...
# unless it was already pending in which case send_stop will return () so we should start it
if ( !send_stop(0, $process) ) {
dPrint(ZoneMinder::Logger::DEBUG, "!send_stop so starting '$command'\n");
start($daemon, @args);
}
return;
}
sub reload {
my $daemon = shift;
my @args = @_;
my $command = join(' ', $daemon, @args);
my $process = $cmd_hash{$command};
if ( $process ) {
if ( $process->{pid} ) {
kill('HUP', $process->{pid});
}
}
}
sub logrot {
logReinit();
foreach my $process ( values %pid_hash ) {
if ( $process->{pid} ) {
Debug("Rotating logs of $$process{command} at $$process{pid}");
# WINCH, not HUP: HUP means reload, which makes zmc drop its camera
# connection and the perl daemons exit for zmdc to restart. Rotating logs
# nightly must not interrupt capture. See issue #5063.
kill('WINCH', $process->{pid});
} else {
Debug("Not rotating logs of $$process{command}");
}
}
}
sub shutdown_sig_handler {
$zm_terminate = 1;
}
sub chld_sig_handler {
my $saved_status = $!;
# Wait for a child to terminate
while ( (my $cpid = waitpid(-1, WNOHANG)) > 0 ) {
$pids_to_reap{$cpid} = { status=>$?, stopped=>time() };
} # end while waitpid
$SIG{CHLD} = \&chld_sig_handler;
$! = $saved_status;
}
sub reaper {
foreach my $cpid ( keys %pids_to_reap ) {
my $process = $pid_hash{$cpid};
delete $pid_hash{$cpid};
my $reap_info = $pids_to_reap{$cpid};
my ( $status, $stopped ) = @$reap_info{'status','stopped'};
delete $pids_to_reap{$cpid};
if ( !$process ) {
dPrint(ZoneMinder::Logger::INFO, "Can't find child with pid of '$cpid'\n");
next;
}
delete $terminating_processes{$$process{command}};
delete $$process{term_sent_at};
$process->{stopped} = $stopped;
$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->{command}' ";
if ( $exit_signal ) {
# 15 == TERM, 14 == ALARM
if ( $exit_signal == 15 || $exit_signal == 14 ) {
$out_str .= 'exited';
} else {
$out_str .= 'crashed';
}
$out_str .= ", signal $exit_signal";
} else {
$out_str .= 'exited ';
if ( $exit_status ) {
$out_str .= "abnormally, exit status $exit_status";
} else {
$out_str .= 'normally';
}
}
#print( ", core dumped" ) if ( $core_dumped );
$out_str .= "\n";
if ( $exit_status == 0 ) {
Info($out_str);
} else {
Error($out_str);
}
if ( $process->{keepalive} ) {
# Schedule for immediate restart
$cmd_hash{$process->{command}} = $process;
if ( !$process->{delay} || ($process->{runtime} > $Config{ZM_MAX_RESTART_DELAY} ) ) {
#start( $process->{daemon}, @{$process->{args}} );
$process->{pending} = $process->{stopped};
$process->{delay} = 5;
} else {
$process->{pending} = $process->{stopped}+$process->{delay};
$process->{delay} *= 2;
# Limit the start delay to 15 minutes max
if ( $process->{delay} > $Config{ZM_MAX_RESTART_DELAY} ) {
$process->{delay} = $Config{ZM_MAX_RESTART_DELAY};
}
}
#Debug("Delay for $$process{command} is now $$process{delay}");
} else {
delete $cmd_hash{$$process{command}};
}
} # end foreach pid_to_reap
} # end sub reaper
sub restartPending {
# Restart any pending processes, we list them first because cmd_hash may change in foreach
my @processes = values %cmd_hash;
foreach my $process ( @processes ) {
if ( $process->{pending} && $process->{pending} <= time() ) {
dPrint(ZoneMinder::Logger::INFO, "Starting pending process, $process->{command}\n");
start($process->{daemon}, @{$process->{args}});
}
}
}
sub shutdownAll {
foreach my $pid ( keys %pid_hash ) {
# This is a quick fix because a SIGCHLD can happen and alter pid_hash while we are in here.
next if ! $pid_hash{$pid};
send_stop(1, $pid_hash{$pid});
}
while ( keys %terminating_processes ) {
reaper() if %pids_to_reap;
check_for_processes_to_kill();
if ( %terminating_processes ) {
Debug("Still " . scalar(keys %terminating_processes) . ' to die. sleeping');
sleep(1);
}
}
dPrint(ZoneMinder::Logger::INFO, 'Server shutdown at '
.strftime('%y/%m/%d %H:%M:%S', localtime())
."\n"
);
unlink(main::SOCK_FILE) or Error("Unable to unlink " . main::SOCK_FILE .". Error message was: $!") if ( -e main::SOCK_FILE );
unlink(ZM_PID) or Error("Unable to unlink " . ZM_PID .". Error message was: $!") if ( -e ZM_PID );
close(CLIENT);
close(SERVER);
exit();
}
sub check {
my $daemon = shift;
my @args = @_;
my $command = join(' ', $daemon, @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;
if (defined($daemon)) {
my $command = join(' ', $daemon, @_);
my $process = $cmd_hash{$command};
if (!$process) {
dPrint(ZoneMinder::Logger::DEBUG, "'$command' not running\n");
return;
}
if ($process->{pending}) {
dPrint(ZoneMinder::Logger::DEBUG, "'$command' pending at "
.strftime('%y/%m/%d %H:%M:%S', localtime($process->{pending}))
."\n"
);
return;
} else {
my $pid = $process->{pid};
if (!$pid_hash{$pid}) {
dPrint(ZoneMinder::Logger::DEBUG, "'$command' not running\n");
return;
}
}
dPrint(ZoneMinder::Logger::DEBUG, "'$command' running since "
.strftime('%y/%m/%d %H:%M:%S', localtime($process->{started}))
.", pid = $process->{pid}"
);
} else {
foreach my $pid (sort { $a <=> $b } keys %pid_hash) {
my $process = $pid_hash{$pid};
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(ZoneMinder::Logger::DEBUG, $out_str);
}
foreach my $process (values %cmd_hash) {
if ($process->{pending}) {
dPrint(ZoneMinder::Logger::DEBUG, "'$process->{command}' pending at "
.strftime('%y/%m/%d %H:%M:%S', localtime($process->{pending}))
."\n"
);
}
} # end foreach process
}
} # end sub status
sub killAll {
my $delay = shift;
# Why sleep before sending term?
#sleep( $delay );
my $killall;
if ( '@HOST_OS@' eq 'BSD' ) {
$killall = 'killall -q -';
} elsif ( '@HOST_OS@' eq 'solaris' ) {
$killall = 'pkill -';
} else {
$killall = 'killall -q -s ';
}
foreach my $daemon ( @daemons ) {
my $cmd = $killall ."TERM $daemon";
Debug($cmd);
qx($cmd);
}
sleep($delay);
foreach my $daemon ( @daemons ) {
my $cmd = $killall."KILL $daemon";
Debug($cmd);
qx($cmd);
}
}
1;
__END__
Reference in new issue View Git Blame Copy Permalink