scripts/zmcontrol.pl.in
Rama master · réplica de lectura del repositorio original.
#!@PERL_EXECUTABLE@ -wT
#
# ==========================================================================
#
# ZoneMinder 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.
#
# ==========================================================================
use strict;
use warnings;
@EXTRA_PERL_LIB@
use ZoneMinder;
use Getopt::Long;
use autouse 'Pod::Usage'=>qw(pod2usage);
use POSIX qw/strftime EPIPE EINTR/;
use Socket;
use Data::Dumper;
use constant MAX_CONNECT_DELAY => 15;
use constant MAX_COMMAND_WAIT => 1800;
$| = 1;
$ENV{PATH} = '@ZM_SCRIPT_PATH@';
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
my $arg_string = join(' ', @ARGV);
my $id;
my $protocol;
my $address;
my $device;
my %options;
GetOptions(
'id=i' =>\$id,
'protocol=s' =>\$protocol,
'address=s' =>\$address,
'device=s' =>\$device,
'command=s' =>\$options{command},
'xcoord=f' =>\$options{xcoord},
'ycoord=f' =>\$options{ycoord},
'speed=f' =>\$options{speed},
'step=i' =>\$options{step},
'panspeed=i' =>\$options{panspeed},
'tiltspeed=i' =>\$options{tiltspeed},
'panstep=i' =>\$options{panstep},
'tiltstep=i' =>\$options{tiltstep},
'preset=i' =>\$options{preset},
'file=i' =>\$options{file},
'autostop' =>\$options{autostop},
) or pod2usage(-exitstatus => -1);
if ($protocol) {
# Direct protocol mode: bypass DB and socket, load module and run command directly
logInit(id=>'zmcontrol_protocol');
my $command = $options{command};
if (!$command) {
print(STDERR "Please supply a --command when using --protocol mode\n");
pod2usage(-exitstatus => -1);
}
# Validate protocol name (alphanumeric and underscore only)
($protocol) = $protocol =~ /^(\w+)$/;
if (!$protocol) {
Fatal('Invalid protocol name');
}
my $module = "ZoneMinder::Control::$protocol";
eval "require $module"
or Fatal("Failed to load protocol module $module: $@");
my $control = bless {
Monitor => {
ControlDevice => $device // '',
ControlAddress => $address // '',
AutoStopTimeout => $options{autostop} // 0,
},
}, $module;
if (!$control->open()) {
Fatal('Failed to open control');
}
Info("Direct protocol mode: $module -> $command");
if (!$control->can($command)) {
Fatal("$module does not implement '$command'");
}
my $result = $control->$command(\%options);
if (defined $result) {
if (ref $result) {
print(Dumper($result));
} else {
print("$result\n");
}
}
$control->close();
exit(0);
}
if (!$id) {
print(STDERR "Please give a valid monitor id or use --protocol for direct mode\n");
pod2usage(-exitstatus => -1);
}
($id) = $id =~ /^(\w+)$/;
logInit($id?(id=>'zmcontrol_'.$id):());
my $sock_file = $Config{ZM_PATH_SOCKS}.'/zmcontrol-'.$id.'.sock';
Debug("zmcontrol: arg string: $arg_string sock file $sock_file");
socket(CLIENT, PF_UNIX, SOCK_STREAM, 0) or Fatal("Can't open socket: $!");
my $saddr = sockaddr_un($sock_file);
if ($options{command}) {
# Have a command, so we are the client, connect to the server and send it.
my $tries = 10;
my $server_up;
while ( $tries and ! ( $server_up = connect(CLIENT, $saddr) ) ) {
Debug("Failed to connect to zmcontrol server at $sock_file");
runCommand("zmdc.pl start zmcontrol.pl --id $id");
sleep 1;
$tries -= 1;
}
if ( $server_up ) {
# The server is there, connect to it
#print( "Writing commands\n" );
CLIENT->autoflush();
if ( $options{command} ) {
my $message = jsonEncode(\%options);
print(CLIENT $message);
}
shutdown(CLIENT, 1);
} else {
Error("Unable to connect to zmcontrol server at $sock_file");
}
} else {
# We are the server
require ZoneMinder::Monitor;
# Only one control server per monitor. Nothing used to stop a second one, and
# it would unlink the live socket further down and bind its own, leaving the
# first listening on an unlinked inode that no client can reach while both
# still held the camera's control connection open. Take the lock before
# anything talks to the camera or the socket.
# The lock is a separate file rather than the socket itself so that a socket
# left behind by a killed server does not block startup for good.
# refs #4423
my $lock_file = $Config{ZM_PATH_SOCKS}.'/zmcontrol-'.$id.'.lock';
# Held for the lifetime of the process: the lock is released when $lock_fh
# goes out of scope, and this block runs until the server exits.
my ($lock_fh, $lock_status, $lock_pid) = acquireExclusiveLock($lock_file);
if (!$lock_fh) {
if ($lock_status eq 'held') {
Error("Another zmcontrol server is already running for monitor $id"
.(defined($lock_pid) ? " (pid $lock_pid)" : '').', exiting');
} else {
Error("Can't take the control server lock at $lock_file, so not starting."
.' It has to be writable by the user zmcontrol.pl runs as, so check its'
.' ownership if it was created by a hand run as another user.');
}
# zmdc starts us with keepalive, so a non-zero exit here is retried with a
# backoff capped at ZM_MAX_RESTART_DELAY rather than staying dead. That is
# what we want while a duplicate is still up, since it clears itself once
# the other server goes. A lock file we cannot open never clears on its own,
# which is why that case says what to look at.
exit(1);
}
my $monitor = ZoneMinder::Monitor->find_one(Id=>$id);
Fatal("Unable to load control data for monitor $id") if !$monitor;
my $control = $monitor->Control();
my $protocol = $control->{Protocol};
if (!$protocol) {
Fatal('No protocol is set in monitor. Please edit the monitor, edit control type, select the control capability and fill in the Protocol field');
}
Info("Starting control server $id/$protocol");
close(CLIENT);
my $zm_terminate = 0;
sub TermHandler {
Info('Received TERM, exiting');
$zm_terminate = 1;
}
$SIG{TERM} = \&TermHandler;
$SIG{INT} = \&TermHandler;
Info("Control server $id/$protocol starting at " .strftime('%y/%m/%d %H:%M:%S', localtime()));
$0 = $0.' --id '.$id;
my $control_key = $control->getKey();
$control->loadMonitor();
if (!$control->open()) {
Warning("Failed to open control");
}
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: $!");
my $rin = '';
vec($rin, fileno(SERVER), 1) = 1;
my $win = $rin;
my $ein = $win;
# Use a short timeout if the module supports keepAlive so the session
# does not expire between commands (Dahua cameras expire after ~60s idle).
my $timeout = $control->can('keepAlive') ? 30 : MAX_COMMAND_WAIT;
while (!$zm_terminate) {
# Checked every time round rather than only when select times out. A busy
# monitor never reaches the idle branch below, and used to hold a session
# the camera had already expired, so its next command came back
# undecodable. Here so that the 'next' paths in the command handling
# cannot skip it.
if ($control->can('keepAlive') and $control->keepAliveDue($timeout)) {
$control->keepAlive();
}
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>;
if ( !$message ) {
close(CLIENT);
next;
}
my $params = jsonDecode($message);
Debug(Dumper($params));
my $command = $params->{command};
if ( $command eq 'quit' ) {
close(CLIENT);
last;
} elsif ( $command and $command !~ /^[A-Za-z]\w*$/ ) {
# The name comes from a web request and is called as a method; a qualified name
# (Package::sub) would call a sub outside the control module. refs GHSA-qcm7-vq92-f86f
Warning('Invalid control command');
close(CLIENT);
} elsif ( $command ) {
# A monitor's actions and ui buttons are configured independently of
# its control protocol, so a command the protocol does not implement
# is a configuration mistake, not a reason to take the control server
# down. Swapping a camera for a different make leaves exactly this
# behind: a LightOn action pointing at a protocol with no lightOn,
# which used to die with "Can't locate object method".
if ( !$control->can($command) ) {
# ${id} braced: "$id's" parses as $id::s, the old package
# separator, so the id silently vanished from the message.
Error("Control protocol $protocol does not implement '$command',"
." ignoring it. Check monitor ${id}'s control type and the"
.' actions configured against it.');
if ( $params->{wants_response} ) {
local $SIG{PIPE} = 'IGNORE';
print(CLIENT jsonEncode({result => undef, error => "unsupported command $command"}));
}
close(CLIENT);
next;
}
my $result = $control->$command($params);
# Opt-in response: only write back when the caller asked for one, so
# fire-and-forget callers (which have already closed their end) never
# get a write -> no SIGPIPE. Ignore PIPE defensively in case a query
# client gave up before reading.
if ( $params->{wants_response} ) {
local $SIG{PIPE} = 'IGNORE';
print(CLIENT jsonEncode({result => $result}));
}
close(CLIENT);
} else {
Warning("No command in $message");
close(CLIENT);
}
} else {
Fatal('Bogus descriptor');
}
} elsif ( $nfound < 0 ) {
if ( $! == EINTR ) {
# Likely just SIGHUP
Debug("Can't select: $!");
} elsif ( $! == EPIPE ) {
Error("Can't select: $!");
} else {
Fatal("Can't select: $!");
}
} else {
Debug(3, 'Select timed out');
}
} # end while !$zm_terminate
Info("Control server $id/$protocol exiting");
unlink($sock_file);
$control->close();
} # end if !server up
exit(0);
1;
__END__
=head1 NAME
zmcontrol.pl - ZoneMinder control script
=head1 SYNOPSIS
zmcontrol.pl --id {monitor_id} [--command={command}] [various options]
zmcontrol.pl --protocol {module} --address {addr} [--device {dev}] --command {cmd}
=head1 DESCRIPTION
ZoneMinder camera control script. Operates in two modes:
B<Monitor mode> (--id): Connects to the control daemon for the given monitor,
or starts the daemon if run without --command. Requires a running ZoneMinder
instance with database access.
B<Direct protocol mode> (--protocol): Loads a ZoneMinder::Control module
directly and executes a single command without requiring database access or a
running ZoneMinder instance. Useful for testing control modules.
=head1 OPTIONS
--id [ monitor_id ] - Monitor ID (monitor mode)
--protocol [ name ] - Control module name, e.g. ONVIF (direct mode)
--address [ addr ] - ControlAddress, e.g. user:pass@host:port (direct mode)
--device [ dev ] - ControlDevice / profile token (direct mode)
--command [ cmd ] - Command to execute (e.g. moveConUp, get_config)
--autostop -
--xcoord [ arg ] - X-coord
--ycoord [ arg ] - Y-coord
--speed [ arg ] - Speed
--step [ arg ] -
--panspeed [ arg ] -
--panstep [ arg ] -
--tiltspeed [ arg ] -
--tiltstep [ arg ] -
--preset [ arg ] -
=head1 EXAMPLES
# Direct protocol testing (no database needed)
zmcontrol.pl --protocol ONVIF --address admin:pass@192.168.1.100 --command get_config
# With profile token
zmcontrol.pl --protocol ONVIF --address admin:pass@cam:8080 --device prof0 --command get_config
# Send command to running monitor daemon
zmcontrol.pl --id 1 --command moveConUp
=cut