# 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 () {
$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;
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);
-}
+#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;
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;
if (my $ret = mod_perl_init($_[0])) {
return $ret;
}
- start($_[0]);
+#S start($_[0]);
+ start();
no strict 'subs';
return Apache::Constants::OK();
}