Refactor onvif client code
This commit is contained in:
Jan M. Hochstein
parent
d290af2c9f
commit
4b896add26
|
|
@ -0,0 +1,244 @@
|
|||
# ==========================================================================
|
||||
#
|
||||
# ZoneMinder ONVIF Client module
|
||||
# Copyright (C) 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
#
|
||||
# ==========================================================================
|
||||
#
|
||||
# This module contains the implementation of the ONVIF client module
|
||||
#
|
||||
|
||||
package ONVIF::Client;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Class::Std::Fast;
|
||||
|
||||
use version; our $VERSION = qv('1.00.00');
|
||||
|
||||
require SOAP::WSDL::Transport::HTTP;
|
||||
|
||||
require WSSecurity::SecuritySerializer;
|
||||
|
||||
require ONVIF::Device::Interfaces::Device::DevicePort;
|
||||
require ONVIF::Media::Interfaces::Media::MediaPort;
|
||||
require ONVIF::PTZ::Interfaces::PTZ::PTZPort;
|
||||
require ONVIF::Analytics::Interfaces::Analytics::AnalyticsEnginePort;
|
||||
require ONVIF::Analytics::Interfaces::Analytics::RuleEnginePort;
|
||||
|
||||
use Data::Dump qw(dump);
|
||||
|
||||
# ========================================================================
|
||||
# Globals
|
||||
|
||||
my %namespace_map = (
|
||||
'http://www.onvif.org/ver10/device/wsdl' => 'device',
|
||||
'http://www.onvif.org/ver10/media/wsdl' => 'media',
|
||||
'http://www.onvif.org/ver20/imaging/wsdl' => 'imaging',
|
||||
'http://www.onvif.org/ver20/analytics/wsdl' => 'analytics',
|
||||
'http://www.onvif.org/ver10/deviceIO/wsdl' => 'deviceio',
|
||||
'http://www.onvif.org/ver10/ptz/wsdl' => 'ptz',
|
||||
'http://www.onvif.org/ver10/events/wsdl' => 'events',
|
||||
);
|
||||
|
||||
# ========================================================================
|
||||
# Attributes
|
||||
|
||||
my %services_of :ATTR(:default<{}>);
|
||||
|
||||
my %serializer_of :ATTR();
|
||||
|
||||
# =========================================================================
|
||||
# private methods
|
||||
|
||||
sub service
|
||||
{
|
||||
my ($self, $serviceName, $attr) = @_;
|
||||
$services_of{ident $self}{$serviceName}{$attr};
|
||||
}
|
||||
|
||||
sub set_service
|
||||
{
|
||||
my ($self, $serviceName, $attr, $value) = @_;
|
||||
$services_of{ident $self}{$serviceName}{$attr} = $value;
|
||||
}
|
||||
|
||||
sub serializer
|
||||
{
|
||||
my ($self) = @_;
|
||||
$serializer_of{ident $self};
|
||||
}
|
||||
|
||||
sub set_serializer
|
||||
{
|
||||
my ($self, $serializer) = @_;
|
||||
$serializer_of{ident $self} = $serializer;
|
||||
}
|
||||
|
||||
|
||||
sub get_service_urls
|
||||
{
|
||||
my ($self) = @_;
|
||||
|
||||
my $result = $self->service('device', 'ep')->GetServices( {
|
||||
IncludeCapability => 'true', # boolean
|
||||
},,
|
||||
);
|
||||
|
||||
die $result if not $result;
|
||||
# print $result . "\n";
|
||||
|
||||
foreach my $svc ( @{ $result->get_Service() } ) {
|
||||
my $short_name = $namespace_map{$svc->get_Namespace()};
|
||||
my $url_svc = $svc->get_XAddr()->get_value();
|
||||
if(defined $short_name && defined $url_svc) {
|
||||
# print "Got $short_name service\n";
|
||||
$self->set_service($short_name, 'url', $url_svc);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub http_digest {
|
||||
my ($service, $username, $password) = @_;
|
||||
|
||||
# my $transport = SecurityTransport->new();
|
||||
# $transport->set_username($username);
|
||||
# $transport->set_password($password);
|
||||
|
||||
# warn "transport: " . $service->get_transport();
|
||||
|
||||
*SOAP::Transport::HTTP::Client::get_basic_credentials = sub {
|
||||
#*SOAP::WSDL::Transport::HTTP::get_basic_credentials = sub {
|
||||
my ($self, $realm, $uri, $isproxy) = @_;
|
||||
|
||||
warn "### Requested credentials for $uri ###";
|
||||
|
||||
return ($username, $password)
|
||||
};
|
||||
}
|
||||
|
||||
# =========================================================================
|
||||
|
||||
|
||||
sub BUILD
|
||||
{
|
||||
my ($self, $ident, $args_ref) = @_;
|
||||
|
||||
my $url_svc_device = $args_ref->{'url_svc_device'};
|
||||
|
||||
my $svc_device = ONVIF::Device::Interfaces::Device::DevicePort->new({
|
||||
proxy => $url_svc_device,
|
||||
deserializer_args => { strict => 0 }
|
||||
});
|
||||
|
||||
$services_of{$ident}{'device'} = { url => $url_svc_device, ep => $svc_device };
|
||||
|
||||
$self->get_service_urls();
|
||||
|
||||
}
|
||||
|
||||
sub get_users
|
||||
{
|
||||
my ($self) = @_;
|
||||
|
||||
my $result = $self->service('device', 'ep')->GetUsers( { },, );
|
||||
|
||||
die $result if not $result;
|
||||
# print $result . "\n";
|
||||
}
|
||||
|
||||
sub create_user
|
||||
{
|
||||
my ($self, $username, $password) = @_;
|
||||
|
||||
my $result = $self->service('device', 'ep')->CreateUsers( {
|
||||
User => { # ONVIF::Device::Types::User
|
||||
Username => $username, # string
|
||||
Password => $password, # string
|
||||
UserLevel => 'Administrator', # UserLevel
|
||||
Extension => { # ONVIF::Device::Types::UserExtension
|
||||
},
|
||||
},
|
||||
},,
|
||||
);
|
||||
|
||||
die $result if not $result;
|
||||
# print $result . "\n";
|
||||
|
||||
}
|
||||
|
||||
sub set_credentials
|
||||
{
|
||||
my ($self, $username, $password, $create_if_not_exists) = @_;
|
||||
|
||||
# TODO: snyc device and client time
|
||||
|
||||
if ($create_if_not_exists) {
|
||||
# If GetUsers() is ok but empty then CreateUsers()
|
||||
# if(not get_users()) {
|
||||
# create_user($username, $password);
|
||||
# }
|
||||
}
|
||||
|
||||
## from here on use authorization
|
||||
$self->set_serializer(WSSecurity::SecuritySerializer->new());
|
||||
$self->serializer()->set_username($username);
|
||||
$self->serializer()->set_password($password);
|
||||
|
||||
$self->service('device', 'ep')->set_serializer($self->serializer());
|
||||
}
|
||||
|
||||
# use this after set_credentials
|
||||
sub create_services
|
||||
{
|
||||
my ($self) = @_;
|
||||
|
||||
if(defined $self->service('media', 'url')) {
|
||||
$self->set_service('media', 'ep', ONVIF::Media::Interfaces::Media::MediaPort->new({
|
||||
proxy => $self->service('media', 'url'),
|
||||
serializer => $self->serializer(),
|
||||
# transport => $transport
|
||||
}));
|
||||
}
|
||||
if(defined $self->service('ptz', 'url')) {
|
||||
$self->set_service('ptz', 'ep', ONVIF::PTZ::Interfaces::PTZ::PTZPort->new({
|
||||
proxy => $self->service('ptz', 'url'),
|
||||
serializer => $self->serializer(),
|
||||
# transport => $transport
|
||||
}));
|
||||
}
|
||||
if(defined $self->service('analytics', 'url')) {
|
||||
$self->set_service('analytics', 'ep', ONVIF::Analytics::Interfaces::Analytics::AnalyticsEnginePort->new({
|
||||
proxy => $self->service('analytics', 'url'),
|
||||
serializer => $self->serializer(),
|
||||
# transport => $transport
|
||||
}));
|
||||
$self->set_service('rules', 'ep', ONVIF::Analytics::Interfaces::Analytics::RuleEnginePort->new({
|
||||
proxy => $self->service('analytics', 'url'),
|
||||
serializer => $self->serializer(),
|
||||
# transport => $transport
|
||||
}));
|
||||
}
|
||||
}
|
||||
|
||||
sub get_endpoint
|
||||
{
|
||||
my ($self, $serviceType) = @_;
|
||||
|
||||
$self->service($serviceType, 'ep');
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
@ -22,37 +22,19 @@
|
|||
# This module contains the implementation of the ONVIF capability prober
|
||||
#
|
||||
|
||||
require SOAP::WSDL::Transport::HTTP;
|
||||
require ONVIF::Client;
|
||||
|
||||
require WSDiscovery::Interfaces::WSDiscovery::WSDiscoveryPort;
|
||||
require WSDiscovery::Elements::Types;
|
||||
require WSDiscovery::Elements::Scopes;
|
||||
|
||||
require WSDiscovery::TransportUDP;
|
||||
require WSSecurity::SecuritySerializer;
|
||||
|
||||
require ONVIF::Device::Interfaces::Device::DevicePort;
|
||||
require ONVIF::Media::Interfaces::Media::MediaPort;
|
||||
require ONVIF::PTZ::Interfaces::PTZ::PTZPort;
|
||||
|
||||
use Data::Dump qw(dump);
|
||||
|
||||
#
|
||||
# ========================================================================
|
||||
# Globals
|
||||
|
||||
my %namespace_map = (
|
||||
'http://www.onvif.org/ver10/device/wsdl' => 'device',
|
||||
'http://www.onvif.org/ver10/media/wsdl' => 'media',
|
||||
'http://www.onvif.org/ver20/imaging/wsdl' => 'imaging',
|
||||
'http://www.onvif.org/ver20/analytics/wsdl' => 'analytics',
|
||||
'http://www.onvif.org/ver10/deviceIO/wsdl' => 'deviceio',
|
||||
'http://www.onvif.org/ver10/ptz/wsdl' => 'ptz',
|
||||
'http://www.onvif.org/ver10/events/wsdl' => 'events',
|
||||
);
|
||||
|
||||
my %services = { };
|
||||
|
||||
my $serializer;
|
||||
my $client;
|
||||
|
||||
# =========================================================================
|
||||
|
||||
|
|
@ -71,7 +53,7 @@ sub discover
|
|||
|
||||
foreach my $xaddr (split ' ', $result->get_ProbeMatch()->get_XAddrs()) {
|
||||
# find IPv4 address
|
||||
if($xaddr =~ m|//[0-9]+.[0-9]+.[0-9]+.[0-9]+./|) {
|
||||
if($xaddr =~ m|//[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+/|) {
|
||||
print $xaddr . ", ";
|
||||
last;
|
||||
}
|
||||
|
|
@ -92,85 +74,6 @@ sub discover
|
|||
print ")\n";
|
||||
}
|
||||
|
||||
sub get_services
|
||||
{
|
||||
my $result = $services{device}{ep}->GetServices( {
|
||||
IncludeCapability => 'true', # boolean
|
||||
},,
|
||||
);
|
||||
|
||||
die $result if not $result;
|
||||
# print $result . "\n";
|
||||
|
||||
foreach my $svc ( @{ $result->get_Service() } ) {
|
||||
my $short_name = $namespace_map{$svc->get_Namespace()};
|
||||
my $url_svc = $svc->get_XAddr()->get_value();
|
||||
if(defined $short_name && defined $url_svc) {
|
||||
# print "Got $short_name service\n";
|
||||
$services{$short_name}{url} = $url_svc;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub create_services
|
||||
{
|
||||
if(defined $services{media}{url}) {
|
||||
$services{media}{ep} = ONVIF::Media::Interfaces::Media::MediaPort->new({
|
||||
proxy => $services{media}{url},
|
||||
serializer => $serializer,
|
||||
# transport => $transport
|
||||
});
|
||||
}
|
||||
if(defined $services{ptz}{url}) {
|
||||
$services{ptz}{ep} = ONVIF::PTZ::Interfaces::PTZ::PTZPort->new({
|
||||
proxy => $services{ptz}{url},
|
||||
serializer => $serializer,
|
||||
# transport => $transport
|
||||
});
|
||||
}
|
||||
}
|
||||
|
||||
sub get_users
|
||||
{
|
||||
my $result = $services{device}{ep}->GetUsers( { },, );
|
||||
|
||||
die $result if not $result;
|
||||
print $result . "\n";
|
||||
}
|
||||
|
||||
sub create_user
|
||||
{
|
||||
my ($username, $password) = @_;
|
||||
|
||||
my $result = $services{device}{ep}->CreateUsers( {
|
||||
},,
|
||||
);
|
||||
|
||||
die $result if not $result;
|
||||
print $result . "\n";
|
||||
|
||||
}
|
||||
|
||||
sub http_digest {
|
||||
my ($service, $username, $password) = @_;
|
||||
|
||||
# my $transport = SecurityTransport->new();
|
||||
# $transport->set_username($username);
|
||||
# $transport->set_password($password);
|
||||
|
||||
# warn "transport: " . $service->get_transport();
|
||||
|
||||
*SOAP::Transport::HTTP::Client::get_basic_credentials = sub {
|
||||
#*SOAP::WSDL::Transport::HTTP::get_basic_credentials = sub {
|
||||
my ($self, $realm, $uri, $isproxy) = @_;
|
||||
|
||||
warn "### Requested credentials for $uri ###";
|
||||
|
||||
return ($username, $password)
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub profiles
|
||||
{
|
||||
|
|
@ -178,7 +81,7 @@ sub profiles
|
|||
# die $result if not $result;
|
||||
# print $result . "\n";
|
||||
|
||||
$result = $services{media}{ep}->GetProfiles( { } ,, );
|
||||
my $result = $client->get_endpoint('media')->GetProfiles( { } ,, );
|
||||
die $result if not $result;
|
||||
# print $result . "\n";
|
||||
|
||||
|
|
@ -195,7 +98,7 @@ sub profiles
|
|||
$profile->get_VideoEncoderConfiguration()->get_RateControl()->get_FrameRateLimit() .
|
||||
", ";
|
||||
|
||||
$result = $services{media}{ep}->GetStreamUri( {
|
||||
$result = $client->get_endpoint('media')->GetStreamUri( {
|
||||
StreamSetup => { # ONVIF::Media::Types::StreamSetup
|
||||
Stream => 'RTP_unicast', # StreamType
|
||||
Transport => { # ONVIF::Media::Types::Transport
|
||||
|
|
@ -222,13 +125,30 @@ sub move
|
|||
my ($dir) = @_;
|
||||
|
||||
|
||||
my $result = $services{ptz}{ep}->GetNodes( { } ,, );
|
||||
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";
|
||||
|
||||
my $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";
|
||||
|
||||
|
||||
}
|
||||
|
||||
# ========================================================================
|
||||
# MAIN
|
||||
|
||||
|
|
@ -243,31 +163,11 @@ else {
|
|||
my $username = shift;
|
||||
my $password = shift;
|
||||
|
||||
my $svc_device = ONVIF::Device::Interfaces::Device::DevicePort->new({
|
||||
proxy => $url_svc_device,
|
||||
deserializer_args => { strict => 0 }
|
||||
});
|
||||
$client = ONVIF::Client->new( { 'url_svc_device' => $url_svc_device } );
|
||||
|
||||
$services{'device'} = { url => $url_svc_device, ep => $svc_device };
|
||||
|
||||
get_services();
|
||||
|
||||
# TODO: snyc device and client time
|
||||
|
||||
# If GetUsers() is ok but empty then CreateUser()
|
||||
# if(not get_users()) {
|
||||
# create_user($username, $password);
|
||||
# }
|
||||
$client->set_credentials($username, $password, 1);
|
||||
|
||||
|
||||
## from here on use authorization
|
||||
$serializer = WSSecurity::SecuritySerializer->new();
|
||||
$serializer->set_username($username);
|
||||
$serializer->set_password($password);
|
||||
|
||||
$services{device}{ep}->set_serializer($serializer);
|
||||
|
||||
create_services($username, $password);
|
||||
$client->create_services();
|
||||
|
||||
|
||||
if($action eq "profiles") {
|
||||
|
|
@ -278,6 +178,9 @@ else {
|
|||
my $dir = shift;
|
||||
move($dir);
|
||||
}
|
||||
elsif($action eq "metadata") {
|
||||
metadata();
|
||||
}
|
||||
else {
|
||||
print("Error: Unknown command\"$action\"");
|
||||
exit(1);
|
||||
|
|
|
|||
Loading…
Reference in New Issue