code comment cleanup addendum

[perl/plp/.git] / PLP.pm

diff --git a/PLP.pm b/PLP.pm
index c78af4163f560d7ef16feb7ebe4fd104aa2431bc..e595ec16363f09b43cf65ccedc0850ae55a0685c 100644 (file)
--- a/PLP.pm
+++ b/PLP.pm
@@ -120,7 +120,7 @@ sub sendheaders () {
                    $inB = 0;
                    $source .= "; print q\cQ";
                } elsif ($part =~ /^<\((.*?)\)>\z/ and not $inA || $inB) {
-                   my $ipath = File::Spec->rel2abs($1);
+                   my $ipath = File::Spec->rel2abs($1, File::Basename::dirname($path));
                    $source .= source($1, $level + 1, undef, $ipath) .
                               qq/\cQ, \n#line $linenr "$file"\nq\cQ/;
                    push @{ $cached{$path}[0] }, $ipath;
@@ -246,6 +246,7 @@ sub mod_perl_init {
     $ENV{PLP_NAME} = $r->uri;
 
     our $use_cache = $r->dir_config('PLPcache') !~ /^off$/i;
+    our $use_safe  = $r->dir_config('PLPsafe')  =~ /^on$/i;
     my $path = $r->filename();
     my ($file, $dir) = File::Basename::fileparse($path);
     chdir $dir;
@@ -255,9 +256,27 @@ sub mod_perl_init {
     return 0; # OK
 }
 
-# Let the games begin!
-# No lexicals may exist at this point.
+# For PLPsafe scripts
+sub safe_eval {
+    my ($r, $code) = @_;
+    $r->send_http_header('text/plain');
+    require Safe;
+    unless ($PLP::safe) {
+       $PLP::safe = Safe->new('PLP::Script');
+       for ( map split, $r->dir_config->get('PLPsafe_module') ) {
+           $PLP::safe->share('*' . $_ . '::');
+           s!::!/!g;
+           require $_ . '.pm';
+       }
+       $PLP::safe->permit(Opcode::full_opset());
+       $PLP::safe->deny(Opcode::opset(':dangerous'));
+    }
+    $PLP::safe->reval($code);
+}
+
+# Let the games begin! No lexicals may exist at this point.
 sub start {
+    my ($r) = @_;
     no strict;
     tie *PLPOUT, 'PLP::Tie::Print';
     select PLPOUT;
@@ -271,9 +290,18 @@ sub start {
        *cookies = \%cookie;
        PLP::Functions->import();
        # No lexicals may exist at this point.
-       eval qq{ package PLP::Script; $PLP::code; };
+       
+       if ($PLP::use_safe) {
+           PLP::safe_eval($r, $PLP::code);
+       } else {
+           eval qq{ package PLP::Script; $PLP::code; };
+       }
        PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
-       eval   { package PLP::Script; $_->() for reverse @PLP::END };
+       if ($PLP::use_safe) {
+           PLP::safe_eval($r, '$_->() for reverse @PLP::END');
+       } else {
+           eval   { package PLP::Script; $_->() for reverse @PLP::END };
+       }
        PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
     }
     PLP::sendheaders() unless $PLP::sentheaders;
@@ -294,10 +322,10 @@ sub everything {
 sub handler {
     require Apache::Constants;
     clean();
-    if (my $ret = mod_perl_init(shift)) {
+    if (my $ret = mod_perl_init($_[0])) {
        return $ret;
     }
-    start();
+    start($_[0]);
     no strict 'subs';
     return Apache::Constants::OK();
 }