/usr/local/CPAN/RCGI/SafeCall.pm

• package SafeCall
  • Render_Safe
  • Execute
• EOF

package SafeCall;

use Safe;
use Carp qw( carp cluck);

sub Render_Safe {
    my($argument) = shift;
    my($result);
    my($compartment) = new Safe;
    my($quote) = ($argument =~ /^\s*[\'\"]/) ? 1 : 0;

    if ($argument =~ /^[\s\w\,\'\"]+$/) {
	return $argument;
    }
    if ($argument =~ /\`/) {
	return undef;
    }
    $result = $compartment->reval($argument .';');
    if (!defined($result) || $@ !~ /^\s*$/) {
	cluck $@;
	return undef;
    }
    if ($quote) {
	return "'".$result."'";
    } else {
	return $result;
    }
}

sub Execute {
    my($use_lib) = shift;
    my($module) = shift;
    my($subroutine) = shift;
    my($status_ref) = shift;
    my(@arguments) = @_;
    my($eval_code);
    my(@forbidden) = (
		      'POSIX'
		      );
    my($safe_module);
    my($safe_subroutine);
    
    # Process 'use lib library;'
    if (defined($use_lib) && $use_lib !~ /^\s*$/) {
	$eval_code = "use lib '$use_lib';\n";
    }
    $safe_module = Render_Safe($module);
    $safe_subroutine = Render_Safe($subroutine);
    if (!defined($safe_module) || $safe_module =~ /^\s*$/) {
	carp "Module name was not passed or was illegal";
	if (defined($status_ref) && $status_ref =~ /^SCALAR/) {
	    $$status_ref = -1;
	}
	return;
    }
    # Process 'use module;'
    map {
	if ( $safe_module eq $_) {
	    carp "Module: $_ is forbidden";
	    if (defined($status_ref) && $status_ref =~ /^SCALAR/) {
		$$status_ref = -2;
	    }
	    return;
	}
    } @forbidden;
    $eval_code .= "use $safe_module;\n";
    # Setup subroutine
    if (!defined($safe_subroutine) || $safe_subroutine =~ /^\s*$/) {
	carp "Subroutine name was not passed or was illegal";
	if (defined($status_ref) && $status_ref =~ /^SCALAR/) {
	    $$status_ref = -3;
	}
	return;
    }
    $eval_code .= "$safe_module\:\:$safe_subroutine( \@arguments );\n";
    if (defined($status_ref) && $status_ref =~ /^SCALAR/) {
	$$status_ref = 0;
    }
    return eval $eval_code;
}

1;