Calling subroutines.
Hi,
I want to be able to do something like the following:
perl
my $method = shift(@ARGV);
my @vars = @ARGV;
eval {
$method(@vars);
};
if ($@) {
die Method doesn't exist;
}
sub METH1 {
my @passed_vars = @_;
print Welcome to method 1;
}
package MyPgk;
sub METH2 {
my @passed_vars = @_;
print Welcome to method 1;
}
/perl
So the above code would work for methods called METH1 and MyPgk::METH2
but no other.
I realise that what is passed could be tainted and need to check for
that, I was just wondering if there was a nice way of doing this or
whether I should do it at all?
TIA
Andy
Re: Calling subroutines.
Andy Williams (IMAP HILLWAY) wrote:
Hi,
I want to be able to do something like the following:
perl
my $method = shift(@ARGV);
my @vars = @ARGV;
eval {
$method(@vars);
};
if ($@) {
die Method doesn't exist;
}
sub METH1 {
my @passed_vars = @_;
print Welcome to method 1;
}
package MyPgk;
sub METH2 {
my @passed_vars = @_;
print Welcome to method 1;
}
/perl
So the above code would work for methods called METH1 and MyPgk::METH2
but no other.
I realise that what is passed could be tainted and need to check for
that, I was just wondering if there was a nice way of doing this or
whether I should do it at all?
'can' does this?
package Monster;
sub method_monster { print 'monster' };
package main;
for ('Monster::method_monster', 'arse', 'main_method') {
print main-can ($_);
}
sub main_method { print 'method main' }
[EMAIL PROTECTED] jmccrea]$ perl -l testy
CODE(0x8104124)
CODE(0x81041d8)
[EMAIL PROTECTED] jmccrea]$
Unless I'm totally misunderstanding what the problem is?
Jasper
Re: Calling subroutines.
Andy Williams (IMAP HILLWAY) wrote:
Hi,
I want to be able to do something like the following:
perl
my $method = shift(@ARGV);
my @vars = @ARGV;
eval {
$method(@vars);
};
if ($@) {
die Method doesn't exist;
}
sub METH1 {
my @passed_vars = @_;
print Welcome to method 1;
}
package MyPgk;
sub METH2 {
my @passed_vars = @_;
print Welcome to method 1;
}
/perl
So the above code would work for methods called METH1 and MyPgk::METH2
but no other.
A nice simple way of doing that would be to have a hash of valid values
for $method.
my %valid = (
'METH1' = 1,
'MyPkg::METH2' = 1
);
if ($method and $valid{$method}) {
{
no strict 'refs';
eval { $method(@args) };
}
if ($@) {
my $args = join(', ', map {'$_'} @args);
warn Error doing $method($args):[EMAIL PROTECTED];
}
}
else {
die Invalid method $method\n;
}
That way you know that only approved subroutines can be called.
I realise that what is passed could be tainted and need to check for
that, I was just wondering if there was a nice way of doing this or
whether I should do it at all.
Tainted data is only a problem when you interact with the shell, AFAIK.
If this program is supposed to interact with the shell, I'd say find
another way of doing it, cause it's probably going to end up being a
total hornet's nest.
HTH,
Matt
Re: Calling subroutines.
I realise that what is passed could be tainted and need to check for
that, I was just wondering if there was a nice way of doing this or
whether I should do it at all?
Maybe not a 'nice' approach, but definitely effective in this case,
would walking the main stash. So something like this would do it
sub find_sub {
my($pkg, $method) = @_;
my $ret;
return $ret
if $ret = $pkg-can($method);
for(keys %{$pkg\::}) {
next if $_ eq $pkg\::;
$ret = find_sub($1 = $method)
if /(.*)\b::$/ and defined %{$1\::};
}
return $ret;
}
die Usage: $0 METHOD [ARGS]\n
unless @ARGV;
my($method, @vars) = @ARGV;
die $0: couldn't find subroutine '$method'\n
unless my $sub = find_sub main = $method;
$sub-( @vars );
exit(0);
sub METH1 {
my @passed_vars = @_;
print Welcome to method 1\n;
}
package MyPgk;
sub METH2 {
my @passed_vars = @_;
print Welcome to method 2\n;
}
Now if you run it at the command-line
shell perl find_sub.pl METH1
Welcome to method 1
shell perl find_sub.pl METH2
Welcome to method 2
shell perl find_sub.pl NOFUNC
do_method.pl: couldn't find subroutine 'NOFUNC'
Hope that helps.
Dan
RE: Calling subroutines.
-Original Message-
From: [EMAIL PROTECTED]
[mailto:[EMAIL PROTECTED] On Behalf Of Matt Lawrence
Sent: 01 August 2003 16:20
To: [EMAIL PROTECTED]
Subject: Re: Calling subroutines.
A nice simple way of doing that would be to have a hash of
valid values
for $method.
my %valid = (
'METH1' = 1,
'MyPkg::METH2' = 1
);
if ($method and $valid{$method}) {
{
no strict 'refs';
eval { $method(@args) };
}
if ($@) {
my $args = join(', ', map {'$_'} @args);
warn Error doing $method($args):[EMAIL PROTECTED];
}
}
else {
die Invalid method $method\n;
}
That way you know that only approved subroutines can be called.
Great thanks.
I had thought of doing that but it needs to know about subroutines that
another programmer may put in an entirely different package. (Basically
I will be the only one to have access to this code).
I guess I can just leave the hash off. but that just doesn't feel
very secure maybe it's just me :)
Andy
Re: Calling subroutines.
Andy Williams (IMAP HILLWAY) wrote: Great thanks. I had thought of doing that but it needs to know about subroutines that another programmer may put in an entirely different package. (Basically I will be the only one to have access to this code). Er... you seem confused. If you're the only one with access to this code, who's the another programmer? (: I suspect can is probably the tidiest way of doing what you want (it'll work with inheritance everything, if that matters) I guess I can just leave the hash off. but that just doesn't feel very secure maybe it's just me :) I agree. This is only partly about security, though. _If_ you are dealing with dubious data which might say store, or alternatively `rm -rf /`, you'd better not say eval $dubious_data or you'd be in trouble. It's more particularly a matter of knowing what your interfaces are up to, and not having unexpected methods/functions (DESTROY?) called without realising what's going on. (This is more of a problem where other programmers are involved - to parapharse Satre, hell is [what] other people [do to your interfaces] - but it's fairly easy to pervert one's own interfaces by mistake). HTH, -- Ti'
