no strict "refs" and require

little has asked for the wisdom of the Perl Monks concerning the following question:

At first: I know that there are tons of Modules out there and I know how to use em. But as somebody asked me for a quick solution I came up with this.

The Question about was to have "template" files in which he simply could reference to predefined or otherwise provided values which should replace the call made.

For example:

The line "I don't wanna $boo with you." should end up as "I dont wanna dance with you" with $boo = "dance"; The Configuration itself is extracted from a plain text file called cfg which in my eyes is not a problem.
However the script runs as is without errors or warnings, but my concern is that the person wants to have a file in which it can define values alike:

file: "values.dat" /#usr/bin/perl $foo = "this"; $bar = "the other one" 1; The Configuration itself is extracted from a plain text file called cfg which in my eyes is not a problem.

So as I use require inside a BEGIN to load this file, and it is called with a "wrong" extension at will, I am still concerned about security.

Just, I don't know what it is that gives me the feeling I abused somewhat 'the no strict "refs"' just to keep me happy saying "hey look, it uses strict ..."

BUT...

Where is the gap? Can you tell me, I don't see it but I feel it is there. Sitting inside the SUB getValue just with that 'no strict "refs"'.

Ok, but however, you could as well tell me how to keep the kind of file the 'somebody' wants but not to take the risk that ships with it, actually I've been thinking of parsing the file instead of requiring it, so he could keep that format and I don't load myself with security risks which I am trying to prevent.

I am looking forward to your comments and suggestions.

#!/usr/bin/perl -wT
use strict;
$|++;


BEGIN {
    require '/usr/home/little/data/values.dat';
}
    
my %CONF;
eval {
 populateHash(\%CONF,'/usr/home/little/conf/cfg');
};
if ($@) {
    print "Content-Type: text/html\n\n";
    print "<h1>Couldn't initialize!</h1>";
    print "$@";
    exit 0;
}

use CGI qw/:standard /;
$CGI::DISABLE_UPLOADS = 1;
$CGI::POST_MAX = 0;
# alternatively use CGI::Safe :-)

# never on Live-Server
use CGI::Carp qw(fatalsToBrowser);
use Storable qw(store retrieve);
use LWP::Simple;

## END: LOAD MODULES ##


my $ENDUNG = ".html";

my %pages = (
'head'    => $CONF{'TEMPLATES_DIR'}.'header/header.shtml',
'foot'    => $CONF{'TEMPLATES_DIR'}.'footer/footer.shtml',
'error'   => $CONF{'TEMPLATES_DIR'}.'error.txt',
'default' => $CONF{'TEMPLATES_DIR'}.'index'.$ENDUNG,
'id'      => '',
'keywords'=> ''
);

            
my %myVars = (
'autor'   => 'minka',
'counter' => \&counter,
'zufall' => \&random,
'userlist' => \&userlist
);
## END: CONFIG ##

my $zu ='default';

if (!param('keywords')) {
    if (param('id')) {
        if (param('id') =~ m/(\.(\.)?\/)|(\\)/) {
            $zu = 'error';
        } else {    
            $pages{'id'} = $CONF{'TEMPLATES_DIR'}.param('id').$ENDUNG;
            $zu = (-e $pages{'id'})? 'id' : 'error';
        }
    }
}

## Ausgabe ##
print header;

foreach my $tmp ('head',$zu,'foot') {
    my $line = ${slurpFile($pages{$tmp},'string')};
    # are names requested in the file?
    if ($line =~ m/\$(\w+)/g) {
        # if so, load hash %myVars from a file
        populateHash(\%myVars,$CONF{'DATEN_DIR'}.'variablen.txt');
        # now try to replace the name with its value 
        $line =~ s/\$(\w+)/${getValue(\%myVars,\$1);}/sgex;
    }
    print $line;
}
 
# END #
 
## SUBROUTINES ##

#####
## getValue(\%hash,\$string);
## input: - hashref (required) to the Hash to be looked up
##        - stringref (required) which shall be found as key in the ha
+sh
## ouptut: - value if a value for the given keywas found 
##         - otherwise an empty string (false value) if it failed
#####
 
sub getValue {
    # gimme a ref to a hash
    my $tmp = $_[0] || die "Ungenügende oder falsche Parameter: Refere
+nz des zu durchsuchenden Hashes muß übergeben werden!";
    # gimme a name to look up
    my $var = ${$_[1]} || die "Ungenügende Parameter: Der Schlüssel fü
+r den Rückgabewert muß als Referenz übergeben werden!";
    # I won't say anything unless I have something to tell
    my $result = '';
    # does the provided hash have such key?
    if (exists %{$tmp}->{$var}) {
        # is the value for that key not a ref?
        if (!ref(%{$tmp}->{$var})){
            # the answer will be the value 
            $result = %{$tmp}->{$var};
        # but if the value is a ref, is it a coderef?
        }elsif (ref(%{$tmp}->{$var}) eq 'CODE' )  {
            # well, lets execute it
            $result = &{%{$tmp}->{$var}};
        }
    # here starts the nightmare
    # so the provide hash had no key with such name
    } else {
        # I FEAR THIS
        no strict "refs";
        # uhm, but it exists in our namespace ? in our scope? 
        if (defined $$var){
            # if so, then take the value of the skalar 
            $result = $$var;
        } else {        
        warn "undefined Variable $var requested!";
        }
    }
    return \$result;
}

sub populateHash {
    my $tmp = $_[0] || die "Missing parameter: Referenz des zu füllend
+en Hashes muß übergeben werden!";
    my $file = $_[1] || die "Eine Datei zum Einlesen der Werte in den 
+Hash wird benötigt!";
    die "Wrong call!Der erste übergebene Parameter muß eine Referenz a
+uf einen Hash sein!" unless (ref($tmp));
    die "Der erste übergebene Parameter muß eine Referenz auf einen Ha
+sh sein!" unless (ref($tmp) eq "HASH") ;

    foreach (@{slurpFile($file,'array','#')}) {
        chomp;
            next if !/\S/;
            my($var, $val) = $_ =~ /^\s*(\S+)\s+(.+)$/;
            $val =~ s/\s*$//;
            next unless $var && $val;
        %{$tmp}->{$var} = $val;
    }
    return;
}
 
sub slurpFile {
        my $file = shift || die "Missing parameter: Path/filename !";
        my $mode = shift || '';
        my $ignore = shift || '';
        $mode = ( grep { $_ eq $mode} ('string','array'))? $mode: 'arr
+ay';
        my $content;
        die "Couldn't find file $file , request in line:".(caller)[2].
+'!' unless (-e $file);
        open (HANDLE,"<".$file) || die "Couldn't open file $file to re
+ad from: $!";
        if ($mode eq 'array') {
            while (<HANDLE>) {
                next if ($ignore && (/$ignore/));
                chomp;
                push @{$content}, $_ ;
            }
    } elsif ($mode eq 'string') {
            local $/ = undef;
            ${$content} = <HANDLE>;
        }
        close (HANDLE);
        return $content;
}
# was not my idea
sub random {
    my $zahl;
    foreach (1..9) {
        $zahl .= int(rand(9));
    }
    return $zahl;
}
# I wonder what happens upon server crash, probably sets back to zero
# wanna test? crash the server *grin*
sub counter {
        my $tmp;
        $tmp = retrieve($CONF{'TEMP_DIR'}.'counter') if (-e $CONF{'TEM
+P_DIR'}.'counter');
    ${$tmp}++;
        store($tmp, $CONF{'TEMP_DIR'}.'counter') or die "Kann nicht in
+ $CONF{'TEMP_DIR'}counter speichern!\n";
        return ${$tmp};
};

#quick n dirty
sub userlist {
    # uncomment if proper URL provided
    # my $url = "http://bla/liste.txt";
    # my $inhalt = get($url);
    # comment out if proper URL provided
    my $inhalt = ${slurpFile($CONF{'DATEN_DIR'}.'users','string')};
    my $liste;
    my $bgcolor = ${getValue(\%myVars,\'bgcolor');};
    if ($inhalt) {
        $liste = join('', 
        map {'<tr><td bgcolor="'.$bgcolor.'">'.$_->[0].'</td><td>'.$_-
+>[1].'</td></tr>'."\n" }
        map {[/\((.*?)\)/sg]}
        split(/\r?\n/, $inhalt));
    }
    $liste = '<tr><td colspan="2">List is empty</td></tr>' unless $lis
+te;
    return $liste;
};

1;
[download]

Have a nice day
All decision is left to your taste

Edit: chipmunk 2002-02-12

Comment on no strict "refs" and require Download Code

Replies are listed 'Best First'.
Re: no strict "refs" and require by blakem (Monsignor) on Feb 12, 2002 at 22:52 UTC
Expanding variables in strings is covered in the FAQ: How can I expand variables in text strings. -Blake	[reply]
Re: Re: no strict "refs" and require by little (Curate) on Feb 12, 2002 at 23:03 UTC
the way desribed in that FAQ is the way which I use to do it :-) BUT that causes an error when running under strict pragma. So my Question is, which one is the other way (that doens't cause strict to die with a nice warning about string "blabla" not allowed while strict refs) _and_ not explicitely saying 'no strict "refs"' ? Because the latter one gives me that strange feeling or am I paranoic here? Have a nice day All decision is left to your taste	[reply]
Re: Re: Re: no strict "refs" and require by blakem (Monsignor) on Feb 13, 2002 at 00:26 UTC
The faq covers three different approaches. The first only works with globals and is not strict compliant. The second works with lexicals or globals and is strict compliant. The third shows how one could accomplish a similiar task using hash keys instead of variable names. I'd recommend either of the last two. -Blake	[reply]
Re: Re: Re: Re: no strict "refs" and require by little (Curate) on Feb 13, 2002 at 00:45 UTC
Re: Re: no strict "refs" and require by little (Curate) on Feb 13, 2002 at 02:01 UTC
As I said before, the script works as intended. If one would write "$zu" in a Template he would get an empty string as I don't want to expose script internals just by error. `# But if I change these lines in sub getValue from ... # here starts the nightmare # so the provide hash had no key with such name } else { # I FEAR THIS no strict "refs"; # uhm, but it exists, in our namespace ? in our scope? besides +? if (defined $$var){ # if so, then take the value of the skalar $result = $$var; } else { warn "undefined Variable $var requested!"; } } ... #to } else { $result = '$'.$var; $result =~ s/(\$\w+)/$1/eeg; }` [download] I don't get an error BUT a warning in my log stating that $var has not been imported BUT one would get the current value of $zu which is exactly what I try to avoid, besides, then he gets an empty string for the skalars defined in the required script. I wouldn't ask if I had a clue on this ;-)	[reply] [d/l]
Re: no strict "refs" and require by dragonchild (Archbishop) on Feb 13, 2002 at 14:20 UTC
Have you looked at do? ------ We are the carpenters and bricklayers of the Information Age. Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.	[reply]
Re: Re: no strict "refs" and require by little (Curate) on Feb 13, 2002 at 14:29 UTC
Erm, could you elaborate on that? Have a nice day All decision is left to your taste	[reply]
Re: Re: Re: no strict "refs" and require by dragonchild (Archbishop) on Feb 13, 2002 at 16:12 UTC
do is, essentially, a file-slup + eval all in one. Try the following: `data.txt -------- $foo = "Hello, World"; data.pl ------- #!/usr/local/bin/perl use 5.6.0; use strict; our $foo; do 'data.txt'; print $foo, $/; __END__` [download] Note that this will only work with non-lexical variables. If you change to `my $foo;`, this will not work, due to the lexical scoping of my. Before 5.6.0, this trick is accomplished with `use vars qw/$foo/;` instead of `our $foo;` ------ We are the carpenters and bricklayers of the Information Age. Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.	[reply] [d/l] [select]