Stas Bekman wrote:
[...]
You can see that tests like t/404.t are failing with it, when using this version in addition to my last patch:

and APR::EACCESS compile. So here is the whole patch to save you time:

Index: ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
===================================================================
--- ModPerl-Registry/lib/ModPerl/RegistryCooker.pm      (revision 155373)
+++ ModPerl-Registry/lib/ModPerl/RegistryCooker.pm      (working copy)
@@ -41,6 +41,7 @@
 use File::Spec::Functions ();
 use File::Basename;

+use APR::Const     -compile => qw(EACCES);
 use Apache::Const  -compile => qw(:common &OPT_EXECCGI);
 use ModPerl::Const -compile => 'EXIT';

@@ -254,21 +255,10 @@
     my $self = shift;
     my $r = $self->{REQ};

-    unless (-r $r->my_finfo && -s _) {
-        $self->log_error("$self->{FILENAME} not found or unable to stat");
-        return Apache::NOT_FOUND;
-    }
+    return Apache::DECLINED if -d $r->my_finfo;

-    return Apache::DECLINED if -d _;
-
     $self->{MTIME} = -M _;

-    unless (-x _ or IS_WIN32) {
-        $r->log_error("file permissions deny server execution",
-                       $self->{FILENAME});
-        return Apache::FORBIDDEN;
-    }
-
     if (!($r->allow_options & Apache::OPT_EXECCGI)) {
         $r->log_error("Options ExecCGI is off in this directory",
                        $self->{FILENAME});
@@ -372,10 +362,13 @@
 sub convert_script_to_compiled_handler {
     my $self = shift;

+    my $rc = Apache::OK;
+
     $self->debug("Adding package $self->{PACKAGE}") if DEBUG & D_NOISE;

     # get the script's source
-    $self->read_script;
+    $rc = $self->read_script;
+    return $rc unless $rc == Apache::OK;

     # convert the shebang line opts into perl code
     $self->rewrite_shebang;
@@ -408,7 +401,7 @@
                     ${ $self->{CODE} },
                     "\n}"; # last line comment without newline?

- my $rc = $self->compile(\$eval);
+ $rc = $self->compile(\$eval);
return $rc unless $rc == Apache::OK;
$self->debug(qq{compiled package \"$self->{PACKAGE}\"}) if DEBUG & D_NOISE;


@@ -534,16 +527,23 @@
 # dflt: read_script
 # desc: reads the script in
 # args: $self - registry blessed object
-# rtrn: nothing
+# rtrn: Apache::OK on success, some other code on failure
 # efct: initializes the CODE field with the source script
 #########################################################################

 # reads the contents of the file
 sub read_script {
     my $self = shift;
+    my $rc = Apache::OK;

     $self->debug("reading $self->{FILENAME}") if DEBUG & D_NOISE;
-    $self->{CODE} = $self->{REQ}->slurp_filename(0); # untainted
+    $self->{CODE} = eval { $self->{REQ}->slurp_filename(0) }; # untainted
+    if ($@) {
+        $self->log_error("$@");
+        $rc = $@ == APR::EACCES ? Apache::FORBIDDEN : Apache::NOT_FOUND;
+    }
+
+    return $rc;
 }

 #########################################################################

--
__________________________________________________________________
Stas Bekman            JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/     mod_perl Guide ---> http://perl.apache.org
mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org   http://ticketmaster.com

---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]



Reply via email to