zoneminder/onvif/modules/lib/ONVIF/Client.pm

# ==========================================================================
#
# ZoneMinder ONVIF Client 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 client module
#

package ONVIF::Client;
use strict; 
use warnings;
use Class::Std::Fast;

use version; our $VERSION = qv('1.00.00');

## Transport
require SOAP::WSDL::Transport::HTTP;

## Serializer
require ONVIF::Serializer::SOAP11;
require ONVIF::Serializer::SOAP12;
require WSSecurity::SecuritySerializer;

## Deserializer
require ONVIF::Deserializer::XSD;

## ONVIF APIs
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;

require WSNotification::Interfaces::WSBaseNotificationSender::NotificationProducerPort;

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', 
  'http://www.onvif.org/ver10/recording.wsdl'   => 'recording',
  'http://www.onvif.org/ver10/search.wsdl'      => 'search',
  'http://www.onvif.org/ver10/replay/wsdl'      => 'replay',
);

# ========================================================================
# Attributes

my %services_of      :ATTR(:default<{}>);

my %serializer_of    :ATTR();
my %soap_version_of  :ATTR(:default<('1.1')>);
my $verbose;

# =========================================================================
# private methods

sub service {
  my ($self, $serviceName, $attr) = @_;
  #print "service: " . $services_of{${$self}}{$serviceName}{$attr} . "\n";
# Please note that the Std::Class::Fast docs say not to use ident.
  $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 soap_version {
  my ($self) = @_;
  $soap_version_of{ident $self};
}

sub set_soap_version {
  my ($self, $soap_version) = @_;
  $soap_version_of{ident $self} = $soap_version;

  # setting the soap version invalidates the serializer
  delete $serializer_of{ ident $self };
}

sub get_service_urls {
  my ($self) = @_;

  my $result = $self->service('device', 'ep')->GetServices( {
    IncludeCapability =>  'true', # boolean
    }
  );
  if ( $result ) {
    print "Have results from GetServices\n" if $verbose;
    my $services = $result->get_Service();
    if ( $services ) {
      foreach my $svc ( @{ $services } ) {
        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 $url_svc\n" if $verbose;
          $self->set_service($short_name, 'url', $url_svc);
        }
      } # end foreach service
    } else {
      print "No services from GetServices\n" if $verbose;
    } # end if services
  } else {
    print "No results from GetServices\n" if $verbose;
  }

  # Some devices do not support getServices, so we have to try getCapabilities

  $result = $self->service('device', 'ep')->GetCapabilities( {}, , );
  if ( !$result ) {
    print "No results from GetCapabilities: $result\n" if $verbose;
    return;
  }
  print "Have results from GetCapabilities: $result\n" if $verbose;
  # Result is a GetCapabilitiesResponse
  foreach my $capabilities ( @{ $result->get_Capabilities() } ) {
    foreach my $capability ( 'PTZ', 'Media', 'Imaging', 'Events', 'Device' ) {
      if ( my $function = $capabilities->can( "get_$capability" ) ) {
        my $Services = $function->( $capabilities );
        if ( !$Services ) {
          #print "Nothing returned from get_$capability\n";
        } else {
          foreach my $svc ( @{ $Services } ) {
            # The capability versions don't have a namespace, so just lowercase them.
            my $short_name = lc $capability;
            my $url_svc = $svc->get_XAddr()->get_value();
            if ( defined $url_svc ) {
              #print "Got $short_name service\n";
              $self->set_service($short_name, 'url', $url_svc);
            }
          } # end foreach svr
        }
      } else {
        print "No $capability function\n";
      } # end if has a get_ function
    } # end foreach capability
  } # end foreach capabilities

} # end sub get_service_urls

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) = @_;
  
  $verbose = $args_ref->{verbose};
  my $url_svc_device = $args_ref->{url_svc_device};
  my $soap_version = $args_ref->{soap_version};
  if ( !$soap_version ) {
    $soap_version = '1.1';
  }
  $self->set_soap_version($soap_version);
  
  my $serializer = ONVIF::Serializer::Base->new();
  $serializer->set_soap_version($soap_version);

  my $svc_device = ONVIF::Device::Interfaces::Device::DevicePort->new({
   proxy => $url_svc_device,
   serializer => $serializer,
#   "strict => 0" does not work with SOAP header
#   deserializer_args => { strict => 0 }
  });

  $services_of{$ident}{device} = { url => $url_svc_device, ep => $svc_device };

  # Can't, don't have credentials yet
  # $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_soap_version($self->soap_version());
  $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) = @_;

  $self->get_service_urls();

  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('events', 'url') ) {
    $self->set_service('events', 'ep', WSNotification::Interfaces::WSBaseNotificationSender::NotificationProducerPort->new({
      proxy => $self->service('events', '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
    }));
  }
} # end sub create_services

sub get_endpoint {
  my ($self, $serviceType) = @_;
  
  $self->service($serviceType, 'ep');
}

1;
__END__