#!/usr/bin/perl -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. # # ========================================================================== =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 use strict; @EXTRA_PERL_LIB@ use ZoneMinder; use Getopt::Long; use autouse 'Pod::Usage'=>qw(pod2usage); use POSIX qw/strftime EPIPE/; use Socket; #use Data::Dumper; use Module::Load::Conditional qw{can_load};; use constant MAX_CONNECT_DELAY => 10; 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)}; logInit(); my $arg_string = join( " ", @ARGV ); my $id; my %options; GetOptions( 'id=i' =>\$id, 'command=s' =>\$options{command}, 'xcoord=i' =>\$options{xcoord}, 'ycoord=i' =>\$options{ycoord}, 'speed=i' =>\$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 || !$options{command} ) { print( STDERR "Please give a valid monitor id and command\n" ); pod2usage(-exitstatus => -1); } ( $id ) = $id =~ /^(\w+)$/; Debug( $arg_string ); my $sock_file = $Config{ZM_PATH_SOCKS}.'/zmcontrol-'.$id.'.sock'; 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 ) { # The server isn't there my $monitor = zmDbGetMonitorAndControl( $id ); if ( !$monitor ) { Fatal( "Unable to load control data for monitor $id" ); } my $protocol = $monitor->{Protocol}; if ( -x $protocol ) { # Protocol is actually a script! # Holdover from previous versions my $command .= $protocol.' '.$arg_string; Debug( $command."\n" ); my $output = qx($command); my $status = $? >> 8; if ( $status || logDebugging() ) { chomp( $output ); Debug( "Output: $output\n" ); } if ( $status ) { Error( "Command '$command' exited with status: $status\n" ); 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"); } if ( my $cpid = fork() ) { logReinit(); # Parent process just sleep and fall through socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" ); my $attempts = 0; while (!connect( CLIENT, $saddr )) { $attempts++; Fatal( "Can't connect: $! after $attempts attempts to $sock_file" ) if ($attempts > MAX_CONNECT_DELAY); sleep(1); } } elsif ( defined($cpid) ) { close( STDOUT ); close( STDERR ); setpgrp(); logReinit(); 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(); 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( 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 = ; next if ( !$message ); my $params = jsonDecode( $message ); #Debug( Dumper( $params ) ); my $command = $params->{command}; close( CLIENT ); if ( $command eq 'quit' ) { last; } $control->$command( $params ); } else { Fatal( "Bogus descriptor" ); } } elsif ( $nfound < 0 ) { if ( $! == EPIPE ) { Error( "Can't select: $!" ); } else { Fatal( "Can't select: $!" ); } } else { #print( "Select timed out\n" ); last; } } Info( "Control server $id/$protocol exiting at " .strftime( '%y/%m/%d %H:%M:%S', localtime() ) ); unlink( $sock_file ); $control->close(); exit( 0 ); } else { Fatal( "Can't fork: $!" ); } } # The server is there, connect to it #print( "Writing commands\n" ); CLIENT->autoflush(); my $message = jsonEncode( \%options ); print( CLIENT $message ); shutdown( CLIENT, 1 ); exit( 0 );