svn commit: r156121 - in perl/modperl/trunk: Changes ModPerl-Registry/lib/ModPerl/RegistryCooker.pm ModPerl-Registry/t/basic.t

[stas]

Author: stas
Date: Thu Mar  3 18:09:03 2005
New Revision: 156121

URL: http://svn.apache.org/viewcvs?view=rev&rev=156121
Log:
ModPerl::Registry no longer checks for -x bit (we don't executed
scripts anyway), and thus works on acl-based filesystems. Also
replaced the -r check with a proper error handling when the file is
read in.

Modified:
    perl/modperl/trunk/Changes
    perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
    perl/modperl/trunk/ModPerl-Registry/t/basic.t

Modified: perl/modperl/trunk/Changes
URL: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/Changes?view=diff&r1=156120&r2=156121
==============================================================================
--- perl/modperl/trunk/Changes (original)
+++ perl/modperl/trunk/Changes Thu Mar  3 18:09:03 2005
@@ -12,6 +12,11 @@
 
 =item 1.999_22-dev
 
+ModPerl::Registry no longer checks for -x bit (we don't executed
+scripts anyway), and thus works on acl-based filesystems. Also
+replaced the -r check with a proper error handling when the file is
+read in. [Damon Buckwalter <[EMAIL PROTECTED]>]
+
 Apache::RequestUtil::slurp_filename now throws an APR::Error exception
 object (before it was just croaking). [Stas]
 

Modified: perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
URL: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm?view=diff&r1=156120&r2=156121
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm (original)
+++ perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm Thu Mar  
3 18:09:03 2005
@@ -41,6 +41,7 @@
 use File::Spec::Functions ();
 use File::Basename;
 
+use APR::Const     -compile => qw(EACCES ENOENT);
 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 _;
+    return Apache::DECLINED if -d $r->my_finfo;
 
     $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,7 +527,7 @@
 # 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
 #########################################################################
 
@@ -543,7 +536,20 @@
     my $self = shift;
 
     $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("$@");
+
+        if (ref $@ eq 'APR::Error') {
+            return Apache::FORBIDDEN if $@ == APR::EACCES;
+            return Apache::NOT_FOUND if $@ == APR::ENOENT
+        }
+        else {
+            return Apache::SERVER_ERROR;
+        }
+    }
+
+    return Apache::OK;
 }
 
 #########################################################################

Modified: perl/modperl/trunk/ModPerl-Registry/t/basic.t
URL: 
http://svn.apache.org/viewcvs/perl/modperl/trunk/ModPerl-Registry/t/basic.t?view=diff&r1=156120&r2=156121
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/t/basic.t (original)
+++ perl/modperl/trunk/ModPerl-Registry/t/basic.t Thu Mar  3 18:09:03 2005
@@ -32,7 +32,7 @@
     );
 }
 
-# test non-executable bit
+# test non-executable bit (it should be executed w/o a problem)
 for my $alias (@aliases) {
     if (Apache::TestConfig::WIN32) {
         skip "non-executable bit test for Win32", 0;
@@ -42,8 +42,8 @@
 
     t_client_log_error_is_expected();
     ok t_cmp(
-        HEAD($url)->status_line(),
-        "403 Forbidden",
+        HEAD($url)->code,
+        200,
         "$modules{$alias} non-executable file",
     );
 }