From a18399af69615864f7bed1f2c654bc63283a84d0 Mon Sep 17 00:00:00 2001 From: "Jan M. Hochstein" Date: Sun, 17 Aug 2014 21:24:27 +0200 Subject: [PATCH] Basic support for SOAP 1.1 and 1.2 --- onvif/modules/lib/ONVIF/Client.pm | 38 ++- .../lib/ONVIF/Deserializer/MessageParser.pm | 267 ++++++++++++++++++ onvif/modules/lib/ONVIF/Deserializer/XSD.pm | 66 +++++ onvif/modules/lib/ONVIF/Serializer/Base.pm | 177 ++++++++++++ onvif/modules/lib/ONVIF/Serializer/SOAP11.pm | 19 ++ onvif/modules/lib/ONVIF/Serializer/SOAP12.pm | 19 ++ onvif/modules/lib/WSDiscovery/TransportUDP.pm | 47 ++- .../lib/WSSecurity/SecuritySerializer.pm | 19 +- onvif/scripts/zmonvif-probe.pl | 168 +++++++++-- web/skins/classic/views/onvifprobe.php | 12 +- 10 files changed, 776 insertions(+), 56 deletions(-) create mode 100644 onvif/modules/lib/ONVIF/Deserializer/MessageParser.pm create mode 100644 onvif/modules/lib/ONVIF/Deserializer/XSD.pm create mode 100644 onvif/modules/lib/ONVIF/Serializer/Base.pm create mode 100644 onvif/modules/lib/ONVIF/Serializer/SOAP11.pm create mode 100644 onvif/modules/lib/ONVIF/Serializer/SOAP12.pm diff --git a/onvif/modules/lib/ONVIF/Client.pm b/onvif/modules/lib/ONVIF/Client.pm index 9cfe0270f..2d16c9d13 100644 --- a/onvif/modules/lib/ONVIF/Client.pm +++ b/onvif/modules/lib/ONVIF/Client.pm @@ -29,10 +29,18 @@ 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; @@ -61,6 +69,7 @@ my %namespace_map = ( my %services_of :ATTR(:default<{}>); my %serializer_of :ATTR(); +my %soap_version_of :ATTR(:default<('1.1')>); # ========================================================================= # private methods @@ -89,6 +98,20 @@ sub set_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 { @@ -139,10 +162,20 @@ sub BUILD my ($self, $ident, $args_ref) = @_; 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, - deserializer_args => { strict => 0 } + 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 }; @@ -195,7 +228,8 @@ sub set_credentials } ## from here on use authorization - $self->set_serializer(WSSecurity::SecuritySerializer->new()); + $self->set_serializer( WSSecurity::SecuritySerializer->new() ); + $self->serializer()->set_soap_version($self->soap_version()); $self->serializer()->set_username($username); $self->serializer()->set_password($password); diff --git a/onvif/modules/lib/ONVIF/Deserializer/MessageParser.pm b/onvif/modules/lib/ONVIF/Deserializer/MessageParser.pm new file mode 100644 index 000000000..c9234ae76 --- /dev/null +++ b/onvif/modules/lib/ONVIF/Deserializer/MessageParser.pm @@ -0,0 +1,267 @@ +#!/usr/bin/perl +package ONVIF::Deserializer::MessageParser; +use strict; use warnings; + +use SOAP::WSDL::XSD::Typelib::Builtin; +use SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType; + +## copied from SOAP::Constants +use constant URI_SOAP11_ENV => "http://schemas.xmlsoap.org/soap/envelope/"; +use constant URI_SOAP12_ENV => "http://www.w3.org/2003/05/soap-envelope"; + +## copied and adapted from +use base qw(SOAP::WSDL::Expat::MessageParser); + +## we get the soap version from the message +my %soap_version_of; # :ATTR( :default<()>); + +sub soap_version { + my ($self) = @_; + $soap_version_of{ident $self}; +} + +# override new() to pass along the init_args +sub new { + my ($class, $args) = @_; + my $self = { + class_resolver => $args->{ class_resolver }, + strict => defined $args->{ strict } ? $args->{ strict } : 1, + }; + + bless $self, $class; + + # could be written as && - but Devel::Cover doesn't like that + if ($args->{ class_resolver }) { + $self->load_classes() + if ! exists $SOAP::WSDL::Expat::MessageParser::LOADED_OF{ $self->{ class_resolver } }; + } + return $self; +## calling the parent's calss new() dows not work here. +# return SOAP::WSDL::Expat::MessageParser->new($class, $args); +} + +sub _initialize { + my ($self, $parser) = @_; + + $self->{ parser } = $parser; + + delete $self->{ data }; # remove potential old results + delete $self->{ header }; + + my $characters; + + # Note: $current MUST be undef - it is used as sentinel + # on the object stack via if (! defined $list->[-1]) + # DON'T set it to anything else ! + my $current = undef; + my $list = []; # node list (object stack) + + my $path = []; # current path + my $skip = 0; # skip elements + my $depth = 0; + + my %content_check = $self->{strict} + ? ( + 0 => sub { + die "Bad top node $_[1]" if $_[1] ne 'Envelope'; + if($_[0]->namespace($_[1]) eq URI_SOAP11_ENV) { + $_[0]{ soap_version } = '1.1'; +# $soap_version_of{ident $_[0]} = '1.1'; + } + elsif($_[0]->namespace($_[1]) eq URI_SOAP12_ENV) { + $_[0]{ soap_version } = '1.2'; + } + else { + die "Bad namespace for SOAP envelope: " . $_[0]->recognized_string(); + } + #print "Receiving SOAP " . $_[0]{ soap_version } ."\n"; + $depth++; + return; + }, + 1 => sub { + # Header or Body + #print "Start $_[1] at level 1\n"; + $depth++; + if ($_[1] eq 'Body') { + if (exists $self->{ data }) { # there was header data + $self->{ header } = $self->{ data }; + delete $self->{ data }; + $list = []; + $path = []; + undef $current; + } + } + return; + } + ) + : ( + 0 => sub { $depth++ }, + 1 => sub { $depth++ }, + ); + + # use "globals" for speed + my ($_prefix, $_method, $_class, $_leaf) = (); + + my $char_handler = sub { + return if (!$_leaf); # we only want characters in leaf nodes + $characters .= $_[1]; # add to characters + return; # return void + }; + + no strict qw(refs); + $parser->setHandlers( + Start => sub { + # my ($parser, $element, %attrs) = @_; + + #print "Start $_[1]\n"; + + $_leaf = 1; # believe we're a leaf node until we see an end + + # call methods without using their parameter stack + # That's slightly faster than $content_check{ $depth }->() + # and we don't have to pass $_[1] to the method. + # Yup, that's dirty. + return &{$content_check{ $depth }} + if exists $content_check{ $depth }; + + push @{ $path }, $_[1]; # step down in path + return if $skip; # skip inside __SKIP__ + + # resolve class of this element + $_class = $self->{ class_resolver }->get_class( $path ); + +# we cannot use this if there are elements +# if (! defined($_class) and $self->{ strict }) { +# die "Cannot resolve class for " +# . join('/', @{ $path }) . " via " . $self->{ class_resolver }; +# } + + if (! defined($_class) or ($_class eq '__SKIP__') ) { + $skip = join('/', @{ $path }); + $_[0]->setHandlers( Char => undef ); + return; + } + + # step down in tree (remember current) + # + # on the first object (after skipping Envelope/Body), $current + # is undef. + # We put it on the stack, anyway, and use it as sentinel when + # going through the closing tags in the End handler + # + push @$list, $current; + + # cleanup. Mainly here to help profilers find the real hot spots + undef $current; + + # cleanup + $characters = q{}; + + # Create and set new objects using Class::Std::Fast's object cache + # if possible, or blessing directly into the class in question + # (circumventing constructor) here. + # That's dirty, but fast. + # + # TODO: check whether this is faster under all perls - there's + # strange benchmark results... + # + # The alternative would read: + # $current = $_class->new({ @_[2..$#_] }); + # + $current = pop @{ $SOAP::WSDL::Expat::MessageParser::OBJECT_CACHE_REF->{ $_class } }; + if (not defined $current) { + my $o = Class::Std::Fast::ID(); + $current = bless \$o, $_class; + } + + # set attributes if there are any + ATTR: { + if (@_ > 2) { + # die Data::Dumper::Dumper(@_[2..$#_]); + my %attr = @_[2..$#_]; + if (my $nil = delete $attr{nil}) { + # TODO: check namespace + if ($nil && $nil ne 'false') { + undef $characters; + last ATTR if not (%attr); + } + } + $current->attr(\%attr); + } + } + $depth++; + + # TODO: Skip content of anyType / any stuff + + return; + }, + + Char => $char_handler, + + End => sub { + + #print "End $_[1]\n"; + pop @{ $path }; # step up in path + + # check __SKIP__ + if ($skip) { + return if $skip ne join '/', @{ $path }, $_[1]; + $skip = 0; + $_[0]->setHandlers( Char => $char_handler ); + return; + } + + $depth--; + + # we only set character values in leaf nodes + if ($_leaf) { + # Use dirty but fast access via global variables. + # + # The normal way (via method) would be this: + # + # $current->set_value( $characters ) if (length($characters)); + # + $SOAP::WSDL::XSD::Typelib::Builtin::anySimpleType::___value + ->{ $$current } = $characters + if defined $characters && defined $current; # =~m{ [^\s] }xms; + } + + # empty characters + $characters = q{}; + + # stop believing we're a leaf node + $_leaf = 0; + + # return if there's only one elment - can't set it in parent ;-) + # but set as root element if we don't have one already. + if (not defined $list->[-1]) { + $self->{ data } = $current if (not exists $self->{ data }); + return; + }; + + # set appropriate attribute in last element + # multiple values must be implemented in base class + # TODO check if hash access is faster + # $_method = "add_$_localname"; + $_method = "add_$_[1]"; + # + # fixup XML names for perl names + # + $_method =~s{\.}{__}xg; + $_method =~s{\-}{_}xg; + $list->[-1]->$_method( $current ); + + $current = pop @$list; # step up in object hierarchy + + return; + } + ); + + return $parser; +} + +sub get_header { + return $_[0]->{ header }; +} + +1; diff --git a/onvif/modules/lib/ONVIF/Deserializer/XSD.pm b/onvif/modules/lib/ONVIF/Deserializer/XSD.pm new file mode 100644 index 000000000..6d96aa406 --- /dev/null +++ b/onvif/modules/lib/ONVIF/Deserializer/XSD.pm @@ -0,0 +1,66 @@ +package ONVIF::Deserializer::XSD; +use strict; +use warnings; + +use base qw(SOAP::WSDL::Deserializer::XSD); + +use SOAP::WSDL::SOAP::Typelib::Fault11; +use ONVIF::Deserializer::MessageParser; + +use SOAP::WSDL::Factory::Deserializer; + +SOAP::WSDL::Factory::Deserializer->register('1.1', __PACKAGE__ ); +SOAP::WSDL::Factory::Deserializer->register('1.2', __PACKAGE__ ); + +## we get the soap version from the message parser +my %soap_version_of :ATTR( :default<()>); + + +sub soap_version { + my ($self) = @_; + if($SOAP::WSDL::Deserializer::XSD::parser_of{ident $self}) { + return $SOAP::WSDL::Deserializer::XSD::parser_of{ident $self}->soap_version(); + } + return ''; +} + +sub deserialize { + my ($self, $content) = @_; + + my $parser = $SOAP::WSDL::Deserializer::XSD::parser_of{ ${ $self } }; + if(not $parser) { + $parser = ONVIF::Deserializer::MessageParser->new({ + strict => $SOAP::WSDL::Deserializer::XSD::strict_of{ ${ $self } } + }); + $SOAP::WSDL::Deserializer::XSD::parser_of{ ${ $self } } = $parser; + } + + $parser->class_resolver( + $self->SOAP::WSDL::Deserializer::XSD::get_class_resolver() ); + eval { $parser->parse_string( $content ) }; + if ($@) { + return $self->generate_fault({ + code => 'SOAP-ENV:Server', + role => 'urn:localhost', + message => "Error deserializing message: $@. \n" + . "Message was: \n$content" + }); + } + return ( $parser->get_data(), + $parser->get_header() ); +} + +sub generate_fault { + my ($self, $args_from_ref) = @_; + return SOAP::WSDL::SOAP::Typelib::Fault11->new({ + faultcode => $args_from_ref->{ code } || 'SOAP-ENV:Client', + faultactor => $args_from_ref->{ role } || 'urn:localhost', + faultstring => $args_from_ref->{ message } || "Unknown error" + }); +} + +1; + +__END__ + + diff --git a/onvif/modules/lib/ONVIF/Serializer/Base.pm b/onvif/modules/lib/ONVIF/Serializer/Base.pm new file mode 100644 index 000000000..b6edf360f --- /dev/null +++ b/onvif/modules/lib/ONVIF/Serializer/Base.pm @@ -0,0 +1,177 @@ +#!/usr/bin/perl -w +package ONVIF::Serializer::Base; +use strict; +use warnings; + +# ========================================================================= + +use Class::Std::Fast::Storable; +use Scalar::Util qw(blessed); + +require SOAP::WSDL::Factory::Serializer; + +## require SOAP::Constants; +use constant URI_1999_SCHEMA_XSD => "http://www.w3.org/1999/XMLSchema"; +use constant URI_1999_SCHEMA_XSI => "http://www.w3.org/1999/XMLSchema-instance"; +use constant URI_2000_SCHEMA_XSD => "http://www.w3.org/2000/10/XMLSchema"; +use constant URI_2000_SCHEMA_XSI => "http://www.w3.org/2000/10/XMLSchema-instance"; +use constant URI_2001_SCHEMA_XSD => "http://www.w3.org/2001/XMLSchema"; +use constant URI_2001_SCHEMA_XSI => "http://www.w3.org/2001/XMLSchema-instance"; +use constant URI_LITERAL_ENC => ""; +use constant URI_SOAP11_ENC => "http://schemas.xmlsoap.org/soap/encoding/"; +use constant URI_SOAP11_ENV => "http://schemas.xmlsoap.org/soap/envelope/"; +use constant URI_SOAP11_NEXT_ACTOR => "http://schemas.xmlsoap.org/soap/actor/next"; +use constant URI_SOAP12_ENC => "http://www.w3.org/2003/05/soap-encoding"; +use constant URI_SOAP12_ENV => "http://www.w3.org/2003/05/soap-envelope"; +use constant URI_SOAP12_NOENC => "http://www.w3.org/2003/05/soap-envelope/encoding/none"; +use constant URI_SOAP12_NEXT_ACTOR => "http://www.w3.org/2003/05/soap-envelope/role/next"; + + +my %soap_version_of :ATTR( :default<()>); + +my $XML_INSTANCE_NS = 'http://www.w3.org/2001/XMLSchema-instance'; + +sub soap_version +{ + my ($self) = @_; + $soap_version_of{ident $self}; +} + +sub set_soap_version +{ + my ($self, $version) = @_; + if(! (($version eq '1.1') or ($version eq '1.2')) ) { + warn "Undefined SOAP version \'$version\'"; + return; + } + #print "using SOAP $version\n"; + $soap_version_of{ident $self} = $version; +} + + +sub serialize { + my ($self, $args_of_ref) = @_; + + my $SOAP_NS; + if($self->soap_version() eq '1.2') { + $SOAP_NS = URI_SOAP12_ENV; + } + else { + $SOAP_NS = URI_SOAP11_ENV; + } + + my $opt = $args_of_ref->{ options }; + + if (not $opt->{ namespace }->{ $SOAP_NS }) + { + $opt->{ namespace }->{ $SOAP_NS } = 'SOAP-ENV'; + } + + if (not $opt->{ namespace }->{ $XML_INSTANCE_NS }) + { + $opt->{ namespace }->{ $XML_INSTANCE_NS } = 'xsi'; + } + + my $soap_prefix = $opt->{ namespace }->{ $SOAP_NS }; + + # envelope start with namespaces + my $xml = "<$soap_prefix\:Envelope "; + + while (my ($uri, $prefix) = each %{ $opt->{ namespace } }) + { + $xml .= "xmlns:$prefix=\"$uri\" "; + } + # + # add namespace for user-supplied prefix if needed + $xml .= "xmlns:$opt->{prefix}=\"" . $args_of_ref->{ body }->get_xmlns() . "\" " + if $opt->{prefix}; + + # TODO insert encoding + $xml.='>'; + $xml .= $self->serialize_header($args_of_ref->{ method }, $args_of_ref->{ header }, $opt); + $xml .= $self->serialize_body($args_of_ref->{ method }, $args_of_ref->{ body }, $opt); + $xml .= ''; + + return $xml; +} + +sub serialize_header { + my ($self, $method, $data, $opt) = @_; + + my $SOAP_NS; + if($self->soap_version() eq '1.2') { + $SOAP_NS = URI_SOAP12_ENV; + } + else { + $SOAP_NS = URI_SOAP11_ENV; + } + + # header is optional. Leave out if there's no header data + return q{} if not $data; + return join ( q{}, + "<$opt->{ namespace }->{ $SOAP_NS }\:Header>", + blessed $data ? $data->serialize_qualified : (), + "{ namespace }->{ $SOAP_NS }\:Header>", + ); +} + +sub serialize_body { + my ($self, $method, $data, $opt) = @_; + + my $SOAP_NS; + if($self->soap_version() eq '1.2') { + $SOAP_NS = URI_SOAP12_ENV; + } + else { + $SOAP_NS = URI_SOAP11_ENV; + } + + # TODO This one wipes out the old class' XML name globally + # Fix in some more appropriate place... + $data->__set_name("$opt->{prefix}:" . $data->__get_name() ) if $opt->{prefix}; + + # Body is NOT optional. Serialize to empty body + # if we have no data. + return join ( q{}, + "<$opt->{ namespace }->{ $SOAP_NS }\:Body>", + defined $data + ? ref $data eq 'ARRAY' + ? join q{}, map { blessed $_ ? $_->serialize_qualified() : () } @{ $data } + : blessed $data + ? $opt->{prefix} + ? $data->serialize() + : $data->serialize_qualified() + : () + : (), + "{ namespace }->{ $SOAP_NS }\:Body>", + ); +} + +# ========================================================================= + + +1; + + +__END__ + +=pod + +=head1 NAME + +Copy of SOAP:WSDL::Serializer::XSD adapted + +=head1 LICENSE AND COPYRIGHT + +This file was adapted from a part of SOAP-WSDL. You may +distribute/modify it under the same terms as perl itself + +=head1 REPOSITORY INFORMATION + + $Rev: 851 $ + $LastChangedBy: kutterma $ + $Id: XSD.pm 851 2009-05-15 22:45:18Z kutterma $ + $HeadURL: https://soap-wsdl.svn.sourceforge.net/svnroot/soap-wsdl/SOAP-WSDL/trunk/lib/SOAP/WSDL/Serializer/XSD.pm $ + +=cut + diff --git a/onvif/modules/lib/ONVIF/Serializer/SOAP11.pm b/onvif/modules/lib/ONVIF/Serializer/SOAP11.pm new file mode 100644 index 000000000..2813a0688 --- /dev/null +++ b/onvif/modules/lib/ONVIF/Serializer/SOAP11.pm @@ -0,0 +1,19 @@ +#!/usr/bin/perl -w +package ONVIF::Serializer::SOAP11; +use strict; +use warnings; + +use base qw(ONVIF::Serializer::Base); + +use SOAP::WSDL::Factory::Serializer; + +SOAP::WSDL::Factory::Serializer->register( '1.1' , __PACKAGE__ ); + +sub BUILD +{ + my ($self, $ident, $args_ref) = @_; +# $soapversion_of{ $ident } = '1.1'; + $self->set_soap_version('1.1'); +} + +1; diff --git a/onvif/modules/lib/ONVIF/Serializer/SOAP12.pm b/onvif/modules/lib/ONVIF/Serializer/SOAP12.pm new file mode 100644 index 000000000..d378a3614 --- /dev/null +++ b/onvif/modules/lib/ONVIF/Serializer/SOAP12.pm @@ -0,0 +1,19 @@ +#!/usr/bin/perl -w +package ONVIF::Serializer::SOAP12; +use strict; +use warnings; + +use base qw(ONVIF::Serializer::Base); + +use SOAP::WSDL::Factory::Serializer; + +SOAP::WSDL::Factory::Serializer->register( '1.2' , __PACKAGE__ ); + +sub BUILD +{ + my ($self, $ident, $args_ref) = @_; +# $soapversion_of{ $ident } = '1.2'; + $self->set_soap_version('1.2'); +} + +1; diff --git a/onvif/modules/lib/WSDiscovery/TransportUDP.pm b/onvif/modules/lib/WSDiscovery/TransportUDP.pm index f270af291..9bc6c74c9 100644 --- a/onvif/modules/lib/WSDiscovery/TransportUDP.pm +++ b/onvif/modules/lib/WSDiscovery/TransportUDP.pm @@ -31,9 +31,9 @@ use Time::HiRes qw( usleep ); use version; our $VERSION = qv('1.00.00'); -# 50 times 100 msec = 5sec timeout -use constant WAIT_TIME => 100; -use constant WAIT_COUNT => 50; +# 20 times 200 msec = 4sec timeout +use constant WAIT_TIME => 200.0; +use constant WAIT_COUNT => 20; SOAP::WSDL::Factory::Transport->register( 'soap.udp' => __PACKAGE__ ); @@ -53,6 +53,13 @@ SUBFACTORY: { } } +# override to receive more than one response +sub _notify_response +{ +# my ($transport, $response) = @_; + +} + sub send_multi() { my ($self, $address, $port, $data) = @_; @@ -74,9 +81,14 @@ sub receive_multi() { LocalPort=>$port, ReuseAddr=>1); $socket->mcast_add($address); - $socket->recv($data, 9999); + my $readbits = ''; + vec($readbits, $socket->fileno, 1) = 1; - return $data; + if(select($readbits, undef, undef, WAIT_TIME/1000)) { + $socket->recv($data, 9999); + return $data; + } + return undef; } sub receive_uni() { @@ -88,9 +100,14 @@ sub receive_uni() { $socket->mcast_add($address); - $socket->recv($data, 9999); + my $readbits = ''; + vec($readbits, $socket->fileno, 1) = 1; - return $data; + if(select($readbits, undef, undef, WAIT_TIME/1000)) { + $socket->recv($data, 9999); + return $data; + } + return undef; } sub send_receive { @@ -107,22 +124,24 @@ sub send_receive { my $localaddr = $self->get_local_addr(); - my $response; + my ($response, $last_response); my $wait = WAIT_COUNT; - while ($wait) { + while ( $wait >= 0 ) { if($localaddr) { if($response = $self->receive_uni($address, $port, $localaddr)) { - last; + $last_response = $response; + $self->_notify_response($response); } + $wait --; } if($response = $self->receive_multi($address, $port)) { - last; + $last_response = $response; + $self->_notify_response($response); } - msleep(WAIT_TIME); $wait --; } - if($response) { + if($last_response) { $self->code(); $self->message(); $self->is_success(1); @@ -134,7 +153,7 @@ sub send_receive { $self->is_success(0); $self->status('TIMEOUT'); } - return $response; + return $last_response; } 1; diff --git a/onvif/modules/lib/WSSecurity/SecuritySerializer.pm b/onvif/modules/lib/WSSecurity/SecuritySerializer.pm index 009c34420..a2daac028 100644 --- a/onvif/modules/lib/WSSecurity/SecuritySerializer.pm +++ b/onvif/modules/lib/WSSecurity/SecuritySerializer.pm @@ -30,19 +30,25 @@ use Digest::SHA1; use MIME::Base64; -use base qw( SOAP::WSDL::Serializer::XSD ); +use base qw( ONVIF::Serializer::Base ); use version; our $VERSION = qv('1.00.00'); -my $SOAP_NS = 'http://schemas.xmlsoap.org/soap/envelope/'; -my $XML_INSTANCE_NS = 'http://www.w3.org/2001/XMLSchema-instance'; - +use constant URI_SOAP11_ENV => "http://schemas.xmlsoap.org/soap/envelope/"; +use constant URI_SOAP12_ENV => "http://www.w3.org/2003/05/soap-envelope"; #SOAP::WSDL::Factory::Serializer->register( '1.1' , __PACKAGE__ ); my %username_of :ATTR(:name :default<()>); my %password_of :ATTR(:name :default<()>); +#sub BUILD +#{ +# my ($self, $ident, $args_ref) = @_; +# $soapversion_of{ $ident } = '1.2'; +#} + + SUBFACTORY: { for (qw(username password)) { my $setter = "set_$_"; @@ -122,6 +128,11 @@ sub security_header { sub serialize_header() { my ($self, $method, $data, $opt) = @_; + my $SOAP_NS = URI_SOAP11_ENV; + if($self->soap_version() eq '1.2') { + $SOAP_NS = URI_SOAP12_ENV; + } + # header is optional. Leave out if there's no header data return join ( q{}, "<$opt->{ namespace }->{ $SOAP_NS }\:Header>", diff --git a/onvif/scripts/zmonvif-probe.pl b/onvif/scripts/zmonvif-probe.pl index 500aa91b0..fe2753afd 100755 --- a/onvif/scripts/zmonvif-probe.pl +++ b/onvif/scripts/zmonvif-probe.pl @@ -32,17 +32,126 @@ require WSDiscovery::Elements::Scopes; require WSDiscovery::TransportUDP; -# +# # ======================================================================== # Globals 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, @responses, %services) = @_; + + foreach my $response ( @responses ) { + + my $result = deserialize_message($svc_discover, $response); + next if not $result; + + my $xaddr; + foreach my $l_xaddr (split ' ', $result->get_ProbeMatch()->get_XAddrs()) { + # find IPv4 address + if($l_xaddr =~ m|//[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+/|) { + $xaddr = $l_xaddr; + last; + } + } + + # 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 { - my $svc_discover = WSDiscovery::Interfaces::WSDiscovery::WSDiscoveryPort->new(); + ## 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 $svc_discover = WSDiscovery::Interfaces::WSDiscovery::WSDiscoveryPort->new({ +# no_dispatch => '1', + }); + $svc_discover->set_soap_version('1.1'); my $result = $svc_discover->ProbeOp( { # WSDiscovery::Types::ProbeType @@ -50,30 +159,25 @@ sub discover Scopes => { value => '' }, },, ); - die $result if not $result; -# print $result; +# print $result . "\n"; - foreach my $xaddr (split ' ', $result->get_ProbeMatch()->get_XAddrs()) { -# find IPv4 address - if($xaddr =~ m|//[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+/|) { - print $xaddr . ", "; - last; - } - } - - 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"; + interpret_messages($svc_discover, \@responses, \%services); + @responses = (); + + $svc_discover = WSDiscovery::Interfaces::WSDiscovery::WSDiscoveryPort->new({ +# no_dispatch => '1', + }); + $svc_discover->set_soap_version('1.2'); + + $result = $svc_discover->ProbeOp( + { # WSDiscovery::Types::ProbeType + Types => { 'dn:NetworkVideoTransmitter', 'tds:Device' }, # QNameListType + Scopes => { value => '' }, + },, + ); +# print $result . "\n"; + + interpret_messages($svc_discover, @responses, \%services); } @@ -144,11 +248,10 @@ sub metadata die $result if not $result; print $result . "\n"; - $result = $client->get_endpoint('analytics')->GetServiceCapabilities( { } ,, ); - die $result if not $result; - print $result . "\n"; - - +# $result = $client->get_endpoint('analytics')->GetServiceCapabilities( { } ,, ); +# die $result if not $result; +# print $result . "\n"; + } # ======================================================================== @@ -162,10 +265,13 @@ if($action eq "probe") { else { # all other actions need URI and credentials my $url_svc_device = shift; + my $soap_version = shift; my $username = shift; my $password = shift; - $client = ONVIF::Client->new( { 'url_svc_device' => $url_svc_device } ); + $client = ONVIF::Client->new( { + 'url_svc_device' => $url_svc_device, + 'soap_version' => $soap_version } ); $client->set_credentials($username, $password, 1); diff --git a/web/skins/classic/views/onvifprobe.php b/web/skins/classic/views/onvifprobe.php index 4644d226f..22c365296 100644 --- a/web/skins/classic/views/onvifprobe.php +++ b/web/skins/classic/views/onvifprobe.php @@ -47,18 +47,20 @@ function probeCameras( $localIp ) foreach ( $lines as $line ) { $line = rtrim( $line ); - if ( preg_match( '|^(.+),\s\((.*)\)$|', $line, $matches ) ) + if ( preg_match( '|^(.+),(.+),\s\((.*)\)$|', $line, $matches ) ) { $device_ep = $matches[1]; + $soapversion = $matches[2]; $camera = array( 'model' => "Unknown ONVIF Camera", 'monitor' => array( 'Function' => "Monitor", 'Type' => 'Ffmpeg', 'Host' => $device_ep, + 'SOAP' => $soapversion, ), ); - foreach ( preg_split('|,\s*|', $matches[2]) as $attr_val ) { + foreach ( preg_split('|,\s*|', $matches[3]) as $attr_val ) { if( preg_match( '|(.+)=\'(.*)\'|', $attr_val, $tokens ) ) { if($tokens[1] == "hardware") { @@ -80,11 +82,11 @@ function probeCameras( $localIp ) return( $cameras ); } -function probeProfiles( $device_ep, $username, $password ) +function probeProfiles( $device_ep, $soapversion, $username, $password ) { $profiles = array(); $count = 0; - if ( $lines = @execONVIF( "profiles $device_ep $username $password" ) ) + if ( $lines = @execONVIF( "profiles $device_ep $soapversion $username $password" ) ) { foreach ( $lines as $line ) { @@ -230,7 +232,7 @@ else if($_REQUEST['step'] == "2") //print $monitor['Host'].", ".$_REQUEST['username'].", ".$_REQUEST['password']."
"; - $detprofiles = probeProfiles( $monitor['Host'], $_REQUEST['username'], $_REQUEST['password']); + $detprofiles = probeProfiles( $monitor['Host'], $monitor['SOAP'], $_REQUEST['username'], $_REQUEST['password']); foreach ( $detprofiles as $profile ) { $monitor = $camera['monitor'];