# 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 () {
$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;
$ENV{PLP_NAME} = $r->uri;
our $use_cache = $r->dir_config('PLPcache') !~ /^off$/i;
+#S our $use_safe = $r->dir_config('PLPsafe') =~ /^on$/i;
my $path = $r->filename();
my ($file, $dir) = File::Basename::fileparse($path);
chdir $dir;
return 0; # OK
}
-# 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 {
+#S my ($r) = @_;
no strict;
tie *PLPOUT, 'PLP::Tie::Print';
select PLPOUT;
*cookies = \%cookie;
PLP::Functions->import();
# No lexicals may exist at this point.
- eval qq{ package PLP::Script; $PLP::code; };
+
+#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/;
- eval { package PLP::Script; $_->() for reverse @PLP::END };
+
+#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;
sub handler {
require Apache::Constants;
clean();
- if (my $ret = mod_perl_init(shift)) {
+ if (my $ret = mod_perl_init($_[0])) {
return $ret;
}
+#S start($_[0]);
start();
no strict 'subs';
return Apache::Constants::OK();