339 lines
10 KiB
Perl
Executable File
339 lines
10 KiB
Perl
Executable File
#!/usr/bin/perl -wT
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# ZoneMinder External Trigger Script, $Date$, $Revision$
|
|
# Copyright (C) 2003 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# This script is used to trigger and cancel alarms from external sources
|
|
# using an arbitrary text based format
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# User config
|
|
#
|
|
# ==========================================================================
|
|
|
|
use constant ZM_CONFIG => "<from zmconfig>";
|
|
use constant ZM_VERSION => "<from zmconfig>";
|
|
use constant ZM_PATH_BUILD => "<from zmconfig>";
|
|
use constant ZM_PATH_BIN => "<from zmconfig>";
|
|
use constant ZM_PATH_WEB => "<from zmconfig>";
|
|
|
|
# Load the config from the database into the symbol table
|
|
BEGIN
|
|
{
|
|
no strict 'refs';
|
|
|
|
open( CONFIG, "<".ZM_CONFIG ) or die( "Can't open config file: $!" );
|
|
foreach my $str ( <CONFIG> )
|
|
{
|
|
next if ( $str =~ /^\s*$/ );
|
|
next if ( $str =~ /^\s*#/ );
|
|
my ( $name, $value ) = $str =~ /^\s*([^=\s]+)\s*=\s*([^=\s]+)\s*$/;
|
|
$name =~ tr/a-z/A-Z/;
|
|
if (( $name eq 'ZM_DB_SERVER' ) ||
|
|
( $name eq 'ZM_DB_NAME' ) ||
|
|
( $name eq 'ZM_DB_USER' ) ||
|
|
( $name eq 'ZM_DB_PASS' ))
|
|
{
|
|
*{$name} = sub { $value };
|
|
}
|
|
}
|
|
close( CONFIG );
|
|
|
|
use DBI;
|
|
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USERA, ZM_DB_PASSA );
|
|
my $sql = "select * from Config";
|
|
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
|
my $res = $sth->execute() or die( "Can't execute: ".$sth->errstr() );
|
|
while( my $config = $sth->fetchrow_hashref() )
|
|
{
|
|
*{$config->{Name}} = sub { $config->{Value} };
|
|
}
|
|
$sth->finish();
|
|
$dbh->disconnect();
|
|
}
|
|
|
|
use constant LOG_FILE => ZM_PATH_LOGS.'/zmtrigger.log';
|
|
use constant MAX_CONNECT_DELAY => 10;
|
|
use constant VERBOSE => 0; # Whether to output more verbose debug
|
|
|
|
# Now define the trigger sources, can be inet socket, unix socket or file based
|
|
# Ignore parser field for now.
|
|
|
|
my @sources = (
|
|
{ name=>"S1", type=>"inet", port=>"6802", parser=>"", },
|
|
{ name=>"S2", type=>"unix", path=>"/tmp/test.sock", parser=>"", },
|
|
{ name=>"S3", type=>"file", path=>"/dev/ttyS0", parser=>"", },
|
|
);
|
|
|
|
# Need to make sure each parser function is defined
|
|
sub parseTrigger1
|
|
{
|
|
}
|
|
|
|
# ==========================================================================
|
|
#
|
|
# Don't change anything from here on down
|
|
#
|
|
# ==========================================================================
|
|
|
|
use strict;
|
|
use DBI;
|
|
use POSIX;
|
|
use Fcntl;
|
|
use Socket;
|
|
use IO::Handle;
|
|
use Data::Dumper;
|
|
|
|
$| = 1;
|
|
|
|
$ENV{PATH} = '/bin:/usr/bin';
|
|
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
|
|
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
|
|
|
|
open( LOG, ">>".LOG_FILE ) or die( "Can't open log file: $!" );
|
|
open(STDOUT, ">&LOG") || die( "Can't dup stdout: $!" );
|
|
select( STDOUT ); $| = 1;
|
|
open(STDERR, ">&LOG") || die( "Can't dup stderr: $!" );
|
|
select( STDERR ); $| = 1;
|
|
select( LOG ); $| = 1;
|
|
|
|
print( "Trigger daemon starting at ".strftime( '%y/%m/%d %H:%M:%S', localtime() )."\n" );
|
|
|
|
my $dbh = DBI->connect( "DBI:mysql:database=".ZM_DB_NAME.";host=".ZM_DB_SERVER, ZM_DB_USERA, ZM_DB_PASSA );
|
|
|
|
my $sql = "select * from Monitors where Id = ? or Name = ?";
|
|
my $sth = $dbh->prepare_cached( $sql ) or die( "Can't prepare '$sql': ".$dbh->errstr() );
|
|
|
|
$SIG{HUP} = \&status;
|
|
|
|
my $base_rin = '';
|
|
foreach my $source ( @sources )
|
|
{
|
|
print( "Opening source '$source->{name}'\n" );
|
|
if ( $source->{type} eq "inet" )
|
|
{
|
|
local *sfh;
|
|
my $saddr = sockaddr_in( $source->{port}, INADDR_ANY );
|
|
socket( *sfh, PF_INET, SOCK_STREAM, getprotobyname('tcp') ) or die( "Can't open socket: $!" );
|
|
setsockopt( *sfh, SOL_SOCKET, SO_REUSEADDR, 1 );
|
|
bind( *sfh, $saddr ) or die( "Can't bind: $!" );
|
|
listen( *sfh, SOMAXCONN ) or die( "Can't listen: $!" );
|
|
$source->{handle} = *sfh;
|
|
vec( $base_rin, fileno($source->{handle}),1) = 1;
|
|
}
|
|
elsif ( $source->{type} eq "unix" )
|
|
{
|
|
local *sfh;
|
|
unlink( $source->{path} );
|
|
my $saddr = sockaddr_un( $source->{path} );
|
|
socket( *sfh, PF_UNIX, SOCK_STREAM, 0 ) or die( "Can't open socket: $!" );
|
|
bind( *sfh, $saddr ) or die( "Can't bind: $!" );
|
|
listen( *sfh, SOMAXCONN ) or die( "Can't listen: $!" );
|
|
$source->{handle} = *sfh;
|
|
vec( $base_rin, fileno($source->{handle}),1) = 1;
|
|
}
|
|
elsif ( $source->{type} eq "file" )
|
|
{
|
|
local *sfh;
|
|
#sysopen( *sfh, $source->{path}, O_NONBLOCK|O_RDONLY ) or die( "Can't sysopen: $!" );
|
|
open( *sfh, "<".$source->{path} ) or die( "Can't open: $!" );
|
|
$source->{handle} = *sfh;
|
|
vec( $base_rin, fileno($source->{handle}),1) = 1;
|
|
}
|
|
else
|
|
{
|
|
die( "Bogus source type '$source->{type}' found for '$source->{name}'" );
|
|
}
|
|
}
|
|
|
|
my $sigset = POSIX::SigSet->new;
|
|
my $blockset = POSIX::SigSet->new( SIGCHLD );
|
|
sigprocmask( SIG_BLOCK, $blockset, $sigset ) or die( "Can't block SIGCHLD: $!" );
|
|
|
|
my %connections;
|
|
|
|
$! = undef;
|
|
my $rin = '';
|
|
my $win = $rin;
|
|
my $ein = $win;
|
|
my $timeout = 1;
|
|
my %actions;
|
|
while( 1 )
|
|
{
|
|
$rin = $base_rin;
|
|
foreach my $fileno ( keys(%connections) )
|
|
{
|
|
vec( $rin, $fileno,1) = 1;
|
|
}
|
|
my $nfound = select( my $rout = $rin, undef, my $eout = $ein, $timeout );
|
|
if ( $nfound > 0 )
|
|
{
|
|
print( "Got input from $nfound sources\n" ) if ( VERBOSE );
|
|
foreach my $source ( @sources )
|
|
{
|
|
if ( vec( $rout, fileno($source->{handle}),1) )
|
|
{
|
|
print( "Got input from source $source->{name} (".fileno($source->{handle}).")\n" ) if ( VERBOSE );
|
|
if ( $source->{type} eq "inet" || $source->{type} eq "unix" )
|
|
{
|
|
local *cfh;
|
|
my $paddr = accept( *cfh, $source->{handle} );
|
|
$connections{fileno(*cfh)} = { source=>$source, handle=>*cfh };
|
|
print( "Added new connection (".fileno(*cfh)."), ".int(keys(%connections))." connections\n" ) if ( VERBOSE );
|
|
}
|
|
else
|
|
{
|
|
my $buffer;
|
|
my $nbytes = sysread( $source->{handle}, $buffer, POSIX::BUFSIZ );
|
|
if ( !$nbytes )
|
|
{
|
|
die( "Got unexpected close on source $source->{name}" );
|
|
}
|
|
else
|
|
{
|
|
print( "Got '$buffer' ($nbytes bytes)\n" ) if ( VERBOSE );
|
|
handleMessage( $buffer );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
foreach my $connection ( values(%connections) )
|
|
{
|
|
print( "Got input from connection on ".$connection->{source}->{name}." (".fileno($connection->{handle}).")\n" ) if ( VERBOSE );
|
|
if ( vec( $rout, fileno($connection->{handle}),1) )
|
|
{
|
|
my $buffer;
|
|
my $nbytes = sysread( $connection->{handle}, $buffer, POSIX::BUFSIZ );
|
|
if ( !$nbytes )
|
|
{
|
|
delete( $connections{fileno($connection->{handle})} );
|
|
print( "Removed connection (".fileno($connection->{handle})."), ".int(keys(%connections))." connections\n" ) if ( VERBOSE );
|
|
close( $connection->{handle} );
|
|
}
|
|
else
|
|
{
|
|
print( "Got '$buffer' ($nbytes bytes)\n" ) if ( VERBOSE );
|
|
handleMessage( $buffer );
|
|
}
|
|
}
|
|
}
|
|
}
|
|
elsif ( $nfound < 0 )
|
|
{
|
|
if ( $! == EINTR )
|
|
{
|
|
# Dead child, will be reaped
|
|
#print( "Probable dead child\n" );
|
|
}
|
|
else
|
|
{
|
|
die( "Can't select: $!" );
|
|
}
|
|
}
|
|
else
|
|
{
|
|
print( "Checking for timed actions at ".time()."\n" ) if ( VERBOSE && int(keys(%actions)) );
|
|
my $now = time();
|
|
foreach my $action_time ( sort( grep { $_ < $now } keys( %actions ) ) )
|
|
{
|
|
print( "Found actions expiring at $action_time\n" );
|
|
foreach my $action ( @{$actions{$action_time}} )
|
|
{
|
|
print( "Found action '$action'\n" );
|
|
handleMessage( $action );
|
|
}
|
|
delete( $actions{$action_time} );
|
|
}
|
|
}
|
|
}
|
|
print( "Trigger daemon exiting\n" );
|
|
|
|
sub handleMessage
|
|
{
|
|
my $buffer = shift;
|
|
#chomp( $buffer );
|
|
|
|
print( "Processing buffer '$buffer'\n" ) if ( VERBOSE );
|
|
foreach my $message ( split( /\r?\n/, $buffer ) )
|
|
{
|
|
next if ( !$message );
|
|
print( "Processing message '$message'\n" ) if ( VERBOSE );
|
|
my ( $id, $action, $score, $cause, $text ) = split( /\|/, $message );
|
|
|
|
my $res = $sth->execute( $id, $id ) or die( "Can't execute '$sql': ".$sth->errstr() );
|
|
my $monitor = $sth->fetchrow_hashref();
|
|
|
|
if ( !$monitor )
|
|
{
|
|
print( "Can't find monitor '$id' for message '$message'\n" );
|
|
next;
|
|
}
|
|
print( "Found monitor for id '$id'\n" ) if ( VERBOSE );
|
|
my $size = 512; # We only need the first 512 bytes really for the alarm state and forced alarm
|
|
$monitor->{ShmKey} = hex(ZM_SHM_KEY)|$monitor->{Id};
|
|
$monitor->{ShmId} = shmget( $monitor->{ShmKey}, $size, 0 );
|
|
if ( !defined($monitor->{ShmId}) )
|
|
{
|
|
printf( "Can't get shared memory id '%x': $!\n", $monitor->{ShmKey}, $! );
|
|
next;
|
|
}
|
|
|
|
print( "Handling action '$action'\n" ) if ( VERBOSE );
|
|
if ( $action =~ /^(on|off)(?:\+(\d+))?$/ )
|
|
{
|
|
my $trigger = $1;
|
|
my $delay = $2;
|
|
my $force_data = pack( "llZ32Z256", $trigger eq "on"?1:2, $trigger eq "on"?$score:0, $cause, $text );
|
|
if ( !shmwrite( $monitor->{ShmId}, $force_data, 52, 4+4+32+256 ) )
|
|
{
|
|
print( "Can't write to shared memory: $!\n" );
|
|
}
|
|
print( "Triggered event $trigger '$cause'\n" );
|
|
if ( $delay )
|
|
{
|
|
my $action_time = time()+$delay;
|
|
my $action_text = $id."|cancel|".$cause."|".$text;
|
|
my $action_array = $actions{$action_time};
|
|
if ( !$action_array )
|
|
{
|
|
$action_array = $actions{$action_time} = [];
|
|
}
|
|
push( @$action_array, $action_text );
|
|
print( "Added timed event '$action_text', expires at $action_time (+$delay secs)\n" ) if ( VERBOSE );
|
|
}
|
|
}
|
|
elsif( $action eq "cancel" )
|
|
{
|
|
my $force_data = pack( "llZ32Z256", 0, 0, "", "" );
|
|
if ( !shmwrite( $monitor->{ShmId}, $force_data, 52, 4+4+32+256 ) )
|
|
{
|
|
print( "Can't write to shared memory: $!\n" );
|
|
}
|
|
print( "Cancelled event '$cause'\n" );
|
|
}
|
|
else
|
|
{
|
|
print( "Unrecognised action '$action' in message '$message'\n" );
|
|
}
|
|
}
|
|
}
|