ZaneYork
/
zoneminder
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge https://github.com/michaelbarkdoll/ZoneMinder into trendnet

This commit is contained in:
Isaac Connor 2018-08-13 11:05:50 -04:00
parent 6db55a24d3 fa7f6088c8
commit 70ba0ad342
7 changed files with 1326 additions and 813 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
db/zm_create.sql.in
View File

@ -780,6 +780,7 @@ INSERT INTO `Controls` VALUES (NULL,'Reolink RLC-420','Ffmpeg','Reolink',0,0,1,0
INSERT INTO `Controls` VALUES (NULL,'D-LINK DCS-3415','Remote','DCS3415',0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0); INSERT INTO `Controls` VALUES (NULL,'D-LINK DCS-3415','Remote','DCS3415',0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0);
INSERT INTO `Controls` VALUES (NULL,'IOS Camera','Ffmpeg','IPCAMIOS',0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0); INSERT INTO `Controls` VALUES (NULL,'IOS Camera','Ffmpeg','IPCAMIOS',0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0);
INSERT INTO `Controls` VALUES (NULL,'Dericam P2','Ffmpeg','DericamP2',0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,10,0,1,1,1,0,0,0,1,1,0,0,0,0,1,1,45,0,0,1,0,0,0,0,1,1,45,0,0,0,0); INSERT INTO `Controls` VALUES (NULL,'Dericam P2','Ffmpeg','DericamP2',0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,10,0,1,1,1,0,0,0,1,1,0,0,0,0,1,1,45,0,0,1,0,0,0,0,1,1,45,0,0,0,0);
INSERT INTO `Controls` VALUES (NULL,'Trendnet','Remote','Trendnet',1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,1,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0);
-- --
-- Add some monitor preset values -- Add some monitor preset values
-- --

526
scripts/ZoneMinder/lib/ZoneMinder/Control/Netcat.pm
View File

@ -74,377 +74,351 @@ use ZoneMinder::Config qw(:all);
use Time::HiRes qw( usleep ); use Time::HiRes qw( usleep );
sub open sub open {
{ my $self = shift;
my $self = shift;
$self->loadMonitor(); $self->loadMonitor();
use LWP::UserAgent; use LWP::UserAgent;
$self->{ua} = LWP::UserAgent->new; $self->{ua} = LWP::UserAgent->new;
$self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION ); $self->{ua}->agent('ZoneMinder Control Agent/'.ZoneMinder::Base::ZM_VERSION);
$self->{state} = 'open'; $self->{state} = 'open';
} }
sub printMsg sub printMsg {
{ my $self = shift;
my $self = shift; my $msg = shift;
my $msg = shift; my $msg_len = length($msg);
my $msg_len = length($msg);
Debug( $msg."[".$msg_len."]" ); Debug($msg.'['.$msg_len.']');
} }
sub sendCmd sub sendCmd {
{ my $self = shift;
my $self = shift; my $cmd = shift;
my $cmd = shift; my $msg = shift;
my $msg = shift; my $content_type = shift;
my $content_type = shift; my $result = undef;
my $result = undef;
printMsg( $cmd, "Tx" ); printMsg($cmd, 'Tx');
my $server_endpoint = "http://".$self->{Monitor}->{ControlAddress}."/$cmd"; my $server_endpoint = 'http://'.$self->{Monitor}->{ControlAddress}.'/'.$cmd;
my $req = HTTP::Request->new( POST => $server_endpoint ); my $req = HTTP::Request->new(POST => $server_endpoint);
$req->header('content-type' => $content_type); $req->header('content-type' => $content_type);
$req->header('Host' => $self->{Monitor}->{ControlAddress}); $req->header('Host' => $self->{Monitor}->{ControlAddress});
$req->header('content-length' => length($msg)); $req->header('content-length' => length($msg));
$req->header('accept-encoding' => 'gzip, deflate'); $req->header('accept-encoding' => 'gzip, deflate');
$req->header('connection' => 'Close'); $req->header('connection' => 'Close');
$req->content($msg); $req->content($msg);
my $res = $self->{ua}->request($req); my $res = $self->{ua}->request($req);
if ( $res->is_success ) { if ( $res->is_success ) {
$result = !undef; $result = !undef;
} else { } else {
Error( "After sending PTZ command, camera returned the following error:'".$res->status_line()."'" ); Error("After sending PTZ command, camera returned the following error:'".$res->status_line()."'");
}
return $result;
}
sub getCamParams {
my $self = shift;
my $msg = '<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><GetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken></GetImagingSettings></s:Body></s:Envelope>';
my $server_endpoint = 'http://'.$self->{Monitor}->{ControlAddress}.'/onvif/imaging';
my $req = HTTP::Request->new(POST => $server_endpoint);
$req->header('content-type' => 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/GetImagingSettings"');
$req->header('Host' => $self->{Monitor}->{ControlAddress});
$req->header('content-length' => length($msg));
$req->header('accept-encoding' => 'gzip, deflate');
$req->header('connection' => 'Close');
$req->content($msg);
my $res = $self->{ua}->request($req);
if ( $res->is_success ) {
# We should really use an xml or soap library to parse the xml tags
my $content = $res->decoded_content;
if ( $content =~ /.*<tt:(Brightness)>(.+)<\/tt:Brightness>.*/ ) {
$CamParams{$1} = $2;
} }
return( $result ); if ( $content =~ /.*<tt:(Contrast)>(.+)<\/tt:Contrast>.*/ ) {
} $CamParams{$1} = $2;
sub getCamParams
{
my $self = shift;
my $msg = '<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><GetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken></GetImagingSettings></s:Body></s:Envelope>';
my $server_endpoint = "http://".$self->{Monitor}->{ControlAddress}."/onvif/imaging";
my $req = HTTP::Request->new( POST => $server_endpoint );
$req->header('content-type' => 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/GetImagingSettings"');
$req->header('Host' => $self->{Monitor}->{ControlAddress});
$req->header('content-length' => length($msg));
$req->header('accept-encoding' => 'gzip, deflate');
$req->header('connection' => 'Close');
$req->content($msg);
my $res = $self->{ua}->request($req);
if ( $res->is_success ) {
# We should really use an xml or soap library to parse the xml tags
my $content = $res->decoded_content;
if ($content =~ /.*<tt:(Brightness)>(.+)<\/tt:Brightness>.*/) {
$CamParams{$1} = $2;
}
if ($content =~ /.*<tt:(Contrast)>(.+)<\/tt:Contrast>.*/) {
$CamParams{$1} = $2;
}
}
else
{
Error( "Unable to retrieve camera image settings:'".$res->status_line()."'" );
} }
} else {
Error("Unable to retrieve camera image settings:'".$res->status_line()."'");
}
} }
#autoStop #autoStop
#This makes use of the ZoneMinder Auto Stop Timeout on the Control Tab #This makes use of the ZoneMinder Auto Stop Timeout on the Control Tab
sub autoStop sub autoStop {
{ my $self = shift;
my $self = shift; my $autostop = shift;
my $autostop = shift;
if( $autostop ) { if ( $autostop ) {
Debug( "Auto Stop" ); Debug('Auto Stop');
my $cmd = 'onvif/PTZ'; my $cmd = 'onvif/PTZ';
my $msg = '<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><Stop xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PanTilt>true</PanTilt><Zoom>false</Zoom></Stop></s:Body></s:Envelope>'; my $msg = '<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><Stop xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PanTilt>true</PanTilt><Zoom>false</Zoom></Stop></s:Body></s:Envelope>';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
usleep( $autostop ); usleep($autostop);
$self->sendCmd( $cmd, $msg, $content_type ); $self->sendCmd($cmd, $msg, $content_type);
} }
} }
# Reset the Camera # Reset the Camera
sub reset sub reset {
{ Debug('Camera Reset');
Debug( "Camera Reset" ); my $self = shift;
my $self = shift; my $cmd = '';
my $cmd = ""; my $msg = '<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SystemReboot xmlns="http://www.onvif.org/ver10/device/wsdl"/></s:Body></s:Envelope>';
my $msg = '<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SystemReboot xmlns="http://www.onvif.org/ver10/device/wsdl"/></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver10/device/wsdl/SystemReboot"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver10/device/wsdl/SystemReboot"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type );
} }
#Up Arrow #Up Arrow
sub moveConUp sub moveConUp {
{ Debug('Move Up');
Debug( "Move Up" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0" y="0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0" y="0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Down Arrow #Down Arrow
sub moveConDown sub moveConDown {
{ Debug('Move Down');
Debug( "Move Down" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0" y="-0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0" y="-0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Left Arrow #Left Arrow
sub moveConLeft sub moveConLeft {
{ Debug('Move Left');
Debug( "Move Left" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="-0.49" y="0" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="-0.49" y="0" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Right Arrow #Right Arrow
sub moveConRight sub moveConRight {
{ Debug('Move Right');
Debug( "Move Right" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0.49" y="0" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0.49" y="0" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Zoom In #Zoom In
sub zoomConTele sub zoomConTele {
{ Debug('Zoom Tele');
Debug( "Zoom Tele" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><Zoom x="0.49" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><Zoom x="0.49" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Zoom Out #Zoom Out
sub zoomConWide sub zoomConWide {
{ Debug('Zoom Wide');
Debug( "Zoom Wide" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><Zoom x="-0.49" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><Zoom x="-0.49" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Diagonally Up Right Arrow #Diagonally Up Right Arrow
#This camera does not have builtin diagonal commands so we emulate them #This camera does not have builtin diagonal commands so we emulate them
sub moveConUpRight sub moveConUpRight {
{ Debug('Move Diagonally Up Right');
Debug( "Move Diagonally Up Right" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0.5" y="0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0.5" y="0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Diagonally Down Right Arrow #Diagonally Down Right Arrow
#This camera does not have builtin diagonal commands so we emulate them #This camera does not have builtin diagonal commands so we emulate them
sub moveConDownRight sub moveConDownRight {
{ Debug('Move Diagonally Down Right');
Debug( "Move Diagonally Down Right" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0.5" y="-0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="0.5" y="-0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Diagonally Up Left Arrow #Diagonally Up Left Arrow
#This camera does not have builtin diagonal commands so we emulate them #This camera does not have builtin diagonal commands so we emulate them
sub moveConUpLeft sub moveConUpLeft {
{ Debug('Move Diagonally Up Left');
Debug( "Move Diagonally Up Left" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="-0.5" y="0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="-0.5" y="0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Diagonally Down Left Arrow #Diagonally Down Left Arrow
#This camera does not have builtin diagonal commands so we emulate them #This camera does not have builtin diagonal commands so we emulate them
sub moveConDownLeft sub moveConDownLeft {
{ Debug('Move Diagonally Down Left');
Debug( "Move Diagonally Down Left" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="-0.5" y="-0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><ContinuousMove xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><Velocity><PanTilt x="-0.5" y="-0.5" xmlns="http://www.onvif.org/ver10/schema"/></Velocity></ContinuousMove></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type ); $self->autoStop($self->{Monitor}->{AutoStopTimeout});
$self->autoStop( $self->{Monitor}->{AutoStopTimeout} );
} }
#Stop #Stop
sub moveStop sub moveStop {
{ Debug('Move Stop');
Debug( "Move Stop" ); my $self = shift;
my $self = shift; my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><Stop xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PanTilt>true</PanTilt><Zoom>false</Zoom></Stop></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><Stop xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PanTilt>true</PanTilt><Zoom>false</Zoom></Stop></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type );
} }
#Set Camera Preset #Set Camera Preset
sub presetSet sub presetSet {
{ my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; my $preset = $self->getParam($params, 'preset');
my $preset = $self->getParam( $params, 'preset' ); Debug("Set Preset $preset");
Debug( "Set Preset $preset" ); my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetPreset xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PresetToken>'.$preset.'</PresetToken></SetPreset></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetPreset xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PresetToken>'.$preset.'</PresetToken></SetPreset></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/SetPreset"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/SetPreset"'; $self->sendCmd($cmd, $msg, $content_type);
$self->sendCmd( $cmd, $msg, $content_type );
} }
#Recall Camera Preset #Recall Camera Preset
sub presetGoto sub presetGoto {
{ my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; my $preset = $self->getParam($params, 'preset');
my $preset = $self->getParam( $params, 'preset' ); Debug("Goto Preset $preset");
Debug( "Goto Preset $preset" ); my $cmd = 'onvif/PTZ';
my $cmd = 'onvif/PTZ'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><GotoPreset xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PresetToken>'.$preset.'</PresetToken></GotoPreset></s:Body></s:Envelope>';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><GotoPreset xmlns="http://www.onvif.org/ver20/ptz/wsdl"><ProfileToken>000</ProfileToken><PresetToken>'.$preset.'</PresetToken></GotoPreset></s:Body></s:Envelope>'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/GotoPreset"';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/GotoPreset"'; $self->sendCmd( $cmd, $msg, $content_type );
$self->sendCmd( $cmd, $msg, $content_type );
} }
#Horizontal Patrol #Horizontal Patrol
#To be determined if this camera supports this feature #To be determined if this camera supports this feature
sub horizontalPatrol sub horizontalPatrol {
{ Debug('Horizontal Patrol');
Debug( "Horizontal Patrol" ); my $self = shift;
my $self = shift; my $cmd = '';
my $cmd = ''; my $msg ='';
my $msg =''; my $content_type = '';
my $content_type = ''; # $self->sendCmd( $cmd, $msg, $content_type );
# $self->sendCmd( $cmd, $msg, $content_type ); Error('PTZ Command not implemented in control script.');
Error( "PTZ Command not implemented in control script." );
} }
#Horizontal Patrol Stop #Horizontal Patrol Stop
#To be determined if this camera supports this feature #To be determined if this camera supports this feature
sub horizontalPatrolStop sub horizontalPatrolStop {
{ Debug('Horizontal Patrol Stop');
Debug( "Horizontal Patrol Stop" ); my $self = shift;
my $self = shift; my $cmd = '';
my $cmd = ''; my $msg ='';
my $msg =''; my $content_type = '';
my $content_type = ''; # $self->sendCmd( $cmd, $msg, $content_type );
# $self->sendCmd( $cmd, $msg, $content_type ); Error('PTZ Command not implemented in control script.');
Error( "PTZ Command not implemented in control script." );
} }
# Increase Brightness # Increase Brightness
sub irisAbsOpen sub irisAbsOpen {
{ Debug("Iris $CamParams{Brightness}");
Debug( "Iris $CamParams{'Brightness'}" ); my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; $self->getCamParams() unless($CamParams{Brightness});
$self->getCamParams() unless($CamParams{'Brightness'}); my $step = $self->getParam($params, 'step');
my $step = $self->getParam( $params, 'step' ); my $max = 100;
my $max = 100;
$CamParams{'Brightness'} += $step; $CamParams{Brightness} += $step;
$CamParams{'Brightness'} = $max if ($CamParams{'Brightness'} > $max); $CamParams{Brightness} = $max if ($CamParams{Brightness} > $max);
my $cmd = 'onvif/imaging'; my $cmd = 'onvif/imaging';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Brightness xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{'Brightness'}.'</Brightness></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Brightness xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{Brightness}.'</Brightness></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
$self->sendCmd( $cmd, $msg, $content_type ); $self->sendCmd( $cmd, $msg, $content_type );
} }
# Decrease Brightness # Decrease Brightness
sub irisAbsClose sub irisAbsClose
{ {
Debug( "Iris $CamParams{'Brightness'}" ); Debug( "Iris $CamParams{Brightness}" );
my $self = shift; my $self = shift;
my $params = shift; my $params = shift;
$self->getCamParams() unless($CamParams{'brightness'}); $self->getCamParams() unless($CamParams{brightness});
my $step = $self->getParam( $params, 'step' ); my $step = $self->getParam( $params, 'step' );
my $min = 0; my $min = 0;
$CamParams{'Brightness'} -= $step; $CamParams{Brightness} -= $step;
$CamParams{'Brightness'} = $min if ($CamParams{'Brightness'} < $min); $CamParams{Brightness} = $min if ($CamParams{Brightness} < $min);
my $cmd = 'onvif/imaging'; my $cmd = 'onvif/imaging';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Brightness xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{'Brightness'}.'</Brightness></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Brightness xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{Brightness}.'</Brightness></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
$self->sendCmd( $cmd, $msg, $content_type ); $self->sendCmd( $cmd, $msg, $content_type );
} }
# Increase Contrast # Increase Contrast
sub whiteAbsIn sub whiteAbsIn {
{ Debug("Iris $CamParams{Contrast}");
Debug( "Iris $CamParams{'Contrast'}" ); my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; $self->getCamParams() unless($CamParams{Contrast});
$self->getCamParams() unless($CamParams{'Contrast'}); my $step = $self->getParam( $params, 'step' );
my $step = $self->getParam( $params, 'step' ); my $max = 100;
my $max = 100;
$CamParams{'Contrast'} += $step; $CamParams{Contrast} += $step;
$CamParams{'Contrast'} = $max if ($CamParams{'Contrast'} > $max); $CamParams{Contrast} = $max if ($CamParams{Contrast} > $max);
my $cmd = 'onvif/imaging'; my $cmd = 'onvif/imaging';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Contrast xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{'Contrast'}.'</Contrast></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Contrast xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{Contrast}.'</Contrast></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
} }
# Decrease Contrast # Decrease Contrast
sub whiteAbsOut sub whiteAbsOut {
{ Debug("Iris $CamParams{Contrast}");
Debug( "Iris $CamParams{'Contrast'}" ); my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; $self->getCamParams() unless($CamParams{Contrast});
$self->getCamParams() unless($CamParams{'Contrast'}); my $step = $self->getParam($params, 'step');
my $step = $self->getParam( $params, 'step' ); my $min = 0;
my $min = 0;
$CamParams{'Contrast'} -= $step; $CamParams{Contrast} -= $step;
$CamParams{'Contrast'} = $min if ($CamParams{'Contrast'} < $min); $CamParams{Contrast} = $min if ($CamParams{Contrast} < $min);
my $cmd = 'onvif/imaging'; my $cmd = 'onvif/imaging';
my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Contrast xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{'Contrast'}.'</Contrast></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>'; my $msg ='<s:Envelope xmlns:s="http://www.w3.org/2003/05/soap-envelope"><s:Body xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><SetImagingSettings xmlns="http://www.onvif.org/ver20/imaging/wsdl"><VideoSourceToken>000</VideoSourceToken><ImagingSettings><Contrast xmlns="http://www.onvif.org/ver10/schema">'.$CamParams{Contrast}.'</Contrast></ImagingSettings><ForcePersistence>true</ForcePersistence></SetImagingSettings></s:Body></s:Envelope>';
my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"';
} }
1; 1;
__END__

590
scripts/ZoneMinder/lib/ZoneMinder/Control/TVIP672WI.pm Normal file
View File

@ -0,0 +1,590 @@
# =========================================================================
#
# ZoneMinder Trendnet TV-IP672WI IP Control Protocol Module, $Date: $, $Revision: $
# Copyright (C) 2014 Vincent Giovannone
# Updated 2017 Michael Barkdoll
#
#
# ==========================================================================
#
# 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.
#
# ==========================================================================
#
# This module contains the implementation of the Trendnet TV-IP672WI IP camera control
# protocol.
#
# Tested on Zoneminder 1.30.4
#
# Under control capability:
#
# * Main: name it (suggest TVIP672WI), type is FFMPEG (or remote if you're using MJPEG), protocol is TVIP672WI
# * Main (more): Can wake, can sleep, can reset
# * Move: Can move, can move diagonally, can move mapped, can move relative
# * Pan: Can pan
# * Tilt: Can tilt
#
# * Presets: Has presets, num presets 20, has home preset (don't set presets via camera's web server, only set via ZM.)
# (I didn't test/use presets -MB)
#
# Under control tab in the monitor itself:
#
# * Controllable
# * Control type is the name you gave it in control capability above
# * Control device is the username and password you use to authenticate to the camera
# E.g., admin:password
#
# * Control address is the camera's ip address AND web port
# E.g., 192.168.1.100:80
# Optionally, it can parse all username and password with the following format:
# http://admin:password@192.168.1.100:80
#
#
# If using with anything but a TV-IP672WI (ex: TV-IP672PI), YOU MUST MATCH THE REALM TO MATCH YOUR CAMERA FURTHER DOWN!
#
#
# Due to how the TVIP672 represents presets internally, you MUST define the presets in order... i.e. 1,2,3,4... not 1,10,3,4.
# (see much further down for why, if you care...)
#
# Install this file with the following commands:
#
# sudo cp TVIP672WI.pm /usr/share/perl5/ZoneMinder/Control/
# sudo chmod 755 /usr/share/perl5/ZoneMinder/Control/TVIP672WI.pm
package ZoneMinder::Control::TVIP672WI;
use 5.006;
use strict;
use warnings;
require ZoneMinder::Base;
require ZoneMinder::Control;
our @ISA = qw(ZoneMinder::Control);
#
# ******** YOU MUST CHANGE THE FOLLOWING LINES TO MATCH YOUR CAMERA! **********
#
# I assume that "TV-IP672WI" would work for the TV-IP672PI, but can't test since I don't own one.
#
# TV-IP672WI works for the WI version, of course.
#
# Finally, the username is the username you'd like to authenticate as.
#
#our $REALM = 'TV-IP862IC';
#our $REALM = 'TV-IP672PI';
our $REALM = 'TV-IP672WI';
#our $REALM = 'TVIP672WI';
# $USERNAME and $PASSWORD are parsed from ControlDevice field in GUI
# E.g., username:password
# Note: values defined below are overriden by GUI values
our $USERNAME = '';
our $PASSWORD = '';
# $ADDRESS is parsed from field, 'Control Address'
our $ADDRESS = '';
# ==========================================================================
#
# Trendnet TV-IP672PI Control Protocol
#
# ==========================================================================
use ZoneMinder::Logger qw(:all);
use ZoneMinder::Config qw(:all);
sub new
{
my $class = shift;
my $id = shift;
my $self = ZoneMinder::Control->new( $id );
bless( $self, $class );
srand( time() );
return $self;
}
our $AUTOLOAD;
sub AUTOLOAD
{
my $self = shift;
my $class = ref($self) || croak( "$self not object" );
my $name = $AUTOLOAD;
$name =~ s/.*://;
if ( exists($self->{$name}) )
{
return( $self->{$name} );
}
Fatal( "Can't access $name member of object of class $class" );
}
sub open
{
my $self = shift;
$self->loadMonitor();
my $controldevice = $self->{Monitor}->{ControlDevice};
if ( $controldevice && $controldevice =~ m/\:/ ) {
my ( $adminname, $lastpass )
= split(/\:/, $controldevice, 2);
if ( $adminname ) {
$USERNAME = $adminname;
#Error( "Username updated to: " . $USERNAME );
}
if ( $lastpass ) {
$PASSWORD = $lastpass;
#Error( "Password updated to: " . $PASSWORD );
}
} else {
if ( $controldevice ) {
$PASSWORD = $controldevice;
#Error( "Password updated to: " . $PASSWORD );
} else {
Error ( "Unable to parse Control Device field: " . $controldevice );
}
}
my ( $protocol, $username, $password, $address )
= $self->{Monitor}->{ControlAddress} =~ /^(http?:\/\/)?([^:]+):([^\/@]+)@(.*)$/;
if ( ( $username ) && ( $password ) && ( $address ) ) {
$USERNAME = $username;
$PASSWORD = $password;
$ADDRESS = $address;
#Error( "Set USERNAME: " . $USERNAME . "PASSWORD: " . $PASSWORD . "ADDRESS: " . $ADDRESS );
} else {
if ( ! ( $controldevice ) ) {
Error( "Failed to parse auth from address");
Error( "Unable to pull username and password for authentication from fields ControlAddress or ControlDevice" );
Error( "Control script attempts to pull these values from field ControlDevice as username:password" );
Error( "Optionally, these values can also be set at /usr/share/perl5/ZoneMinder/Control/TVIP672WI.pm" );
}
$ADDRESS = $self->{Monitor}->{ControlAddress};
}
if ( ! ( $ADDRESS =~ m/\:/ ) ) {
$ADDRESS .= ':80';
Debug( "You generally need to also specify the port. I will append :80" );
}
Debug ( "Address is now: " . $ADDRESS );
use LWP::UserAgent;
use HTTP::Request::Common;
$self->{ua} = LWP::UserAgent->new;
$self->{ua}->agent( "ZoneMinder Control Agent/".$ZoneMinder::Base::ZM_VERSION );
$self->{state} = 'open';
# credentials: ("ip:port" (no prefix!), realm (string), username (string), password (string)
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
# Detect REALM
my $req = HTTP::Request->new( GET=>"http://".$ADDRESS."/cgi/ptdc.cgi" );
my $res = $self->{ua}->request($req);
if ( ! $res->is_success ) {
Debug("Need newer REALM");
if ( $res->status_line() eq '401 Unauthorized' ) {
my $headers = $res->headers();
foreach my $k ( keys %$headers ) {
Error("Initial Header $k => $$headers{$k}");
} # end foreach
if ( $$headers{'www-authenticate'} ) {
my ( $auth, $tokens ) = $$headers{'www-authenticate'} =~ /^(\w+)\s+(.*)$/;
if ( $tokens =~ /\w+="([^"]+)"/i ) {
$REALM = $1;
Debug( "Changing REALM to $REALM" );
$self->{ua}->credentials($ADDRESS, $REALM, $USERNAME, $PASSWORD);
my $req = HTTP::Request->new( GET=>"http://".$ADDRESS."/cgi/ptdc.cgi" );
my $res = $self->{ua}->request($req);
if ( ! $res->is_success ) {
Error ( "Unable to authenticate!!!" );
}
} # end if
} else {
Error("No headers line");
} # end if headers
} # end if $res->status_line() eq '401 Unauthorized'
} # end if ! $res->is_success
}
sub close
{
my $self = shift;
$self->{state} = 'closed';
}
sub printMsg
{
my $self = shift;
my $msg = shift;
my $msg_len = length($msg);
Debug( $msg."[".$msg_len."]" );
}
sub sendCmd
{
# This routine is used for all moving, which are all GET commands...
my $self = shift;
my $cmd = shift;
my $result = undef;
# Assuming you've placed your camera on a secure vlan network for ip cameras...
my $url = "http://".$USERNAME.":".$PASSWORD."@".$ADDRESS."/cgi/ptdc.cgi?command=".$cmd;
# The following didn't work with the TV-IP672WI; required authentication despite previous auth
#my $url = "http://".$ADDRESS."/cgi/ptdc.cgi?command=".$cmd;
my $req = HTTP::Request->new( GET=>$url );
Debug ("sendCmd command: " . $url );
my $res = $self->{ua}->request($req);
if ( $res->is_success ) {
$result = !undef;
} else {
if ( $res->status_line() eq '401 Unauthorized' ) {
Debug( "Error check failed, trying again: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
Debug("Content was " . $res->content() );
my $res = $self->{ua}->request($req);
if ( $res->is_success ) {
$result = !undef;
} else {
Debug("Content was " . $res->content() );
}
}
if ( ! $result ) {
Debug( "Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
}
}
return( $result );
}
sub sendCmdPost
{
#
# This routine is used for setting/clearing presets and IR commands, which are POST commands...
#
my $self = shift;
my $url = shift;
my $cmd = shift;
my $result = undef;
if ($url eq undef)
{
Error ("url passed to sendCmdPost is undefined.");
return(-1);
}
Debug ("sendCmdPost url: " . $url . " cmd: " . $cmd);
my $req = HTTP::Request->new(POST => "http://".$ADDRESS.$url);
$req->content_type('application/x-www-form-urlencoded');
$req->content($cmd);
Debug ( "sendCmdPost credentials control address:'".$ADDRESS."' realm:'" . $REALM . "' username:'" . $USERNAME . "' password:'".$PASSWORD."'");
my $res = $self->{ua}->request($req);
if ( $res->is_success )
{
$result = !undef;
}
else
{
Error( "sendCmdPost Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
if ( $res->status_line() eq '401 Unauthorized' ) {
Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
} else {
Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
} # endif
}
return( $result );
}
sub move
{
my $self = shift;
my $panSteps = shift;
my $tiltSteps = shift;
my $cmd = "set_relative_pos&posX=$panSteps&posY=$tiltSteps";
$self->sendCmd( $cmd );
}
sub moveRelUpLeft
{
my $self = shift;
Debug( "Move Up Left" );
$self->move(-3, 3);
}
sub moveRelUp
{
my $self = shift;
Debug( "Move Up" );
$self->move(0, 3);
}
sub moveRelUpRight
{
my $self = shift;
Debug( "Move Up Right" );
$self->move(3, 3);
}
sub moveRelLeft
{
my $self = shift;
Debug( "Move Left" );
$self->move(-3, 0);
}
sub moveRelRight
{
my $self = shift;
Debug( "Move Right" );
$self->move(3, 0);
}
sub moveRelDownLeft
{
my $self = shift;
Debug( "Move Down Left" );
$self->move(-3, -3);
}
sub moveRelDown
{
my $self = shift;
Debug( "Move Down" );
$self->move(0, -3);
}
sub moveRelDownRight
{
my $self = shift;
Debug( "Move Down Right" );
$self->move(3, -3);
}
# moves the camera to center on the point that the user clicked on in the video image.
# This isn't mega accurate but good enough for most purposes
sub moveMap
{
# If the camera moves too much, increase hscale and vscale. (...if it doesn't move enough, try decreasing!)
# They scale the movement and are here to compensate for manufacturing variation.
# It's never going to be perfect, so just get somewhere in the ballpark and call it a day.
# (Don't forget to kill the zmcontrol process while tweaking!)
# 1280x800
my $hscale = 31;
my $vscale = 25;
# 1280x800 with fisheye
#my $hscale = 15;
#my $vscale = 15;
# 640x400
#my $hscale = 14;
#my $vscale = 12;
my $self = shift;
my $params = shift;
my $xcoord = $self->getParam( $params, 'xcoord' );
my $ycoord = $self->getParam( $params, 'ycoord' );
my $hor = ($xcoord - ($self->{Monitor}->{Width} / 2))/$hscale;
my $ver = ($ycoord - ($self->{Monitor}->{Height} / 2))/$vscale;
$hor = int($hor);
$ver = -1 * int($ver);
Debug( "Move Map to $xcoord,$ycoord, hor=$hor, ver=$ver" );
$self->move( $hor, $ver );
}
# **** PRESETS ****
#
# OK, presets work a little funky but they DO work, provided you define them in order and don't skip any.
#
# The problem is that when you load the web page for this camera, it gives a list of preset names tied to index numbers.
# So let's say you have four presets... A, B, C, and D, and defined them in that order.
# So A is index 0, B is index 1, C is index 2, D is index 3. When you tell the camera to go to a preset, you actually tell it by number, not by name.
# (So "Go to D" is really "go to index 3".)
#
# Now let's say somebody deletes C via the camera's web GUI. The camera re-numbers the existing presets A=0, B=1, D=2.
# There's really no easy way for ZM to discover this re-numbering, so zoneminder would still send "go to preset 3" thinking
# it's telling the camera to go to point D. In actuality it's telling the camera to go to a preset that no longer exists.
#
# As long as you define your presets in order (i.e. define preset 1, then preset 2, then preset 3, etc.) everything will work just
# fine in ZoneMinder.
#
# (Home preset needs to be set via the camera's web gui, and is unaffected by any of this.)
#
# So that's the limitation: DEFINE YOUR PRESETS IN ORDER THROUGH (and only through!) ZM AND DON'T SKIP ANY.
#
sub presetClear
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset' );
my $cmd = "presetName=$preset&command=del";
my $url = "/eng/admin/cam_control.cgi";
Debug ("presetClear: " . $preset . " cmd: " . $cmd);
$self->sendCmdPost($url,$cmd);
}
sub presetSet
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset' );
my $cmd = "presetName=$preset&command=add";
my $url = "/eng/admin/cam_control.cgi";
Debug ("presetSet " . $preset . " cmd: " . $cmd);
$self->sendCmdPost ($url,$cmd);
}
sub presetGoto
{
my $self = shift;
my $params = shift;
my $preset = $self->getParam( $params, 'preset' );
$preset = $preset - 1;
Debug( "Goto Preset $preset" );
my $cmd = "goto_preset_position&index=$preset";
$self->sendCmd( $cmd );
}
sub presetHome
{
my $self = shift;
Debug( "Home Preset" );
my $cmd = "go_home";
$self->sendCmd( $cmd );
}
#
# **** IR CONTROLS ****
#
#
# Wake: Force IR on, always. (always night mode)
#
# Sleep: Force IR off, always. (always day mode)
#
# Reset: Automatic IR mode. (day/night mode determined by camera)
#
sub wake
{
# force IR on ("always night mode")
my $self = shift;
my $url = "/eng/admin/adv_audiovideo.cgi";
my $cmd = "irMode=3";
Debug("Wake -- IR on");
$self->sendCmdPost ($url,$cmd);
}
sub sleep
{
# force IR off ("always day mode")
my $self=shift;
my $url = "/eng/admin/adv_audiovideo.cgi";
my $cmd = "irMode=2";
Debug("Sleep -- IR off");
$self->sendCmdPost ($url,$cmd);
}
sub reset
{
# IR auto
my $self=shift;
my $url = "/eng/admin/adv_audiovideo.cgi";
my $cmd = "irMode=0";
Debug("Reset -- IR auto");
$self->sendCmdPost ($url,$cmd);
}
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
ZoneMinder::Database - Perl extension for Trendnet TVIP672
=head1 SYNOPSIS
use ZoneMinder::Database;
stuff this in /usr/share/perl5/ZoneMinder/Control , then eat a sandwich
=head1 DESCRIPTION
Stub documentation for Trendnet TVIP672, created by Vince, updated by Michael.
=head2 EXPORT
None by default.
=head1 SEE ALSO
Read the comments at the beginning of this file to see the usage for zoneminder 1.25.0
=head1 AUTHOR
Vincent Giovannone, I'd rather you not email me; sure no problem...
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2014 by Vincent Giovannone
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
at your option, any later version of Perl 5 you may have available.
=cut

578
scripts/ZoneMinder/lib/ZoneMinder/Control/TVIP862.pm
View File

@ -1,4 +1,4 @@
# ========================================================================= #===========================================================================
# #
# ZoneMinder Trendnet TV-IP862IC IP Control Protocol Module, $Date: $, $Revision: $ # ZoneMinder Trendnet TV-IP862IC IP Control Protocol Module, $Date: $, $Revision: $
# Copyright (C) 2014 Vincent Giovannone # Copyright (C) 2014 Vincent Giovannone
@ -17,10 +17,8 @@
# #
# ========================================================================== # ==========================================================================
# #
# This module contains the implementation of the Trendnet TV-IP672PI IP camera control # This module contains the implementation of the Trendnet # IP camera control
# protocol. Also works or TV-IP862IC # protocol. Has been testing with TV-IP862IC and TV-IP672PI
#
# For Zoneminder 1.26+
# #
# Under control capability: # Under control capability:
# #
@ -33,20 +31,17 @@
# #
# Under control tab in the monitor itself: # Under control tab in the monitor itself:
# #
# * Controllable # Controllable
# * Control type is the name you gave it in control capability above # Control type is the name you gave it in control capability above
# * Control device is the password you use to authenticate to the camera (see further below if you need to change the username from "admin") # Control address is the camera's ip address AND web port. example: 192.168.1.1:80
# * Control address is the camera's ip address AND web port. example: 192.168.1.1:80 # You can also put the authentication information here and change the
# # protocol to https using something like https://admin:password@192.168.1.1:80
#
# If using with anything but a TV-IP672PI (ex: TV-IP672WI), YOU MUST MATCH THE REALM TO MATCH YOUR CAMERA FURTHER DOWN!
# #
# #
# Due to how the TVIP672 represents presets internally, you MUST define the presets in order... i.e. 1,2,3,4... not 1,10,3,4. # Due to how the TVIP672 represents presets internally, you MUST define the presets in order... i.e. 1,2,3,4... not 1,10,3,4.
# (see much further down for why, if you care...) # (see much further down for why, if you care...)
# #
package ZoneMinder::Control::TVIP862; package ZoneMinder::Control::TVIP862;
use 5.006; use 5.006;
@ -61,13 +56,14 @@ our @ISA = qw(ZoneMinder::Control);
# #
# ******** YOU MUST CHANGE THE FOLLOWING LINES TO MATCH YOUR CAMERA! ********** # ******** YOU MUST CHANGE THE FOLLOWING LINES TO MATCH YOUR CAMERA! **********
# #
# I assume that "TV-IP672WI" would work for the TV-IP672WI, but can't test since I don't own one. # You do not need to change the REALM, but you can get slightly faster response
# by setting so that the first auth request succeeds.
# #
# TV-IP672PI works for the PI version, of course. # The username and password should be passed in the ControlDevice field but you
# # can set them here if you want.
# Finally, the username is the username you'd like to authenticate as.
# #
our $REALM = 'TV-IP862IC'; our $REALM = 'TV-IP862IC';
our $PROTOCOL = 'http://';
our $USERNAME = 'admin'; our $USERNAME = 'admin';
our $PASSWORD = ''; our $PASSWORD = '';
our $ADDRESS = ''; our $ADDRESS = '';
@ -81,333 +77,307 @@ our $ADDRESS = '';
use ZoneMinder::Logger qw(:all); use ZoneMinder::Logger qw(:all);
use ZoneMinder::Config qw(:all); use ZoneMinder::Config qw(:all);
sub open sub open {
{ my $self = shift;
my $self = shift; $self->loadMonitor();
$self->loadMonitor();
my ( $protocol, $username, $password, $address ) if ( ( $self->{Monitor}->{ControlAddress} =~ /^(?<PROTOCOL>https?:\/\/)?(?<USERNAME>[^:@]+)?:?(?<PASSWORD>[^\/@]+)?@?(?<ADDRESS>.*)$/ ) ) {
= $self->{Monitor}->{ControlAddress} =~ /^(https?:\/\/)?([^:]+):([^\/@]+)@(.*)$/; $PROTOCOL = $+{PROTOCOL} if $+{PROTOCOL};
if ( $username ) { $USERNAME = $+{USERNAME} if $+{USERNAME};
$USERNAME = $username; $PASSWORD = $+{PASSWORD} if $+{PASSWORD};
$PASSWORD = $password; $ADDRESS = $+{ADDRESS} if $+{ADDRESS};
$ADDRESS = $address; } else {
} else { Error('Failed to parse auth from address ' . $self->{Monitor}->{ControlAddress});
Error( "Failed to parse auth from address"); $ADDRESS = $self->{Monitor}->{ControlAddress};
$ADDRESS = $self->{Monitor}->{ControlAddress}; }
} if ( !($ADDRESS =~ /:/) ) {
if ( ! $ADDRESS =~ /:/ ) { Error('You generally need to also specify the port. I will append :80');
Error( "You generally need to also specify the port. I will append :80" ); $ADDRESS .= ':80';
$ADDRESS .= ':80'; }
}
use LWP::UserAgent; use LWP::UserAgent;
$self->{ua} = LWP::UserAgent->new; $self->{ua} = LWP::UserAgent->new;
$self->{ua}->agent( "ZoneMinder Control Agent/".$ZoneMinder::Base::ZM_VERSION ); $self->{ua}->agent('ZoneMinder Control Agent/'.$ZoneMinder::Base::ZM_VERSION);
$self->{state} = 'closed';
# credentials: ("ip:port" (no prefix!), realm (string), username (string), password (string)
Debug ( "sendCmd credentials control address:'".$ADDRESS
."' realm:'" . $REALM
. "' username:'" . $USERNAME
. "' password:'".$PASSWORD
."'"
);
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
# Detect REALM
my $res = $self->{ua}->get($PROTOCOL.$ADDRESS.'/cgi/ptdc.cgi');
if ( $res->is_success ) {
$self->{state} = 'open'; $self->{state} = 'open';
# credentials: ("ip:port" (no prefix!), realm (string), username (string), password (string) return;
Debug ( "sendCmd credentials control address:'".$ADDRESS }
."' realm:'" . $REALM
. "' username:'" . $USERNAME
. "' password:'".$PASSWORD
."'"
);
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
# Detect REALM if ( $res->status_line() eq '401 Unauthorized' ) {
my $req = HTTP::Request->new( GET=>"http://".$ADDRESS."/cgi/ptdc.cgi" );
my $res = $self->{ua}->request($req);
if ( ! $res->is_success ) { my $headers = $res->headers();
Debug("Need newer REALM"); foreach my $k ( keys %$headers ) {
if ( $res->status_line() eq '401 Unauthorized' ) { Debug("Initial Header $k => $$headers{$k}");
my $headers = $res->headers();
foreach my $k ( keys %$headers ) {
Debug("Initial Header $k => $$headers{$k}");
} # end foreach
if ( $$headers{'www-authenticate'} ) {
my ( $auth, $tokens ) = $$headers{'www-authenticate'} =~ /^(\w+)\s+(.*)$/;
if ( $tokens =~ /\w+="([^"]+)"/i ) {
$REALM = $1;
Debug( "Changing REALM to $REALM" );
$self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
} # end if
} else {
Debug("No headers line");
} # end if headers
} # end if $res->status_line() eq '401 Unauthorized'
} # end if ! $res->is_success
}
sub printMsg
{
my $self = shift;
my $msg = shift;
my $msg_len = length($msg);
Debug( $msg."[".$msg_len."]" );
}
sub sendCmd
{
# This routine is used for all moving, which are all GET commands...
my $self = shift;
my $cmd = shift;
my $result = undef;
my $url = "http://".$ADDRESS."/cgi/ptdc.cgi?command=".$cmd;
my $req = HTTP::Request->new( GET=>$url );
Debug ("sendCmd command: " . $url );
my $res = $self->{ua}->request($req);
if ( $res->is_success ) {
$result = !undef;
} else {
if ( $res->status_line() eq '401 Unauthorized' ) {
Error( "Error check failed, trying again: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
Error("Content was " . $res->content() );
my $res = $self->{ua}->request($req);
if ( $res->is_success ) {
$result = !undef;
} else {
Error("Content was " . $res->content() );
}
}
if ( ! $result ) {
Error( "Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
}
} }
return( $result ); if ( $$headers{'www-authenticate'} ) {
} my ( $auth, $tokens ) = $$headers{'www-authenticate'} =~ /^(\w+)\s+(.*)$/;
if ( $tokens =~ /\w+="([^"]+)"/i ) {
if ( $REALM ne $1 ) {
$REALM = $1;
sub sendCmdPost Debug("Changing REALM to $REALM");
{ $self->{ua}->credentials($ADDRESS,$REALM,$USERNAME,$PASSWORD);
$res = $self->{ua}->get($PROTOCOL.$ADDRESS.'/cgi/ptdc.cgi');
# if ( $res->is_success() ) {
# This routine is used for setting/clearing presets and IR commands, which are POST commands... $self->{state} = 'open';
# return;
}
my $self = shift; Error('Authentication still failed after updating REALM' . $res->status_line);
my $url = shift; $headers = $res->headers();
my $cmd = shift; foreach my $k ( keys %$headers ) {
Debug("Initial Header $k => $$headers{$k}");
my $result = undef; } # end foreach
if ($url eq undef)
{
Error ("url passed to sendCmdPost is undefined.");
return(-1);
}
Debug ("sendCmdPost url: " . $url . " cmd: " . $cmd);
my $req = HTTP::Request->new(POST => "http://".$ADDRESS.$url);
$req->content_type('application/x-www-form-urlencoded');
$req->content($cmd);
Debug ( "sendCmdPost credentials control address:'".$ADDRESS."' realm:'" . $REALM . "' username:'" . $USERNAME . "' password:'".$PASSWORD."'");
my $res = $self->{ua}->request($req);
if ( $res->is_success )
{
$result = !undef;
}
else
{
Error( "sendCmdPost Error check failed: '".$res->status_line()."' cmd:'".$cmd."'" );
if ( $res->status_line() eq '401 Unauthorized' ) {
Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD );
} else { } else {
Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD ); Error('Authentication failed, not a REALM problem');
} # endif }
} } else {
Error('Failed to match realm in tokens');
} # end if
} else {
Debug('No headers line');
} # end if headers
} # end if $res->status_line() eq '401 Unauthorized'
} # end sub open
return( $result ); sub printMsg {
my $self = shift;
my $msg = shift;
my $msg_len = length($msg);
Debug($msg.'['.$msg_len.']');
} }
sub sendCmd {
# This routine is used for all moving, which are all GET commands...
sub move my $self = shift;
{ my $cmd = shift;
my $self = shift;
my $panSteps = shift;
my $tiltSteps = shift;
my $cmd = "set_relative_pos&posX=$panSteps&posY=$tiltSteps"; my $url = $PROTOCOL.$ADDRESS.'/cgi/ptdc.cgi?command='.$cmd;
$self->sendCmd( $cmd ); my $res = $self->{ua}->get($url);
Debug('sendCmd command: ' . $url);
if ( $res->is_success ) {
return !undef;
}
Error("Error check failed: '".$res->status_line()."' cmd:'".$cmd."'");
return;
} }
sub moveRelUpLeft sub sendCmdPost {
{
my $self = shift; #
Debug( "Move Up Left" ); # This routine is used for setting/clearing presets and IR commands, which are POST commands...
$self->move(-3, 3); #
my $self = shift;
my $url = shift;
my $form = shift;
my $result = undef;
if ( $url eq undef ) {
Error('url passed to sendCmdPost is undefined.');
return -1;
}
#Debug('sendCmdPost url: ' . $url . ' cmd: ' . $cmd);
my $res;
$res = $self->{ua}->post(
$PROTOCOL.$ADDRESS.$url,
Referer=>$PROTOCOL.$ADDRESS.$url,
Content=>$form
);
Debug("sendCmdPost credentials control to: $PROTOCOL$ADDRESS$url realm:'" . $REALM . "' username:'" . $USERNAME . "' password:'".$PASSWORD."'");
if ( $res->is_success ) {
return !undef;
}
Error("sendCmdPost Error check failed: '".$res->status_line()."' cmd:");
return $result;
} # end sub sendCmdPost
sub move {
my $self = shift;
my $panSteps = shift;
my $tiltSteps = shift;
my $cmd = "set_relative_pos&posX=$panSteps&posY=$tiltSteps";
$self->sendCmd($cmd);
} }
sub moveRelUp sub moveRelUpLeft {
{ my $self = shift;
my $self = shift; Debug('Move Up Left');
Debug( "Move Up" ); $self->move(-3, 3);
$self->move(0, 3);
} }
sub moveRelUpRight sub moveRelUp {
{ my $self = shift;
my $self = shift; Debug('Move Up');
Debug( "Move Up Right" ); $self->move(0, 3);
$self->move(3, 3);
} }
sub moveRelLeft sub moveRelUpRight {
{ my $self = shift;
my $self = shift; Debug('Move Up Right');
Debug( "Move Left" ); $self->move(3, 3);
$self->move(-3, 0);
} }
sub moveRelRight sub moveRelLeft {
{ my $self = shift;
my $self = shift; Debug('Move Left');
Debug( "Move Right" ); $self->move(-3, 0);
$self->move(3, 0);
} }
sub moveRelDownLeft sub moveRelRight {
{ my $self = shift;
my $self = shift; Debug('Move Right');
Debug( "Move Down Left" ); $self->move(3, 0);
$self->move(-3, -3);
} }
sub moveRelDown sub moveRelDownLeft {
{ my $self = shift;
my $self = shift; Debug('Move Down Left');
Debug( "Move Down" ); $self->move(-3, -3);
$self->move(0, -3);
} }
sub moveRelDownRight sub moveRelDown {
{ my $self = shift;
my $self = shift; Debug('Move Down');
Debug( "Move Down Right" ); $self->move(0, -3);
$self->move(3, -3);
} }
sub moveRelDownRight {
my $self = shift;
Debug('Move Down Right');
$self->move(3, -3);
}
# moves the camera to center on the point that the user clicked on in the video image. # moves the camera to center on the point that the user clicked on in the video image.
# This isn't mega accurate but good enough for most purposes # This isn't mega accurate but good enough for most purposes
sub moveMap sub moveMap {
{
# If the camera moves too much, increase hscale and vscale. (...if it doesn't move enough, try decreasing!) # If the camera moves too much, increase hscale and vscale. (...if it doesn't move enough, try decreasing!)
# They scale the movement and are here to compensate for manufacturing variation. # They scale the movement and are here to compensate for manufacturing variation.
# It's never going to be perfect, so just get somewhere in the ballpark and call it a day. # It's never going to be perfect, so just get somewhere in the ballpark and call it a day.
# (Don't forget to kill the zmcontrol process while tweaking!) # (Don't forget to kill the zmcontrol process while tweaking!)
# 1280x800 # 1280x800
my $hscale = 31; my $hscale = 31;
my $vscale = 25; my $vscale = 25;
# 1280x800 with fisheye # 1280x800 with fisheye
#my $hscale = 15; #my $hscale = 15;
#my $vscale = 15; #my $vscale = 15;
# 640x400 # 640x400
#my $hscale = 14; #my $hscale = 14;
#my $vscale = 12; #my $vscale = 12;
my $self = shift; my $self = shift;
my $params = shift; my $params = shift;
my $xcoord = $self->getParam( $params, 'xcoord' ); my $xcoord = $self->getParam( $params, 'xcoord' );
my $ycoord = $self->getParam( $params, 'ycoord' ); my $ycoord = $self->getParam( $params, 'ycoord' );
my $hor = ($xcoord - ($self->{Monitor}->{Width} / 2))/$hscale; my $hor = ($xcoord - ($self->{Monitor}->{Width} / 2))/$hscale;
my $ver = ($ycoord - ($self->{Monitor}->{Height} / 2))/$vscale; my $ver = ($ycoord - ($self->{Monitor}->{Height} / 2))/$vscale;
$hor = int($hor); $hor = int($hor);
$ver = -1 * int($ver); $ver = -1 * int($ver);
Debug( "Move Map to $xcoord,$ycoord, hor=$hor, ver=$ver" ); Debug("Move Map to $xcoord,$ycoord, hor=$hor, ver=$ver");
$self->move( $hor, $ver ); $self->move($hor, $ver);
} }
# **** PRESETS **** # **** PRESETS ****
# #
# OK, presets work a little funky but they DO work, provided you define them in order and don't skip any. # OK, presets work a little funky but they DO work, provided you define them
# in order and don't skip any.
# #
# The problem is that when you load the web page for this camera, it gives a list of preset names tied to index numbers. # The problem is that when you load the web page for this camera, it gives a
# So let's say you have four presets... A, B, C, and D, and defined them in that order. # list of preset names tied to index numbers.
# So A is index 0, B is index 1, C is index 2, D is index 3. When you tell the camera to go to a preset, you actually tell it by number, not by name. # So let's say you have four presets... A, B, C, and D, and defined them in
# that order.
# So A is index 0, B is index 1, C is index 2, D is index 3. When you tell
# the camera to go to a preset, you actually tell it by number, not by name.
# (So "Go to D" is really "go to index 3".) # (So "Go to D" is really "go to index 3".)
# #
# Now let's say somebody deletes C via the camera's web GUI. The camera re-numbers the existing presets A=0, B=1, D=2. # Now let's say somebody deletes C via the camera's web GUI. The camera
# There's really no easy way for ZM to discover this re-numbering, so zoneminder would still send "go to preset 3" thinking # re-numbers the existing presets A=0, B=1, D=2.
# it's telling the camera to go to point D. In actuality it's telling the camera to go to a preset that no longer exists. # There's really no easy way for ZM to discover this re-numbering, so
# zoneminder would still send "go to preset 3" thinking
# it's telling the camera to go to point D. In actuality it's telling the
# camera to go to a preset that no longer exists.
# #
# As long as you define your presets in order (i.e. define preset 1, then preset 2, then preset 3, etc.) everything will work just # As long as you define your presets in order (i.e. define preset 1, then
# preset 2, then preset 3, etc.) everything will work just
# fine in ZoneMinder. # fine in ZoneMinder.
# #
# (Home preset needs to be set via the camera's web gui, and is unaffected by any of this.) # (Home preset needs to be set via the camera's web gui, and is unaffected by
# any of this.)
# #
# So that's the limitation: DEFINE YOUR PRESETS IN ORDER THROUGH (and only through!) ZM AND DON'T SKIP ANY. # So that's the limitation: DEFINE YOUR PRESETS IN ORDER THROUGH (and only
# through!) ZM AND DON'T SKIP ANY.
# #
sub presetClear {
sub presetClear my $self = shift;
{ my $params = shift;
my $self = shift; my $preset = $self->getParam($params, 'preset');
my $params = shift; my $cmd = "presetName=$preset&command=del";
my $preset = $self->getParam( $params, 'preset' ); my $url = '/eng/admin/cam_control.cgi';
my $cmd = "presetName=$preset&command=del"; Debug('presetClear: ' . $preset . ' cmd: ' . $cmd);
my $url = "/eng/admin/cam_control.cgi"; $self->sendCmdPost($url,{presetName=>$preset, command=>'del'});
Debug ("presetClear: " . $preset . " cmd: " . $cmd);
$self->sendCmdPost($url,$cmd);
} }
sub presetSet {
sub presetSet my $self = shift;
{ my $params = shift;
my $self = shift; my $preset = $self->getParam($params, 'preset');
my $params = shift; my $cmd = "presetName=$preset&command=add";
my $preset = $self->getParam( $params, 'preset' ); my $url = '/eng/admin/cam_control.cgi';
my $cmd = "presetName=$preset&command=add"; Debug('presetSet ' . $preset . ' cmd: ' . $cmd);
my $url = "/eng/admin/cam_control.cgi"; $self->sendCmdPost($url,{presetName=>$preset, command=>'add', Submit=>'Add'});
Debug ("presetSet " . $preset . " cmd: " . $cmd);
$self->sendCmdPost ($url,$cmd);
} }
sub presetGoto sub presetGoto {
{ my $self = shift;
my $self = shift; my $params = shift;
my $params = shift; my $preset = $self->getParam($params, 'preset');
my $preset = $self->getParam( $params, 'preset' ); $preset = $preset - 1;
$preset = $preset - 1; Debug("Goto Preset $preset");
Debug( "Goto Preset $preset" ); my $cmd = "goto_preset_position&index=$preset";
my $cmd = "goto_preset_position&index=$preset"; $self->sendCmd($cmd);
$self->sendCmd( $cmd );
} }
sub presetHome sub presetHome {
{ my $self = shift;
my $self = shift; Debug('Home Preset');
Debug( "Home Preset" ); my $cmd = 'go_home';
my $cmd = "go_home"; $self->sendCmd($cmd);
$self->sendCmd( $cmd );
} }
# #
# **** IR CONTROLS **** # **** IR CONTROLS ****
# #
@ -419,47 +389,42 @@ sub presetHome
# Reset: Automatic IR mode. (day/night mode determined by camera) # Reset: Automatic IR mode. (day/night mode determined by camera)
# #
sub wake {
# force IR on ("always night mode")
sub wake my $self = shift;
{ my $url = '/eng/admin/adv_audiovideo.cgi';
# force IR on ("always night mode") my $cmd = 'irMode=3';
my $self = shift; Debug('Wake -- IR on');
my $url = "/eng/admin/adv_audiovideo.cgi";
my $cmd = "irMode=3";
Debug("Wake -- IR on"); $self->sendCmdPost($url,$cmd);
$self->sendCmdPost ($url,$cmd);
} }
sub sleep sub sleep {
{ # force IR off ("always day mode")
# force IR off ("always day mode")
my $self=shift; my $self = shift;
my $url = "/eng/admin/adv_audiovideo.cgi"; my $url = '/eng/admin/adv_audiovideo.cgi';
my $cmd = "irMode=2"; my $cmd = 'irMode=2';
Debug("Sleep -- IR off"); Debug('Sleep -- IR off');
$self->sendCmdPost ($url,$cmd); $self->sendCmdPost($url,$cmd);
} }
sub reset sub reset {
{ # IR auto
# IR auto
my $self=shift; my $self=shift;
my $url = "/eng/admin/adv_audiovideo.cgi"; my $url = '/eng/admin/adv_audiovideo.cgi';
my $cmd = "irMode=0"; my $cmd = 'irMode=0';
Debug("Reset -- IR auto"); Debug('Reset -- IR auto');
$self->sendCmdPost ($url,$cmd); $self->sendCmdPost($url,$cmd);
} }
1; 1;
__END__ __END__
# Below is stub documentation for your module. You'd better edit it! # Below is stub documentation for your module. You'd better edit it!
@ -471,7 +436,7 @@ ZoneMinder::Database - Perl extension for Trendnet TVIP672
=head1 SYNOPSIS =head1 SYNOPSIS
use ZoneMinder::Database; use ZoneMinder::Database;
stuff this in /usr/share/perl5/ZoneMinder/Control , then eat a sandwich place this in /usr/share/perl5/ZoneMinder/Control
=head1 DESCRIPTION =head1 DESCRIPTION
@ -490,11 +455,10 @@ Read the comments at the beginning of this file to see the usage for zoneminder
=head1 AUTHOR =head1 AUTHOR
Vincent Giovannone, I'd rather you not email me.
=head1 COPYRIGHT AND LICENSE =head1 COPYRIGHT AND LICENSE
Copyright (C) 2014 by Vincent Giovannone Copyright (C) 2018 by ZoneMinder LLC
This library is free software; you can redistribute it and/or modify This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or, it under the same terms as Perl itself, either Perl version 5.8.3 or,

17
scripts/ZoneMinder/lib/ZoneMinder/Database.pm
View File

@ -184,16 +184,19 @@ sub zmDbGetMonitor {
my $id = shift; my $id = shift;
return( undef ) if ( !defined($id) ); if ( !defined($id) ) {
croak("Undefined id in zmDbgetMonitor");
return undef ;
}
my $sql = "select * from Monitors where Id = ?"; my $sql = 'SELECT * FROM Monitors WHERE Id = ?';
my $sth = $dbh->prepare_cached( $sql ) my $sth = $dbh->prepare_cached($sql)
or croak( "Can't prepare '$sql': ".$dbh->errstr() ); or croak("Can't prepare '$sql': ".$dbh->errstr());
my $res = $sth->execute( $id ) my $res = $sth->execute($id)
or croak( "Can't execute '$sql': ".$sth->errstr() ); or croak("Can't execute '$sql': ".$sth->errstr());
my $monitor = $sth->fetchrow_hashref(); my $monitor = $sth->fetchrow_hashref();
return( $monitor ); return $monitor;
} }
sub zmDbGetMonitorAndControl { sub zmDbGetMonitorAndControl {

27
scripts/ZoneMinder/lib/ZoneMinder/Logger.pm
View File

@ -527,6 +527,7 @@ sub logPrint {
my $this = shift; my $this = shift;
my $level = shift; my $level = shift;
my $string = shift; my $string = shift;
my ($caller, undef, $line) = @_ ? @_ : caller;
if ( $level <= $this->{effectiveLevel} ) { if ( $level <= $this->{effectiveLevel} ) {
$string =~ s/[\r\n]+$//g; $string =~ s/[\r\n]+$//g;
@ -537,12 +538,14 @@ sub logPrint {
my ($seconds, $microseconds) = gettimeofday(); my ($seconds, $microseconds) = gettimeofday();
if ( $level <= $this->{fileLevel} or $level <= $this->{termLevel} ) { if ( $level <= $this->{fileLevel} or $level <= $this->{termLevel} ) {
my $message = sprintf( my $message = sprintf(
'%s.%06d %s[%d].%s [%s]' '%s.%06d %s[%d].%s [%s:%d] [%s]'
, strftime('%x %H:%M:%S', localtime($seconds)) , strftime('%x %H:%M:%S', localtime($seconds))
, $microseconds , $microseconds
, $this->{id} , $this->{id}
, $$ , $$
, $codes{$level} , $codes{$level}
, $caller
, $line
, $string , $string
); );
if ( $this->{trace} ) { if ( $this->{trace} ) {
@ -660,39 +663,39 @@ sub Dump {
sub debug { sub debug {
my $log = shift; my $log = shift;
$log->logPrint(DEBUG, @_); $log->logPrint(DEBUG, @_, caller);
} }
sub Debug( @ ) { sub Debug( @ ) {
fetch()->logPrint(DEBUG, @_); fetch()->logPrint(DEBUG, @_, caller);
} }
sub Info( @ ) { sub Info( @ ) {
fetch()->logPrint(INFO, @_); fetch()->logPrint(INFO, @_, caller);
} }
sub info { sub info {
my $log = shift; my $log = shift;
$log->logPrint(INFO, @_); $log->logPrint(INFO, @_, caller);
} }
sub Warning( @ ) { sub Warning( @ ) {
fetch()->logPrint(WARNING, @_); fetch()->logPrint(WARNING, @_, caller);
} }
sub warn { sub warn {
my $log = shift; my $log = shift;
$log->logPrint(WARNING, @_); $log->logPrint(WARNING, @_, caller);
} }
sub Error( @ ) { sub Error( @ ) {
fetch()->logPrint(ERROR, @_); fetch()->logPrint(ERROR, @_, caller);
} }
sub error { sub error {
my $log = shift; my $log = shift;
$log->logPrint(ERROR, @_); $log->logPrint(ERROR, @_, caller);
} }
sub Fatal( @ ) { sub Fatal( @ ) {
fetch()->logPrint(FATAL, @_); fetch()->logPrint(FATAL, @_, caller);
if ( $SIG{TERM} and ( $SIG{TERM} ne 'DEFAULT' ) ) { if ( $SIG{TERM} and ( $SIG{TERM} ne 'DEFAULT' ) ) {
$SIG{TERM}(); $SIG{TERM}();
} }
@ -700,7 +703,7 @@ sub Fatal( @ ) {
} }
sub Panic( @ ) { sub Panic( @ ) {
fetch()->logPrint(PANIC, @_); fetch()->logPrint(PANIC, @_, caller);
confess($_[0]); confess($_[0]);
} }

400
scripts/zmcontrol.pl.in
View File

@ -21,6 +21,195 @@
# #
# ========================================================================== # ==========================================================================
use strict;
@EXTRA_PERL_LIB@
use ZoneMinder;
use Getopt::Long;
use autouse 'Pod::Usage'=>qw(pod2usage);
use POSIX qw/strftime EPIPE/;
use Socket;
#use Data::Dumper;
use Module::Load::Conditional qw{can_load};;
use constant MAX_CONNECT_DELAY => 15;
use constant MAX_COMMAND_WAIT => 1800;
$| = 1;
$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
logInit();
my $arg_string = join( " ", @ARGV );
my $id;
my %options;
GetOptions(
'id=i' =>\$id,
'command=s' =>\$options{command},
'xcoord=i' =>\$options{xcoord},
'ycoord=i' =>\$options{ycoord},
'speed=i' =>\$options{speed},
'step=i' =>\$options{step},
'panspeed=i' =>\$options{panspeed},
'tiltspeed=i' =>\$options{tiltspeed},
'panstep=i' =>\$options{panstep},
'tiltstep=i' =>\$options{tiltstep},
'preset=i' =>\$options{preset},
'autostop' =>\$options{autostop},
) or pod2usage(-exitstatus => -1);
if ( !$id || !$options{command} ) {
print( STDERR "Please give a valid monitor id and command\n" );
pod2usage(-exitstatus => -1);
}
( $id ) = $id =~ /^(\w+)$/;
Debug("zmcontrol: arg string: $arg_string");
my $sock_file = $Config{ZM_PATH_SOCKS}.'/zmcontrol-'.$id.'.sock';
socket(CLIENT, PF_UNIX, SOCK_STREAM, 0)
or Fatal("Can't open socket: $!");
my $saddr = sockaddr_un($sock_file);
my $server_up = connect(CLIENT, $saddr);
if ( !$server_up ) {
# The server isn't there
my $monitor = zmDbGetMonitorAndControl($id);
if ( !$monitor ) {
Fatal("Unable to load control data for monitor $id");
}
my $protocol = $monitor->{Protocol};
if ( -x $protocol ) {
# Protocol is actually a script!
# Holdover from previous versions
my $command .= $protocol.' '.$arg_string;
Debug($command);
my $output = qx($command);
my $status = $? >> 8;
if ( $status || logDebugging() ) {
chomp($output);
Debug("Output: $output");
}
if ( $status ) {
Error("Command '$command' exited with status: $status");
exit($status);
}
exit(0);
}
Info("Starting control server $id/$protocol");
close(CLIENT);
if ( ! can_load( modules => { "ZoneMinder::Control::$protocol" => undef } ) ) {
Fatal("Can't load ZoneMinder::Control::$protocol\n$Module::Load::Conditional::ERROR");
}
if ( my $cpid = fork() ) {
logReinit();
# Parent process just sleep and fall through
socket(CLIENT, PF_UNIX, SOCK_STREAM, 0)
or die("Can't open socket: $!");
my $attempts = 0;
while ( !connect(CLIENT, $saddr) ) {
$attempts++;
Fatal("Can't connect: $! after $attempts attempts to $sock_file") if $attempts > MAX_CONNECT_DELAY;
sleep(1);
}
} elsif ( defined($cpid) ) {
close(STDOUT);
close(STDERR);
setpgrp();
logReinit();
Info("Control server $id/$protocol starting at "
.strftime('%y/%m/%d %H:%M:%S', localtime())
);
$0 = $0." --id $id";
my $control = "ZoneMinder::Control::$protocol"->new($id);
my $control_key = $control->getKey();
$control->loadMonitor();
$control->open();
socket(SERVER, PF_UNIX, SOCK_STREAM, 0)
or Fatal("Can't open socket: $!");
unlink($sock_file);
bind(SERVER, $saddr) or Fatal("Can't bind: $!");
listen(SERVER, SOMAXCONN) or Fatal("Can't listen: $!");
my $rin = '';
vec( $rin, fileno(SERVER), 1 ) = 1;
my $win = $rin;
my $ein = $win;
my $timeout = MAX_COMMAND_WAIT;
while( 1 ) {
my $nfound = select(my $rout = $rin, undef, undef, $timeout);
if ( $nfound > 0 ) {
if ( vec( $rout, fileno(SERVER), 1 ) ) {
my $paddr = accept(CLIENT, SERVER);
my $message = <CLIENT>;
next if !$message;
my $params = jsonDecode($message);
#Debug( Dumper( $params ) );
my $command = $params->{command};
close( CLIENT );
if ( $command eq 'quit' ) {
last;
}
$control->$command($params);
} else {
Fatal('Bogus descriptor');
}
} elsif ( $nfound < 0 ) {
if ( $! == EPIPE ) {
Error("Can't select: $!");
} else {
Fatal("Can't select: $!");
}
} else {
#print( "Select timed out\n" );
last;
}
} # end while forever
Info("Control server $id/$protocol exiting");
unlink($sock_file);
$control->close();
exit(0);
} else {
Fatal("Can't fork: $!");
}
} # end if !server up
# The server is there, connect to it
#print( "Writing commands\n" );
CLIENT->autoflush();
my $message = jsonEncode(\%options);
print(CLIENT $message);
shutdown(CLIENT, 1);
exit(0);
1;
__END__
=head1 NAME =head1 NAME
zmcontrol.pl - ZoneMinder control script zmcontrol.pl - ZoneMinder control script
@ -47,214 +236,3 @@ FIXME FIXME
--preset [ arg ] - --preset [ arg ] -
=cut =cut
use strict;
@EXTRA_PERL_LIB@
use ZoneMinder;
use Getopt::Long;
use autouse 'Pod::Usage'=>qw(pod2usage);
use POSIX qw/strftime EPIPE/;
use Socket;
#use Data::Dumper;
use Module::Load::Conditional qw{can_load};;
use constant MAX_CONNECT_DELAY => 10;
use constant MAX_COMMAND_WAIT => 1800;
$| = 1;
$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
logInit();
my $arg_string = join( " ", @ARGV );
my $id;
my %options;
GetOptions(
'id=i' =>\$id,
'command=s' =>\$options{command},
'xcoord=i' =>\$options{xcoord},
'ycoord=i' =>\$options{ycoord},
'speed=i' =>\$options{speed},
'step=i' =>\$options{step},
'panspeed=i' =>\$options{panspeed},
'tiltspeed=i' =>\$options{tiltspeed},
'panstep=i' =>\$options{panstep},
'tiltstep=i' =>\$options{tiltstep},
'preset=i' =>\$options{preset},
'autostop' =>\$options{autostop},
) or pod2usage(-exitstatus => -1);
if ( !$id || !$options{command} )
{
print( STDERR "Please give a valid monitor id and command\n" );
pod2usage(-exitstatus => -1);
}
( $id ) = $id =~ /^(\w+)$/;
Debug( $arg_string );
my $sock_file = $Config{ZM_PATH_SOCKS}.'/zmcontrol-'.$id.'.sock';
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 )
or Fatal( "Can't open socket: $!" );
my $saddr = sockaddr_un( $sock_file );
my $server_up = connect( CLIENT, $saddr );
if ( !$server_up )
{
# The server isn't there
my $monitor = zmDbGetMonitorAndControl( $id );
if ( !$monitor )
{
Fatal( "Unable to load control data for monitor $id" );
}
my $protocol = $monitor->{Protocol};
if ( -x $protocol )
{
# Protocol is actually a script!
# Holdover from previous versions
my $command .= $protocol.' '.$arg_string;
Debug( $command."\n" );
my $output = qx($command);
my $status = $? >> 8;
if ( $status || logDebugging() )
{
chomp( $output );
Debug( "Output: $output\n" );
}
if ( $status )
{
Error( "Command '$command' exited with status: $status\n" );
exit( $status );
}
exit( 0 );
}
Info( "Starting control server $id/$protocol" );
close( CLIENT );
if ( ! can_load( modules => { "ZoneMinder::Control::$protocol" => undef } ) ) {
Fatal("Can't load ZoneMinder::Control::$protocol");
}
if ( my $cpid = fork() )
{
logReinit();
# Parent process just sleep and fall through
socket( CLIENT, PF_UNIX, SOCK_STREAM, 0 )
or die( "Can't open socket: $!" );
my $attempts = 0;
while (!connect( CLIENT, $saddr ))
{
$attempts++;
Fatal( "Can't connect: $! after $attempts attempts to $sock_file" ) if ($attempts > MAX_CONNECT_DELAY);
sleep(1);
}
}
elsif ( defined($cpid) )
{
close( STDOUT );
close( STDERR );
setpgrp();
logReinit();
Info( "Control server $id/$protocol starting at "
.strftime( '%y/%m/%d %H:%M:%S', localtime() )
);
$0 = $0." --id $id";
my $control = "ZoneMinder::Control::$protocol"->new( $id );
my $control_key = $control->getKey();
$control->loadMonitor();
$control->open();
socket( SERVER, PF_UNIX, SOCK_STREAM, 0 )
or Fatal( "Can't open socket: $!" );
unlink( $sock_file );
bind( SERVER, $saddr ) or Fatal( "Can't bind: $!" );
listen( SERVER, SOMAXCONN ) or Fatal( "Can't listen: $!" );
my $rin = '';
vec( $rin, fileno(SERVER), 1 ) = 1;
my $win = $rin;
my $ein = $win;
my $timeout = MAX_COMMAND_WAIT;
while( 1 )
{
my $nfound = select( my $rout = $rin, undef, undef, $timeout );
if ( $nfound > 0 )
{
if ( vec( $rout, fileno(SERVER), 1 ) )
{
my $paddr = accept( CLIENT, SERVER );
my $message = <CLIENT>;
next if ( !$message );
my $params = jsonDecode( $message );
#Debug( Dumper( $params ) );
my $command = $params->{command};
close( CLIENT );
if ( $command eq 'quit' ) {
last;
}
$control->$command( $params );
}
else
{
Fatal( "Bogus descriptor" );
}
}
elsif ( $nfound < 0 )
{
if ( $! == EPIPE )
{
Error( "Can't select: $!" );
}
else
{
Fatal( "Can't select: $!" );
}
}
else
{
#print( "Select timed out\n" );
last;
}
}
Info( "Control server $id/$protocol exiting at "
.strftime( '%y/%m/%d %H:%M:%S', localtime() )
);
unlink( $sock_file );
$control->close();
exit( 0 );
}
else
{
Fatal( "Can't fork: $!" );
}
}
# The server is there, connect to it
#print( "Writing commands\n" );
CLIENT->autoflush();
my $message = jsonEncode( \%options );
print( CLIENT $message );
shutdown( CLIENT, 1 );
exit( 0 );