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

Author: Torsten Förtsch

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]

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__

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

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';
+}

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;
 }