perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Damon Buckwalter <buck...@gmail.com>
Subject Re: ACL filesystem incompatibility and potential race condition
Date Thu, 03 Mar 2005 01:11:06 GMT
On Wed, 02 Mar 2005 18:32:40 -0500, Stas Bekman <stas@stason.org> wrote:
> 
> failing to open a file will cover the -r check. What will cover the -x
> check? Or do you suggest that we shouldn't require cgi scripts to be
> executable? At least mod_cgi requires so when doing exec, but we don't
> exec. So we should probably keep it in, no?

I'd say no, because we're not really exec'ing anything.  It will be a
user education issue, that PerlRun/Registry scripts will run if you
tell Apache to handle then and ExecCGI is enabled in that context. 
Plus it breaks my whole scheme to make mod_perl ACL compatible...
 
> [...]
> > I tried this, dropping the -x and -r checks _alone_ does not work as I
> > would think is intended.  With just those checks removed, and if this
> > is my config:
> >
> > <Files *.cgi>
> > SetHandler perl-script
> > PerlResponseHandler ModPerl::PerlRun
> > PerlOptions +ParseHeaders
> > Options +ExecCGI
> > </Files>
> >
> > Scripts accessible only via ACL permissions work okay, but a 500
> > Internal server error is returned for *.cgi files that do not exist in
> > the filesystem.  This is because the SLURP_SUCCESS method croaks on
> > any error, as you show below.
> >
> > e.g. a request for /mp/bar.cgi, which does not exist:
> >
> > [Mon Feb 28 23:10:02 2005] [error] [client ::1] Error opening '/home/damon/test/
> > apache2/htdocs/mp/bar.cgi': No such file or directory  at /home/damon/test/perl/
> > lib/site_perl/5.9.1/i686-linux-thread-multi-64int-ld/ModPerl/RegistryCooker.pm l
> > ine 546.\n
> >
> > The browser gets a 500, but I believe that a 404 would be more
> > helpful.  That means changing slurp_filename/SLURP_SUCCESS to return
> > the apropriate Apache status code (404, 403, etc) instead of just
> > returning the content of the file to be slurped or croaking if it
> > cannot be loaded.
> >
> > This is where I start to get lost in the mod_perl code, so I'm hoping
> > someone understands the problem and how to solve it better than I do
> > in the code.
> 
> Please take a look at the attached patch. I believe it does what you want.
> The only remaining concern of mine is the -x bit.
> 

> Here is the patch (3 sub tests now fail since we no longer report
> FORBIDDEN when -x is not there):
> 
> Index: ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
> ===================================================================
> --- ModPerl-Registry/lib/ModPerl/RegistryCooker.pm      (revision 155373)
> +++ ModPerl-Registry/lib/ModPerl/RegistryCooker.pm      (working copy)

[...]

> @@ -534,16 +526,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 = Apache::NOT_FOUND; # map various issues into one
> +    }
> +
> +    return $rc;
>   }
> 
>   #########################################################################

I managed to come up with something very similar to this, minus the
last bit.  I like it, but I did manage to (partially) implement some
code on the C/XS side to return different statuses based on whether
the file is unreadable or non-existent.  It is broken because I can't
figure out how to return the script from modperl_slurp_filehandle() to
$self->{CODE}.  I just started learning XS today ;^)...  I was able to
make missing or unreadable files return a proper status code at least.

Give my patch a look and see if you think there's something of value there.



Index: src/modules/perl/modperl_util.c
===================================================================
--- src/modules/perl/modperl_util.c	(revision 155813)
+++ src/modules/perl/modperl_util.c	(working copy)
@@ -600,13 +600,11 @@
 #define SLURP_SUCCESS(action) \
     if (rc != APR_SUCCESS) { \
         SvREFCNT_dec(sv); \
-        Perl_croak(aTHX_ "Error " action " '%s': %s ", r->filename, \
-                   modperl_error_strerror(aTHX_ rc)); \
+        return rc; \
     }
 
-MP_INLINE SV *modperl_slurp_filename(pTHX_ request_rec *r, int tainted)
+MP_INLINE apr_status_t modperl_slurp_filename(pTHX_ request_rec *r,
int tainted, SV *sv)
 {
-    SV *sv;
     apr_status_t rc;
     apr_size_t size;
     apr_file_t *file;
@@ -616,7 +614,8 @@
 
     if (!size) {
         sv_setpvn(sv, "", 0);
-        return newRV_noinc(sv);
+        sv = newRV_noinc(sv);
+        return APR_SUCCESS;
     }
 
     /* XXX: could have checked whether r->finfo.filehand is valid and
@@ -653,7 +652,8 @@
         SvTAINTED_off(sv);
     }
 
-    return newRV_noinc(sv);
+    sv = newRV_noinc(sv);
+    return APR_SUCCESS;
 }
 
 #define MP_VALID_PKG_CHAR(c) (isalnum(c) ||(c) == '_')
Index: src/modules/perl/modperl_util.h
===================================================================
--- src/modules/perl/modperl_util.h	(revision 155813)
+++ src/modules/perl/modperl_util.h	(working copy)
@@ -92,7 +92,7 @@
  * @param tainted whether the SV should be marked tainted or not
  * @return a PV scalar with the contents of the file
  */
-SV *modperl_slurp_filename(pTHX_ request_rec *r, int tainted);
+MP_INLINE apr_status_t modperl_slurp_filename(pTHX_ request_rec *r,
int tainted, SV *sv);
 
 char *modperl_file2package(apr_pool_t *p, const char *file);
 
Index: xs/maps/modperl_functions.map
===================================================================
--- xs/maps/modperl_functions.map	(revision 155813)
+++ xs/maps/modperl_functions.map	(working copy)
@@ -41,7 +41,7 @@
 PACKAGE=Apache::RequestRec
  mpxs_Apache__RequestRec_new | | classname, c, base_pool_sv=Nullsv
  SV *:DEFINE_dir_config | | request_rec *:r, char *:key=NULL, SV
*:sv_val=Nullsv
- SV *:DEFINE_slurp_filename | | request_rec *:r, int:tainted=1
+ apr_status_t:DEFINE_slurp_filename | | request_rec *:r, int:tainted=1, SV *:sv
 
 PACKAGE=Apache
  mpxs_Apache_request | | classname, svr=Nullsv
Index: xs/Apache/RequestUtil/Apache__RequestUtil.h
===================================================================
--- xs/Apache/RequestUtil/Apache__RequestUtil.h	(revision 155813)
+++ xs/Apache/RequestUtil/Apache__RequestUtil.h	(working copy)
@@ -241,8 +241,8 @@
 #define mpxs_Apache__RequestRec_dir_config(r, key, sv_val) \
     modperl_dir_config(aTHX_ r, r->server, key, sv_val)
 
-#define mpxs_Apache__RequestRec_slurp_filename(r, tainted) \
-    modperl_slurp_filename(aTHX_ r, tainted)
+#define mpxs_Apache__RequestRec_slurp_filename(r, tainted, sv) \
+    modperl_slurp_filename(aTHX_ r, tainted, sv)
 
 static MP_INLINE
 char *mpxs_Apache__RequestRec_location(request_rec *r)
Index: ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
===================================================================
--- ModPerl-Registry/lib/ModPerl/RegistryCooker.pm	(revision 155813)
+++ ModPerl-Registry/lib/ModPerl/RegistryCooker.pm	(working copy)
@@ -41,6 +41,7 @@
 use File::Spec::Functions ();
 use File::Basename;
 
+use APR::Const     -compile => qw(:common :error);
 use Apache::Const  -compile => qw(:common &OPT_EXECCGI);
 use ModPerl::Const -compile => 'EXIT';
 
@@ -254,20 +255,20 @@
     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;
-    }
+    #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 _;
 
-    $self->{MTIME} = -M _;
+    $self->{MTIME} = -M $r->my_finfo;
 
-    unless (-x _ or IS_WIN32) {
-        $r->log_error("file permissions deny server execution",
-                       $self->{FILENAME});
-        return Apache::FORBIDDEN;
-    }
+    #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",
@@ -375,7 +376,8 @@
     $self->debug("Adding package $self->{PACKAGE}") if DEBUG & D_NOISE;
 
     # get the script's source
-    $self->read_script;
+    my $rc = $self->read_script;
+    return $rc unless $rc == Apache::OK;
 
     # convert the shebang line opts into perl code
     $self->rewrite_shebang;
@@ -408,7 +410,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;
 
@@ -543,7 +545,16 @@
     my $self = shift;
 
     $self->debug("reading $self->{FILENAME}") if DEBUG & D_NOISE;
-    $self->{CODE} = $self->{REQ}->slurp_filename(0); # untainted
+    
+    my $rc = $self->{REQ}->slurp_filename(0, $self->{CODE}); # untainted
+
+    if ($rc == APR::EACCES) {
+        return Apache::DECLINED;
+    } elsif ($rc == APR::ENOENT) {
+        return Apache::NOT_FOUND;
+    } else {
+        return Apache::OK;
+    }
 }
 
 #########################################################################

---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org


Mime
View raw message