zoneminder/scripts/zmcontrol.pl.in

248 lines
6.5 KiB
Perl

#!@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;
@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 Module::Load::Conditional qw{can_load};
use constant MAX_CONNECT_DELAY => 15;
use constant MAX_COMMAND_WAIT => 1800;
$| = 1;
$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
my $arg_string = join(' ', @ARGV);
my $id;
my %options;
GetOptions(
'id=i' =>\$id,
'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},
'autostop' =>\$options{autostop},
) or pod2usage(-exitstatus => -1);
if (!$id) {
print(STDERR "Please give a valid monitor id\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 {
# The server isn't there
my $monitor = zmDbGetMonitorAndControl($id);
Fatal("Unable to load control data for monitor $id") if !$monitor;
my $protocol = $monitor->{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');
}
if (-x $protocol) {
# Protocol is actually a script!
# Holdover from previous versions
my $command .= $protocol.' '.$arg_string;
Debug($command);
my $output = qx($command);
my $status = $? >> 8;
if ($status || logDebugging()) {
chomp($output);
Debug("Output: $output");
}
if ($status) {
Error("Command '$command' exited with status: $status");
exit($status);
}
exit(0);
}
Info("Starting control server $id/$protocol");
close(CLIENT);
if (!can_load(modules => {'ZoneMinder::Control::'.$protocol => undef})) {
Fatal("Can't load ZoneMinder::Control::$protocol\n$Module::Load::Conditional::ERROR");
}
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 = ('ZoneMinder::Control::'.$protocol)->new($id);
my $control_key = $control->getKey();
$control->loadMonitor();
$control->open();
# If we have a command when starting up, then do it.
if ($options{command}) {
my $command = $options{command};
$control->$command(\%options);
}
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;
my $timeout = MAX_COMMAND_WAIT;
while (!$zm_terminate) {
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>;
close(CLIENT);
next if !$message;
my $params = jsonDecode($message);
Debug(Dumper($params));
my $command = $params->{command};
if ( $command eq 'quit' ) {
last;
} elsif ( $command ) {
$control->$command($params);
} else {
Warning("No command in $message");
}
} 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('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]
=head1 DESCRIPTION
FIXME FIXME
=head1 OPTIONS
--autostop -
--xcoord [ arg ] - X-coord
--ycoord [ arg ] - Y-coord
--speed [ arg ] - Speed
--step [ arg ] -
--panspeed [ arg ] -
--panstep [ arg ] -
--tiltspeed [ arg ] -
--tiltstep [ arg ] -
--preset [ arg ] -
=cut