This queue is for tickets about the SOAP-Lite CPAN distribution.

Report information
The Basics
Id:
30945
Status:
open
Priority:
Low/Low
Queue:

People
Owner:
Nobody in particular
Requestors:
pierre.girard [...] in2p3.fr
Cc:
AdminCc:

BugTracker
Severity:
(no value)
Broken in:
(no value)
Fixed in:
(no value)



Subject: SOAP::Serializer::envelope: Client Denied access to method
Date: Sat, 24 Nov 2007 01:41:42 +0100
To: bug-SOAP-Lite@rt.cpan.org
From: Pierre GIRARD <pierre.girard@in2p3.fr>
Hello, I'm using SOAP::Lite 0.69.
Show quoted text
> [pierre@localhost SOAP]$ perl -MSOAP::Lite -e 'print > $SOAP::Lite::VERSION."\n";' > 0.69
I noticed a problem when SOAP::Transport::HTTP::Daemon is dynamically binding for the first time a perl module that has already been imported by the perl program. In such a case, if you request the call at any method of this imported module, you will get a "Client Denied access to method" error. - Problem That comes from a bad test at line 2500 of SOAP/Lite.pm within find_target method:
Show quoted text
> 2493 # TODO - sort this mess out: > 2494 # SOAP::Lite 0.60: > 2495 # unless (defined %{"${class}::"}) { > 2496 # Patch to SOAP::Lite 0.60: > 2497 # The following patch does not work for packages defined > within a BEGIN block > 2498 # unless (exists($INC{join '/', split /::/, $class.'.pm'})) { > 2499 # Combination of 0.60 and patch: > 2500 unless (defined(%{"*${class}::"}) || exists($INC{join '/', > split /::/, $class.'.pm'})) { > 2501 # allow all for static and only specified path for dynamic > bindings > 2502 local @INC = (($static ? @INC : ()), grep {!ref && > m![/\\.]!} $self->dispatch_to); > 2503 eval 'local $^W; ' . "require $class"; > 2504 die "Failed to access class ($class): $@" if $@; > 2505 $self->dispatched($class) unless $static; > 2506 }
Indeed, if $class was already used before executing this code, the above block is never performed and so, $class is never "dispatched". - Fix: I think that you should dispatch the class after the block:
Show quoted text
> 2500 unless (defined(%{"*${class}::"}) || exists($INC{join '/', > split /::/, $class.'.pm'})) { > 2501 # allow all for static and only specified path for dynamic > bindings > 2502 local @INC = (($static ? @INC : ()), grep {!ref && > m![/\\.]!} $self->dispatch_to); > 2503 eval 'local $^W; ' . "require $class"; > 2504 die "Failed to access class ($class): $@" if $@; > 2505 } > 2506 $self->dispatched($class) unless($static || grep > {/^$class$/} $self->dispatched) ;
And then remove the useless test
Show quoted text
> 2508 die "Denied access to method ($method_name) in class ($class)" > 2509 unless $static || grep {/^$class$/} $self->dispatched;
- Reproducing the problem ************ ./Modules/Hello.pm package Hello; sub new { my $class = shift; my $self = {}; bless ($self, $class); return $self; } sub hello { my $self = shift; my $name = shift; return "Hello $name"; } 1; ************ server code use SOAP::Transport::HTTP; my $daemon = SOAP::Transport::HTTP::Daemon -> new (LocalAddr => 'localhost', LocalPort => 80) -> dispatch_to('./Mdules'); print "Contact to SOAP server at ", $daemon->url, "\n"; $daemon->handle; ************ Emulate Hello->new()->hello("pierre") by using curl to send a SOAP message curl --stderr /dev/null \ -H "Content-Type: text/xml; charset=utf-8" \ -H "SOAPAction: \"urn:Hello#hello\"" \ -d "<SOAP-ENV:Envelope SOAP-ENV:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\" xmlns:SOAP-ENV=\"http://schemas.xmlsoap.org/soap/envelope/\" xmlns:namesp1=\"http://namespaces.soaplite.com/perl\" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\" xmlns:xsd=\"http://www.w3.org/2001/XMLSchema\" xmlns:SOAP-ENC=\"http://schemas.xmlsoap.org/soap/encoding/\"> <SOAP-ENV:Header> </SOAP-ENV:Header> <SOAP-ENV:Body> <hello xmlns=\"urn:Hello\"> <!-- FAILURE COMES FROM THERE: The first argument is a Hello instance. So, in order to evaluate the hello method arguments, SOAP server will prematurely require Hello.pm module without declaring it as a dispatched module of the server. the hello call will then fail because Hello module is already used but it is not part of the dispatched module. --> <Hello xsi:type=\"namesp1:Hello\"/> <c-gensym3 xsi:type=\"xsd:string\">Herong</c-gensym3> </hello> </SOAP-ENV:Body> </SOAP-ENV:Envelope>" http://localhost:80 ************ Result <?xml version="1.0" encoding="UTF-8"?><soap:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsd="http://www.w3.org/2001/XMLSchema" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"><soap:Body><soap:Fault><faultcode>soap:Client</faultcode><faultstring>Denied access to method (hello) in class (Hello) at /usr/local/lib/perl5/site_perl/5.8.8/SOAP/Lite.pm line 2509. </faultstring><faultactor>http://localhost.localdomain:1981/</faultactor></soap:Fault></soap:Body></soap:Envelope> Hope that helps, Pierre
Subject: [rt.cpan.org #30945] Some additional clarifications and a quick fix
Date: Sat, 24 Nov 2007 20:26:53 +0100
To: bug-SOAP-Lite@rt.cpan.org
From: Pierre GIRARD <pierre.girard@in2p3.fr>
Hello again, Investigating a bit more about this problem, I understood better the problem: At line 2500:
Show quoted text
> 2500 unless (defined(%{"*${class}::"}) > || exists($INC{join '/',split /::/, $class.'.pm'})) {
you assume that 'defined(%{"${class}::"}' is false when handling the first SOAP message requiring this $class, but it can be true because of 2 reasons at least: 1) For any reason, you had to use the target module (Hello module here) in your server code before handling any SOAP message referring to this module.
Show quoted text
> use SOAP::Lite trace => [ 'all' ]; > use SOAP::Transport::HTTP; > use Modules::Hello > > # VIC (Very Importnt Code): > # make my server very polite by making it say 'hello' when starting > print Hello->new->hello('Pierre')."\n"; > > # Then, any SOAP message referring to any Hello method will fail. > my $daemon = SOAP::Transport::HTTP::Daemon > -> new (LocalAddr => 'localhost', LocalPort => 80) > -> dispatch_to('./Modules');
2) For some reason, a statement "bless($res => $class)" was prematurely executed. For instance, this the case with the SOAP message below:
Show quoted text
> <SOAP-ENV:Envelope > SOAP-ENV:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" > xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" > xmlns:namesp1="http://namespaces.soaplite.com/perl" > xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" > xmlns:xsd="http://www.w3.org/2001/XMLSchema" > xmlns:SOAP-ENC="http://schemas.xmlsoap.org/soap/encoding/"> > <SOAP-ENV:Header> > </SOAP-ENV:Header> > <SOAP-ENV:Body> > <hello xmlns="urn:Hello"> > <Hello xsi:type="namesp1:Hello"/> > <c-gensym3 xsi:type="xsd:string">Herong</c-gensym3> > </hello> > </SOAP-ENV:Body> > </SOAP-ENV:Envelope>
Indeed, by default, when decoding the value of first argument "<Hello xsi:type="namesp1:Hello"/>", a hash will be blessed into "Hello". Consequently, 'defined(%{"*Hello::"} will be true, even if Hello package has not yet been required and then, its methods are not yet available. Proposed solutions: - To solve 1st case, take the class dispatching out of 'unless' block, as proposed in my previous message. - To solve 2nd case, it's a bit more complicated, but we can propose different solutions: a- Don't bless into a class without checking before that the required class is already available. b- Find a better way than 'defined(%{"*${class}::"}' test to check the availability of the class In both a) and b), you need to be able to check that the class is already in use, but I don't know how to do it in Perl. Let me know if you know how to do so. However, I can at least make your test stronger by checking whether the called method of the class actually exists or not by replacing 'defined(%{"${class}::"})' by 'exists(${"${class}::"}{${method_name}}'. So for now, my complete quick fix to your code to deal with my problems is:
Show quoted text
> unless (exists(${"${class}::"}{${method_name}}) || exists($INC{join > '/', split /::/, $class.'.pm'})) { > # allow all for static and only specified path for dynamic bindings > local @INC = (($static ? @INC : ()), grep {!ref && m![/\\.]!} > $self->dispatch_to); > eval 'local $^W; ' . "require $class"; > die "Failed to access class ($class): $@" if $@; > } > > $self->dispatched($class) unless $static || grep {/^$class$/} > $self->dispatched; > > return ($class, $method_uri, $method_name);
It seems to work. Let me know if there is any problem with that. Cheers Pierre
Hi Pierre, in fact, for 2), there's no easy way out. Perl creates a packages symbol table entry by its first use, so you can't check whether a class has been loaded properly or been created on the fly (accidentally or on purpose - class factories use this), so one cannot trust defined(%{"*${class}::"} for this question. Chacking %INC is a bad idea either: It just answers whether a file with that name has been loaded, not if the file contained the package in question. exists(${"${class}::"}{${method_name}} actually checks whether the class contains any symbol (scalar, hash, array, glob, or subroutine) of the name $method_name, and should be replaced by exists &{ "$class\::$method_name } (which, to my knowledge, is the fastest way to check whether a subroutine exists in the class in question). However, this still neglects inheritance (the class in question might inherit the method from a base class), so we would have to use $class->can($method_name), and it neglects AUTOLOAD which simply cannot be tested. So problem 2) looks pretty much unsolveable in current perls - it would require the ability to check whether a class has been defind via "package $class;". I will, however, adress 1) - but I'll have to dig into HTTP::Server to make sure the security checks actually do what they're supposed to, so it'll take a few days. Thanks for reporting, Martin
Hi Pierre, in fact, for 2), there's no easy way out. Perl creates a packages symbol table entry by its first use, so you can't check whether a class has been loaded properly or been created on the fly (accidentally or on purpose - class factories use this), so one cannot trust defined(%{"*${class}::"} for this question. Chacking %INC is a bad idea either: It just answers whether a file with that name has been loaded, not if the file contained the package in question. exists(${"${class}::"}{${method_name}} actually checks whether the class contains any symbol (scalar, hash, array, glob, or subroutine) of the name $method_name, and should be replaced by exists &{ "$class\::$method_name } (which, to my knowledge, is the fastest way to check whether a subroutine exists in the class in question). However, this still neglects inheritance (the class in question might inherit the method from a base class), so we would have to use $class->can($method_name), and it neglects AUTOLOAD which simply cannot be tested. So problem 2) looks pretty much unsolveable in current perls - it would require the ability to check whether a class has been defind via "package $class;". I will, however, adress 1) - but I'll have to dig into HTTP::Server to make sure the security checks actually do what they're supposed to, so it'll take a few days. Thanks for reporting, Martin


This service runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.