From fdf32a8a6ce00b0567463fbaf6a124dc4a88f146 Mon Sep 17 00:00:00 2001 From: Andreas Granig Date: Wed, 15 Mar 2017 15:57:11 +0100 Subject: [PATCH] TT#1678 Properly type SOAP responses using WSDL Took the Utils/SOAP.pm from ossbss Backend.pm and adapted for ngcp-panel usage to properly type the response elements in accordance to the WSDL. Change-Id: I8d8011b5ff256c65469a006d4e0c76467a2325a5 --- debian/control | 1 + lib/NGCP/Panel/Controller/SOAP/Intercept.pm | 17 ++- lib/NGCP/Panel/Utils/SOAP.pm | 145 ++++++++++++++++++++ 3 files changed, 156 insertions(+), 7 deletions(-) create mode 100644 lib/NGCP/Panel/Utils/SOAP.pm diff --git a/debian/control b/debian/control index 768c9dac7a..b651ec0dcb 100644 --- a/debian/control +++ b/debian/control @@ -88,6 +88,7 @@ Depends: gettext, libsereal-encoder-perl, libsipwise-base-perl, libsoap-lite-perl, + libsoap-wsdl-perl, libstring-mkpasswd-perl, libtemplate-perl, libtemplate-plugin-json-escape-perl, diff --git a/lib/NGCP/Panel/Controller/SOAP/Intercept.pm b/lib/NGCP/Panel/Controller/SOAP/Intercept.pm index 081997c952..f2505c5002 100644 --- a/lib/NGCP/Panel/Controller/SOAP/Intercept.pm +++ b/lib/NGCP/Panel/Controller/SOAP/Intercept.pm @@ -18,7 +18,9 @@ sub thewsdl : GET Path('/SOAP/Intercept.wsdl') :Local :Args() { sub index : POST Path('/SOAP/Intercept') { my ($self, $c) = @_; my $h = Sipwise::SOAP::Intercept->new(c => $c); - my $out = SOAP::Transport::LOCAL::Client->new + my $server = SOAP::Transport::LOCAL::Client->new; + $server->serializer->register_ns('http://dev.sipwise.com/SOAP/Provisioning/Types', 'typens'); + my $out = $server ->dispatch_with({ 'urn:/SOAP/Intercept' => $h }) ->handle($c->req->body); $c->response->content_type('text/xml'); @@ -32,6 +34,7 @@ use NGCP::Panel::Form::Intercept::Create; use NGCP::Panel::Form::Intercept::Update; use NGCP::Panel::Form::Intercept::Delete; use Data::Structure::Util qw/unbless/; +use NGCP::Panel::Utils::SOAP qw/typed/; use UUID; use Moose; use NGCP::Panel::Utils::Admin; @@ -179,7 +182,7 @@ sub create_interception { ->faultstring($e); } } - return $i->id; + return typed($c, $i->id); } sub update_interception { @@ -329,7 +332,7 @@ sub get_interception_by_id { ->faultstring("interception ID '$$params{id}' does not exist"); } - return { + return typed($c, { id => $i->id, LIID => $i->LIID, number => $i->number, @@ -344,7 +347,7 @@ sub get_interception_by_id { host => $i->cc_delivery_host, port => $i->cc_delivery_port, } - }; + }); } sub get_interceptions_by_liid { @@ -382,7 +385,7 @@ sub get_interceptions_by_liid { ->faultcode('Server.Internal') ->faultstring($e); } - return \@interceptions; + return typed($c, \@interceptions); } sub get_interceptions_by_number { @@ -420,7 +423,7 @@ sub get_interceptions_by_number { ->faultcode('Server.Internal') ->faultstring($e); } - return \@interceptions; + return typed($c, \@interceptions); } sub get_interceptions { @@ -457,7 +460,7 @@ sub get_interceptions { ->faultcode('Server.Internal') ->faultstring($e); } - return \@interceptions; + return typed($c, \@interceptions); } diff --git a/lib/NGCP/Panel/Utils/SOAP.pm b/lib/NGCP/Panel/Utils/SOAP.pm new file mode 100644 index 0000000000..99b8e18479 --- /dev/null +++ b/lib/NGCP/Panel/Utils/SOAP.pm @@ -0,0 +1,145 @@ +package NGCP::Panel::Utils::SOAP; +use strict; +use warnings; + +use SOAP::Lite; +use SOAP::WSDL::Expat::WSDLParser; +use SOAP::WSDL::XSD::Schema; +use XML::Simple; + +use Exporter qw(import); +our @EXPORT = qw(); +our @EXPORT_OK = qw(typed); +our %EXPORT_TAGS = qw(); +$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0; + +sub typed; +sub dotype; + +my $Parser = SOAP::WSDL::Expat::WSDLParser->new(); +my %Wsdls; +my $Wsdl; +my $TNS; +my $TTNS; + +### SOAP data typing function ### +sub typed { + my $c = shift; + my $response = shift; + + my $function = (caller(1))[3]; + return $response unless $function =~ /^Sipwise::(SOAP)::([^:]+)::([^:]+)$/; + my $transport = $1; + my $package = $2; + $function = $3; + + + my $WSDL = 'https://127.0.0.1:'. $c->config->{intercept}{soap_port} .'/SOAP/' . $package . '.wsdl'; + unless(exists $Wsdls{$package}) { + $Wsdls{$package} = $Parser->parse_uri($WSDL); + } + + $Wsdl = $Wsdls{$package}; + $TNS = $Wsdl->get_targetNamespace(); + $TTNS = ${${$Wsdl->get_types()}[0]->get_schema()}[-1]->get_targetNamespace(); + my $nss = ${${$Wsdl->get_types()}[0]->get_schema()}[-1]->get_xmlns(); + my $typens = 'typens'; + for(eval {keys %$nss}) { + if($$nss{$_} eq $TTNS) { + $typens = $_; + last; + } + } + + my $resmsg = eval { ${$Wsdl->find_portType($TNS, $package.'PortType')->find_operation($TNS, $function)->get_output()}[0]->get_message()}; + return $response unless defined $resmsg; + + $resmsg =~ s/^.+://; + + if(defined ${$Wsdl->find_message($TNS, $resmsg)->get_part()}[0]) { + my $resnam = ${$Wsdl->find_message($TNS, $resmsg)->get_part()}[0]->get_name(); + my $restyp = ${$Wsdl->find_message($TNS, $resmsg)->get_part()}[0]->get_type(); + if($restyp =~ /^$typens:/) { + $response = dotype($resnam, $restyp, $response, $transport); +# $response = SOAP::Data->name($resnam => $response); + } else { + $restyp =~ s/^(.+)://; + $response = SOAP::Data->name($resnam => $response)->type($restyp); + } + } else { # "empty_Response" for void functions + return $transport eq 'XMLRPC' ? undef : (); + } + + return $response; +} + +sub dotype { + my ($resnam, $restyp, $response, $transport) = @_; + my $tresponse; + + if($restyp =~ /^(.+):(.+)$/) { + my $cns = $1; + my $ctype = $2; + if($ctype =~ s/Array$//) { + $ctype =~ s/^String$/string/; + if(eval { @$response }) { + if($ctype eq 'boolean' or $ctype eq 'int' or $ctype eq 'string') { + for(eval { @$response }) { + push @$tresponse, SOAP::Data->name(item => $_)->type($ctype); + } + } else { + for(eval { @$response }) { + push @$tresponse, dotype('item', "$cns:$ctype", $_, $transport); + } + } + $tresponse = SOAP::Data->name($resnam => $tresponse); + } else { + if($ctype eq 'boolean' or $ctype eq 'int' or $ctype eq 'string') { + $tresponse = SOAP::Data->name($resnam => [])->attr({'soapenc:arrayType' => "xsd:$ctype".'[0]'}); + } else { + # FIXME: data types should be set to XMLRPC simple types for transport via XMLRPC + # (because no other data types are known) + # not fixed to avoid possible side-effects + $tresponse = SOAP::Data->name($resnam => [])->attr({'soapenc:arrayType' => "$cns:$ctype".'[0]'}); + } + } + } elsif ($ctype =~ /Enum$/) { + # set data types to string for transport via XMLRPC + # (because the WSDL enum types are not known) + if ($transport eq 'XMLRPC' || $ENV{HTTP_USER_AGENT} =~ /SOAP::Lite/i) { + $tresponse = SOAP::Data->name($resnam => $response)->type('string'); + } else { + $tresponse = SOAP::Data->name($resnam => $response)->type("$cns:$ctype"); + } + } else { + $restyp =~ s/^(.+)://; + my $typdef = ${$Wsdl->get_types()}[0]->find_type($TTNS, $restyp); + foreach my $telem (@{$typdef->get_element()}) { + my $tnam = $telem->get_name(); + my $ttyp = $telem->get_type(); + $$tresponse{$tnam} = dotype($tnam, $ttyp, $$response{$tnam}, $transport); + } + # FIXME: data types should be set to XMLRPC simple types for transport via XMLRPC + # (because no other data types are known) + # not fixed to avoid possible side-effects + $tresponse = SOAP::Data->name($resnam => $tresponse)->type("$cns:$restyp"); + } + } else { + # fix some types for trasport via XMLRPC + # (because defaults are the SOAP types) + if ($transport eq 'XMLRPC') { + $restyp =~ s/^base64Binary$/base64/; + $restyp =~ s/^float$/double/; + + # prevent "" in response for NULL values + if ($restyp eq 'int' and not defined $response) { + $response = 0; + } + } + $tresponse = SOAP::Data->name($resnam => $response)->type($restyp); + } + + return $tresponse; +} + +1;