[ic] Using Interchange as a SOAP server

Mike Heins mike at perusion.com
Wed Apr 13 10:12:11 EDT 2005


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

-- 
Mike Heins
Perusion -- Expert Interchange Consulting    http://www.perusion.com/
phone +1.765.647.1295  tollfree 800-949-1889 <mike at perusion.com>

People who want to share their religious views with you
almost never want you to share yours with them. -- Dave Barry


More information about the interchange-users mailing list