diff --git a/db/zm_create.sql.in b/db/zm_create.sql.in index 966fa9023..2bd0706ef 100644 --- a/db/zm_create.sql.in +++ b/db/zm_create.sql.in @@ -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,'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,'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 -- diff --git a/scripts/ZoneMinder/lib/ZoneMinder/Control/Netcat.pm b/scripts/ZoneMinder/lib/ZoneMinder/Control/Netcat.pm index e345e5eab..efffd2d19 100644 --- a/scripts/ZoneMinder/lib/ZoneMinder/Control/Netcat.pm +++ b/scripts/ZoneMinder/lib/ZoneMinder/Control/Netcat.pm @@ -74,377 +74,351 @@ use ZoneMinder::Config qw(:all); use Time::HiRes qw( usleep ); -sub open -{ - my $self = shift; +sub open { + my $self = shift; - $self->loadMonitor(); + $self->loadMonitor(); - use LWP::UserAgent; - $self->{ua} = LWP::UserAgent->new; - $self->{ua}->agent( "ZoneMinder Control Agent/".ZoneMinder::Base::ZM_VERSION ); + use LWP::UserAgent; + $self->{ua} = LWP::UserAgent->new; + $self->{ua}->agent('ZoneMinder Control Agent/'.ZoneMinder::Base::ZM_VERSION); - $self->{state} = 'open'; + $self->{state} = 'open'; } -sub printMsg -{ - my $self = shift; - my $msg = shift; - my $msg_len = length($msg); +sub printMsg { + my $self = shift; + my $msg = shift; + my $msg_len = length($msg); - Debug( $msg."[".$msg_len."]" ); + Debug($msg.'['.$msg_len.']'); } -sub sendCmd -{ - my $self = shift; - my $cmd = shift; - my $msg = shift; - my $content_type = shift; - my $result = undef; +sub sendCmd { + my $self = shift; + my $cmd = shift; + my $msg = shift; + my $content_type = shift; + my $result = undef; - printMsg( $cmd, "Tx" ); + printMsg($cmd, 'Tx'); - my $server_endpoint = "http://".$self->{Monitor}->{ControlAddress}."/$cmd"; - my $req = HTTP::Request->new( POST => $server_endpoint ); - $req->header('content-type' => $content_type); - $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 $server_endpoint = 'http://'.$self->{Monitor}->{ControlAddress}.'/'.$cmd; + my $req = HTTP::Request->new(POST => $server_endpoint); + $req->header('content-type' => $content_type); + $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); + my $res = $self->{ua}->request($req); - if ( $res->is_success ) { - $result = !undef; - } else { - Error( "After sending PTZ command, camera returned the following error:'".$res->status_line()."'" ); + if ( $res->is_success ) { + $result = !undef; + } else { + Error("After sending PTZ command, camera returned the following error:'".$res->status_line()."'"); + } + return $result; +} + +sub getCamParams { + my $self = shift; + my $msg = '000'; + 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>.*/ ) { + $CamParams{$1} = $2; } - return( $result ); -} - -sub getCamParams -{ - my $self = shift; - my $msg = '000'; - 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>.*/) { - $CamParams{$1} = $2; - } - if ($content =~ /.*(.+)<\/tt:Contrast>.*/) { - $CamParams{$1} = $2; - } - } - else - { - Error( "Unable to retrieve camera image settings:'".$res->status_line()."'" ); + if ( $content =~ /.*(.+)<\/tt:Contrast>.*/ ) { + $CamParams{$1} = $2; } + } else { + Error("Unable to retrieve camera image settings:'".$res->status_line()."'"); + } } #autoStop #This makes use of the ZoneMinder Auto Stop Timeout on the Control Tab -sub autoStop -{ - my $self = shift; - my $autostop = shift; +sub autoStop { + my $self = shift; + my $autostop = shift; - if( $autostop ) { - Debug( "Auto Stop" ); - my $cmd = 'onvif/PTZ'; - my $msg = '000truefalse'; - my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; - usleep( $autostop ); - $self->sendCmd( $cmd, $msg, $content_type ); - } + if ( $autostop ) { + Debug('Auto Stop'); + my $cmd = 'onvif/PTZ'; + my $msg = '000truefalse'; + my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; + usleep($autostop); + $self->sendCmd($cmd, $msg, $content_type); + } } # Reset the Camera -sub reset -{ - Debug( "Camera Reset" ); - my $self = shift; - my $cmd = ""; - my $msg = ''; - my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver10/device/wsdl/SystemReboot"'; - $self->sendCmd( $cmd, $msg, $content_type ); +sub reset { + Debug('Camera Reset'); + my $self = shift; + my $cmd = ''; + my $msg = ''; + my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver10/device/wsdl/SystemReboot"'; + $self->sendCmd($cmd, $msg, $content_type); } #Up Arrow -sub moveConUp -{ - Debug( "Move Up" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000'; - 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->autoStop( $self->{Monitor}->{AutoStopTimeout} ); +sub moveConUp { + Debug('Move Up'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000'; + 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->autoStop($self->{Monitor}->{AutoStopTimeout}); } #Down Arrow -sub moveConDown -{ - Debug( "Move Down" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000'; - 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->autoStop( $self->{Monitor}->{AutoStopTimeout} ); +sub moveConDown { + Debug('Move Down'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000'; + 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->autoStop($self->{Monitor}->{AutoStopTimeout}); } #Left Arrow -sub moveConLeft -{ - Debug( "Move Left" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000'; - 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->autoStop( $self->{Monitor}->{AutoStopTimeout} ); +sub moveConLeft { + Debug('Move Left'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000'; + 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->autoStop($self->{Monitor}->{AutoStopTimeout}); } #Right Arrow -sub moveConRight -{ - Debug( "Move Right" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000'; - 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->autoStop( $self->{Monitor}->{AutoStopTimeout} ); +sub moveConRight { + Debug('Move Right'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000'; + 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->autoStop($self->{Monitor}->{AutoStopTimeout}); } #Zoom In -sub zoomConTele -{ - Debug( "Zoom Tele" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000'; - 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->autoStop( $self->{Monitor}->{AutoStopTimeout} ); +sub zoomConTele { + Debug('Zoom Tele'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000'; + 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->autoStop($self->{Monitor}->{AutoStopTimeout}); } #Zoom Out -sub zoomConWide -{ - Debug( "Zoom Wide" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000'; - 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->autoStop( $self->{Monitor}->{AutoStopTimeout} ); +sub zoomConWide { + Debug('Zoom Wide'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000'; + 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->autoStop($self->{Monitor}->{AutoStopTimeout}); } #Diagonally Up Right Arrow #This camera does not have builtin diagonal commands so we emulate them -sub moveConUpRight -{ - Debug( "Move Diagonally Up Right" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000'; - 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->autoStop( $self->{Monitor}->{AutoStopTimeout} ); +sub moveConUpRight { + Debug('Move Diagonally Up Right'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000'; + 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->autoStop($self->{Monitor}->{AutoStopTimeout}); } #Diagonally Down Right Arrow #This camera does not have builtin diagonal commands so we emulate them -sub moveConDownRight -{ - Debug( "Move Diagonally Down Right" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000'; - 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->autoStop( $self->{Monitor}->{AutoStopTimeout} ); +sub moveConDownRight { + Debug('Move Diagonally Down Right'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000'; + 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->autoStop($self->{Monitor}->{AutoStopTimeout}); } #Diagonally Up Left Arrow #This camera does not have builtin diagonal commands so we emulate them -sub moveConUpLeft -{ - Debug( "Move Diagonally Up Left" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000'; - 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->autoStop( $self->{Monitor}->{AutoStopTimeout} ); +sub moveConUpLeft { + Debug('Move Diagonally Up Left'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000'; + 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->autoStop($self->{Monitor}->{AutoStopTimeout}); } #Diagonally Down Left Arrow #This camera does not have builtin diagonal commands so we emulate them -sub moveConDownLeft -{ - Debug( "Move Diagonally Down Left" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000'; - 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->autoStop( $self->{Monitor}->{AutoStopTimeout} ); +sub moveConDownLeft { + Debug('Move Diagonally Down Left'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000'; + 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->autoStop($self->{Monitor}->{AutoStopTimeout}); } #Stop -sub moveStop -{ - Debug( "Move Stop" ); - my $self = shift; - my $cmd = 'onvif/PTZ'; - my $msg ='000truefalse'; - my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; - $self->sendCmd( $cmd, $msg, $content_type ); +sub moveStop { + Debug('Move Stop'); + my $self = shift; + my $cmd = 'onvif/PTZ'; + my $msg ='000truefalse'; + my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/ContinuousMove"'; + $self->sendCmd($cmd, $msg, $content_type); } #Set Camera Preset -sub presetSet -{ - my $self = shift; - my $params = shift; - my $preset = $self->getParam( $params, 'preset' ); - Debug( "Set Preset $preset" ); - my $cmd = 'onvif/PTZ'; - my $msg ='000'.$preset.''; - my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/SetPreset"'; - $self->sendCmd( $cmd, $msg, $content_type ); +sub presetSet { + my $self = shift; + my $params = shift; + my $preset = $self->getParam($params, 'preset'); + Debug("Set Preset $preset"); + my $cmd = 'onvif/PTZ'; + my $msg ='000'.$preset.''; + my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/SetPreset"'; + $self->sendCmd($cmd, $msg, $content_type); } #Recall Camera Preset -sub presetGoto -{ - my $self = shift; - my $params = shift; - my $preset = $self->getParam( $params, 'preset' ); - Debug( "Goto Preset $preset" ); - my $cmd = 'onvif/PTZ'; - my $msg ='000'.$preset.''; - my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/GotoPreset"'; - $self->sendCmd( $cmd, $msg, $content_type ); +sub presetGoto { + my $self = shift; + my $params = shift; + my $preset = $self->getParam($params, 'preset'); + Debug("Goto Preset $preset"); + my $cmd = 'onvif/PTZ'; + my $msg ='000'.$preset.''; + my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/ptz/wsdl/GotoPreset"'; + $self->sendCmd( $cmd, $msg, $content_type ); } #Horizontal Patrol #To be determined if this camera supports this feature -sub horizontalPatrol -{ - Debug( "Horizontal Patrol" ); - my $self = shift; - my $cmd = ''; - my $msg =''; - my $content_type = ''; -# $self->sendCmd( $cmd, $msg, $content_type ); - Error( "PTZ Command not implemented in control script." ); +sub horizontalPatrol { + Debug('Horizontal Patrol'); + my $self = shift; + my $cmd = ''; + my $msg =''; + my $content_type = ''; + # $self->sendCmd( $cmd, $msg, $content_type ); + Error('PTZ Command not implemented in control script.'); } #Horizontal Patrol Stop #To be determined if this camera supports this feature -sub horizontalPatrolStop -{ - Debug( "Horizontal Patrol Stop" ); - my $self = shift; - my $cmd = ''; - my $msg =''; - my $content_type = ''; -# $self->sendCmd( $cmd, $msg, $content_type ); - Error( "PTZ Command not implemented in control script." ); +sub horizontalPatrolStop { + Debug('Horizontal Patrol Stop'); + my $self = shift; + my $cmd = ''; + my $msg =''; + my $content_type = ''; + # $self->sendCmd( $cmd, $msg, $content_type ); + Error('PTZ Command not implemented in control script.'); } # Increase Brightness -sub irisAbsOpen -{ - Debug( "Iris $CamParams{'Brightness'}" ); - my $self = shift; - my $params = shift; - $self->getCamParams() unless($CamParams{'Brightness'}); - my $step = $self->getParam( $params, 'step' ); - my $max = 100; +sub irisAbsOpen { + Debug("Iris $CamParams{Brightness}"); + my $self = shift; + my $params = shift; + $self->getCamParams() unless($CamParams{Brightness}); + my $step = $self->getParam($params, 'step'); + my $max = 100; - $CamParams{'Brightness'} += $step; - $CamParams{'Brightness'} = $max if ($CamParams{'Brightness'} > $max); + $CamParams{Brightness} += $step; + $CamParams{Brightness} = $max if ($CamParams{Brightness} > $max); - my $cmd = 'onvif/imaging'; - my $msg ='000'.$CamParams{'Brightness'}.'true'; - my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; - $self->sendCmd( $cmd, $msg, $content_type ); + my $cmd = 'onvif/imaging'; + my $msg ='000'.$CamParams{Brightness}.'true'; + my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; + $self->sendCmd( $cmd, $msg, $content_type ); } # Decrease Brightness sub irisAbsClose { - Debug( "Iris $CamParams{'Brightness'}" ); - my $self = shift; - my $params = shift; - $self->getCamParams() unless($CamParams{'brightness'}); - my $step = $self->getParam( $params, 'step' ); - my $min = 0; + Debug( "Iris $CamParams{Brightness}" ); + my $self = shift; + my $params = shift; + $self->getCamParams() unless($CamParams{brightness}); + my $step = $self->getParam( $params, 'step' ); + my $min = 0; - $CamParams{'Brightness'} -= $step; - $CamParams{'Brightness'} = $min if ($CamParams{'Brightness'} < $min); + $CamParams{Brightness} -= $step; + $CamParams{Brightness} = $min if ($CamParams{Brightness} < $min); - my $cmd = 'onvif/imaging'; - my $msg ='000'.$CamParams{'Brightness'}.'true'; - my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; - $self->sendCmd( $cmd, $msg, $content_type ); + my $cmd = 'onvif/imaging'; + my $msg ='000'.$CamParams{Brightness}.'true'; + my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; + $self->sendCmd( $cmd, $msg, $content_type ); } # Increase Contrast -sub whiteAbsIn -{ - Debug( "Iris $CamParams{'Contrast'}" ); - my $self = shift; - my $params = shift; - $self->getCamParams() unless($CamParams{'Contrast'}); - my $step = $self->getParam( $params, 'step' ); - my $max = 100; +sub whiteAbsIn { + Debug("Iris $CamParams{Contrast}"); + my $self = shift; + my $params = shift; + $self->getCamParams() unless($CamParams{Contrast}); + my $step = $self->getParam( $params, 'step' ); + my $max = 100; - $CamParams{'Contrast'} += $step; - $CamParams{'Contrast'} = $max if ($CamParams{'Contrast'} > $max); + $CamParams{Contrast} += $step; + $CamParams{Contrast} = $max if ($CamParams{Contrast} > $max); - my $cmd = 'onvif/imaging'; - my $msg ='000'.$CamParams{'Contrast'}.'true'; - my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; + my $cmd = 'onvif/imaging'; + my $msg ='000'.$CamParams{Contrast}.'true'; + my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; } # Decrease Contrast -sub whiteAbsOut -{ - Debug( "Iris $CamParams{'Contrast'}" ); - my $self = shift; - my $params = shift; - $self->getCamParams() unless($CamParams{'Contrast'}); - my $step = $self->getParam( $params, 'step' ); - my $min = 0; +sub whiteAbsOut { + Debug("Iris $CamParams{Contrast}"); + my $self = shift; + my $params = shift; + $self->getCamParams() unless($CamParams{Contrast}); + my $step = $self->getParam($params, 'step'); + my $min = 0; - $CamParams{'Contrast'} -= $step; - $CamParams{'Contrast'} = $min if ($CamParams{'Contrast'} < $min); + $CamParams{Contrast} -= $step; + $CamParams{Contrast} = $min if ($CamParams{Contrast} < $min); - my $cmd = 'onvif/imaging'; - my $msg ='000'.$CamParams{'Contrast'}.'true'; - my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; + my $cmd = 'onvif/imaging'; + my $msg ='000'.$CamParams{Contrast}.'true'; + my $content_type = 'application/soap+xml; charset=utf-8; action="http://www.onvif.org/ver20/imaging/wsdl/SetImagingSettings"'; } 1; - +__END__ diff --git a/scripts/ZoneMinder/lib/ZoneMinder/Control/TVIP672WI.pm b/scripts/ZoneMinder/lib/ZoneMinder/Control/TVIP672WI.pm new file mode 100644 index 000000000..4828b65b0 --- /dev/null +++ b/scripts/ZoneMinder/lib/ZoneMinder/Control/TVIP672WI.pm @@ -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 \ No newline at end of file diff --git a/scripts/ZoneMinder/lib/ZoneMinder/Control/TVIP862.pm b/scripts/ZoneMinder/lib/ZoneMinder/Control/TVIP862.pm index 827540dce..ec6e5a95e 100644 --- a/scripts/ZoneMinder/lib/ZoneMinder/Control/TVIP862.pm +++ b/scripts/ZoneMinder/lib/ZoneMinder/Control/TVIP862.pm @@ -1,4 +1,4 @@ -# ========================================================================= +#=========================================================================== # # ZoneMinder Trendnet TV-IP862IC IP Control Protocol Module, $Date: $, $Revision: $ # Copyright (C) 2014 Vincent Giovannone @@ -17,10 +17,8 @@ # # ========================================================================== # -# This module contains the implementation of the Trendnet TV-IP672PI IP camera control -# protocol. Also works or TV-IP862IC -# -# For Zoneminder 1.26+ +# This module contains the implementation of the Trendnet # IP camera control +# protocol. Has been testing with TV-IP862IC and TV-IP672PI # # Under control capability: # @@ -33,20 +31,17 @@ # # Under control tab in the monitor itself: # -# * Controllable -# * 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 -# -# -# If using with anything but a TV-IP672PI (ex: TV-IP672WI), YOU MUST MATCH THE REALM TO MATCH YOUR CAMERA FURTHER DOWN! +# Controllable +# Control type is the name you gave it in control capability above +# 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 # # # 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...) # - package ZoneMinder::Control::TVIP862; use 5.006; @@ -61,13 +56,14 @@ 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-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. -# -# Finally, the username is the username you'd like to authenticate as. +# The username and password should be passed in the ControlDevice field but you +# can set them here if you want. # our $REALM = 'TV-IP862IC'; +our $PROTOCOL = 'http://'; our $USERNAME = 'admin'; our $PASSWORD = ''; our $ADDRESS = ''; @@ -81,333 +77,307 @@ our $ADDRESS = ''; use ZoneMinder::Logger qw(:all); use ZoneMinder::Config qw(:all); -sub open -{ - my $self = shift; - $self->loadMonitor(); +sub open { + my $self = shift; + $self->loadMonitor(); - my ( $protocol, $username, $password, $address ) - = $self->{Monitor}->{ControlAddress} =~ /^(https?:\/\/)?([^:]+):([^\/@]+)@(.*)$/; - if ( $username ) { - $USERNAME = $username; - $PASSWORD = $password; - $ADDRESS = $address; - } else { - Error( "Failed to parse auth from address"); - $ADDRESS = $self->{Monitor}->{ControlAddress}; - } - if ( ! $ADDRESS =~ /:/ ) { - Error( "You generally need to also specify the port. I will append :80" ); - $ADDRESS .= ':80'; - } + if ( ( $self->{Monitor}->{ControlAddress} =~ /^(?https?:\/\/)?(?[^:@]+)?:?(?[^\/@]+)?@?(?
.*)$/ ) ) { + $PROTOCOL = $+{PROTOCOL} if $+{PROTOCOL}; + $USERNAME = $+{USERNAME} if $+{USERNAME}; + $PASSWORD = $+{PASSWORD} if $+{PASSWORD}; + $ADDRESS = $+{ADDRESS} if $+{ADDRESS}; + } else { + Error('Failed to parse auth from address ' . $self->{Monitor}->{ControlAddress}); + $ADDRESS = $self->{Monitor}->{ControlAddress}; + } + if ( !($ADDRESS =~ /:/) ) { + Error('You generally need to also specify the port. I will append :80'); + $ADDRESS .= ':80'; + } - use LWP::UserAgent; - $self->{ua} = LWP::UserAgent->new; - $self->{ua}->agent( "ZoneMinder Control Agent/".$ZoneMinder::Base::ZM_VERSION ); + use LWP::UserAgent; + $self->{ua} = LWP::UserAgent->new; + $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'; -# 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); + return; + } - # Detect REALM - my $req = HTTP::Request->new( GET=>"http://".$ADDRESS."/cgi/ptdc.cgi" ); - my $res = $self->{ua}->request($req); + if ( $res->status_line() eq '401 Unauthorized' ) { - if ( ! $res->is_success ) { - Debug("Need newer REALM"); - if ( $res->status_line() eq '401 Unauthorized' ) { - 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."'" ); - } + my $headers = $res->headers(); + foreach my $k ( keys %$headers ) { + Debug("Initial Header $k => $$headers{$k}"); } - 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 ); + if ( $$headers{'www-authenticate'} ) { + my ( $auth, $tokens ) = $$headers{'www-authenticate'} =~ /^(\w+)\s+(.*)$/; + if ( $tokens =~ /\w+="([^"]+)"/i ) { + if ( $REALM ne $1 ) { + $REALM = $1; + 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() ) { + $self->{state} = 'open'; + return; + } + Error('Authentication still failed after updating REALM' . $res->status_line); + $headers = $res->headers(); + foreach my $k ( keys %$headers ) { + Debug("Initial Header $k => $$headers{$k}"); + } # end foreach } else { - Error( "sendCmdPost Error check failed: USERNAME: $USERNAME realm: $REALM password: " . $PASSWORD ); - } # endif - } + Error('Authentication failed, not a REALM problem'); + } + } 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 $panSteps = shift; - my $tiltSteps = shift; + my $self = shift; + my $cmd = shift; - my $cmd = "set_relative_pos&posX=$panSteps&posY=$tiltSteps"; - $self->sendCmd( $cmd ); + my $url = $PROTOCOL.$ADDRESS.'/cgi/ptdc.cgi?command='.$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 -{ - my $self = shift; - Debug( "Move Up Left" ); - $self->move(-3, 3); +sub sendCmdPost { + + # + # This routine is used for setting/clearing presets and IR commands, which are POST commands... + # + + 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 -{ - my $self = shift; - Debug( "Move Up" ); - $self->move(0, 3); +sub moveRelUpLeft { + my $self = shift; + Debug('Move Up Left'); + $self->move(-3, 3); } -sub moveRelUpRight -{ - my $self = shift; - Debug( "Move Up Right" ); - $self->move(3, 3); +sub moveRelUp { + my $self = shift; + Debug('Move Up'); + $self->move(0, 3); } -sub moveRelLeft -{ - my $self = shift; - Debug( "Move Left" ); - $self->move(-3, 0); +sub moveRelUpRight { + my $self = shift; + Debug('Move Up Right'); + $self->move(3, 3); } -sub moveRelRight -{ - my $self = shift; - Debug( "Move Right" ); - $self->move(3, 0); +sub moveRelLeft { + my $self = shift; + Debug('Move Left'); + $self->move(-3, 0); } -sub moveRelDownLeft -{ - my $self = shift; - Debug( "Move Down Left" ); - $self->move(-3, -3); +sub moveRelRight { + my $self = shift; + Debug('Move Right'); + $self->move(3, 0); } -sub moveRelDown -{ - my $self = shift; - Debug( "Move Down" ); - $self->move(0, -3); +sub moveRelDownLeft { + my $self = shift; + Debug('Move Down Left'); + $self->move(-3, -3); } -sub moveRelDownRight -{ - my $self = shift; - Debug( "Move Down Right" ); - $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 -{ +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!) + # 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 + my $hscale = 31; + my $vscale = 25; - # 1280x800 with fisheye - #my $hscale = 15; - #my $vscale = 15; + # 1280x800 with fisheye + #my $hscale = 15; + #my $vscale = 15; - # 640x400 - #my $hscale = 14; - #my $vscale = 12; + # 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 $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; + 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 ); + $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. +# 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. +# 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. +# 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 +# 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.) +# (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 -{ - 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 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,{presetName=>$preset, command=>'del'}); } - -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 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,{presetName=>$preset, command=>'add', Submit=>'Add'}); } -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 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 ); +sub presetHome { + my $self = shift; + Debug('Home Preset'); + my $cmd = 'go_home'; + $self->sendCmd($cmd); } - # # **** IR CONTROLS **** # @@ -419,47 +389,42 @@ sub presetHome # Reset: Automatic IR mode. (day/night mode determined by camera) # +sub wake { + # force IR on ("always night mode") -sub wake -{ - # force IR on ("always night mode") + my $self = shift; + my $url = '/eng/admin/adv_audiovideo.cgi'; + my $cmd = 'irMode=3'; - my $self = shift; - my $url = "/eng/admin/adv_audiovideo.cgi"; - my $cmd = "irMode=3"; + Debug('Wake -- IR on'); - Debug("Wake -- IR on"); - - $self->sendCmdPost ($url,$cmd); + $self->sendCmdPost($url,$cmd); } -sub sleep -{ - # force IR off ("always day mode") +sub sleep { + # force IR off ("always day mode") - my $self=shift; - my $url = "/eng/admin/adv_audiovideo.cgi"; - my $cmd = "irMode=2"; + my $self = shift; + my $url = '/eng/admin/adv_audiovideo.cgi'; + my $cmd = 'irMode=2'; - Debug("Sleep -- IR off"); + Debug('Sleep -- IR off'); - $self->sendCmdPost ($url,$cmd); + $self->sendCmdPost($url,$cmd); } -sub reset -{ - # IR auto +sub reset { + # IR auto - my $self=shift; - my $url = "/eng/admin/adv_audiovideo.cgi"; - my $cmd = "irMode=0"; + my $self=shift; + my $url = '/eng/admin/adv_audiovideo.cgi'; + my $cmd = 'irMode=0'; - Debug("Reset -- IR auto"); + Debug('Reset -- IR auto'); - $self->sendCmdPost ($url,$cmd); + $self->sendCmdPost($url,$cmd); } - 1; __END__ # 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 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 @@ -490,11 +455,10 @@ Read the comments at the beginning of this file to see the usage for zoneminder =head1 AUTHOR -Vincent Giovannone, I'd rather you not email me. =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 it under the same terms as Perl itself, either Perl version 5.8.3 or, diff --git a/scripts/ZoneMinder/lib/ZoneMinder/Database.pm b/scripts/ZoneMinder/lib/ZoneMinder/Database.pm index fcc1392a2..12e3c7065 100644 --- a/scripts/ZoneMinder/lib/ZoneMinder/Database.pm +++ b/scripts/ZoneMinder/lib/ZoneMinder/Database.pm @@ -184,16 +184,19 @@ sub zmDbGetMonitor { 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 $sth = $dbh->prepare_cached( $sql ) - or croak( "Can't prepare '$sql': ".$dbh->errstr() ); - my $res = $sth->execute( $id ) - or croak( "Can't execute '$sql': ".$sth->errstr() ); + my $sql = 'SELECT * FROM Monitors WHERE Id = ?'; + my $sth = $dbh->prepare_cached($sql) + or croak("Can't prepare '$sql': ".$dbh->errstr()); + my $res = $sth->execute($id) + or croak("Can't execute '$sql': ".$sth->errstr()); my $monitor = $sth->fetchrow_hashref(); - return( $monitor ); + return $monitor; } sub zmDbGetMonitorAndControl { diff --git a/scripts/ZoneMinder/lib/ZoneMinder/Logger.pm b/scripts/ZoneMinder/lib/ZoneMinder/Logger.pm index b58b98003..bac118a13 100644 --- a/scripts/ZoneMinder/lib/ZoneMinder/Logger.pm +++ b/scripts/ZoneMinder/lib/ZoneMinder/Logger.pm @@ -527,6 +527,7 @@ sub logPrint { my $this = shift; my $level = shift; my $string = shift; + my ($caller, undef, $line) = @_ ? @_ : caller; if ( $level <= $this->{effectiveLevel} ) { $string =~ s/[\r\n]+$//g; @@ -537,12 +538,14 @@ sub logPrint { my ($seconds, $microseconds) = gettimeofday(); if ( $level <= $this->{fileLevel} or $level <= $this->{termLevel} ) { my $message = sprintf( - '%s.%06d %s[%d].%s [%s]' + '%s.%06d %s[%d].%s [%s:%d] [%s]' , strftime('%x %H:%M:%S', localtime($seconds)) , $microseconds , $this->{id} , $$ , $codes{$level} + , $caller + , $line , $string ); if ( $this->{trace} ) { @@ -660,39 +663,39 @@ sub Dump { sub debug { my $log = shift; - $log->logPrint(DEBUG, @_); - } + $log->logPrint(DEBUG, @_, caller); +} sub Debug( @ ) { - fetch()->logPrint(DEBUG, @_); + fetch()->logPrint(DEBUG, @_, caller); } sub Info( @ ) { - fetch()->logPrint(INFO, @_); + fetch()->logPrint(INFO, @_, caller); } sub info { my $log = shift; - $log->logPrint(INFO, @_); + $log->logPrint(INFO, @_, caller); } sub Warning( @ ) { - fetch()->logPrint(WARNING, @_); + fetch()->logPrint(WARNING, @_, caller); } sub warn { my $log = shift; - $log->logPrint(WARNING, @_); + $log->logPrint(WARNING, @_, caller); } sub Error( @ ) { - fetch()->logPrint(ERROR, @_); + fetch()->logPrint(ERROR, @_, caller); } sub error { my $log = shift; - $log->logPrint(ERROR, @_); + $log->logPrint(ERROR, @_, caller); } sub Fatal( @ ) { - fetch()->logPrint(FATAL, @_); + fetch()->logPrint(FATAL, @_, caller); if ( $SIG{TERM} and ( $SIG{TERM} ne 'DEFAULT' ) ) { $SIG{TERM}(); } @@ -700,7 +703,7 @@ sub Fatal( @ ) { } sub Panic( @ ) { - fetch()->logPrint(PANIC, @_); + fetch()->logPrint(PANIC, @_, caller); confess($_[0]); } diff --git a/scripts/zmcontrol.pl.in b/scripts/zmcontrol.pl.in index 79aeccb10..7d7053335 100644 --- a/scripts/zmcontrol.pl.in +++ b/scripts/zmcontrol.pl.in @@ -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 = ; + + 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 zmcontrol.pl - ZoneMinder control script @@ -47,214 +236,3 @@ FIXME FIXME --preset [ arg ] - =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 = ; - - 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 );