[ic] Using Interchange as a SOAP server

Chris Sendall cjs2 at admin.cam.ac.uk
Wed Apr 13 11:43:08 EDT 2005


interchange-users-bounces at icdevgroup.org wrote:
> Quoting Dr. Michael Streubel (michael.streubel at ibizplanet.com):
>> 
>> 
>> Kevin Walsh wrote:
>> 
>>> Dr. Michael Streubel [michael.streubel at ibizplanet.com] wrote:
>>>> However, it appears to me that there is a bug in Vend/SOAP.pm
>>>> where there is a loop of the form 
>>>> 
>>>> for $subref ($Global::SOAP_Control,    
>>>> $Vend::Cfg->{SOAP_Control}) { 
>>>> 
>>>> with the intention to give global control configurations
>>>> precedence over local ones. But that doesn't seem to work. So
>>>> replace this statement by 
>>>> 
>>>> for $subref ( $Vend::Cfg->{SOAP_Control}) {
>>>> 
>>>> and it'll work. Hope that helps.
>>>> 
>>>> 
>>>> 
>>> A better patch could be to add the line marked with a "+" below:
>>> 
>>>       for $subref ($Global::SOAP_Control,
>>>                                $Vend::Cfg->{SOAP_Control}) {
>>> +               next unless $subref;
>>>               @args = @_;
>>> 
>>> I haven't tested that patch, but it looks as if it'll fix the
>>> problem you described. 
>>> 
>>> 
>>> 
>> Well, I guess the patch should be something like
>> 
>> +               next unless keys %$subref;
>> 
>> 
>> since $Global::SOAP_Control is an existing hash reference in any
>> case. But thanks for your looking into it more closely.
> 
> Hmm. I can't get the code to fail in testing. The only reason that it
> would fail is that the value of $Global::SOAP_Control is not correct,
> and I don't think that is the case.
> 
> Can you give me an idea of the failure mode? This test prints:
> 
>     foo=1
>     bar=0
>     baz=1
>     buz=0
>     boo=0
> 
> as I think it should.
> 
> ## Begin standalone test code
> 
> $Global::SOAP_Control = {
> 	foo => 'always',
> 	bar => 'always',
> 	baz => 'local',
> 	buz => 'local',
> };
> 
> $Vend::Cfg = {
> 	SOAP_Control => {
> 		foo => 'always',
> 		bar => 'never',
> 		buz => 'never',
> 	},
> };
> 
> $CGI::remote_addr = '127.0.0.1';
> 
> my %intrinsic = (local => sub {$CGI::remote_addr eq '127.0.0.1'},
> 				never => sub {return 0},
> 				always => sub {return 1});
> 
> sub soap_gate {
> 	my (@args, $status, $subref, $spath);
> 
> 	# check first global control configuration which takes
> 	# precedence, then catalog control configuration
> 	for $subref ($Global::SOAP_Control,
> 				 $Vend::Cfg->{SOAP_Control}) {
> 		@args = @_;
> 
> 		while (@args) {
> 			$spath = join('/', @args);
> 			pop(@args);
> 			next unless exists $subref->{$spath};
> 
> 			if (ref($subref->{$spath}) eq 'CODE') {
> 				$status = $subref->{$spath}->($spath);
> 			} elsif ($subref->{$spath}) {
> 				$status =
soap_control_intrinsic($subref->{$spath}, $spath);
> 			}
> 
> 			# check found, done with loop
> 			last;
> 		}
> 
> 		last unless $status;
> 	}
> 
> 	unless($status) {
> 	    return 0;
> 	}
> 
> 	return 1;
> }
> 
> sub soap_control_intrinsic {
> 	my ($checklist, $action) = @_;
> 	my @checks = split /\s*;\s*/, $checklist;
> 	my $status = 1;
> 
> 	for(@checks) {
> 		my ($check, @args) = split /:/, $_;
> 		my $sub = $intrinsic{$check} or return 0;
> 
> 		unless( $sub->($action, @args) ) {
> 			$status = 0;
> 			last;
> 		}
> 	}
> 	return $status;
> }
> 
> for(qw/ foo bar baz buz boo / ) {
>     print "$_=";
>     print soap_gate($_);
>     print "\n";
> }
> 
> ## End standalone test code

Thanks to Michael for the help, basically works now.

If there are no SOAP_Control definitions in interchange.cfg then the catalog.cfg
is not checked

I added some debug statements
sub soap_gate {
        my (@args, $status, $subref, $spath);

        # check first global control configuration which takes
        # precedence, then catalog control configuration
        for $subref ($Global::SOAP_Control,$Vend::Cfg->{SOAP_Control}) {
            #next unless keys %$subref;
::logDebug("SOAP soap_gate subref $subref");
            foreach my $key (keys %$subref) {
::logDebug("SOAP soap_gate subref{$key} = $subref->{$key}");
}
                    @args = @_;

                while (@args) {
                        $spath = join('/', @args);
::logDebug("SOAP soap_gate spath $spath");
                        pop(@args);
                        next unless exists $subref->{$spath};
::logDebug("SOAP soap_gate spath $spath FOUND $subref->{$spath}");
                        if (ref($subref->{$spath}) eq 'CODE') {
                                $status = $subref->{$spath}->($spath);
                        } elsif ($subref->{$spath}) {
                                $status = soap_control_intrinsic($subref->{$spa\
th}, $spath);
                        }
::logDebug("SOAP soap_gate status $status");

                        # check found, done with loop
                        last;
                }

                last unless $status;
        }

        die errmsg("Unauthorized access to '%s' method\n", join('/', @_))
                unless $status;

        return 1;
}

interchange.cfg:
SOAP_Control Tag/order always
SOAP_Control Tag/userdb always
SOAP_Control Tag/value always

catalog.cfg
SOAP_Control  Tag/userdb always
SOAP_Control  Tag/order  always
SOAP_Control  Tag/process  always

Diagnostics for processing 'order' loops through both hashes.

Vend::SOAP:debug: SOAP call soap_gate 'Tag' order
Vend::SOAP:debug: SOAP soap_gate subref HASH(0xad6bce8)
Vend::SOAP:debug: SOAP soap_gate subref{Tag/value} = always
Vend::SOAP:debug: SOAP soap_gate subref{Tag/order} = always
Vend::SOAP:debug: SOAP soap_gate subref{Tag/userdb} = always
Vend::SOAP:debug: SOAP soap_gate spath Tag/order
Vend::SOAP:debug: SOAP soap_gate spath Tag/order FOUND always
Vend::SOAP:debug: SOAP soap_control_intrinsic always Tag/order
Vend::SOAP:debug: SOAP soap_control_intrinsic check always
Vend::SOAP:debug: SOAP soap_control_intrinsic sub CODE(0xafc174c)
Vend::SOAP:debug: SOAP soap_gate status 1
Vend::SOAP:debug: SOAP soap_gate subref HASH(0xbaf8768)
Vend::SOAP:debug: SOAP soap_gate subref{Tag/process} = always
Vend::SOAP:debug: SOAP soap_gate subref{_mvsafe} = Safe=HASH(0xbae7f50)
Vend::SOAP:debug: SOAP soap_gate subref{Tag/order} = always
Vend::SOAP:debug: SOAP soap_gate subref{Tag/userdb} = always
Vend::SOAP:debug: SOAP soap_gate spath Tag/order
Vend::SOAP:debug: SOAP soap_gate spath Tag/order FOUND always
Vend::SOAP:debug: SOAP soap_control_intrinsic always Tag/order
Vend::SOAP:debug: SOAP soap_control_intrinsic check always
Vend::SOAP:debug: SOAP soap_control_intrinsic sub CODE(0xafc174c)
Vend::SOAP:debug: SOAP soap_gate status 1
Vend::SOAP:debug: do_tag order, args=[
  {
    'quantity' => '2',
    'code' => 'os90001'
  }

Diagnostics for processing 'process' loops through first hash and because not
found, $status is undef and last unless $status  exits from loop.
Vend::SOAP:debug: SOAP call soap_gate 'Tag' process
Vend::SOAP:debug: SOAP soap_gate subref HASH(0xad6bce8)
Vend::SOAP:debug: SOAP soap_gate subref{Tag/value} = always
Vend::SOAP:debug: SOAP soap_gate subref{Tag/order} = always
Vend::SOAP:debug: SOAP soap_gate subref{Tag/userdb} = always
Vend::SOAP:debug: SOAP soap_gate spath Tag/process
Vend::SOAP:debug: SOAP soap_gate spath Tag


Chris


-- 

Chris Sendall
MISD, First Floor, Greenwich House, Madingley Rise, Madingley Road,
Cambridge, CB3 0TX. Telephone: +44 1223 339653    Fax: +44 1223 339003 
e-mail:cjs2 at admin.cam.ac.uk 




More information about the interchange-users mailing list