Hi Paul,<br><br>my query was actually generated from the material coming from your own web site! I think I understand better the security issues now.<br><br>I have thought of some other solutions than using a hash table. Having to maintain the hash table can be cumbersome to maintain or not applicable to all situations.
<br><br><span style="font-weight: bold;">Solution 1:</span> use a namespace convention such as<br><br><span style="font-family: courier new,monospace;">&("namespace_name_" . $sub}(); </span><br><br>But this leaves the call by reference.
<br><br><span style="font-weight: bold;">Solution 2:</span> Use tags to flag which one are the subs which can be called from the outside and build the hashtable "on the fly" at execution time. This seems to be similar to what Catalyst does.
<br><br>for instance:<br><br><span style="font-family: courier new,monospace;">#!/usr/bin/perl</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">use safe_call;</span><br style="font-family: courier new,monospace;">
<br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">sub can_be_called: Callable { ...... }</span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;">
<span style="font-family: courier new,monospace;">my $sub = $ENV{QUERY_STRING};</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">safe_call($sub);</span><br><br>and in safe_call.pm
<br><br><span style="font-family: courier new,monospace;">my %symcache;</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">my @declarations;</span><br style="font-family: courier new,monospace;">
<span style="font-family: courier new,monospace;">my $identified = 0;</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">my %callable;</span><br style="font-family: courier new,monospace;">
<br><span style="font-family: courier new,monospace;">#from Attribute::Handlers</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">sub findsym {<br style="font-family: courier new,monospace;">
</span><span style="font-family: courier new,monospace;"> my ($pkg, $ref) = @_;</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> return $symcache{$pkg,$ref} if $symcache{$pkg,$ref};
</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> $type ||= ref($ref);</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">
foreach my $sym ( values %{$pkg."::"} ) {</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> if (*{$sym}{$type} && *{$sym}{$type} == $ref) {
</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> $callable{ *{$sym}{NAME} } = 1;</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">
#print "added ", *{$sym}{NAME}, "\n";</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> $symcache{$pkg,$ref} = \$sym</span>
<br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> }</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> }
</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">}</span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">
#just stores the declarations for later identification</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">sub MODIFY_CODE_ATTRIBUTES</span><br style="font-family: courier new,monospace;">
<span style="font-family: courier new,monospace;">{</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> my ($module, $ref, @attributes) = @_;</span><br style="font-family: courier new,monospace;">
<span style="font-family: courier new,monospace;"> my @other_attr;</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> foreach (@attributes) {</span><br style="font-family: courier new,monospace;">
<span style="font-family: courier new,monospace;"> if ($_ eq "Callable") { push @declarations, [ $module, $ref ]; }</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">
else { push @other_attr, $_;};</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> }</span><span style="font-family: courier new,monospace;"></span><br style="font-family: courier new,monospace;">
<span style="font-family: courier new,monospace;"> return @other_attr;</span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">
}</span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">sub identify</span><br style="font-family: courier new,monospace;">
<span style="font-family: courier new,monospace;">{</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> foreach (@declarations) {</span><br style="font-family: courier new,monospace;">
<span style="font-family: courier new,monospace;"> findsym @$_[0,1];</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> }</span><br style="font-family: courier new,monospace;">
<span style="font-family: courier new,monospace;"> $identified = 1;</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">}</span><br style="font-family: courier new,monospace;">
<br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">sub safe_call {</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> identify() unless $identified;
</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> $sub_name = shift;</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">
if ($callable{$sub_name}) {</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> &{$sub_name};</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">
}</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> else {</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">
die "Trying to call unallowed sub $sub_name \n";</span><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;"> }</span><br style="font-family: courier new,monospace;">
<span style="font-family: courier new,monospace;">}</span><br style="font-family: courier new,monospace;"><br style="font-family: courier new,monospace;"><span style="font-family: courier new,monospace;">1;</span><br><br>
I am sure that the above can be improved.<br><br>R.<br><br><div><span class="gmail_quote">On 1/31/06, <b class="gmail_sendername">Paul Fenwick</b> <<a href="mailto:pjf@perltraining.com.au">pjf@perltraining.com.au</a>> wrote:
</span><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">G'day Raphael,<br><br>Raphael Alla wrote:<br><br>> *#!/usr/bin/perl<br>> my $sub = $ENV{QUERY_STRING};
<br>> &{$sub};<br><br>This code warrants that every subroutine from every module and library you have<br>loaded is perfectly safe to be called without arguments by a hostile attacker.<br>That's a very big warrant.<br>
<br>&{$sub} does not in any way restrict you to your own package. If your<br>subroutine specifies a subroutine in another package (eg:<br>'Dangerous::Package::Kaboom') then that *will* be called.<br><br>To make matters worse, the use of &{...} syntax results in the contents of @_
<br>being passed implicitly to the subroutine, something which not many people expect.<br><br>This code has two fundamental problems, even if there are some circumstances<br>where you may not be able to exploit them:<br><br>
* It results in action from a distance. Any subroutine from any<br> module could be called, making it *very* hard to determine all<br> possible execution paths. This is not only very bad for security,
<br> it also makes debugging and maintenance difficult. This is reason<br> enough to never ever use symbolic references.<br><br> * It is the antithesis to 'deny by default'. Any potential hole<br>
elsewhere in the program is magnified greatly by the code above.<br><br>I personally would never allow such code past review, let alone run in a<br>security sensitive context.<br><br>All the best,<br><br> Paul
<br><br>--<br>Paul Fenwick <<a href="mailto:pjf@perltraining.com.au">pjf@perltraining.com.au</a>> | <a href="http://perltraining.com.au/">http://perltraining.com.au/</a><br>Director of Training | Ph: +61 3 9354 6001
<br>Perl Training Australia | Fax: +61 3 9354 2681<br>_______________________________________________<br>Melbourne-pm mailing list<br><a href="mailto:Melbourne-pm@pm.org">Melbourne-pm@pm.org</a><br><a href="http://mail.pm.org/mailman/listinfo/melbourne-pm">
http://mail.pm.org/mailman/listinfo/melbourne-pm</a><br></blockquote></div><br><br clear="all"><br>-- <br>Raphael Alla<br>Mitija Australia<br>+61 4 15 678 576<br><br>Premium open source accounting for Australia<br><a href="http://www.thetravelingaccountant.com">
http://www.thetravelingaccountant.com</a>