diff --git a/Changes b/Changes index f57a5bdc1..c86e749da 100644 --- a/Changes +++ b/Changes @@ -12,6 +12,10 @@ Also refer to the Apache::Test changes log file, at Apache-Test/Changes =item 2.0.8-dev +use APR::Finfo instead of Perl's stat() in ModPerl::RegistryCooker to +generate HTTP code 404 even if the requested filename contains newlines +[Torsten] + Remove all uses of deprecated core perl symbols. [Steve Hay] Add branch release tag to 'make tag' target. [Phred] diff --git a/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm b/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm index 4ccacd0d0..9b055a77d 100644 --- a/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm +++ b/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm @@ -36,6 +36,7 @@ use Apache2::Log (); use Apache2::Access (); use APR::Table (); +use APR::Finfo (); use APR::Status (); use ModPerl::Util (); @@ -45,6 +46,7 @@ use File::Spec::Functions (); use File::Basename (); use Apache2::Const -compile => qw(:common &OPT_EXECCGI); +use APR::Const -compile => qw(FILETYPE_REG); use ModPerl::Const -compile => 'EXIT'; unless (defined $ModPerl::Registry::MarkLine) { @@ -256,9 +258,10 @@ sub can_compile { my $self = shift; my $r = $self->{REQ}; - return Apache2::Const::DECLINED if -d $r->my_finfo; + return Apache2::Const::DECLINED + unless $r->finfo->filetype==APR::Const::FILETYPE_REG; - $self->{MTIME} = -M _; + $self->{MTIME} = $r->finfo->mtime; if (!($r->allow_options & Apache2::Const::OPT_EXECCGI)) { $r->log_error("Options ExecCGI is off in this directory", @@ -485,9 +488,9 @@ sub is_cached { # wasn't modified sub should_compile_if_modified { my $self = shift; - $self->{MTIME} ||= -M $self->{REQ}->my_finfo; + $self->{MTIME} ||= $self->{REQ}->finfo->mtime; !($self->is_cached && - $self->cache_table->{ $self->{PACKAGE} }{mtime} <= $self->{MTIME}); + $self->cache_table->{ $self->{PACKAGE} }{mtime} == $self->{MTIME}); } # return false if the package is cached already @@ -780,14 +783,5 @@ sub uncache_myself { } -# XXX: should go away when finfo() is ported to 2.0 (don't want to -# depend on compat.pm) -sub Apache2::RequestRec::my_finfo { - my $r = shift; - stat $r->filename; - \*_; -} - - 1; __END__ diff --git a/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm b/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm index 2b7d1184e..f06bd6a8c 100644 --- a/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm +++ b/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm @@ -22,6 +22,8 @@ use ModPerl::RegistryCooker (); use Apache2::ServerUtil (); use Apache2::Log (); use APR::Pool (); +use APR::Finfo (); +use APR::Const -compile=>qw(FINFO_NORM); use Carp; use File::Spec (); @@ -110,8 +112,11 @@ sub handler { sub get_server_name { return $_[0]->{virthost} if exists $_[0]->{virthost} } sub filename { shift->{filename} } -sub status { Apache2::Const::HTTP_OK } -sub my_finfo { shift->{filename} } +sub status { Apache2::Const::HTTP_OK } +sub pool { shift->{pool}||=APR::Pool->new() } +sub finfo { $_[0]->{finfo}||=APR::Finfo::stat($_[0]->{filename}, + APR::Const::FINFO_NORM, + $_[0]->pool); } sub uri { shift->{uri} } sub path_info {} sub allow_options { Apache2::Const::OPT_EXECCGI } #will be checked again at run-time diff --git a/ModPerl-Registry/t/404-filename-with-newline.t b/ModPerl-Registry/t/404-filename-with-newline.t new file mode 100644 index 000000000..f28710b38 --- /dev/null +++ b/ModPerl-Registry/t/404-filename-with-newline.t @@ -0,0 +1,20 @@ +#!perl + +use strict; +use warnings FATAL => 'all'; + +use Apache::Test; +use Apache::TestUtil; +use Apache::TestRequest qw(GET_RC); + +plan tests => 1, need 'mod_alias.c'; + +{ + # this used to result in 500 due to a combination of Perl warning about + # a newline in the filename passed to stat() and our + # use warnings FATAL=>'all' + + t_client_log_error_is_expected(); + my $url = '/registry/file%0dwith%0anl%0d%0aand%0a%0dcr'; + ok t_cmp GET_RC($url), 404, 'URL with \\r and \\n embedded'; +} diff --git a/ModPerl-Registry/t/cgi-bin/closure.pl b/ModPerl-Registry/t/cgi-bin/closure.pl index 40a7c9c12..a4c6e73eb 100755 --- a/ModPerl-Registry/t/cgi-bin/closure.pl +++ b/ModPerl-Registry/t/cgi-bin/closure.pl @@ -1,7 +1,7 @@ #!perl -w BEGIN { - use Apache::TestUtil; + use Apache::TestUtil qw/t_server_log_warn_is_expected/; t_server_log_warn_is_expected(); } @@ -16,7 +16,7 @@ BEGIN counter(); sub counter { - #warn "$$"; + #warn "$$: counter=$counter"; print ++$counter; }