zoneminder/scripts/zmcamtool.pl.in

#!@PERL_EXECUTABLE@ -wT
#
# ==========================================================================
#
# ZoneMinder Update 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

zmcamtool.pl - ZoneMinder tool to import camera controls and presets

=head1 SYNOPSIS

 zmcamtool.pl [--user=<dbuser> --pass=<dbpass>]
              [--import [file.sql] [--overwrite]]
              [--export [name]]
              [--topreset id [--noregex]]

=head1 DESCRIPTION

This script provides a way to import new ptz camera controls & camera presets
into existing zoneminder systems. This script also provides a way to export
ptz camera controls & camera presets from an existing zoneminder system into
a sql file, which can then be easily imported to another zoneminder system.

=head1 OPTIONS

 --export            - Export all camera controls and presets to STDOUT.
                       Optionally specify a control or preset name.
 --import [file.sql] - Import new camera controls and presets found in
                       zm_create.sql into the ZoneMinder dB.
                       Optionally specify an alternate sql file to read from.
 --overwrite         - Overwrite any existing controls or presets.
                       with the same name as the new controls or presets.
 --topreset id       - Copy a monitor to a Camera Preset given the monitor id.
 --noregex           - Do not try to find and replace fields such as usernames,
                       passwords, IP addresses, etc with generic placeholders
                       when converting a monitor to a preset.
 --help              - Print usage information.
 --user=<dbuser>     - Alternate dB user with privileges to alter dB.
 --pass=<dbpass>     - Password of alternate dB user with privileges to alter dB.
 --version           - Print version.

=cut
use strict;
use bytes;

@EXTRA_PERL_LIB@
use ZoneMinder::Config qw(:all);
use ZoneMinder::Logger qw(:all);
use ZoneMinder::General qw(:all);
use ZoneMinder::Database qw(:all);
use DBI;
use Getopt::Long;
use autouse 'Pod::Usage'=>qw(pod2usage);

$ENV{PATH}  = '@ZM_SCRIPT_PATH@';
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};

my $web_uid = (getpwnam( $Config{ZM_WEB_USER} ))[2];
my $use_log = (($> == 0) || ($> == $web_uid));

logInit( toFile=>$use_log?DEBUG:NOLOG );
logSetSignal();

my $export = 0;
my $import = 0;
my $overwrite = 0;
my $help = 0;
my $topreset = 0;
my $noregex = 0;
my $sqlfile = '';
my $dbUser = $Config{ZM_DB_USER};
my $dbPass = $Config{ZM_DB_PASS};
my $version = 0;

GetOptions(
    'export'        =>\$export,
    'import'        =>\$import,
    'overwrite'     =>\$overwrite,
    'help'          =>\$help,
    'topreset'      =>\$topreset,
    'noregex'       =>\$noregex,
    'user:s'        =>\$dbUser,
    'pass:s'        =>\$dbPass,
    'version'       =>\$version
) or pod2usage(-exitstatus => -1);

$Config{ZM_DB_USER} = $dbUser;
$dbUser =~ s/'/\\'/g;
$Config{ZM_DB_PASS} = $dbPass;
$dbPass =~ s/'/\\'/g;

if ( $version ) {
  print( ZoneMinder::Base::ZM_VERSION . "\n");
  exit(0);
}
# Check to make sure commandline params make sense
if ( ((!$help) && ($import + $export + $topreset) != 1 )) {
  print( STDERR qq/Please give only one of the following: "import", "export", or "topreset".\n/ );
  pod2usage(-exitstatus => -1);
}

if ( ($export)&&($overwrite) ) {
  print( "Warning: Overwrite parameter ignored during an export.\n");
}

if ( ($noregex)&&(!$topreset) ) {
  print( qq/Warning: Noregex parameter only applies when "topreset" parameter is also set. Ignoring.\n/);
}

if ( ($topreset)&&($ARGV[0] !~ /\d\d*/) ) {
  print( STDERR qq/Parameter "topreset" requires a valid monitor ID.\n/ );
  pod2usage(-exitstatus => -1);
}

# Call the appropriate subroutine based on the params given on the commandline
if ($help) {
  pod2usage(-exitstatus => -1);
}

if ($export) {
  exportsql();
}

if ($import) {
  importsql();
}

if ($topreset) {
  toPreset();
}

###############
# SUBROUTINES #
###############

# Execute a pre-built sql select query
sub selectQuery {
  my $dbh = shift;
  my $sql = shift;
  my $monitorid = shift;

  my $sth = $dbh->prepare_cached( $sql )
    or die( "Can't prepare '$sql': ".$dbh->errstr() );
  my $res = $sth->execute($monitorid)
    or die( "Can't execute: ".$sth->errstr() );

  my @data = $sth->fetchrow_array();
  $sth->finish();

  return @data;
}

# Execute a pre-built sql query
sub runQuery {
  my $dbh = shift;
  my $sql = shift;
  my $sth = $dbh->prepare_cached( $sql )
    or die( "Can't prepare '$sql': ".$dbh->errstr() );
  my $res = $sth->execute()
    or die( "Can't execute: ".$sth->errstr() );
  $sth->finish();

  return $res;
}

# Build and execute a sql insert query
sub insertQuery {
  my $dbh = shift;
  my $tablename = shift;
  my @data = @_;

  my $sql = "INSERT INTO $tablename VALUES (NULL,"
    .(join ', ', ('?') x @data).')'; # Add "?" for each array element

    my $sth = $dbh->prepare_cached( $sql )
    or die( "Can't prepare '$sql': ".$dbh->errstr() );
  my $res = $sth->execute(@data)
    or die( "Can't execute: ".$sth->errstr() );
  $sth->finish();

  return $res;
}

# Build and execute a sql delete query
sub deleteQuery {
  my $dbh = shift;
  my $sqltable = shift;
  my $sqlname = shift;

  my $sql = "DELETE FROM $sqltable WHERE Name = ?";
  my $sth = $dbh->prepare_cached( $sql )
    or die( "Can't prepare '$sql': ".$dbh->errstr() );
  my $res = $sth->execute($sqlname)
    or die( "Can't execute: ".$sth->errstr() );
  $sth->finish();

  return $res;
}

# Build and execute a sql select count query
sub checkExists {
  my $dbh = shift;
  my $sqltable = shift;
  my $sqlname = shift;
  my $result = 0; 

  my $sql = "SELECT count(*) FROM $sqltable WHERE Name = ?";
  my $sth = $dbh->prepare_cached( $sql )
    or die( "Can't prepare '$sql': ".$dbh->errstr() );
  my $res = $sth->execute($sqlname)
    or die( "Can't execute: ".$sth->errstr() );

  my $rows = $sth->fetchrow_arrayref();
  $sth->finish();

  if ($rows->[0] > 0) {
    $result = 1;
  }

  return $result;
}

# Split a sql list on its top level commas, leaving quoted strings and
# parenthesised subqueries alone. The seed data contains both -- a Name may
# hold a comma, and a MonitorPresets row resolves its control with a SELECT --
# so a plain split would cut a value in half.
sub splitSqlList {
  my ($str) = @_;
  my (@parts, $quote);
  my $cur = '';
  my $depth = 0;
  my @chars = split //, $str;

  for (my $i = 0; $i < @chars; $i++) {
    my $ch = $chars[$i];

    if (defined $quote) {
      if ($ch eq '\\' and $i+1 < @chars) {
        $cur .= $ch.$chars[++$i];
        next;
      }
      $cur .= $ch;
      if ($ch eq $quote) {
        if ($i+1 < @chars and $chars[$i+1] eq $quote) {
          $cur .= $chars[++$i];   # '' is an escaped quote, still inside
          next;
        }
        undef $quote;
      }
      next;
    }

    if ($ch eq "'" or $ch eq '"') {
      $quote = $ch;
      $cur .= $ch;
      next;
    }
    if ($ch eq '(') {
      $depth++;
    } elsif ($ch eq ')') {
      $depth--;
    } elsif ($ch eq ',' and !$depth) {
      push @parts, $cur;
      $cur = '';
      next;
    }
    $cur .= $ch;
  }
  push @parts, $cur;

  return @parts;
}

# Turn one sql value back into the plain string it represents.
sub sqlUnquote {
  my ($val) = @_;

  $val =~ s/^\s+//;
  $val =~ s/\s+$//;
  if ($val =~ /^'(.*)'$/s) {
    $val = $1;
    $val =~ s/''/'/g;
    $val =~ s/\\(.)/$1/g;
  }
  return $val;
}

# Ask the database where each column of a table actually sits, so a positional
# INSERT can be read without assuming an order. Name is the second column of
# Controls but the third of MonitorPresets, which is the sort of thing that
# quietly stops being true.
sub tableColumns {
  my ($dbh, $table) = @_;

  my $sql = 'SELECT `COLUMN_NAME` FROM `information_schema`.`COLUMNS`
              WHERE `TABLE_SCHEMA` = DATABASE() AND `TABLE_NAME` = ?
              ORDER BY `ORDINAL_POSITION`';
  my $sth = $dbh->prepare_cached($sql)
    or die( "Can't prepare '$sql': ".$dbh->errstr() );
  $sth->execute($table)
    or die( "Can't execute: ".$sth->errstr() );

  my @cols;
  while (my $row = $sth->fetchrow_arrayref()) {
    push @cols, $row->[0];
  }
  $sth->finish();

  return @cols;
}

# Collect the INSERT statements for the given tables out of an sql file,
# keyed by the Name they carry, with any primary key blanked so the row gets a
# fresh one. Follows `source` directives: the seed rows for Controls live in
# controls.sql, which zm_create.sql only pulls in by reference.
sub extractInserts {
  my ($dbh, $file, $tables, $found, $seen) = @_;

  $found ||= {};
  $seen  ||= {};
  return $found if $seen->{$file}++;

  my $FH;
  if (!open($FH, '<', $file)) {
    warn( "Warning: unable to read $file: $!\n" );
    return $found;
  }

  my ($dir) = $file =~ m{^(.*)/[^/]*$};
  $dir = '.' if !defined $dir;

  while (my $line = <$FH>) {
    chomp $line;

    if ($line =~ /^\s*source\s+(.+?)\s*;?\s*$/i) {
      my $included = $1;
      $included = $dir.'/'.$included if $included !~ m{^/};
      extractInserts($dbh, $included, $tables, $found, $seen);
      next;
    }

    next if $line !~ /^\s*INSERT\s+INTO\s+`?(\w+)`?\s*(?:\(([^)]*)\))?\s*VALUES\s*\((.*)\)\s*;\s*$/i;
    my ($table, $collist, $values) = ($1, $2, $3);
    next if !grep { lc $_ eq lc $table } @$tables;

    my @vals = splitSqlList($values);
    my @cols;
    if (defined $collist) {
      @cols = map { my $c = $_; $c =~ s/^\s*`?//; $c =~ s/`?\s*$//; $c } splitSqlList($collist);
    } else {
      @cols = tableColumns($dbh, $table);
      if (scalar(@cols) != scalar(@vals)) {
        warn( "Warning: skipping a $table row in $file: it has ".scalar(@vals)
             .' values but the table has '.scalar(@cols)." columns\n" );
        next;
      }
    }

    my ($nameIdx) = grep { lc $cols[$_] eq 'name' } 0..$#cols;
    if (!defined $nameIdx) {
      warn( "Warning: skipping a $table row in $file: no Name column\n" );
      next;
    }
    my $name = sqlUnquote($vals[$nameIdx]);

    # Let the database assign the id rather than carrying the seed file's.
    my ($idIdx) = grep { lc $cols[$_] eq 'id' } 0..$#cols;
    $vals[$idIdx] = 'NULL' if defined $idIdx;

    $found->{$table}{$name} = 'INSERT INTO `'.$table.'` ('
      .join(',', map { '`'.$_.'`' } @cols).') VALUES ('.join(',', @vals).')';
  }
  close $FH;

  return $found;
}

# Blank the primary key of each INSERT in a mysqldump so the rows can be
# imported elsewhere without carrying their ids across.
#
# Done by parsing rather than by pattern: the value before the first quoted
# string is not reliably the id. A MonitorPresets row starts id,ModelId and
# both are unquoted, so a regex reaching for the first ,' swallows the two of
# them into a single NULL and leaves the row a column short.
sub nullifyIds {
  my ($dbh, $sql) = @_;
  my %columns;
  my @out;

  foreach my $line (split(/\n/, $sql, -1)) {
    if ($line =~ /^\s*INSERT\s+INTO\s+`?(\w+)`?\s*(?:\(([^)]*)\))?\s*VALUES\s*\((.*)\)\s*;\s*$/i) {
      my ($table, $collist, $values) = ($1, $2, $3);
      my @vals = splitSqlList($values);
      my @cols;

      if (defined $collist) {
        @cols = map { my $c = $_; $c =~ s/^\s*`?//; $c =~ s/`?\s*$//; $c } splitSqlList($collist);
      } else {
        $columns{$table} = [tableColumns($dbh, $table)] if !$columns{$table};
        @cols = @{$columns{$table}};
      }

      if (scalar(@cols) != scalar(@vals)) {
        warn( "Warning: leaving a $table row as it is: ".scalar(@vals)
             .' values but '.scalar(@cols)." columns\n" );
      } else {
        my ($idIdx) = grep { lc $cols[$_] eq 'id' } 0..$#cols;
        if (defined $idIdx) {
          $vals[$idIdx] = 'NULL';
          $line = 'INSERT INTO `'.$table.'`'
            .(defined $collist ? ' ('.join(',', map { '`'.$_.'`' } @cols).')' : '')
            .' VALUES ('.join(',', @vals).');';
        }
      }
    }
    push @out, $line;
  }

  return join("\n", @out);
}

# Import camera control & presets into the zoneminder dB
sub importsql {
  my @newcontrols;
  my @overwritecontrols;
  my @skippedcontrols;
  my @newpresets;
  my @overwritepresets;
  my @skippedpresets;
  my %controls;
  my %monitorpresets;

  if ($ARGV[0]) {
    $sqlfile = $ARGV[0];
  } else {
    $sqlfile = $Config{ZM_PATH_DATA}.'/db/zm_create.sql';
  }

# Connect first: reading a positional INSERT needs the table's column order.
  my $dbh = zmDbConnect();

# Find and extract ptz control and monitor preset records
  my $found = extractInserts($dbh, $sqlfile, ['Controls', 'MonitorPresets']);
  %controls = %{$found->{Controls}} if $found->{Controls};
  %monitorpresets = %{$found->{MonitorPresets}} if $found->{MonitorPresets};

  if ( ! (%controls || %monitorpresets) ) {
    die( "Error: No relevant data found in $sqlfile.\n" );
  }

# Now that we've got what we were looking for,
# compare to what is already in the dB

  foreach (keys %controls) {
    if (!checkExists($dbh,'Controls',$_)) {
# No existing Control was found. Add new control to dB.
      runQuery($dbh,$controls{$_});
      push @newcontrols, $_;
    } elsif ($overwrite) {
# An existing Control was found and the overwrite flag is set.
# Overwrite the control.
      deleteQuery($dbh,'Controls',$_);
      runQuery($dbh,$controls{$_});
      push @overwritecontrols, $_;
    } else {
# An existing Control was found and the overwrite flag was not set.
# Do nothing.
      push @skippedcontrols, $_;
    }   
  }

  foreach (keys %monitorpresets) {
    if (!checkExists($dbh,'MonitorPresets',$_)) {
# No existing MonitorPreset was found.  Add new MonitorPreset to dB.
      runQuery($dbh,$monitorpresets{$_});
      push @newpresets, $_;
    } elsif ($overwrite) {
# An existing MonitorPreset was found and the overwrite flag is set.
# Overwrite the MonitorPreset.
      deleteQuery($dbh,'MonitorPresets',$_);
      runQuery($dbh,$monitorpresets{$_});
      push @overwritepresets, $_;
    } else {
# An existing MonitorPreset was found and the overwrite flag was
# not set. Do nothing.
      push @skippedpresets, $_;
    }
  }

  if (@newcontrols) {
    print 'Number of ptz camera controls added: '
      .scalar(@newcontrols)."\n";
  }
  if (@overwritecontrols) {
    print 'Number of existing ptz camera controls overwritten: '
      .scalar(@overwritecontrols)."\n";
  }
  if (@skippedcontrols) {
    print 'Number of existing ptz camera controls skipped: '
      .scalar(@skippedcontrols)."\n";
  }

  if (@newpresets) {
    print 'Number of monitor presets added: '
      .scalar(@newpresets)."\n";
  }
  if (@overwritepresets) {
    print 'Number of existing monitor presets overwritten: '
      .scalar(@overwritepresets)."\n";
  }
  if (@skippedpresets) {
    print 'Number of existing presets skipped: '
      .scalar(@skippedpresets)."\n";
  }
}

# Export camera controls & presets from the zoneminder dB to STDOUT
sub exportsql {

  my ( $host, $port ) = ( $Config{ZM_DB_HOST} =~ /^([^:]+)(?::(.+))?$/ );
  my $command = findDbCommand('mysqldump').' -t --skip-opt --compact -h'.$host;
  $command .= ' -P'.$port if defined($port);
  if ( $dbUser ) {
    $command .= ' -u\''.$dbUser.'\'';
    if ( $dbPass ) {
      $command .= ' -p\''.$dbPass.'\'';
    }
  }

  my $name = $ARGV[0];
  if ( $name ) {
		if ( $name =~ /^([A-Za-z0-9 ,.&()\/\-]+)$/ ) { # Allow alphanumeric and " ,.&()/-"
			$name = $1;
			$command .= qq( --where="Name = '$name'");
		} else {
			print "Invalid characters in Name\n";
		}
  }

  $command .= ' '.$Config{ZM_DB_NAME}.' Controls MonitorPresets';

  my $output = qx($command);
  my $status = $? >> 8;
  if ( $status || logDebugging() ) {
    chomp( $output );
    print( "Output: $output\n" );
  }
  if ( $status ) {
    die( "Command '$command' exited with status: $status\n" );
  } else {
# NULLify the primary keys before printing the output to STDOUT
    print nullifyIds(zmDbConnect(), $output);
  }
}

sub toPreset {
  my $dbh = zmDbConnect();
  my $monitorid = $ARGV[0];

# Grap the following fields from the Monitors table
  my $sql = 'SELECT 
    Name, 
    Type, 
    Device, 
    Channel, 
    Format, 
    Protocol, 
    Method, 
    Host, 
    Port, 
    Path, 
    SubPath, 
    Width, 
    Height, 
    Palette, 
    MaxFPS, 
    Controllable, 
    ControlId, 
    ControlDevice, 
    ControlAddress, 
    DefaultRate, 
    DefaultScale 
      FROM Monitors WHERE Id = ?';
  my @data = selectQuery($dbh,$sql,$monitorid);

  if (!@data) {
    die( "Error: Monitor Id $monitorid does not appear to exist in the database.\n" );
  }

# Attempt to search for and replace system specific values such as
# ip addresses, ports, usernames, etc. with generic placeholders
  if (!$noregex) {
    foreach (@data) {
      next if ! $_;
      s/\b(?:\d{1,3}\.){3}\d{1,3}\b/<ip-address>/; # ip address
        s/<ip-address>:(6553[0-5]|655[0-2]\d|65[0-4]\d\d|6[0-4]\d{3}|[1-5]\d{4}|[1-9]\d{0,3}|0)$/<ip-address>:<port>/; # tcpip port
        s/\/\/.*:.*@/\/\/<username>:<pwd>@/; # user & pwd preceding an ip address
        s/(&|\?)(user|username)=\w\w*(&|\?)/$1$2=<username>$3/i; # username embedded in url
        s/(&|\?)(pwd|password)=\w\w*(&|\?)/$1$2=<pwd>$3/i; # password embedded in url
        s/\w\w*:\w\w*/<username>:<pwd>/; # user & pwd in their own field
        s/\/dev\/video\d\d*/\/dev\/video<?>/; # local video devices
    }
  }

  if (!checkExists($dbh,"MonitorPresets",$data[0])) {
# No existing Preset was found.  Add new Preset to dB.
    print "Adding new preset: $data[0]\n";
    insertQuery($dbh,'MonitorPresets',@data);
  } elsif ($overwrite) {
# An existing Control was found and the overwrite flag is set.
# Overwrite the control.
    print "Existing preset $data[0] detected.\nOverwriting...\n";
    deleteQuery($dbh,'MonitorPresets',$data[0]);
    insertQuery($dbh,'MonitorPresets',@data);
  } else {
# An existing Control was found and the overwrite flag was not set.
# Do nothing.
    print "Existing preset $data[0] detected and overwrite flag not set.\nSkipping...\n";
  }
}

1;
__END__