From e7fb0f649b7aaed7cab7013f2c1d80945ad177d9 Mon Sep 17 00:00:00 2001 From: Isaac Connor Date: Wed, 31 Jan 2018 16:56:14 -0500 Subject: [PATCH] move zmonvif-probe.pl to ../scripts. This is in preparation for removing the onvif library from the Zoneminder source into it's own package. --- onvif/CMakeLists.txt | 2 - onvif/scripts/CMakeLists.txt | 9 - onvif/scripts/zmonvif-probe.pl | 405 --------------------------------- 3 files changed, 416 deletions(-) delete mode 100644 onvif/scripts/CMakeLists.txt delete mode 100755 onvif/scripts/zmonvif-probe.pl diff --git a/onvif/CMakeLists.txt b/onvif/CMakeLists.txt index e1ad01556..a6b9bde4e 100644 --- a/onvif/CMakeLists.txt +++ b/onvif/CMakeLists.txt @@ -3,5 +3,3 @@ # Process the perl modules subdirectory add_subdirectory(proxy) add_subdirectory(modules) -add_subdirectory(scripts) - diff --git a/onvif/scripts/CMakeLists.txt b/onvif/scripts/CMakeLists.txt deleted file mode 100644 index 3405fa756..000000000 --- a/onvif/scripts/CMakeLists.txt +++ /dev/null @@ -1,9 +0,0 @@ -# CMakeLists.txt for the ZoneMinder perl scripts. - -# If this is an out-of-source build, copy the files we need to the binary directory -if(NOT (CMAKE_BINARY_DIR STREQUAL CMAKE_SOURCE_DIR)) - file(COPY "${CMAKE_CURRENT_SOURCE_DIR}/zmonvif-probe.pl" DESTINATION "${CMAKE_CURRENT_BINARY_DIR}") -endif(NOT (CMAKE_BINARY_DIR STREQUAL CMAKE_SOURCE_DIR)) - -# Install the perl scripts -install(FILES "${CMAKE_CURRENT_BINARY_DIR}/zmonvif-probe.pl" DESTINATION "${CMAKE_INSTALL_FULL_BINDIR}" PERMISSIONS OWNER_WRITE OWNER_READ OWNER_EXECUTE GROUP_READ GROUP_EXECUTE WORLD_READ WORLD_EXECUTE) diff --git a/onvif/scripts/zmonvif-probe.pl b/onvif/scripts/zmonvif-probe.pl deleted file mode 100755 index de6c18aa3..000000000 --- a/onvif/scripts/zmonvif-probe.pl +++ /dev/null @@ -1,405 +0,0 @@ -#!/usr/bin/perl -w -use strict; -# -# ========================================================================== -# -# ZoneMinder ONVIF Control Protocol Module -# Copyright (C) 2014 Jan M. Hochstein -# -# This program is free software; you can redistribute it and/or -# modify it under the terms of the GNU General Public License -# as published by the Free Software Foundation; either version 2 -# of the License, or (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -# -# ========================================================================== -# -# This module contains the implementation of the ONVIF capability prober -# - -use Getopt::Std; -use Data::UUID; - -require ONVIF::Client; - -require WSDiscovery10::Interfaces::WSDiscovery::WSDiscoveryPort; -require WSDiscovery10::Elements::Header; -require WSDiscovery10::Elements::Types; -require WSDiscovery10::Elements::Scopes; - -require WSDiscovery::TransportUDP; - -# -# ======================================================================== -# Globals - -my $verbose = 0; -my $soap_version = undef; -my $client; - -# ========================================================================= -# internal functions - -sub deserialize_message -{ - my ($wsdl_client, $response) = @_; - - # copied and adapted from SOAP::WSDL::Client - - # get deserializer - my $deserializer = $wsdl_client->get_deserializer(); - - if(! $deserializer) { - $deserializer = SOAP::WSDL::Factory::Deserializer->get_deserializer({ - soap_version => $wsdl_client->get_soap_version(), - %{ $wsdl_client->get_deserializer_args() }, - }); - } - # set class resolver if serializer supports it - $deserializer->set_class_resolver( $wsdl_client->get_class_resolver() ) - if ( $deserializer->can('set_class_resolver') ); - - # Try deserializing response - there may be some, - # even if transport did not succeed (got a 500 response) - if ( $response ) { - # as our faults are false, returning a success marker is the only - # reliable way of determining whether the deserializer succeeded. - # Custom deserializers may return an empty list, or undef, - # and $@ is not guaranteed to be undefined. - my ($success, $result_body, $result_header) = eval { - (1, $deserializer->deserialize( $response )); - }; - if (defined $success) { - return wantarray - ? ($result_body, $result_header) - : $result_body; - } - elsif (blessed $@) { #}&& $@->isa('SOAP::WSDL::SOAP::Typelib::Fault11')) { - return $@; - } - else { - return $deserializer->generate_fault({ - code => 'soap:Server', - role => 'urn:localhost', - message => "Error deserializing message: $@. \n" - . "Message was: \n$response" - }); - } - }; -} - - -sub interpret_messages -{ - my ($svc_discover, $services, @responses ) = @_; - - foreach my $response ( @responses ) { - - if($verbose) { - print "Received message:\n" . $response . "\n"; - } - - my $result = deserialize_message($svc_discover, $response); - if(not $result) { - if($verbose) { - print "Error deserializing message. No message returned from deserializer.\n"; - } - next; - } - - my $xaddr; - foreach my $l_xaddr (split ' ', $result->get_ProbeMatch()->get_XAddrs()) { - # find IPv4 address - if($verbose) { - print "l_xaddr = $l_xaddr\n"; - } - if($l_xaddr =~ m|//[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+[:/]|) { - $xaddr = $l_xaddr; - last; - } else { - print STDERR "Unable to find IPv4 address from xaddr $l_xaddr\n"; - } - } - - # No usable address found - next if not $xaddr; - - # ignore multiple responses from one service - next if defined $services->{$xaddr}; - $services->{$xaddr} = 1; - - print "$xaddr, " . $svc_discover->get_soap_version() . ", "; - - print "("; - my $scopes = $result->get_ProbeMatch()->get_Scopes(); - my $count = 0; - foreach my $scope(split ' ', $scopes) { - if($scope =~ m|onvif://www\.onvif\.org/(.+)/(.*)|) { - my ($attr, $value) = ($1,$2); - if( 0 < $count ++) { - print ", "; - } - print $attr . "=\'" . $value . "\'"; - } - } - print ")\n"; - } -} - -# ========================================================================= -# functions - -sub discover -{ - ## collect all responses - my @responses = (); - - no warnings 'redefine'; - - *WSDiscovery::TransportUDP::_notify_response = sub { - my ($transport, $response) = @_; - push @responses, $response; - }; - - ## try both soap versions - my %services; - - my $uuid_gen = Data::UUID->new(); - - if ( ( ! $soap_version ) or ( $soap_version eq '1.1' ) ) { - - if($verbose) { - print "Probing for SOAP 1.1\n" - } - my $svc_discover = WSDiscovery10::Interfaces::WSDiscovery::WSDiscoveryPort->new({ -# no_dispatch => '1', - }); - $svc_discover->set_soap_version('1.1'); - - my $uuid = $uuid_gen->create_str(); - - my $result = $svc_discover->ProbeOp( - { # WSDiscovery::Types::ProbeType - Types => 'http://www.onvif.org/ver10/network/wsdl:NetworkVideoTransmitter http://www.onvif.org/ver10/device/wsdl:Device', # QNameListType - Scopes => { value => '' }, - }, - WSDiscovery10::Elements::Header->new({ - Action => { value => 'http://schemas.xmlsoap.org/ws/2005/04/discovery/Probe' }, - MessageID => { value => "urn:uuid:$uuid" }, - To => { value => 'urn:schemas-xmlsoap-org:ws:2005:04:discovery' }, - }) - ); - print $result . "\n" if $verbose; - - interpret_messages($svc_discover, \%services, @responses); - @responses = (); - } # end if doing soap 1.1 - - if ( ( ! $soap_version ) or ( $soap_version eq '1.2' ) ) { - if($verbose) { - print "Probing for SOAP 1.2\n" - } - my $svc_discover = WSDiscovery10::Interfaces::WSDiscovery::WSDiscoveryPort->new({ -# no_dispatch => '1', - }); - $svc_discover->set_soap_version('1.2'); - -# copies of the same Probe message must have the same MessageID. -# This is not a copy. So we generate a new uuid. - my $uuid = $uuid_gen->create_str(); - -# Everyone else, like the nodejs onvif code and odm only ask for NetworkVideoTransmitter - my $result = $svc_discover->ProbeOp( - { # WSDiscovery::Types::ProbeType - xmlattr => { 'xmlns:dn' => 'http://www.onvif.org/ver10/network/wsdl', }, - Types => 'dn:NetworkVideoTransmitter', # QNameListType - Scopes => { value => '' }, - }, - WSDiscovery10::Elements::Header->new({ - Action => { value => 'http://schemas.xmlsoap.org/ws/2005/04/discovery/Probe' }, - MessageID => { value => "urn:uuid:$uuid" }, - To => { value => 'urn:schemas-xmlsoap-org:ws:2005:04:discovery' }, - }) - ); - print $result . "\n" if $verbose; - interpret_messages($svc_discover, \%services, @responses); - } # end if doing soap 1.2 - -} - - -sub profiles -{ -# my $result = $services{media}{ep}->GetVideoSources( { } ,, ); -# die $result if not $result; -# print $result . "\n"; - - my $result = $client->get_endpoint('media')->GetProfiles( { } ,, ); - die $result if not $result; - if($verbose) { - print "Received message:\n" . $result . "\n"; - } - - my $profiles = $result->get_Profiles(); - - foreach my $profile ( @{ $profiles } ) { - - my $token = $profile->attr()->get_token() ; - - # Specification gives conflicting values for unicast stream types, try both. - # http://www.onvif.org/onvif/ver10/media/wsdl/media.wsdl#op.GetStreamUri - foreach my $streamtype ( 'RTP_unicast', 'RTP-Unicast' ) { - $result = $client->get_endpoint('media')->GetStreamUri( { - StreamSetup => { # ONVIF::Media::Types::StreamSetup - Stream => $streamtype, # StreamType - Transport => { # ONVIF::Media::Types::Transport - Protocol => 'RTSP', # TransportProtocol - }, - }, - ProfileToken => $token, # ReferenceToken - } ,, ); - last if $result; - } - die $result if not $result; - # print $result . "\n"; - - my $VideoEncoderConfiguration = $profile->get_VideoEncoderConfiguration(); - print join(', ', $token, - $profile->get_Name(), - ( $VideoEncoderConfiguration ? ( - $VideoEncoderConfiguration->get_Encoding(), - $VideoEncoderConfiguration->get_Resolution()->get_Width(), - $VideoEncoderConfiguration->get_Resolution()->get_Height(), - $VideoEncoderConfiguration->get_RateControl()->get_FrameRateLimit(), - ) : () ), - $result->get_MediaUri()->get_Uri() , - ). "\n"; - } # end foreach profile - -# -# use message parser without schema validation ??? -# - -} - -sub move -{ - my ($dir) = @_; - - - my $result = $client->get_endpoint('ptz')->GetNodes( { } ,, ); - - die $result if not $result; - print $result . "\n"; - -} - -sub metadata -{ - my $result = $client->get_endpoint('media')->GetMetadataConfigurations( { } ,, ); - die $result if not $result; - print $result . "\n"; - - $result = $client->get_endpoint('media')->GetVideoAnalyticsConfigurations( { } ,, ); - die $result if not $result; - print $result . "\n"; - -# $result = $client->get_endpoint('analytics')->GetServiceCapabilities( { } ,, ); -# die $result if not $result; -# print $result . "\n"; - -} - -# ======================================================================== -# options processing - -$Getopt::Std::STANDARD_HELP_VERSION = 1; - -our ($opt_v); - -my $OPTIONS = "v"; - -sub HELP_MESSAGE -{ - my ($fh, $pkg, $ver, $opts) = @_; - print $fh "Usage: " . __FILE__ . " [-v] probe \n"; - print $fh " " . __FILE__ . " [-v] \n"; - print $fh <new( { - 'url_svc_device' => $url_svc_device, - 'soap_version' => $soap_version } ); - - $client->set_credentials($username, $password, 1); - - $client->create_services(); - - - if($action eq "profiles") { - - profiles(); - } - elsif($action eq "move") { - my $dir = shift; - move($dir); - } - elsif($action eq "metadata") { - metadata(); - } - else { - print("Error: Unknown command\"$action\""); - exit(1); - } -}