1057 lines
33 KiB
Perl
1057 lines
33 KiB
Perl
#!@PERL_EXECUTABLE@ -wT
|
|
#
|
|
# ==========================================================================
|
|
#
|
|
# ZoneMinder Event Filter 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
|
|
|
|
zmfilter.pl - ZoneMinder tool to filter events
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
zmfilter.pl [-f <filter name>,--filter=<filter name>] [--filter_id=<filter id>] | -v, --version
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This script continuously monitors the recorded events for the given
|
|
monitor and applies any filters which would delete and/or upload
|
|
matching events.
|
|
|
|
=head1 OPTIONS
|
|
|
|
|
|
-f{filter name}, --filter={filter name} - The name of a specific filter to run
|
|
--filter_id={filter id} - The id of a specific filter to run
|
|
-v, --version - Print ZoneMinder version
|
|
|
|
=cut
|
|
use strict;
|
|
use bytes;
|
|
|
|
# ==========================================================================
|
|
#
|
|
# These are the elements you can edit to suit your installation
|
|
#
|
|
# ==========================================================================
|
|
|
|
use constant START_DELAY => 5; # How long to wait before starting
|
|
|
|
# ==========================================================================
|
|
#
|
|
# You shouldn't need to change anything from here downwards
|
|
#
|
|
# ==========================================================================
|
|
|
|
@EXTRA_PERL_LIB@
|
|
use ZoneMinder;
|
|
use DBI;
|
|
use POSIX;
|
|
use Time::HiRes qw/gettimeofday/;
|
|
#use Date::Manip;
|
|
use Getopt::Long;
|
|
use autouse 'Pod::Usage'=>qw(pod2usage);
|
|
use autouse 'Data::Dumper'=>qw(Dumper);
|
|
use File::Path qw(make_path);
|
|
|
|
my $daemon = 0;
|
|
my $filter_name = '';
|
|
my $filter_id;
|
|
my $version = 0;
|
|
my $zm_terminate = 0;
|
|
|
|
GetOptions(
|
|
daemon =>\$daemon,
|
|
'filter=s' =>\$filter_name,
|
|
'filter_id=s' =>\$filter_id,
|
|
version =>\$version
|
|
) or pod2usage(-exitstatus => -1);
|
|
|
|
if ( $version ) {
|
|
print ZoneMinder::Base::ZM_VERSION . "\n";
|
|
exit(0);
|
|
}
|
|
|
|
require ZoneMinder::Event;
|
|
require ZoneMinder::Filter;
|
|
|
|
use constant EVENT_PATH => ($Config{ZM_DIR_EVENTS}=~m|/|)
|
|
? $Config{ZM_DIR_EVENTS}
|
|
: ($Config{ZM_PATH_WEB}.'/'.$Config{ZM_DIR_EVENTS})
|
|
;
|
|
|
|
logInit($filter_id?(id=>'zmfilter_'.$filter_id):());
|
|
|
|
sub HupHandler {
|
|
# This idea at this time is to just exit, freeing up the memory.
|
|
# zmfilter.pl will be respawned by zmdc.
|
|
TermHandler();
|
|
return;
|
|
|
|
Info('Received HUP, reloading');
|
|
ZoneMinder::Object::init_cache();
|
|
&ZoneMinder::Logger::logHupHandler();
|
|
}
|
|
sub TermHandler {
|
|
Info('Received TERM, exiting');
|
|
$zm_terminate = 1;
|
|
}
|
|
sub Term {
|
|
exit(0);
|
|
}
|
|
$SIG{HUP} = \&HupHandler;
|
|
$SIG{TERM} = \&TermHandler;
|
|
$SIG{INT} = \&TermHandler;
|
|
|
|
if ( $Config{ZM_OPT_UPLOAD} ) {
|
|
# Comment these out if you don't have them and don't want to upload
|
|
# or don't want to use that format
|
|
if ( $Config{ZM_UPLOAD_ARCH_FORMAT} eq 'zip' ) {
|
|
require Archive::Zip;
|
|
import Archive::Zip qw( :ERROR_CODES :CONSTANTS );
|
|
} else {
|
|
require Archive::Tar;
|
|
}
|
|
if ( $Config{ZM_UPLOAD_PROTOCOL} eq 'ftp' ) {
|
|
require Net::FTP;
|
|
} else {
|
|
require Net::SFTP::Foreign;
|
|
}
|
|
}
|
|
|
|
if ( $Config{ZM_OPT_EMAIL} ) {
|
|
if ( $Config{ZM_NEW_MAIL_MODULES} ) {
|
|
require MIME::Lite;
|
|
require Net::SMTP;
|
|
} else {
|
|
require MIME::Entity;
|
|
}
|
|
}
|
|
|
|
if ( $Config{ZM_OPT_MESSAGE} ) {
|
|
if ( $Config{ZM_NEW_MAIL_MODULES} ) {
|
|
require MIME::Lite;
|
|
require Net::SMTP;
|
|
} else {
|
|
require MIME::Entity;
|
|
}
|
|
}
|
|
|
|
$| = 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 $delay = $Config{ZM_FILTER_EXECUTE_INTERVAL};
|
|
my $event_id = 0;
|
|
|
|
if ( ! EVENT_PATH ) {
|
|
Error("No event path defined. Config was $Config{ZM_DIR_EVENTS}");
|
|
die;
|
|
}
|
|
|
|
# In future, should not be neccessary wrt StorageAreas
|
|
chdir( EVENT_PATH );
|
|
|
|
# Should not be neccessary... but nice to get a local var. What if it fails?
|
|
my $dbh = zmDbConnect();
|
|
|
|
if ( $filter_name ) {
|
|
Info("Scanning for events using filter '$filter_name'");
|
|
} elsif ( defined($filter_id) ) {
|
|
if ( $filter_id ) {
|
|
Info("Scanning for events using filter id '$filter_id'");
|
|
} else {
|
|
Fatal('No filter_id specified');
|
|
}
|
|
} else {
|
|
Info('Scanning for events using all filters');
|
|
}
|
|
|
|
if ( ! ( $filter_name or $filter_id ) ) {
|
|
Debug('Sleeping due to start delay: ' . START_DELAY . ' seconds...');
|
|
sleep(START_DELAY);
|
|
}
|
|
|
|
my @filters;
|
|
my $last_action = 0;
|
|
|
|
while( !$zm_terminate ) {
|
|
my $now = time;
|
|
if ( ($now - $last_action) > $Config{ZM_FILTER_RELOAD_DELAY} ) {
|
|
Debug('Reloading filters');
|
|
$last_action = $now;
|
|
@filters = getFilters({ Name=>$filter_name, Id=>$filter_id });
|
|
}
|
|
|
|
foreach my $filter ( @filters ) {
|
|
last if $zm_terminate;
|
|
if ( $$filter{Concurrent} and ! ( $filter_id or $filter_name ) ) {
|
|
my ( $proc ) = $0 =~ /(\S+)/;
|
|
my ( $id ) = $$filter{Id} =~ /(\d+)/;
|
|
Debug("Running concurrent filter process $proc --filter_id $$filter{Id} => $id for $$filter{Name}");
|
|
|
|
system(qq`$proc --filter "$$filter{Name}" &`);
|
|
} else {
|
|
checkFilter($filter);
|
|
}
|
|
}
|
|
|
|
last if (!$daemon and ($filter_name or $filter_id)) or $zm_terminate;
|
|
|
|
Debug("Sleeping for $delay seconds");
|
|
sleep($delay);
|
|
}
|
|
|
|
sub getFilters {
|
|
my $sql_filters = @_ ? shift : {};
|
|
my @sql_values;
|
|
|
|
my @filters;
|
|
my $sql = 'SELECT * FROM `Filters` WHERE';
|
|
if ( $$sql_filters{Name} ) {
|
|
$sql .= ' `Name` = ? AND';
|
|
push @sql_values, $$sql_filters{Name};
|
|
} elsif ( $$sql_filters{Id} ) {
|
|
$sql .= ' `Id` = ? AND';
|
|
push @sql_values, $$sql_filters{Id};
|
|
} else {
|
|
$sql .= ' `Background` = 1 AND';
|
|
}
|
|
$sql .= '( `AutoArchive` = 1
|
|
or `AutoUnarchive` = 1
|
|
or `AutoVideo` = 1
|
|
or `AutoUpload` = 1
|
|
or `AutoEmail` = 1
|
|
or `AutoMessage` = 1
|
|
or `AutoExecute` = 1
|
|
or `AutoDelete` = 1
|
|
or `UpdateDiskSpace` = 1
|
|
or `AutoMove` = 1
|
|
or `AutoCopy` = 1
|
|
) ORDER BY `Name`';
|
|
my $sth = $dbh->prepare_cached($sql)
|
|
or Fatal("Unable to prepare '$sql': ".$dbh->errstr());
|
|
my $res = $sth->execute(@sql_values)
|
|
or Fatal("Unable to execute '$sql': ".$dbh->errstr());
|
|
FILTER: while( my $db_filter = $sth->fetchrow_hashref() ) {
|
|
my $filter = new ZoneMinder::Filter($$db_filter{Id}, $db_filter);
|
|
Debug("Found filter '$db_filter->{Name}'");
|
|
# The undef here is to make sure the Sql gets regenerated because the Filter object may be cached
|
|
my $filter_sql = $filter->Sql(undef);
|
|
|
|
if ( !$filter_sql ) {
|
|
Error("Error parsing Sql. skipping filter '$db_filter->{Name}'");
|
|
next FILTER;
|
|
}
|
|
push @filters, $filter;
|
|
}
|
|
$sth->finish();
|
|
if ( ! @filters ) {
|
|
Warning("No filter found for $sql with values(@sql_values)");
|
|
} else {
|
|
Debug("Got " . @filters . " filters");
|
|
}
|
|
|
|
return @filters;
|
|
} # end sub getFilters
|
|
|
|
sub checkFilter {
|
|
my $filter = shift;
|
|
|
|
my $in_transaction = ZoneMinder::Database::start_transaction($dbh) if $$filter{LockRows};
|
|
my @Events = $filter->Execute();
|
|
Debug(
|
|
join(' ',
|
|
'Checking filter', $filter->{Name},
|
|
join(', ',
|
|
($filter->{AutoDelete}?'delete':()),
|
|
($filter->{AutoArchive}?'archive':()),
|
|
($filter->{AutoUnarchive}?'unarchive':()),
|
|
($filter->{AutoVideo}?'video':()),
|
|
($filter->{AutoUpload}?'upload':()),
|
|
($filter->{AutoEmail}?'email':()),
|
|
($filter->{AutoMessage}?'message':()),
|
|
($filter->{AutoExecute}?'execute':()),
|
|
($filter->{AutoMove}?'move':()),
|
|
($filter->{AutoCopy}?'copy':()),
|
|
($filter->{UpdateDiskSpace}?'update disk space':()),
|
|
),
|
|
'returned' , scalar @Events , 'events',
|
|
"\n",
|
|
) );
|
|
|
|
foreach my $event ( @Events ) {
|
|
last if $zm_terminate;
|
|
my $Event = new ZoneMinder::Event($$event{Id}, $event);
|
|
|
|
Debug('Checking event '.$Event->{Id});
|
|
my $delete_ok = !undef;
|
|
$dbh->ping();
|
|
if ( $filter->{AutoArchive} ) {
|
|
Info("Archiving event $Event->{Id}");
|
|
# Do it individually to avoid locking up the table for new events
|
|
my $sql = 'UPDATE `Events` SET `Archived` = 1 WHERE `Id` = ?';
|
|
my $sth = $dbh->prepare_cached($sql)
|
|
or Fatal("Unable to prepare '$sql': ".$dbh->errstr());
|
|
my $res = $sth->execute($Event->{Id})
|
|
or Error("Unable to execute '$sql': ".$dbh->errstr());
|
|
}
|
|
if ( $filter->{AutoUnarchive} ) {
|
|
Info("Unarchiving event $Event->{Id}");
|
|
# Do it individually to avoid locking up the table for new events
|
|
my $sql = 'UPDATE `Events` SET `Archived` = 0 WHERE `Id` = ?';
|
|
my $sth = $dbh->prepare_cached($sql)
|
|
or Fatal("Unable to prepare '$sql': ".$dbh->errstr());
|
|
my $res = $sth->execute($Event->{Id})
|
|
or Error("Unable to execute '$sql': ".$dbh->errstr());
|
|
}
|
|
if ( $Config{ZM_OPT_FFMPEG} && $filter->{AutoVideo} ) {
|
|
if ( !$Event->{Videoed} ) {
|
|
$delete_ok = undef if !generateVideo($filter, $Event);
|
|
}
|
|
}
|
|
if ( $Config{ZM_OPT_EMAIL} && $filter->{AutoEmail} ) {
|
|
if ( !$Event->{Emailed} ) {
|
|
$delete_ok = undef if !sendEmail($filter, $Event);
|
|
}
|
|
}
|
|
if ( $Config{ZM_OPT_MESSAGE} && $filter->{AutoMessage} ) {
|
|
if ( !$Event->{Messaged} ) {
|
|
$delete_ok = undef if !sendMessage($filter, $Event);
|
|
}
|
|
}
|
|
if ( $Config{ZM_OPT_UPLOAD} && $filter->{AutoUpload} ) {
|
|
if ( !$Event->{Uploaded} ) {
|
|
$delete_ok = undef if !uploadArchFile($filter, $Event);
|
|
}
|
|
}
|
|
if ( $filter->{AutoExecute} ) {
|
|
if ( !$Event->{Executed} ) {
|
|
$delete_ok = undef if !executeCommand($filter, $Event);
|
|
}
|
|
}
|
|
if ( $filter->{AutoDelete} ) {
|
|
if ( $delete_ok ) {
|
|
$Event->delete();
|
|
} else {
|
|
Error("Unable to delete event $Event->{Id} as previous operations failed");
|
|
}
|
|
} # end if AutoDelete
|
|
|
|
if ( $filter->{AutoMove} ) {
|
|
my $NewStorage = new ZoneMinder::Storage($filter->{AutoMoveTo});
|
|
$_ = $Event->MoveTo($NewStorage);
|
|
Error($_) if $_;
|
|
}
|
|
if ( $filter->{AutoCopy} ) {
|
|
# Copy To is different from MoveTo in that it JUST copies the files
|
|
# So we still need to update the Event object with the new SecondaryStorageId
|
|
my $NewStorage = ZoneMinder::Storage->find_one(Id=>$filter->{AutoCopyTo});
|
|
if ( $NewStorage ) {
|
|
$_ = $Event->CopyTo($NewStorage);
|
|
if ( $_ ) {
|
|
$ZoneMinder::Database::dbh->commit();
|
|
Error($_);
|
|
} else {
|
|
$Event->save({SecondaryStorageId=>$$NewStorage{Id}});
|
|
$ZoneMinder::Database::dbh->commit();
|
|
}
|
|
} else {
|
|
Error("No storage area found for copy to operation. AutoCopyTo was $$filter{AutoCopyTo}");
|
|
}
|
|
} # end if AutoCopy
|
|
|
|
if ( $filter->{UpdateDiskSpace} ) {
|
|
$ZoneMinder::Database::dbh->begin_work();
|
|
$Event->lock_and_load();
|
|
|
|
my $old_diskspace = $$Event{DiskSpace};
|
|
my $new_diskspace = $Event->DiskSpace(undef);
|
|
|
|
if (
|
|
( (!defined $old_diskspace) and defined $new_diskspace)
|
|
or
|
|
( (defined $old_diskspace) and (defined $new_diskspace) and ( $old_diskspace != $Event->DiskSpace(undef) ) )
|
|
) {
|
|
$Event->save();
|
|
}
|
|
$ZoneMinder::Database::dbh->commit();
|
|
} # end if UpdateDiskSpace
|
|
} # end foreach event
|
|
ZoneMinder::Database::end_transaction($dbh, $in_transaction) if $$filter{LockRows};
|
|
} # end sub checkFilter
|
|
|
|
sub generateVideo {
|
|
my $filter = shift;
|
|
my $Event = shift;
|
|
my $phone = shift;
|
|
|
|
my $rate = $Event->{DefaultRate}/100;
|
|
my $scale = $Event->{DefaultScale}/100;
|
|
my $format;
|
|
|
|
my @ffmpeg_formats = split(/\s+/, $Config{ZM_FFMPEG_FORMATS});
|
|
my $default_video_format;
|
|
my $default_phone_format;
|
|
foreach my $ffmpeg_format( @ffmpeg_formats ) {
|
|
if ( $ffmpeg_format =~ /^(.+)\*\*$/ ) {
|
|
$default_phone_format = $1;
|
|
} elsif ( $ffmpeg_format =~ /^(.+)\*$/ ) {
|
|
$default_video_format = $1;
|
|
}
|
|
}
|
|
|
|
if ( $phone && $default_phone_format ) {
|
|
$format = $default_phone_format;
|
|
} elsif ( $default_video_format ) {
|
|
$format = $default_video_format;
|
|
} else {
|
|
$format = $ffmpeg_formats[0];
|
|
}
|
|
|
|
my $command = join('',
|
|
$Config{ZM_PATH_BIN},
|
|
'/zmvideo.pl -e ',
|
|
$Event->{Id},
|
|
' -r ',
|
|
$rate,
|
|
' -s ',
|
|
$scale,
|
|
' -f ',
|
|
$format,
|
|
);
|
|
my $output = qx($command);
|
|
chomp($output);
|
|
my $status = $? >> 8;
|
|
if ( $status || logDebugging() ) {
|
|
Debug("Output: $output");
|
|
}
|
|
if ( $status ) {
|
|
Error("Video generation '$command' failed with status: $status");
|
|
if ( wantarray() ) {
|
|
return( undef, undef );
|
|
}
|
|
return 0;
|
|
} else {
|
|
my $sql = 'UPDATE `Events` SET `Videoed` = 1 WHERE `Id` = ?';
|
|
my $sth = $dbh->prepare_cached($sql)
|
|
or Fatal("Unable to prepare '$sql': ".$dbh->errstr());
|
|
my $res = $sth->execute($Event->{Id})
|
|
or Fatal("Unable to execute '$sql': ".$dbh->errstr());
|
|
if ( wantarray() ) {
|
|
return( $format, $output );
|
|
}
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
# Returns an image absolute path for given event and frame
|
|
# Optionally an analyse image path may be returned if an analyse image exists
|
|
# If neither capture nor analyse image exists it will try to extract a frame from .mp4 file if exists
|
|
# An empty string is returned if no one from methods above works
|
|
sub generateImage {
|
|
my $Event = shift;
|
|
my $frame = shift;
|
|
my $analyse = @_ ? shift : 0; # don't return analyse image by default
|
|
|
|
my $event_path = $Event->Path();
|
|
my $capture_image_path = sprintf('%s/%0'.$Config{ZM_EVENT_IMAGE_DIGITS}.'d-capture.jpg', $event_path, $frame->{FrameId});
|
|
my $analyse_image_path = sprintf('%s/%0'.$Config{ZM_EVENT_IMAGE_DIGITS}.'d-analyse.jpg', $event_path, $frame->{FrameId}) if $analyse;
|
|
my $video_path = sprintf('%s/%d-video.mp4', $event_path, $Event->{Id});
|
|
my $image_path = '';
|
|
|
|
# check if the image file exists. If the file doesn't exist and we use H264 try to extract it from .mp4 video
|
|
if ( $analyse && -r $analyse_image_path ) {
|
|
$image_path = $analyse_image_path;
|
|
} elsif ( -r $capture_image_path ) {
|
|
$image_path = $capture_image_path;
|
|
} elsif ( -r $video_path ) {
|
|
my $command ="ffmpeg -nostdin -ss $$frame{Delta} -i '$video_path' -frames:v 1 '$capture_image_path'";
|
|
#$command = "ffmpeg -y -v 0 -i $video_path -vf 'select=gte(n\\,$$frame{FrameId}),setpts=PTS-STARTPTS' -vframes 1 -f image2 $capture_image_path";
|
|
my $output = qx($command);
|
|
chomp($output);
|
|
my $status = $? >> 8;
|
|
if ( $status || logDebugging() ) {
|
|
Debug("Output: $output");
|
|
}
|
|
if ( $status ) {
|
|
Error("Failed $command status $status");
|
|
} else {
|
|
$image_path = $capture_image_path;
|
|
}
|
|
}
|
|
return $image_path;
|
|
}
|
|
|
|
|
|
sub uploadArchFile {
|
|
my $filter = shift;
|
|
my $Event = shift;
|
|
|
|
if ( ! $Config{ZM_UPLOAD_HOST} ) {
|
|
Error('Cannot upload archive as no upload host defined');
|
|
return( 0 );
|
|
}
|
|
|
|
# Try to make the path to the upload folder if it doesn't already exist
|
|
make_path( $Config{ZM_UPLOAD_LOC_DIR} );
|
|
|
|
# Complain if the upload folder is still not writable
|
|
if ( ! -w $Config{ZM_UPLOAD_LOC_DIR} ) {
|
|
Error("Upload folder either does not exist or is not writable: $Config{ZM_UPLOAD_LOC_DIR}");
|
|
return(0);
|
|
}
|
|
|
|
my $archFile = $Event->{MonitorName}.'-'.$Event->{Id};
|
|
my $archImagePath = $Event->Path()
|
|
.'/'
|
|
.(
|
|
( $Config{ZM_UPLOAD_ARCH_ANALYSE} )
|
|
? '{*analyse.jpg,*capture.jpg,snapshot.jpg,*.mp4}'
|
|
: '{*capture.jpg,snapshot.jpg,*.mp4}'
|
|
)
|
|
;
|
|
my @archImageFiles = glob($archImagePath);
|
|
my $archLocPath;
|
|
|
|
my $archError = 0;
|
|
if ( $Config{ZM_UPLOAD_ARCH_FORMAT} eq 'zip' ) {
|
|
$archFile .= '.zip';
|
|
$archLocPath = $Config{ZM_UPLOAD_LOC_DIR}.'/'.$archFile;
|
|
my $zip = Archive::Zip->new();
|
|
Info("Creating upload file '$archLocPath', ".int(@archImageFiles).' files');
|
|
|
|
my $status = &AZ_OK;
|
|
foreach my $imageFile ( @archImageFiles ) {
|
|
Debug("Adding $imageFile");
|
|
my $member = $zip->addFile($imageFile);
|
|
if ( !$member ) {
|
|
Error("Unable to add image file $imageFile to zip archive $archLocPath");
|
|
$archError = 1;
|
|
last;
|
|
}
|
|
$member->desiredCompressionMethod( $Config{ZM_UPLOAD_ARCH_COMPRESS}
|
|
? &COMPRESSION_DEFLATED
|
|
: &COMPRESSION_STORED
|
|
);
|
|
}
|
|
if ( !$archError ) {
|
|
$status = $zip->writeToFileNamed( $archLocPath );
|
|
|
|
if ( $archError = ($status != &AZ_OK) ) {
|
|
Error("Zip error: $status");
|
|
}
|
|
} else {
|
|
Error("Error adding images to zip archive $archLocPath, not writing");
|
|
}
|
|
} elsif ( $Config{ZM_UPLOAD_ARCH_FORMAT} eq 'tar' ) {
|
|
if ( $Config{ZM_UPLOAD_ARCH_COMPRESS} ) {
|
|
$archFile .= '.tar.gz';
|
|
} else {
|
|
$archFile .= '.tar';
|
|
}
|
|
$archLocPath = $Config{ZM_UPLOAD_LOC_DIR}.'/'.$archFile;
|
|
Info("Creating upload file '$archLocPath', ".int(@archImageFiles).' files');
|
|
|
|
if ( $archError = !Archive::Tar->create_archive(
|
|
$archLocPath,
|
|
$Config{ZM_UPLOAD_ARCH_COMPRESS},
|
|
@archImageFiles
|
|
)
|
|
) {
|
|
Error('Tar error: '.Archive::Tar->error());
|
|
}
|
|
}
|
|
|
|
if ( $archError ) {
|
|
return 0;
|
|
} else {
|
|
if ( $Config{ZM_UPLOAD_PROTOCOL} eq 'ftp' ) {
|
|
Info('Uploading to '.$Config{ZM_UPLOAD_HOST}.' using FTP');
|
|
my $ftp = Net::FTP->new(
|
|
$Config{ZM_UPLOAD_HOST},
|
|
Timeout=>$Config{ZM_UPLOAD_TIMEOUT},
|
|
Passive=>$Config{ZM_UPLOAD_FTP_PASSIVE},
|
|
Debug=>$Config{ZM_UPLOAD_DEBUG}
|
|
);
|
|
if ( !$ftp ) {
|
|
Error("Unable to create FTP connection: $@");
|
|
return 0;
|
|
}
|
|
$ftp->login($Config{ZM_UPLOAD_USER}, $Config{ZM_UPLOAD_PASS})
|
|
or Error("FTP - Unable to login");
|
|
$ftp->binary()
|
|
or Error("FTP - Unable to go binary");
|
|
$ftp->cwd($Config{ZM_UPLOAD_REM_DIR})
|
|
or Error("FTP - Unable to cwd")
|
|
if ( $Config{ZM_UPLOAD_REM_DIR} );
|
|
$ftp->put( $archLocPath )
|
|
or Error("FTP - Unable to upload '$archLocPath'");
|
|
$ftp->quit()
|
|
or Error("FTP - Unable to quit");
|
|
} else {
|
|
my $host = $Config{ZM_UPLOAD_HOST};
|
|
$host .= ':'.$Config{ZM_UPLOAD_PORT} if $Config{ZM_UPLOAD_PORT};
|
|
Info('Uploading to '.$host.' using SFTP');
|
|
my %sftpOptions = (
|
|
host=>$Config{ZM_UPLOAD_HOST},
|
|
user=>$Config{ZM_UPLOAD_USER},
|
|
($Config{ZM_UPLOAD_PASS} ? (password=>$Config{ZM_UPLOAD_PASS}) : ()),
|
|
($Config{ZM_UPLOAD_PORT} ? (port=>$Config{ZM_UPLOAD_PORT}) : ()),
|
|
($Config{ZM_UPLOAD_TIMEOUT} ? (timeout=>$Config{ZM_UPLOAD_TIMEOUT}) : ()),
|
|
);
|
|
my @more_ssh_args;
|
|
push @more_ssh_args, '-o'=>'StrictHostKeyChecking=no'
|
|
if ! $Config{ZM_UPLOAD_STRICT};
|
|
push @more_ssh_args, '-v'
|
|
if $Config{ZM_UPLOAD_DEBUG};
|
|
$sftpOptions{more} = [@more_ssh_args];
|
|
my $sftp = Net::SFTP::Foreign->new($Config{ZM_UPLOAD_HOST}, %sftpOptions);
|
|
if ( $sftp->error ) {
|
|
Error("Unable to create SFTP connection: ".$sftp->error);
|
|
return 0;
|
|
}
|
|
$sftp->setcwd($Config{ZM_UPLOAD_REM_DIR})
|
|
or Error("SFTP - Unable to setcwd: ".$sftp->error)
|
|
if $Config{ZM_UPLOAD_REM_DIR};
|
|
$sftp->put($archLocPath, $archFile)
|
|
or Error("SFTP - Unable to upload '$archLocPath': ".$sftp->error);
|
|
}
|
|
unlink($archLocPath);
|
|
my $sql = 'UPDATE `Events` SET `Uploaded` = 1 WHERE `Id` = ?';
|
|
my $sth = $dbh->prepare_cached($sql)
|
|
or Fatal("Unable to prepare '$sql': ".$dbh->errstr());
|
|
my $res = $sth->execute($Event->{Id})
|
|
or Fatal("Unable to execute '$sql': ".$dbh->errstr());
|
|
}
|
|
return 1;
|
|
} # end sub uploadArchFile
|
|
|
|
sub substituteTags {
|
|
my $text = shift;
|
|
my $filter = shift;
|
|
my $Event = shift;
|
|
my $attachments_ref = shift;
|
|
|
|
# First we'd better check what we need to get
|
|
# We have a filter and an event, do we need any more
|
|
# monitor information?
|
|
my $need_monitor = $text =~ /%(?:MET|MEH|MED|MEW|MEN|MEA)%/;
|
|
|
|
my $Monitor = $Event->Monitor() if $need_monitor;
|
|
|
|
# Do we need the image information too?
|
|
my $need_images = $text =~ /%(?:EPI1|EPIM|EI1|EIM|EI1A|EIMA|EIMOD)%/;
|
|
my $first_alarm_frame;
|
|
my $max_alarm_frame;
|
|
my $max_alarm_score = 0;
|
|
if ( $need_images ) {
|
|
my $sql = 'SELECT * FROM `Frames` WHERE `EventId`=? AND `Type`=? ORDER BY `FrameId`';
|
|
my $sth = $dbh->prepare_cached($sql)
|
|
or Fatal("Unable to prepare '$sql': ".$dbh->errstr());
|
|
my $res = $sth->execute($Event->{Id},'Alarm')
|
|
or Fatal("Unable to execute '$sql': ".$dbh->errstr());
|
|
my $rows = 0;
|
|
while( my $frame = $sth->fetchrow_hashref() ) {
|
|
if ( !$first_alarm_frame ) {
|
|
$first_alarm_frame = $frame;
|
|
}
|
|
if ( $frame->{Score} > $max_alarm_score ) {
|
|
$max_alarm_frame = $frame;
|
|
$max_alarm_score = $frame->{Score};
|
|
}
|
|
$rows ++;
|
|
}
|
|
Debug("Frames: rows: $rows first alarm frame: $first_alarm_frame max_alaarm_frame: $max_alarm_frame, score: $max_alarm_score");
|
|
$sth->finish();
|
|
}
|
|
|
|
my $url = $Config{ZM_URL};
|
|
$text =~ s/%ZP%/$url/g;
|
|
$text =~ s/%MN%/$Event->{MonitorName}/g;
|
|
$text =~ s/%MET%/$Monitor->{TotalEvents}/g;
|
|
$text =~ s/%MEH%/$Monitor->{HourEvents}/g;
|
|
$text =~ s/%MED%/$Monitor->{DayEvents}/g;
|
|
$text =~ s/%MEW%/$Monitor->{WeekEvents}/g;
|
|
$text =~ s/%MEM%/$Monitor->{MonthEvents}/g;
|
|
$text =~ s/%MEA%/$Monitor->{ArchivedEvents}/g;
|
|
$text =~ s/%MP%/$url?view=watch&mid=$Event->{MonitorId}/g;
|
|
$text =~ s/%MPS%/$url?view=watch&mid=$Event->{MonitorId}&mode=stream/g;
|
|
$text =~ s/%MPI%/$url?view=watch&mid=$Event->{MonitorId}&mode=still/g;
|
|
$text =~ s/%EP%/$url?view=event&mid=$Event->{MonitorId}&eid=$Event->{Id}/g;
|
|
$text =~ s/%EPS%/$url?view=event&mode=stream&mid=$Event->{MonitorId}&eid=$Event->{Id}/g;
|
|
$text =~ s/%EPI%/$url?view=event&mode=still&mid=$Event->{MonitorId}&eid=$Event->{Id}/g;
|
|
$text =~ s/%EI%/$Event->{Id}/g;
|
|
$text =~ s/%EN%/$Event->{Name}/g;
|
|
$text =~ s/%EC%/$Event->{Cause}/g;
|
|
$text =~ s/%ED%/$Event->{Notes}/g;
|
|
$text =~ s/%ET%/$Event->{StartDateTime}/g;
|
|
$text =~ s/%EVF%/$$Event{DefaultVideo}/g; # Event video filename
|
|
$text =~ s/%EL%/$Event->{Length}/g;
|
|
$text =~ s/%EF%/$Event->{Frames}/g;
|
|
$text =~ s/%EFA%/$Event->{AlarmFrames}/g;
|
|
$text =~ s/%EST%/$Event->{TotScore}/g;
|
|
$text =~ s/%ESA%/$Event->{AvgScore}/g;
|
|
$text =~ s/%ESM%/$Event->{MaxScore}/g;
|
|
|
|
if ( $first_alarm_frame ) {
|
|
$text =~ s/%EPF1%/$url?view=frame&mid=$Event->{MonitorId}&eid=$Event->{Id}&fid=$first_alarm_frame->{FrameId}/g;
|
|
$text =~ s/%EPFM%/$url?view=frame&mid=$Event->{MonitorId}&eid=$Event->{Id}&fid=$max_alarm_frame->{FrameId}/g;
|
|
$text =~ s/%EPI1%/$url?view=image&mid=$Event->{MonitorId}&eid=$Event->{Id}&fid=$first_alarm_frame->{FrameId}/g;
|
|
$text =~ s/%EPIM%/$url?view=image&mid=$Event->{MonitorId}&eid=$Event->{Id}&fid=$max_alarm_frame->{FrameId}/g;
|
|
if ( $attachments_ref ) {
|
|
if ( $text =~ s/%EI1%//g ) {
|
|
my $path = generateImage($Event, $first_alarm_frame);
|
|
if ( -e $path ) {
|
|
push @$attachments_ref, { type=>'image/jpeg', path=>$path };
|
|
} else {
|
|
Warning("Path to first image does not exist at $path");
|
|
}
|
|
}
|
|
|
|
if ( $text =~ s/%EIM%//g ) {
|
|
# Don't attach the same image twice
|
|
if ( !@$attachments_ref
|
|
|| ( $first_alarm_frame->{FrameId} != $max_alarm_frame->{FrameId} )
|
|
) {
|
|
my $path = generateImage($Event, $max_alarm_frame);
|
|
if ( -e $path ) {
|
|
push @$attachments_ref, { type=>'image/jpeg', path=>$path };
|
|
} else {
|
|
Warning("No image for EIM at $path");
|
|
}
|
|
}
|
|
}
|
|
|
|
if ( $text =~ s/%EI1A%//g ) {
|
|
my $path = generateImage($Event, $first_alarm_frame, 'analyse');
|
|
if ( -e $path ) {
|
|
push @$attachments_ref, { type=>'image/jpeg', path=>$path };
|
|
} else {
|
|
Warning("No image for EI1A at $path");
|
|
}
|
|
}
|
|
|
|
if ( $text =~ s/%EIMA%//g ) {
|
|
# Don't attach the same image twice
|
|
if ( !@$attachments_ref
|
|
|| ($first_alarm_frame->{FrameId} != $max_alarm_frame->{FrameId})
|
|
) {
|
|
my $path = generateImage($Event, $max_alarm_frame, 'analyse');
|
|
if ( -e $path ) {
|
|
push @$attachments_ref, { type=>'image/jpeg', path=>$path };
|
|
} else {
|
|
Warning("No image for EIMA at $path");
|
|
}
|
|
}
|
|
}
|
|
|
|
if ( $text =~ s/%EIMOD%//g or $text =~ s/%EFMOD%//g ) {
|
|
$text =~ s/%EFMOD%/$url?view=frame&mid=$Event->{MonitorId}&eid=$Event->{Id}&fid=objdetect/g;
|
|
$text =~ s/%EIMOD%/$url?view=image&mid=$Event->{MonitorId}&eid=$Event->{Id}&fid=objdetect/g;
|
|
my $path = $Event->Path().'/objdetect.jpg';
|
|
if ( -e $path ) {
|
|
push @$attachments_ref, { type=>'image/jpeg', path=>$path };
|
|
} else {
|
|
Warning('No image for MOD at '.$path);
|
|
}
|
|
}
|
|
|
|
} # end if attachments_ref
|
|
} # end if $first_alarm_frame
|
|
|
|
if ( $attachments_ref ) {
|
|
if ( $text =~ s/%EV%//g ) {
|
|
if ( $$Event{DefaultVideo} ) {
|
|
push @$attachments_ref, { type=>'video/mp4', path=>join('/',$Event->Path(), $Event->DefaultVideo()) };
|
|
} elsif ( $Config{ZM_OPT_FFMPEG} ) {
|
|
my ( $format, $path ) = generateVideo($filter, $Event);
|
|
if ( !$format ) {
|
|
return undef;
|
|
}
|
|
push @$attachments_ref, { type=>"video/$format", path=>$path };
|
|
}
|
|
}
|
|
if ( $text =~ s/%EVM%//g ) {
|
|
my ( $format, $path ) = generateVideo($filter, $Event, 1);
|
|
if ( !$format ) {
|
|
return undef;
|
|
}
|
|
push @$attachments_ref, { type=>"video/$format", path=>$path };
|
|
}
|
|
}
|
|
$text =~ s/%FN%/$filter->{Name}/g;
|
|
( my $filter_name = $filter->{Name} ) =~ s/ /+/g;
|
|
$text =~ s/%FP%/$url?view=filter&mid=$Event->{MonitorId}&filter_name=$filter_name/g;
|
|
|
|
return $text;
|
|
} # end subsitituteTags
|
|
|
|
sub sendEmail {
|
|
my $filter = shift;
|
|
my $Event = shift;
|
|
|
|
if ( ! $Config{ZM_FROM_EMAIL} ) {
|
|
Error('No from email address defined, not sending email');
|
|
return 0;
|
|
}
|
|
if ( ! $$filter{EmailTo} ) {
|
|
Error('No email address defined, not sending email');
|
|
return 0;
|
|
}
|
|
|
|
Info('Creating notification email');
|
|
|
|
my $subject = substituteTags($$filter{EmailSubject}, $filter, $Event);
|
|
return 0 if !$subject;
|
|
my @attachments;
|
|
my $body = substituteTags($$filter{EmailBody}, $filter, $Event, \@attachments);
|
|
return 0 if !$body;
|
|
|
|
Info("Sending notification email '$subject'");
|
|
|
|
eval {
|
|
if ( $Config{ZM_NEW_MAIL_MODULES} ) {
|
|
### Create the multipart container
|
|
my $mail = MIME::Lite->new (
|
|
From => $Config{ZM_FROM_EMAIL},
|
|
To => $$filter{EmailTo},
|
|
Subject => $subject,
|
|
Type => 'multipart/mixed'
|
|
);
|
|
### Add the text message part
|
|
$mail->attach (
|
|
Type => 'TEXT',
|
|
Data => $body
|
|
);
|
|
### Add the attachments
|
|
my $total_size = 0;
|
|
foreach my $attachment ( @attachments ) {
|
|
my $size = -s $attachment->{path};
|
|
$total_size += $size;
|
|
Info("Attaching '$attachment->{path}' which is $size bytes");
|
|
$mail->attach(
|
|
Path => $attachment->{path},
|
|
Type => $attachment->{type},
|
|
Disposition => 'attachment'
|
|
);
|
|
}
|
|
if ( $total_size > 10*1024*1024 ) {
|
|
Warning('Emails larger than 10Mb will often not be delivered! This one is '.int($total_size/(1024*1024)).'Mb');
|
|
}
|
|
### Send the Message
|
|
if ( $Config{ZM_SSMTP_MAIL} ) {
|
|
my $ssmtp_location = $Config{ZM_SSMTP_PATH};
|
|
if ( !$ssmtp_location ) {
|
|
if ( logDebugging() ) {
|
|
Debug("which ssmtp: $ssmtp_location - set ssmtp path in options to suppress this message");
|
|
}
|
|
$ssmtp_location = qx('which ssmtp');
|
|
}
|
|
if ( !$ssmtp_location ) {
|
|
Warning('Unable to find ssmtp, trying MIME::Lite->send');
|
|
MIME::Lite->send('smtp', $Config{ZM_EMAIL_HOST}, Timeout=>60);
|
|
$mail->send();
|
|
} else {
|
|
### Send using SSMTP
|
|
$mail->send('sendmail', $ssmtp_location, $$filter{EmailTo});
|
|
}
|
|
} else {
|
|
MIME::Lite->send('smtp', $Config{ZM_EMAIL_HOST}, Timeout=>60);
|
|
$mail->send();
|
|
}
|
|
} else {
|
|
my $mail = MIME::Entity->build(
|
|
From => $Config{ZM_FROM_EMAIL},
|
|
To => $$filter{EmailTo},
|
|
Subject => $subject,
|
|
Type => (($body=~/<html/)?'text/html':'text/plain'),
|
|
Data => $body
|
|
);
|
|
|
|
my $total_size = 0;
|
|
foreach my $attachment ( @attachments ) {
|
|
my $size = -s $attachment->{path};
|
|
$total_size += $size;
|
|
Info("Attaching '$attachment->{path}' which is $size bytes");
|
|
|
|
$mail->attach(
|
|
Path => $attachment->{path},
|
|
Type => $attachment->{type},
|
|
Encoding => 'base64'
|
|
);
|
|
} # end foreach attachment
|
|
if ( $total_size > 10*1024*1024 ) {
|
|
Warning('Emails larger than 10Mb will often not be delivered! This one is '.int($total_size/(1024*1024)).'Mb');
|
|
}
|
|
$mail->smtpsend(Host => $Config{ZM_EMAIL_HOST}, MailFrom => $Config{ZM_FROM_EMAIL});
|
|
}
|
|
};
|
|
if ( $@ ) {
|
|
Error("Unable to send email: $@");
|
|
return 0;
|
|
} else {
|
|
Info('Notification email sent');
|
|
}
|
|
my $sql = 'UPDATE `Events` SET `Emailed` = 1 WHERE `Id` = ?';
|
|
my $sth = $dbh->prepare_cached($sql)
|
|
or Fatal("Unable to prepare '$sql': ".$dbh->errstr());
|
|
my $res = $sth->execute($Event->{Id})
|
|
or Fatal("Unable to execute '$sql': ".$dbh->errstr());
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub sendMessage {
|
|
my $filter = shift;
|
|
my $Event = shift;
|
|
|
|
if ( ! $Config{ZM_FROM_EMAIL} ) {
|
|
Error('No from email address defined, not sending message');
|
|
return 0;
|
|
}
|
|
if ( ! $Config{ZM_MESSAGE_ADDRESS} ) {
|
|
Error('No message address defined, not sending message');
|
|
return 0;
|
|
}
|
|
|
|
Info('Creating notification message');
|
|
|
|
my $subject = substituteTags($Config{ZM_MESSAGE_SUBJECT}, $filter, $Event);
|
|
return 0 if !$subject;
|
|
my @attachments;
|
|
my $body = substituteTags($Config{ZM_MESSAGE_BODY}, $filter, $Event, \@attachments);
|
|
return 0 if !$body;
|
|
|
|
Info("Sending notification message '$subject'");
|
|
|
|
eval {
|
|
if ( $Config{ZM_NEW_MAIL_MODULES} ) {
|
|
### Create the multipart container
|
|
my $mail = MIME::Lite->new(
|
|
From => $Config{ZM_FROM_EMAIL},
|
|
To => $Config{ZM_MESSAGE_ADDRESS},
|
|
Subject => $subject,
|
|
Type => 'multipart/mixed'
|
|
);
|
|
### Add the text message part
|
|
$mail->attach (
|
|
Type => 'TEXT',
|
|
Data => $body
|
|
);
|
|
### Add the attachments
|
|
foreach my $attachment ( @attachments ) {
|
|
Info("Attaching '$attachment->{path}");
|
|
$mail->attach(
|
|
Path => $attachment->{path},
|
|
Type => $attachment->{type},
|
|
Disposition => 'attachment'
|
|
);
|
|
}
|
|
### Send the Message
|
|
if ( $Config{ZM_SSMTP_MAIL} ) {
|
|
my $ssmtp_location = $Config{ZM_SSMTP_PATH};
|
|
if ( !$ssmtp_location ) {
|
|
if ( logDebugging() ) {
|
|
Debug("which ssmtp: $ssmtp_location - set ssmtp path in options to suppress this message");
|
|
}
|
|
$ssmtp_location = qx('which ssmtp');
|
|
}
|
|
if ( !$ssmtp_location ) {
|
|
Debug('Unable to find ssmtp, trying MIME::Lite->send');
|
|
MIME::Lite->send(smtp=>$Config{ZM_EMAIL_HOST}, Timeout=>60);
|
|
$mail->send();
|
|
} else {
|
|
### Send using SSMTP
|
|
$mail->send('sendmail', $ssmtp_location, $Config{ZM_MESSAGE_ADDRESS});
|
|
}
|
|
} else {
|
|
MIME::Lite->send(smtp=>$Config{ZM_EMAIL_HOST}, Timeout=>60);
|
|
$mail->send();
|
|
}
|
|
} else {
|
|
my $mail = MIME::Entity->build(
|
|
From => $Config{ZM_FROM_EMAIL},
|
|
To => $Config{ZM_MESSAGE_ADDRESS},
|
|
Subject => $subject,
|
|
Type => (($body=~/<html/)?'text/html':'text/plain'),
|
|
Data => $body
|
|
);
|
|
|
|
foreach my $attachment ( @attachments ) {
|
|
Info("Attaching '$attachment->{path}'");
|
|
$mail->attach(
|
|
Path => $attachment->{path},
|
|
Type => $attachment->{type},
|
|
Encoding => 'base64'
|
|
);
|
|
}
|
|
$mail->smtpsend(
|
|
Host => $Config{ZM_EMAIL_HOST},
|
|
MailFrom => $Config{ZM_FROM_EMAIL}
|
|
);
|
|
}
|
|
};
|
|
if ( $@ ) {
|
|
Error("Unable to send email: $@");
|
|
return 0;
|
|
} else {
|
|
Info('Notification message sent');
|
|
}
|
|
my $sql = 'UPDATE `Events` SET `Messaged` = 1 WHERE `Id` = ?';
|
|
my $sth = $dbh->prepare_cached($sql)
|
|
or Fatal("Unable to prepare '$sql': ".$dbh->errstr());
|
|
my $res = $sth->execute($Event->{Id})
|
|
or Fatal("Unable to execute '$sql': ".$dbh->errstr());
|
|
|
|
return 1;
|
|
} # end sub sendMessage
|
|
|
|
sub executeCommand {
|
|
my $filter = shift;
|
|
my $Event = shift;
|
|
|
|
my $event_path = $Event->Path();
|
|
|
|
my $command = $filter->{AutoExecuteCmd}.' '.$event_path;
|
|
$command = substituteTags($command, $filter, $Event);
|
|
|
|
Info("Executing '$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");
|
|
return 0;
|
|
} else {
|
|
my $sql = 'UPDATE `Events` SET `Executed` = 1 WHERE `Id` = ?';
|
|
my $sth = $dbh->prepare_cached($sql)
|
|
or Fatal("Unable to prepare '$sql': ".$dbh->errstr());
|
|
my $res = $sth->execute( $Event->{Id} )
|
|
or Fatal("Unable to execute '$sql': ".$dbh->errstr());
|
|
}
|
|
return( 1 );
|
|
}
|