zoneminder/zmfilter.pl

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