X-Git-Url: http://git.shiar.net/perl/plp/.git/blobdiff_plain/814e7ba10b896c8810b28a5b5172ef1973d66e3c..982fa288bc0096de89e45dd5f9526da68f9e606f:/PLP.pm

diff --git a/PLP.pm b/PLP.pm
index 93ec49a..01f95ec 100644
--- a/PLP.pm
+++ b/PLP.pm
@@ -14,7 +14,7 @@ use Cwd ();
 
 use strict;
 
-our $VERSION = '3.15';
+our $VERSION = '3.16';
 
 # subs in this package:
 #  sendheaders                      Send headers
@@ -28,6 +28,12 @@ our $VERSION = '3.15';
 #  everything                       Do everything: CGI
 #  handler($r)                      Do everything: mod_perl
 
+# About the #S lines:
+# I wanted to implement Safe.pm so that scripts were run inside a
+# configurable compartment. This needed for XS modules to be pre-loaded,
+# hence the PLPsafe_* Apache directives. However, $safe->reval() lets
+# Apache segfault. End of fun. The lines are still here so that I can
+# s/^#S //m to re-implement them whenever this has been fixed.
 
 # Sends the headers waiting in %PLP::Script::header
 sub sendheaders () {
@@ -120,7 +126,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,7 +252,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;
+#S  our $use_safe  = $r->dir_config('PLPsafe')  =~ /^on$/i;
     my $path = $r->filename();
     my ($file, $dir) = File::Basename::fileparse($path);
     chdir $dir;
@@ -256,28 +262,27 @@ sub mod_perl_init {
     return 0; # OK
 }
 
-# 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.
+#S # For PLPsafe scripts
+#S sub safe_eval {
+#S     my ($r, $code) = @_;
+#S     $r->send_http_header('text/plain');
+#S     require Safe;
+#S     unless ($PLP::safe) {
+#S 	$PLP::safe = Safe->new('PLP::Script');
+#S 	for ( map split, $r->dir_config->get('PLPsafe_module') ) {
+#S 	    $PLP::safe->share('*' . $_ . '::');
+#S 	    s!::!/!g;
+#S 	    require $_ . '.pm';
+#S 	}
+#S 	$PLP::safe->permit(Opcode::full_opset());
+#S 	$PLP::safe->deny(Opcode::opset(':dangerous'));
+#S     }
+#S     $PLP::safe->reval($code);
+#S }
+
+# Let the games begin! No lexicals may exist at this point.
 sub start {
-    my ($r) = @_;
+#S  my ($r) = @_;
     no strict;
     tie *PLPOUT, 'PLP::Tie::Print';
     select PLPOUT;
@@ -292,17 +297,18 @@ sub start {
 	PLP::Functions->import();
 	# No lexicals may exist at this point.
 	
- 	if ($PLP::use_safe) {
- 	    PLP::safe_eval($r, $PLP::code);
- 	} else {
+#S 	if ($PLP::use_safe) {
+#S 	    PLP::safe_eval($r, $PLP::code);
+#S 	} else {
 	    eval qq{ package PLP::Script; $PLP::code; };
- 	}
+#S 	}
 	PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
- 	if ($PLP::use_safe) {
- 	    PLP::safe_eval($r, '$_->() for reverse @PLP::END');
- 	} else {
+
+#S 	if ($PLP::use_safe) {
+#S 	    PLP::safe_eval($r, '$_->() for reverse @PLP::END');
+#S 	} else {
 	    eval   { package PLP::Script; $_->() for reverse @PLP::END };
- 	}
+#S 	}
 	PLP::error($@, 1) if $@ and $@ !~ /\cS\cT\cO\cP/;
     }
     PLP::sendheaders() unless $PLP::sentheaders;
@@ -326,7 +332,8 @@ sub handler {
     if (my $ret = mod_perl_init($_[0])) {
 	return $ret;
     }
-    start($_[0]);
+#S  start($_[0]);
+    start();
     no strict 'subs';
     return Apache::Constants::OK();
 }