You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by to...@apache.org on 2013/03/02 18:20:06 UTC
svn commit: r1451907 - in /perl/modperl/trunk: Changes
ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
ModPerl-Registry/lib/ModPerl/RegistryLoader.pm
ModPerl-Registry/t/404-filename-with-newline.t
ModPerl-Registry/t/cgi-bin/closure.pl
Author: torsten
Date: Sat Mar 2 17:20:05 2013
New Revision: 1451907
URL: http://svn.apache.org/r1451907
Log:
use APR::Finfo instead of Perls stat() in ModPerl::RegistryCooker
Added:
perl/modperl/trunk/ModPerl-Registry/t/404-filename-with-newline.t
Modified:
perl/modperl/trunk/Changes
perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm
perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/closure.pl
Modified: perl/modperl/trunk/Changes
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/Changes?rev=1451907&r1=1451906&r2=1451907&view=diff
==============================================================================
--- perl/modperl/trunk/Changes (original)
+++ perl/modperl/trunk/Changes Sat Mar 2 17:20:05 2013
@@ -12,6 +12,10 @@ Also refer to the Apache::Test changes l
=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]
Modified: perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm?rev=1451907&r1=1451906&r2=1451907&view=diff
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm (original)
+++ perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm Sat Mar 2 17:20:05 2013
@@ -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__
Modified: perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm?rev=1451907&r1=1451906&r2=1451907&view=diff
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm (original)
+++ perl/modperl/trunk/ModPerl-Registry/lib/ModPerl/RegistryLoader.pm Sat Mar 2 17:20:05 2013
@@ -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
Added: perl/modperl/trunk/ModPerl-Registry/t/404-filename-with-newline.t
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/ModPerl-Registry/t/404-filename-with-newline.t?rev=1451907&view=auto
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/t/404-filename-with-newline.t (added)
+++ perl/modperl/trunk/ModPerl-Registry/t/404-filename-with-newline.t Sat Mar 2 17:20:05 2013
@@ -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';
+}
Modified: perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/closure.pl
URL: http://svn.apache.org/viewvc/perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/closure.pl?rev=1451907&r1=1451906&r2=1451907&view=diff
==============================================================================
--- perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/closure.pl (original)
+++ perl/modperl/trunk/ModPerl-Registry/t/cgi-bin/closure.pl Sat Mar 2 17:20:05 2013
@@ -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 @@ my $counter = 0;
counter();
sub counter {
- #warn "$$";
+ #warn "$$: counter=$counter";
print ++$counter;
}