Hi,<br><br>your code will not work in all circumstances. In particular, the way attribute work is that the MODIFY_*_ATTRIBUTE function is called during the BEGIN stage of the compilation process at a stage in which subroutines have not yet been given a name.
<br><br>The Attributes::Handler module works around that by calling the "find_sym" function during the CHECK compilation phase to identify what are the name of the syms. The function they use is the same one I have reused.
<br><br>Now, if you put your code in a module, let's say safe_call.pm, then the identification of module will take place during the compilation of safe_call.pm, and not during the compilation of t.pl. All subs will be identified as ANON.
<br><br><span style="font-family: courier new,monospace;">file t.pl:</span><br style="font-family: courier new,monospace;"><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 this_is_ok: Callable {...}<br>__END__<br></span><br>In the code which I propose, the find_sym sub is called at the first access to the safe_call() sub, which is after the compilation time.<br><br>Your code would work if the sub this_is_ok is part of the file for which the function sub Callable: ATTR is defined.
<br><br>Part of the difficulty stems from the fact that the MODIFY_*_ATTRIBUTE function is not called with a glob as a parameter but with a reference to the code instead. The glob must be found by doing a search through the symbol table, which is cumbersome.
<br><br>This could be the subject of an interesting, yet technical, lightning talk!<br><br>Cheers<br><br>R.<br><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>
> my query was actually generated from the material coming from your own web<br>> site! I think I understand better the security issues now.<br><br>Good... I hope... ;) Would this be from our sample chapter from the Perl
<br>Security course? The one that discusses that if you turn off strict then taint<br>mode won't save you from calling subroutines by symbolic reference?<br><br>> Solution 1: use a namespace convention such as<br>>
<br>> &("namespace_name_" . $sub}();<br>><br>> But this leaves the call by reference.<br><br>Indeed, and if 'namespace_name' is a package (the most obvious choice) there's<br>still a risk that a module that has been use'd has exported subroutines into
<br>that package.<br><br>> Solution 2: Use tags to flag which one are the subs which can be called from<br>> the outside and build the hashtable "on the fly" at execution time. This<br>> seems to be similar to what Catalyst does.
<br><br>[snip]<br><br>The trouble here is making it 'obviously correct'. Luckily, using<br>Attribute::Handlers is a good way of going about this. Attribute::Handlers<br>allows you to write subroutines which will then act when something with that
<br>attribute is declared.<br><br>The following *untested* code, with no warranty, provides an example of how we<br>can catch all subroutines declared with the 'Callable' attribute, and add them<br>to a hash of (name => coderef) pairs.
<br><br>#!/usr/bin/perl -w<br>use strict;<br><br>use Attribute::Handlers;<br><br>my %callable;<br><br># Remember subroutines marked as 'Callable' and place them into the<br># %callable hash declared above. This code does *not* examine the package
<br># into which such subroutines are declared. $_[0] contains the package<br># name if this is required.<br><br>sub Callable :ATTR {<br> my (undef, $glob, $sub_ref, undef, undef, undef) = @_;<br><br> if (ref($sub_ref) ne 'CODE') {
<br> croak q{'Callable' attribute set on non-subroutine};<br> }<br><br> if ($glob eq 'ANON') {<br> croak q{'Callable' attribute set on anonymous subroutine};<br> }<br><br>
# Find the name of the subroutine (technically the typeglob<br> # it was entered into). Note this does not provide the package<br> # name.<br><br> my $name = *{$glob}{NAME}<br> or die "Internal error: subroutine with no name";
<br><br> # Now plug our name -> coderef into our hash.<br><br> $callable{$name} = $sub_ref;<br><br> return;<br><br>}<br><br>__END__<br><br>Cheerio,<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></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>