On Wed, 02 Mar 2005 18:32:40 -0500, Stas Bekman <[EMAIL PROTECTED]> 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: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
