« back to all changes in this revision
Viewing changes to scripts/zmfilter.pl.in
- browse files at revision 4.1.3
- compare with another revision
- download diff
- download tarball
- view history from revision 4.1.3
- Committer: Bazaar Package Importer
- Author(s): Peter Howard
- Date: 2009-09-11 07:02:50 UTC
- mfrom: (1.2.2 upstream)
- mto: This revision was merged to the branch mainline in revision 10.
- Revision ID: james.westby@ubuntu.com-20090911070250-k6rtdg43xi46nix4
Tags: 1.24.2-1
Initial release of zoneminder 1.24.2
- files added:
- db/zm_update-1.24.1.sql
- files removed:
- debian/patches/08_fix_ffmpeg_includes.dpatch
- files modified:
- .hg_archival.txt
added
removed
scripts/zmfilter.pl.in
1
#!/usr/bin/perl -wT
2
#
3
# ==========================================================================
4
#
5
# ZoneMinder Event Filter Script, $Date: 2009-06-08 10:11:56 +0100 (Mon, 08 Jun 2009) $, $Revision: 2908 $
6
# Copyright (C) 2001-2008 Philip Coombes
7
#
8
# This program is free software; you can redistribute it and/or
9
# modify it under the terms of the GNU General Public License
10
# as published by the Free Software Foundation; either version 2
11
# of the License, or (at your option) any later version.
12
#
13
# This program is distributed in the hope that it will be useful,
14
# but WITHOUT ANY WARRANTY; without even the implied warranty of
15
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16
# GNU General Public License for more details.
17
#
18
# You should have received a copy of the GNU General Public License
19
# along with this program; if not, write to the Free Software
20
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
21
#
22
# ==========================================================================
23
#
24
# This script continuously monitors the recorded events for the given
25
# monitor and applies any filters which would delete and/or upload
26
# matching events
27
#
28
use strict;
29
use bytes;
30
31
# ==========================================================================
32
#
33
# These are the elements you can edit to suit your installation
34
#
35
# ==========================================================================
36
37
use constant DBG_ID => "zmfilter"; # Tag that appears in debug to identify source
38
use constant DBG_LEVEL => 0; # 0 is errors, warnings and info only, > 0 for debug
39
40
use constant START_DELAY => 5; # How long to wait before starting
41
42
# ==========================================================================
43
#
44
# You shouldn't need to change anything from here downwards
45
#
46
# ==========================================================================
47
48
@EXTRA_PERL_LIB@
49
use ZoneMinder;
50
use DBI;
51
use POSIX;
52
use Time::HiRes qw/gettimeofday/;
53
use Date::Manip;
54
use Getopt::Long;
55
use PHP::Serialization qw(serialize unserialize);
56
use Data::Dumper;
57
58
use constant EVENT_PATH => ZM_PATH_WEB.'/'.ZM_DIR_EVENTS;
59
60
zmDbgInit( DBG_ID, level=>DBG_LEVEL );
61
zmDbgSetSignal();
62
63
if ( ZM_OPT_UPLOAD )
64
{
65
# Comment these out if you don't have them and don't want to upload
66
# or don't want to use that format
67
if ( ZM_UPLOAD_ARCH_FORMAT eq "zip" )
68
{
69
require Archive::Zip;
70
import Archive::Zip qw( :ERROR_CODES :CONSTANTS );
71
}
72
else
73
{
74
require Archive::Tar;
75
}
76
require Net::FTP;
77
}
78
79
if ( ZM_OPT_EMAIL )
80
{
81
if ( ZM_NEW_MAIL_MODULES )
82
{
83
require MIME::Lite;
84
require Net::SMTP;
85
}
86
else
87
{
88
require MIME::Entity;
89
}
90
}
91
92
if ( ZM_OPT_MESSAGE )
93
{
94
if ( ZM_NEW_MAIL_MODULES )
95
{
96
require MIME::Lite;
97
require Net::SMTP;
98
}
99
else
100
{
101
require MIME::Entity;
102
}
103
}
104
105
106
$| = 1;
107
108
$ENV{PATH} = '/bin:/usr/bin';
109
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
110
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
111
112
my $delay = ZM_FILTER_EXECUTE_INTERVAL;
113
my $event_id = 0;
114
my $filter_parm = "";
115
116
sub Usage
117
{
118
print( "
119
Usage: zmfilter.pl [-f <filter name>,--filter=<filter name>]
120
Parameters are :-
121
-f<filter name>, --filter=<filter name> - The name of a specific filter to run
122
");
123
exit( -1 );
124
}
125
126
#
127
# More or less replicates the equivalent PHP function
128
#
129
sub strtotime
130
{
131
my $dt_str = shift;
132
return( UnixDate( $dt_str, '%s' ) );
133
}
134
135
#
136
# More or less replicates the equivalent PHP function
137
#
138
sub str_repeat
139
{
140
my $string = shift;
141
my $count = shift;
142
return( ${string}x${count} );
143
}
144
145
# Formats a date into MySQL format
146
sub DateTimeToSQL
147
{
148
my $dt_str = shift;
149
my $dt_val = strtotime( $dt_str );
150
if ( !$dt_val )
151
{
152
Error( "Unable to parse date string '$dt_str'\n" );
153
return( undef );
154
}
155
return( strftime( "%Y-%m-%d %H:%M:%S", localtime( $dt_val ) ) );
156
}
157
158
if ( !GetOptions( 'filter=s'=>\$filter_parm ) )
159
{
160
Usage();
161
}
162
163
chdir( EVENT_PATH );
164
165
my $dbh = zmDbConnect();
166
167
if ( $filter_parm )
168
{
169
Info( "Scanning for events using filter '$filter_parm'\n" );
170
}
171
else
172
{
173
Info( "Scanning for events\n" );
174
}
175
176
if ( !$filter_parm )
177
{
178
sleep( START_DELAY );
179
}
180
181
my $filters;
182
my $last_action = 0;
183
184
while( 1 )
185
{
186
if ( (time() - $last_action) > ZM_FILTER_RELOAD_DELAY )
187
{
188
Debug( "Reloading filters\n" );
189
$last_action = time();
190
$filters = getFilters( $filter_parm );
191
}
192
193
foreach my $filter ( @$filters )
194
{
195
checkFilter( $filter );
196
}
197
198
last if ( $filter_parm );
199
200
Debug( "Sleeping for $delay seconds\n" );
201
sleep( $delay );
202
}
203
204
sub getDiskPercent
205
{
206
my $command = "df .";
207
my $df = qx( $command );
208
my $space = -1;
209
if ( $df =~ /\s(\d+)%/ms )
210
{
211
$space = $1;
212
}
213
return( $space );
214
}
215
216
sub getDiskBlocks
217
{
218
my $command = "df .";
219
my $df = qx( $command );
220
my $space = -1;
221
if ( $df =~ /\s(\d+)\s+\d+\s+\d+%/ms )
222
{
223
$space = $1;
224
}
225
return( $space );
226
}
227
228
sub getLoad
229
{
230
my $command = "uptime .";
231
my $uptime = qx( $command );
232
my $load = -1;
233
if ( $uptime =~ /load average:\s+([\d.]+)/ms )
234
{
235
$load = $1;
236
Info( "Load: $load" );
237
}
238
return( $load );
239
}
240
241
sub getFilters
242
{
243
my $filter_name = shift;
244
245
my @filters;
246
my $sql = "select * from Filters where";
247
if ( $filter_name )
248
{
249
$sql .= " Name = ? and";
250
}
251
else
252
{
253
$sql .= " Background = 1 and";
254
}
255
$sql .= " (AutoArchive = 1 or AutoVideo = 1 or AutoUpload = 1 or AutoEmail = 1 or AutoMessage = 1 or AutoExecute = 1 or AutoDelete = 1) order by Name";
256
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
257
my $res;
258
if ( $filter_name )
259
{
260
$res = $sth->execute( $filter_name ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
261
}
262
else
263
{
264
$res = $sth->execute() or Fatal( "Can't execute '$sql': ".$sth->errstr() );
265
}
266
FILTER: while( my $db_filter = $sth->fetchrow_hashref() )
267
{
268
Debug( "Found filter '$db_filter->{Name}'\n" );
269
my $filter_expr = unserialize( $db_filter->{Query} );
270
my $sql = "select E.Id,E.MonitorId,M.Name as MonitorName,M.DefaultRate,M.DefaultScale,E.Name,E.Cause,E.Notes,E.StartTime,unix_timestamp(E.StartTime) as Time,E.Length,E.Frames,E.AlarmFrames,E.TotScore,E.AvgScore,E.MaxScore,E.Archived,E.Videoed,E.Uploaded,E.Emailed,E.Messaged,E.Executed from Events as E inner join Monitors as M on M.Id = E.MonitorId where not isnull(E.EndTime)";
271
$db_filter->{Sql} = '';
272
273
if ( @{$filter_expr->{terms}} )
274
{
275
for ( my $i = 0; $i < @{$filter_expr->{terms}}; $i++ )
276
{
277
if ( exists($filter_expr->{terms}[$i]->{cnj}) )
278
{
279
$db_filter->{Sql} .= " ".$filter_expr->{terms}[$i]->{cnj}." ";
280
}
281
if ( exists($filter_expr->{terms}[$i]->{obr}) )
282
{
283
$db_filter->{Sql} .= " ".str_repeat( "(", $filter_expr->{terms}[$i]->{obr} )." ";
284
}
285
my $value = $filter_expr->{terms}[$i]->{val};
286
my @value_list;
287
if ( $filter_expr->{terms}[$i]->{attr} )
288
{
289
if ( $filter_expr->{terms}[$i]->{attr} =~ /^Monitor/ )
290
{
291
my ( $temp_attr_name ) = $filter_expr->{terms}[$i]->{attr} =~ /^Monitor(.+)$/;
292
$db_filter->{Sql} .= "M.".$temp_attr_name;
293
}
294
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'DateTime' )
295
{
296
$db_filter->{Sql} .= "E.StartTime";
297
}
298
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'Date' )
299
{
300
$db_filter->{Sql} .= "to_days( E.StartTime )";
301
}
302
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'Time' )
303
{
304
$db_filter->{Sql} .= "extract( hour_second from E.StartTime )";
305
}
306
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'Weekday' )
307
{
308
$db_filter->{Sql} .= "weekday( E.StartTime )";
309
}
310
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'DiskPercent' )
311
{
312
$db_filter->{Sql} .= "zmDiskPercent";
313
$db_filter->{HasDiskPercent} = !undef;
314
}
315
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'DiskBlocks' )
316
{
317
$db_filter->{Sql} .= "zmDiskBlocks";
318
$db_filter->{HasDiskBlocks} = !undef;
319
}
320
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'SystemLoad' )
321
{
322
$db_filter->{Sql} .= "zmSystemLoad";
323
$db_filter->{HasSystemLoad} = !undef;
324
}
325
else
326
{
327
$db_filter->{Sql} .= "E.".$filter_expr->{terms}[$i]->{attr};
328
}
329
330
( my $stripped_value = $value ) =~ s/^["\']+?(.+)["\']+?$/$1/;
331
foreach my $temp_value ( split( '/["\'\s]*?,["\'\s]*?/', $stripped_value ) )
332
{
333
if ( $filter_expr->{terms}[$i]->{attr} =~ /^Monitor/ )
334
{
335
$value = "'$temp_value'";
336
}
337
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'Name' || $filter_expr->{terms}[$i]->{attr} eq 'Cause' || $filter_expr->{terms}[$i]->{attr} eq 'Notes' )
338
{
339
$value = "'$temp_value'";
340
}
341
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'DateTime' )
342
{
343
$value = DateTimeToSQL( $temp_value );
344
if ( !$value )
345
{
346
Error( "Error parsing date/time '$temp_value', skipping filter '$db_filter->{Name}'\n" );
347
next FILTER;
348
}
349
$value = "'$value'";
350
}
351
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'Date' )
352
{
353
$value = DateTimeToSQL( $temp_value );
354
if ( !$value )
355
{
356
Error( "Error parsing date/time '$temp_value', skipping filter '$db_filter->{Name}'\n" );
357
next FILTER;
358
}
359
$value = "to_days( '$value' )";
360
}
361
elsif ( $filter_expr->{terms}[$i]->{attr} eq 'Time' )
362
{
363
$value = DateTimeToSQL( $temp_value );
364
if ( !$value )
365
{
366
Error( "Error parsing date/time '$temp_value', skipping filter '$db_filter->{Name}'\n" );
367
next FILTER;
368
}
369
$value = "extract( hour_second from '$value' )";
370
}
371
else
372
{
373
$value = $temp_value;
374
}
375
push( @value_list, $value );
376
}
377
}
378
if ( $filter_expr->{terms}[$i]->{op} )
379
{
380
if ( $filter_expr->{terms}[$i]->{op} eq '=~' )
381
{
382
$db_filter->{Sql} .= " regexp $value";
383
}
384
elsif ( $filter_expr->{terms}[$i]->{op} eq '!~' )
385
{
386
$db_filter->{Sql} .= " not regexp $value";
387
}
388
elsif ( $filter_expr->{terms}[$i]->{op} eq '=[]' )
389
{
390
$db_filter->{Sql} .= " in (".join( ",", @value_list ).")";
391
}
392
elsif ( $filter_expr->{terms}[$i]->{op} eq '!~' )
393
{
394
$db_filter->{Sql} .= " not in (".join( ",", @value_list ).")";
395
}
396
else
397
{
398
$db_filter->{Sql} .= " ".$filter_expr->{terms}[$i]->{op}." $value";
399
}
400
}
401
if ( exists($filter_expr->{terms}[$i]->{cbr}) )
402
{
403
$db_filter->{Sql} .= " ".str_repeat( ")", $filter_expr->{terms}[$i]->{cbr} )." ";
404
}
405
}
406
}
407
if ( $db_filter->{Sql} )
408
{
409
$sql .= " and ( ".$db_filter->{Sql}." )";
410
}
411
my @auto_terms;
412
if ( $db_filter->{AutoArchive} )
413
{
414
push( @auto_terms, "E.Archived = 0" )
415
}
416
if ( $db_filter->{AutoVideo} )
417
{
418
push( @auto_terms, "E.Videoed = 0" )
419
}
420
if ( $db_filter->{AutoUpload} )
421
{
422
push( @auto_terms, "E.Uploaded = 0" )
423
}
424
if ( $db_filter->{AutoEmail} )
425
{
426
push( @auto_terms, "E.Emailed = 0" )
427
}
428
if ( $db_filter->{AutoMessage} )
429
{
430
push( @auto_terms, "E.Messaged = 0" )
431
}
432
if ( $db_filter->{AutoExecute} )
433
{
434
push( @auto_terms, "E.Executed = 0" )
435
}
436
if ( @auto_terms )
437
{
438
$sql .= " and ( ".join( " or ", @auto_terms )." )";
439
}
440
if ( !$filter_expr->{sort_field} )
441
{
442
$filter_expr->{sort_field} = 'StartTime';
443
$filter_expr->{sort_asc} = 0;
444
}
445
my $sort_column = '';
446
if ( $filter_expr->{sort_field} eq 'Id' )
447
{
448
$sort_column = "E.Id";
449
}
450
elsif ( $filter_expr->{sort_field} eq 'MonitorName' )
451
{
452
$sort_column = "M.Name";
453
}
454
elsif ( $filter_expr->{sort_field} eq 'Name' )
455
{
456
$sort_column = "E.Name";
457
}
458
elsif ( $filter_expr->{sort_field} eq 'StartTime' )
459
{
460
$sort_column = "E.StartTime";
461
}
462
elsif ( $filter_expr->{sort_field} eq 'Secs' )
463
{
464
$sort_column = "E.Length";
465
}
466
elsif ( $filter_expr->{sort_field} eq 'Frames' )
467
{
468
$sort_column = "E.Frames";
469
}
470
elsif ( $filter_expr->{sort_field} eq 'AlarmFrames' )
471
{
472
$sort_column = "E.AlarmFrames";
473
}
474
elsif ( $filter_expr->{sort_field} eq 'TotScore' )
475
{
476
$sort_column = "E.TotScore";
477
}
478
elsif ( $filter_expr->{sort_field} eq 'AvgScore' )
479
{
480
$sort_column = "E.AvgScore";
481
}
482
elsif ( $filter_expr->{sort_field} eq 'MaxScore' )
483
{
484
$sort_column = "E.MaxScore";
485
}
486
else
487
{
488
$sort_column = "E.StartTime";
489
}
490
my $sort_order = $filter_expr->{sort_asc}?"asc":"desc";
491
$sql .= " order by ".$sort_column." ".$sort_order;
492
if ( $filter_expr->{limit} )
493
{
494
$sql .= " limit 0,".$filter_expr->{limit};
495
}
496
Debug( "SQL:$sql\n" );
497
$db_filter->{Sql} = $sql;
498
if ( $db_filter->{AutoExecute} )
499
{
500
my $script = $db_filter->{AutoExecuteCmd};
501
$script =~ s/\s.*$//;
502
if ( !-e $script )
503
{
504
Error( "Auto execute script '$script' not found, skipping filter '$db_filter->{Name}'\n" );
505
next FILTER;
506
507
}
508
elsif ( !-x $script )
509
{
510
Error( "Auto execute script '$script' not executable, skipping filter '$db_filter->{Name}'\n" );
511
next FILTER;
512
}
513
}
514
push( @filters, $db_filter );
515
}
516
$sth->finish();
517
518
return( \@filters );
519
}
520
521
sub checkFilter
522
{
523
my $filter = shift;
524
525
Debug( "Checking filter '$filter->{Name}'".
526
($filter->{AutoDelete}?", delete":"").
527
($filter->{AutoArchive}?", archive":"").
528
($filter->{AutoVideo}?", video":"").
529
($filter->{AutoUpload}?", upload":"").
530
($filter->{AutoEmail}?", email":"").
531
($filter->{AutoMessage}?", message":"").
532
($filter->{AutoExecute}?", execute":"").
533
"\n"
534
);
535
my $sql = $filter->{Sql};
536
537
if ( $filter->{HasDiskPercent} )
538
{
539
my $disk_percent = getDiskPercent();
540
$sql =~ s/zmDiskPercent/$disk_percent/g;
541
}
542
if ( $filter->{HasDiskBlocks} )
543
{
544
my $disk_blocks = getDiskBlocks();
545
$sql =~ s/zmDiskBlocks/$disk_blocks/g;
546
}
547
if ( $filter->{HasSystemLoad} )
548
{
549
my $load = getLoad();
550
$sql =~ s/zmSystemLoad/$load/g;
551
}
552
553
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
554
my $res = $sth->execute();
555
if ( !$res )
556
{
557
Error( "Can't execute filter '$sql', ignoring: ".$sth->errstr() );
558
return;
559
}
560
561
while( my $event = $sth->fetchrow_hashref() )
562
{
563
Debug( "Checking event $event->{Id}\n" );
564
my $delete_ok = !undef;
565
if ( $filter->{AutoArchive} )
566
{
567
Info( "Archiving event $event->{Id}\n" );
568
# Do it individually to avoid locking up the table for new events
569
my $sql = "update Events set Archived = 1 where Id = ?";
570
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
571
my $res = $sth->execute( $event->{Id} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
572
}
573
if ( ZM_OPT_FFMPEG && $filter->{AutoVideo} )
574
{
575
if ( !$event->{Videoed} )
576
{
577
$delete_ok = undef if ( !generateVideo( $filter, $event ) );
578
}
579
}
580
if ( ZM_OPT_EMAIL && $filter->{AutoEmail} )
581
{
582
if ( !$event->{Emailed} )
583
{
584
$delete_ok = undef if ( !sendEmail( $filter, $event ) );
585
}
586
}
587
if ( ZM_OPT_MESSAGE && $filter->{AutoMessage} )
588
{
589
if ( !$event->{Messaged} )
590
{
591
$delete_ok = undef if ( !sendMessage( $filter, $event ) );
592
}
593
}
594
if ( ZM_OPT_UPLOAD && $filter->{AutoUpload} )
595
{
596
if ( !$event->{Uploaded} )
597
{
598
$delete_ok = undef if ( !uploadArchFile( $filter, $event ) );
599
}
600
}
601
if ( $filter->{AutoExecute} )
602
{
603
if ( !$event->{Execute} )
604
{
605
$delete_ok = undef if ( !executeCommand( $filter, $event ) );
606
}
607
}
608
if ( $filter->{AutoDelete} )
609
{
610
if ( $delete_ok )
611
{
612
Info( "Deleting event $event->{Id}\n" );
613
# Do it individually to avoid locking up the table for new events
614
my $sql = "delete from Events where Id = ?";
615
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
616
my $res = $sth->execute( $event->{Id} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
617
618
if ( !ZM_OPT_FAST_DELETE )
619
{
620
my $sql = "delete from Frames where EventId = ?";
621
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
622
my $res = $sth->execute( $event->{Id} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
623
624
$sql = "delete from Stats where EventId = ?";
625
$sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
626
$res = $sth->execute( $event->{Id} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
627
628
deleteEventFiles( $event->{Id}, $event->{MonitorId} );
629
}
630
}
631
else
632
{
633
Error( "Unable to delete event $event->{Id} as previous operations failed\n" );
634
}
635
}
636
}
637
$sth->finish();
638
}
639
640
sub generateVideo
641
{
642
my $filter = shift;
643
my $event = shift;
644
my $phone = shift;
645
646
my $rate = $event->{DefaultRate}/100;
647
my $scale = $event->{DefaultScale}/100;
648
my $format;
649
650
my @ffmpeg_formats = split( /\s+/, ZM_FFMPEG_FORMATS );
651
my $default_video_format;
652
my $default_phone_format;
653
foreach my $ffmpeg_format( @ffmpeg_formats )
654
{
655
if ( $ffmpeg_format =~ /^(.+)\*\*$/ )
656
{
657
$default_phone_format = $1;
658
}
659
elsif ( $ffmpeg_format =~ /^(.+)\*$/ )
660
{
661
$default_video_format = $1;
662
}
663
}
664
665
if ( $phone && $default_phone_format )
666
{
667
$format = $default_phone_format;
668
}
669
elsif ( $default_video_format )
670
{
671
$format = $default_video_format;
672
}
673
else
674
{
675
$format = $ffmpeg_formats[0];
676
}
677
678
my $command = ZM_PATH_BIN."/zmvideo.pl -e ".$event->{Id}." -r ".$rate." -s ".$scale." -f ".$format;
679
my $output = qx($command);
680
chomp( $output );
681
my $status = $? >> 8;
682
if ( $status || DBG_LEVEL > 0 )
683
{
684
Debug( "Output: $output\n" );
685
}
686
if ( $status )
687
{
688
Error( "Video generation '$command' failed with status: $status\n" );
689
if ( wantarray() )
690
{
691
return( undef, undef );
692
}
693
return( 0 );
694
}
695
else
696
{
697
my $sql = "update Events set Videoed = 1 where Id = ?";
698
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
699
my $res = $sth->execute( $event->{Id} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
700
if ( wantarray() )
701
{
702
return( $format, sprintf( "%s/%s", getEventPath( $event ), $output ) );
703
}
704
}
705
return( 1 );
706
}
707
708
sub uploadArchFile
709
{
710
my $filter = shift;
711
my $event = shift;
712
713
if ( !ZM_UPLOAD_FTP_HOST )
714
{
715
Error( "Cannot upload archive as no FTP host defined" );
716
return( 0 );
717
}
718
719
my $arch_file = ZM_UPLOAD_FTP_LOC_DIR.'/'.$event->{MonitorName}.'-'.$event->{Id};
720
my $arch_image_path = getEventPath( $event )."/".((ZM_UPLOAD_ARCH_ANALYSE)?'{*analyse,*capture}':'*capture').".jpg";
721
my @arch_image_files = glob($arch_image_path);
722
723
my $arch_error;
724
if ( ZM_UPLOAD_ARCH_FORMAT eq "zip" )
725
{
726
$arch_file .= '.zip';
727
my $zip = Archive::Zip->new();
728
Info( "Creating upload file '$arch_file', ".int(@arch_image_files)." files\n" );
729
730
my $status = &AZ_OK;
731
foreach my $image_file ( @arch_image_files )
732
{
733
Info( "Adding $image_file\n" );
734
my $member = $zip->addFile( $image_file );
735
last unless ( $member );
736
$member->desiredCompressionMethod( (ZM_UPLOAD_ARCH_COMPRESS)?&COMPRESSION_DEFLATED:&COMPRESSION_STORED );
737
}
738
$status = $zip->writeToFileNamed( $arch_file );
739
740
if ( $arch_error = ($status != &AZ_OK) )
741
{
742
Error( "Zip error: $status\n " );
743
}
744
}
745
elsif ( ZM_UPLOAD_ARCH_FORMAT eq "tar" )
746
{
747
if ( ZM_UPLOAD_ARCH_COMPRESS )
748
{
749
$arch_file .= '.tar.gz';
750
}
751
else
752
{
753
$arch_file .= '.tar';
754
}
755
Info( "Creating upload file '$arch_file', ".int(@arch_image_files)." files\n" );
756
757
if ( $arch_error = !Archive::Tar->create_archive( $arch_file, ZM_UPLOAD_ARCH_COMPRESS, @arch_image_files ) )
758
{
759
Error( "Tar error: ".Archive::Tar->error()."\n " );
760
}
761
}
762
763
if ( $arch_error )
764
{
765
return( 0 );
766
}
767
else
768
{
769
Info( "Uploading to ".ZM_UPLOAD_FTP_HOST."\n" );
770
my $ftp = Net::FTP->new( ZM_UPLOAD_FTP_HOST, Timeout=>ZM_UPLOAD_FTP_TIMEOUT, Passive=>ZM_UPLOAD_FTP_PASSIVE, Debug=>ZM_UPLOAD_FTP_DEBUG );
771
if ( !$ftp )
772
{
773
warn( "Can't create ftp connection: $@" );
774
return( 0 );
775
}
776
777
$ftp->login( ZM_UPLOAD_FTP_USER, ZM_UPLOAD_FTP_PASS ) or warn( "FTP - Can't login" );
778
$ftp->binary() or warn( "FTP - Can't go binary" );
779
$ftp->cwd( ZM_UPLOAD_FTP_REM_DIR ) or warn( "FTP - Can't cwd" );
780
$ftp->put( $arch_file ) or warn( "FTP - Can't upload '$arch_file'" );
781
$ftp->quit() or warn( "FTP - Can't quit" );
782
unlink( $arch_file );
783
my $sql = "update Events set Uploaded = 1 where Id = ?";
784
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
785
my $res = $sth->execute( $event->{Id} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
786
}
787
return( 1 );
788
}
789
790
sub substituteTags
791
{
792
my $text = shift;
793
my $filter = shift;
794
my $event = shift;
795
my $attachments_ref = shift;
796
797
# First we'd better check what we need to get
798
# We have a filter and an event, do we need any more
799
# monitor information?
800
my $need_monitor = $text =~ /%(?:MET|MEH|MED|MEW|MEN|MEA)%/;
801
802
my $monitor = {};
803
if ( $need_monitor )
804
{
805
my $db_now = strftime( "%Y-%m-%d %H:%M:%S", localtime() );
806
my $sql = "select M.Id, count(E.Id) as EventCount, count(if(E.Archived,1,NULL)) as ArchEventCount, count(if(E.StartTime>'$db_now' - INTERVAL 1 HOUR && E.Archived = 0,1,NULL)) as HourEventCount, count(if(E.StartTime>'$db_now' - INTERVAL 1 DAY && E.Archived = 0,1,NULL)) as DayEventCount, count(if(E.StartTime>'$db_now' - INTERVAL 7 DAY && E.Archived = 0,1,NULL)) as WeekEventCount, count(if(E.StartTime>'$db_now' - INTERVAL 1 MONTH && E.Archived = 0,1,NULL)) as MonthEventCount from Monitors as M left join Events as E on E.MonitorId = M.Id where MonitorId = ? group by E.MonitorId order by Id";
807
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
808
my $res = $sth->execute( $event->{MonitorId} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
809
$monitor = $sth->fetchrow_hashref();
810
$sth->finish();
811
return() if ( !$monitor );
812
}
813
814
# Do we need the image information too?
815
my $need_images = $text =~ /%(?:EPI1|EPIM|EI1|EIM)%/;
816
my $first_alarm_frame;
817
my $max_alarm_frame;
818
my $max_alarm_score = 0;
819
if ( $need_images )
820
{
821
my $sql = "select * from Frames where EventId = ? and Type = 'Alarm' order by FrameId";
822
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
823
my $res = $sth->execute( $event->{Id} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
824
while( my $frame = $sth->fetchrow_hashref() )
825
{
826
if ( !$first_alarm_frame )
827
{
828
$first_alarm_frame = $frame;
829
}
830
if ( $frame->{Score} > $max_alarm_score )
831
{
832
$max_alarm_frame = $frame;
833
$max_alarm_score = $frame->{Score};
834
}
835
}
836
$sth->finish();
837
}
838
839
my $url = ZM_URL;
840
$text =~ s/%ZP%/$url/g;
841
$text =~ s/%MN%/$event->{MonitorName}/g;
842
$text =~ s/%MET%/$monitor->{EventCount}/g;
843
$text =~ s/%MEH%/$monitor->{HourEventCount}/g;
844
$text =~ s/%MED%/$monitor->{DayEventCount}/g;
845
$text =~ s/%MEW%/$monitor->{WeekEventCount}/g;
846
$text =~ s/%MEM%/$monitor->{MonthEventCount}/g;
847
$text =~ s/%MEA%/$monitor->{ArchEventCount}/g;
848
$text =~ s/%MP%/$url?view=watch&mid=$event->{MonitorId}/g;
849
$text =~ s/%MPS%/$url?view=watchfeed&mid=$event->{MonitorId}&mode=stream/g;
850
$text =~ s/%MPI%/$url?view=watchfeed&mid=$event->{MonitorId}&mode=still/g;
851
$text =~ s/%EP%/$url?view=event&mid=$event->{MonitorId}&eid=$event->{Id}/g;
852
$text =~ s/%EPS%/$url?view=event&mode=stream&mid=$event->{MonitorId}&eid=$event->{Id}/g;
853
$text =~ s/%EPI%/$url?view=event&mode=still&mid=$event->{MonitorId}&eid=$event->{Id}/g;
854
$text =~ s/%EI%/$event->{Id}/g;
855
$text =~ s/%EN%/$event->{Name}/g;
856
$text =~ s/%EC%/$event->{Cause}/g;
857
$text =~ s/%ED%/$event->{Notes}/g;
858
$text =~ s/%ET%/$event->{StartTime}/g;
859
$text =~ s/%EL%/$event->{Length}/g;
860
$text =~ s/%EF%/$event->{Frames}/g;
861
$text =~ s/%EFA%/$event->{AlarmFrames}/g;
862
$text =~ s/%EST%/$event->{TotScore}/g;
863
$text =~ s/%ESA%/$event->{AvgScore}/g;
864
$text =~ s/%ESM%/$event->{MaxScore}/g;
865
if ( $first_alarm_frame )
866
{
867
$text =~ s/%EPI1%/$url?view=frame&mid=$event->{MonitorId}&eid=$event->{Id}&fid=$first_alarm_frame->{FrameId}/g;
868
$text =~ s/%EPIM%/$url?view=frame&mid=$event->{MonitorId}&eid=$event->{Id}&fid=$max_alarm_frame->{FrameId}/g;
869
if ( $attachments_ref && $text =~ s/%EI1%//g )
870
{
871
push( @$attachments_ref, { type=>"image/jpeg", path=>sprintf( "%s/%0".ZM_EVENT_IMAGE_DIGITS."d-capture.jpg", getEventPath( $event ), $first_alarm_frame->{FrameId} ) } );
872
}
873
if ( $attachments_ref && $text =~ s/%EIM%//g )
874
{
875
# Don't attach the same image twice
876
if ( !@$attachments_ref || ($first_alarm_frame->{FrameId} != $max_alarm_frame->{FrameId} ) )
877
{
878
push( @$attachments_ref, { type=>"image/jpeg", path=>sprintf( "%s/%0".ZM_EVENT_IMAGE_DIGITS."d-capture.jpg", getEventPath( $event ), $max_alarm_frame->{FrameId} ) } );
879
}
880
}
881
}
882
if ( $attachments_ref && ZM_OPT_FFMPEG )
883
{
884
if ( $text =~ s/%EV%//g )
885
{
886
my ( $format, $path ) = generateVideo( $filter, $event );
887
if ( !$format )
888
{
889
return( undef );
890
}
891
push( @$attachments_ref, { type=>"video/$format", path=>$path } );
892
}
893
if ( $text =~ s/%EVM%//g )
894
{
895
my ( $format, $path ) = generateVideo( $filter, $event, 1 );
896
if ( !$format )
897
{
898
return( undef );
899
}
900
push( @$attachments_ref, { type=>"video/$format", path=>$path } );
901
}
902
}
903
$text =~ s/%FN%/$filter->{Name}/g;
904
( my $filter_name = $filter->{Name} ) =~ s/ /+/g;
905
$text =~ s/%FP%/$url?view=filter&mid=$event->{MonitorId}&filter_name=$filter_name/g;
906
907
return( $text );
908
}
909
910
sub sendEmail
911
{
912
my $filter = shift;
913
my $event = shift;
914
915
if ( !ZM_FROM_EMAIL )
916
{
917
warn( "No 'from' email address defined, not sending email" );
918
return( 0 );
919
}
920
if ( !ZM_EMAIL_ADDRESS )
921
{
922
warn( "No email address defined, not sending email" );
923
return( 0 );
924
}
925
926
Info( "Creating notification email\n" );
927
928
my $subject = substituteTags( ZM_EMAIL_SUBJECT, $filter, $event );
929
return( 0 ) if ( !$subject );
930
my @attachments;
931
my $body = substituteTags( ZM_EMAIL_BODY, $filter, $event, \@attachments );
932
return( 0 ) if ( !$body );
933
934
Info( "Sending notification email '$subject'\n" );
935
936
eval
937
{
938
if ( ZM_NEW_MAIL_MODULES )
939
{
940
### Create the multipart container
941
my $mail = MIME::Lite->new (
942
From => ZM_FROM_EMAIL,
943
To => ZM_EMAIL_ADDRESS,
944
Subject => $subject,
945
Type => "multipart/mixed"
946
);
947
### Add the text message part
948
$mail->attach (
949
Type => "TEXT",
950
Data => $body
951
);
952
### Add the attachments
953
foreach my $attachment ( @attachments )
954
{
955
Info( "Attaching '$attachment->{path}\n" );
956
$mail->attach(
957
Path => $attachment->{path},
958
Type => $attachment->{type},
959
Disposition => "attachment"
960
);
961
}
962
### Send the Message
963
MIME::Lite->send( "smtp", ZM_EMAIL_HOST, Timeout=>60 );
964
$mail->send();
965
}
966
else
967
{
968
my $mail = MIME::Entity->build(
969
From => ZM_FROM_EMAIL,
970
To => ZM_EMAIL_ADDRESS,
971
Subject => $subject,
972
Type => (($body=~/<html>/)?'text/html':'text/plain'),
973
Data => $body
974
);
975
976
foreach my $attachment ( @attachments )
977
{
978
Info( "Attaching '$attachment->{path}\n" );
979
$mail->attach(
980
Path => $attachment->{path},
981
Type => $attachment->{type},
982
Encoding => "base64"
983
);
984
}
985
$mail->smtpsend( Host => ZM_EMAIL_HOST, MailFrom => ZM_FROM_EMAIL );
986
}
987
};
988
if ( $@ )
989
{
990
warn( "Can't send email: $@" );
991
return( 0 );
992
}
993
else
994
{
995
Info( "Notification email sent\n" );
996
}
997
my $sql = "update Events set Emailed = 1 where Id = ?";
998
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
999
my $res = $sth->execute( $event->{Id} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
1000
1001
return( 1 );
1002
}
1003
1004
sub sendMessage
1005
{
1006
my $filter = shift;
1007
my $event = shift;
1008
1009
if ( !ZM_FROM_EMAIL )
1010
{
1011
warn( "No 'from' email address defined, not sending message" );
1012
return( 0 );
1013
}
1014
if ( !ZM_MESSAGE_ADDRESS )
1015
{
1016
warn( "No message address defined, not sending message" );
1017
return( 0 );
1018
}
1019
1020
Info( "Creating notification message\n" );
1021
1022
my $subject = substituteTags( ZM_MESSAGE_SUBJECT, $filter, $event );
1023
return( 0 ) if ( !$subject );
1024
my @attachments;
1025
my $body = substituteTags( ZM_MESSAGE_BODY, $filter, $event, \@attachments );
1026
return( 0 ) if ( !$body );
1027
1028
Info( "Sending notification message '$subject'\n" );
1029
1030
eval
1031
{
1032
if ( ZM_NEW_MAIL_MODULES )
1033
{
1034
### Create the multipart container
1035
my $mail = MIME::Lite->new (
1036
From => ZM_FROM_EMAIL,
1037
To => ZM_MESSAGE_ADDRESS,
1038
Subject => $subject,
1039
Type => "multipart/mixed"
1040
);
1041
### Add the text message part
1042
$mail->attach (
1043
Type => "TEXT",
1044
Data => $body
1045
);
1046
### Add the attachments
1047
foreach my $attachment ( @attachments )
1048
{
1049
Info( "Attaching '$attachment->{path}\n" );
1050
$mail->attach(
1051
Path => $attachment->{path},
1052
Type => $attachment->{type},
1053
Disposition => "attachment"
1054
);
1055
}
1056
### Send the Message
1057
MIME::Lite->send( "smtp", ZM_EMAIL_HOST, Timeout=>60 );
1058
$mail->send();
1059
}
1060
else
1061
{
1062
my $mail = MIME::Entity->build(
1063
From => ZM_FROM_EMAIL,
1064
To => ZM_MESSAGE_ADDRESS,
1065
Subject => $subject,
1066
Type => (($body=~/<html>/)?'text/html':'text/plain'),
1067
Data => $body
1068
);
1069
1070
foreach my $attachment ( @attachments )
1071
{
1072
Info( "Attaching '$attachment->{path}\n" );
1073
$mail->attach(
1074
Path => $attachment->{path},
1075
Type => $attachment->{type},
1076
Encoding => "base64"
1077
);
1078
}
1079
$mail->smtpsend( Host => ZM_EMAIL_HOST, MailFrom => ZM_FROM_EMAIL );
1080
}
1081
};
1082
if ( $@ )
1083
{
1084
warn( "Can't send email: $@" );
1085
return( 0 );
1086
}
1087
else
1088
{
1089
Info( "Notification message sent\n" );
1090
}
1091
my $sql = "update Events set Messaged = 1 where Id = ?";
1092
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
1093
my $res = $sth->execute( $event->{Id} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
1094
1095
return( 1 );
1096
}
1097
1098
sub executeCommand
1099
{
1100
my $filter = shift;
1101
my $event = shift;
1102
1103
my $event_path = getEventPath( $event );
1104
1105
my $command = $filter->{AutoExecuteCmd};
1106
$command .= " $event_path";
1107
1108
Info( "Executing '$command'\n" );
1109
my $output = qx($command);
1110
my $status = $? >> 8;
1111
if ( $status || DBG_LEVEL > 0 )
1112
{
1113
chomp( $output );
1114
Debug( "Output: $output\n" );
1115
}
1116
if ( $status )
1117
{
1118
Error( "Command '$command' exited with status: $status\n" );
1119
return( 0 );
1120
}
1121
else
1122
{
1123
my $sql = "update Events set Executed = 1 where Id = ?";
1124
my $sth = $dbh->prepare_cached( $sql ) or Fatal( "Can't prepare '$sql': ".$dbh->errstr() );
1125
my $res = $sth->execute( $event->{Id} ) or Fatal( "Can't execute '$sql': ".$sth->errstr() );
1126
}
1127
return( 1 );
1128
}
1129
Loggerhead is a web-based interface for Breezy
Version: 2.0.1