Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
use APR::Finfo instead of Perls stat() in ModPerl::RegistryCooker
git-svn-id: https://svn.apache.org/repos/asf/perl/modperl/trunk@1451907 13f79535-47bb-0310-9956-ffa450edef68
  • Loading branch information
Torsten Förtsch committed Mar 2, 2013
1 parent febe2a4 commit e2ea139
Show file tree
Hide file tree
Showing 5 changed files with 40 additions and 17 deletions.
4 changes: 4 additions & 0 deletions Changes
Expand Up @@ -12,6 +12,10 @@ Also refer to the Apache::Test changes log file, at Apache-Test/Changes


=item 2.0.8-dev =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] Remove all uses of deprecated core perl symbols. [Steve Hay]


Add branch release tag to 'make tag' target. [Phred] Add branch release tag to 'make tag' target. [Phred]
Expand Down
20 changes: 7 additions & 13 deletions ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
Expand Up @@ -36,6 +36,7 @@ use Apache2::Log ();
use Apache2::Access (); use Apache2::Access ();


use APR::Table (); use APR::Table ();
use APR::Finfo ();
use APR::Status (); use APR::Status ();


use ModPerl::Util (); use ModPerl::Util ();
Expand All @@ -45,6 +46,7 @@ use File::Spec::Functions ();
use File::Basename (); use File::Basename ();


use Apache2::Const -compile => qw(:common &OPT_EXECCGI); use Apache2::Const -compile => qw(:common &OPT_EXECCGI);
use APR::Const -compile => qw(FILETYPE_REG);
use ModPerl::Const -compile => 'EXIT'; use ModPerl::Const -compile => 'EXIT';


unless (defined $ModPerl::Registry::MarkLine) { unless (defined $ModPerl::Registry::MarkLine) {
Expand Down Expand Up @@ -256,9 +258,10 @@ sub can_compile {
my $self = shift; my $self = shift;
my $r = $self->{REQ}; 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)) { if (!($r->allow_options & Apache2::Const::OPT_EXECCGI)) {
$r->log_error("Options ExecCGI is off in this directory", $r->log_error("Options ExecCGI is off in this directory",
Expand Down Expand Up @@ -485,9 +488,9 @@ sub is_cached {
# wasn't modified # wasn't modified
sub should_compile_if_modified { sub should_compile_if_modified {
my $self = shift; my $self = shift;
$self->{MTIME} ||= -M $self->{REQ}->my_finfo; $self->{MTIME} ||= $self->{REQ}->finfo->mtime;
!($self->is_cached && !($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 # return false if the package is cached already
Expand Down Expand Up @@ -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; 1;
__END__ __END__
9 changes: 7 additions & 2 deletions ModPerl-Registry/lib/ModPerl/RegistryLoader.pm
Expand Up @@ -22,6 +22,8 @@ use ModPerl::RegistryCooker ();
use Apache2::ServerUtil (); use Apache2::ServerUtil ();
use Apache2::Log (); use Apache2::Log ();
use APR::Pool (); use APR::Pool ();
use APR::Finfo ();
use APR::Const -compile=>qw(FINFO_NORM);


use Carp; use Carp;
use File::Spec (); use File::Spec ();
Expand Down Expand Up @@ -110,8 +112,11 @@ sub handler {


sub get_server_name { return $_[0]->{virthost} if exists $_[0]->{virthost} } sub get_server_name { return $_[0]->{virthost} if exists $_[0]->{virthost} }
sub filename { shift->{filename} } sub filename { shift->{filename} }
sub status { Apache2::Const::HTTP_OK } sub status { Apache2::Const::HTTP_OK }
sub my_finfo { shift->{filename} } 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 uri { shift->{uri} }
sub path_info {} sub path_info {}
sub allow_options { Apache2::Const::OPT_EXECCGI } #will be checked again at run-time sub allow_options { Apache2::Const::OPT_EXECCGI } #will be checked again at run-time
Expand Down
20 changes: 20 additions & 0 deletions 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';
}
4 changes: 2 additions & 2 deletions ModPerl-Registry/t/cgi-bin/closure.pl
@@ -1,7 +1,7 @@
#!perl -w #!perl -w


BEGIN { BEGIN {
use Apache::TestUtil; use Apache::TestUtil qw/t_server_log_warn_is_expected/;
t_server_log_warn_is_expected(); t_server_log_warn_is_expected();
} }


Expand All @@ -16,7 +16,7 @@ BEGIN
counter(); counter();


sub counter { sub counter {
#warn "$$"; #warn "$$: counter=$counter";
print ++$counter; print ++$counter;
} }


0 comments on commit e2ea139

Please sign in to comment.