diff --git a/Apache-SizeLimit/Makefile.PL b/Apache-SizeLimit/Makefile.PL index f1fda05..77c72d8 100644 --- a/Apache-SizeLimit/Makefile.PL +++ b/Apache-SizeLimit/Makefile.PL @@ -66,10 +66,6 @@ else { ); } -if ($ENV{MOD_PERL_2_BUILD}) { - pop @ARGV; -} - sub check_for_apache_test { return unless eval { require Apache::Test; diff --git a/Apache-SizeLimit/lib/Apache/SizeLimit/Core.pm b/Apache-SizeLimit/lib/Apache/SizeLimit/Core.pm index 5942bc8..180b3aa 100644 --- a/Apache-SizeLimit/lib/Apache/SizeLimit/Core.pm +++ b/Apache-SizeLimit/lib/Apache/SizeLimit/Core.pm @@ -117,9 +117,9 @@ sub _limits_are_exceeded { sub _check_size { my $class = shift; - my ($size, $share) = $class->_platform_check_size(); + my ($size, $share, $unshared) = $class->_platform_check_size(); - return ($size, $share, $size - $share); + return ($size, $share, defined $unshared ? $unshared : $size - $share); } sub _load { @@ -143,7 +143,7 @@ BEGIN { *_platform_getppid = \&_linux_getppid; - if (eval { require Linux::Smaps } && Linux::Smaps->new($$)) { + if (eval { require Linux::Smaps && Linux::Smaps->new($$) }) { $USE_SMAPS = 1; *_platform_check_size = \&_linux_smaps_size_check; } @@ -176,7 +176,9 @@ sub _linux_smaps_size_check { return $class->_linux_size_check() unless $USE_SMAPS; my $s = Linux::Smaps->new($$)->all; - return ($s->size, $s->shared_clean + $s->shared_dirty); + return ($s->size, + $s->shared_clean + $s->shared_dirty, + $s->private_clean + $s->private_dirty); } sub _linux_size_check { diff --git a/Apache-SizeLimit/t/response/TestApache/basic.pm b/Apache-SizeLimit/t/response/TestApache/basic.pm index 6e054b6..26211d5 100644 --- a/Apache-SizeLimit/t/response/TestApache/basic.pm +++ b/Apache-SizeLimit/t/response/TestApache/basic.pm @@ -17,8 +17,13 @@ sub handler { plan $r, tests => 13; - ok( ! Apache::SizeLimit->_limits_are_exceeded(), - 'check that _limits_are_exceeded() returns false without any limits set' ); + { + local ($Apache::SizeLimit::Core::MAX_PROCESS_SIZE, + $Apache::SizeLimit::Core::MIN_SHARE_SIZE, + $Apache::SizeLimit::Core::MAX_UNSHARED_SIZE); + ok( ! Apache::SizeLimit->_limits_are_exceeded(), + 'check that _limits_are_exceeded() returns false without any limits set' ); + } { my ( $size, $shared ) = Apache::SizeLimit->_check_size(); diff --git a/Apache-SizeLimit/t/response/TestApache2/basic.pm b/Apache-SizeLimit/t/response/TestApache2/basic.pm index dce4ec1..f8a856c 100644 --- a/Apache-SizeLimit/t/response/TestApache2/basic.pm +++ b/Apache-SizeLimit/t/response/TestApache2/basic.pm @@ -17,8 +17,13 @@ sub handler { plan $r, tests => 10; - ok( ! Apache2::SizeLimit->_limits_are_exceeded(), - 'check that _limits_are_exceeded() returns false without any limits set' ); + { + local ($Apache::SizeLimit::Core::MAX_PROCESS_SIZE, + $Apache::SizeLimit::Core::MIN_SHARE_SIZE, + $Apache::SizeLimit::Core::MAX_UNSHARED_SIZE); + ok( ! Apache2::SizeLimit->_limits_are_exceeded(), + 'check that _limits_are_exceeded() returns false without any limits set' ); + } { my ( $size, $shared ) = Apache2::SizeLimit->_check_size(); diff --git a/Apache-Test/lib/Apache/TestConfig.pm b/Apache-Test/lib/Apache/TestConfig.pm index a12b251..65d8515 100644 --- a/Apache-Test/lib/Apache/TestConfig.pm +++ b/Apache-Test/lib/Apache/TestConfig.pm @@ -23,6 +23,7 @@ use constant OSX => $^O eq 'darwin'; use constant CYGWIN => $^O eq 'cygwin'; use constant NETWARE => $^O eq 'NetWare'; use constant SOLARIS => $^O eq 'solaris'; +use constant AIX => $^O eq 'aix'; use constant WINFU => WIN32 || NETWARE; use constant COLOR => ($ENV{APACHE_TEST_COLOR} && -t STDOUT) ? 1 : 0; @@ -557,6 +558,7 @@ sub massage_config_args { } } else { + $data=~s/\n(?!\z)/\n /g; $args .= " $data"; } $args .= "\n"; @@ -610,7 +612,8 @@ sub add_config_hooks_run { for (@{ $self->{$where} }) { $self->replace; - print $out "$_\n"; + s/\n?$/\n/; + print $out "$_"; } } @@ -1238,7 +1241,9 @@ sub parse_vhost { @out_config = ([Listen => '0.0.0.0:' . $port]); if ($self->{vhosts}->{$module}->{namebased}) { - push @out_config => [NameVirtualHost => "*:$port"]; + push @out_config => ["\n". + "${indent}${indent}NameVirtualHost" + => "*:$port\n${indent}"]; } } diff --git a/Apache-Test/lib/Apache/TestConfigPerl.pm b/Apache-Test/lib/Apache/TestConfigPerl.pm index 835b5f4..152ef58 100644 --- a/Apache-Test/lib/Apache/TestConfigPerl.pm +++ b/Apache-Test/lib/Apache/TestConfigPerl.pm @@ -111,19 +111,15 @@ sub configure_inc { my $inc = $self->{inc}; - my $found; for (catdir($top, qw(blib lib)), catdir($top, qw(blib arch))) { if (-d $_) { push @$inc, $_; - $found=1; } } # try ../blib as well for Apache::Reload & Co - unless ($found) { - for (catdir($top, qw(.. blib lib)), catdir($top, qw(.. blib arch))) { - push @$inc, $_ if -d $_; - } + for (catdir($top, qw(.. blib lib)), catdir($top, qw(.. blib arch))) { + push @$inc, $_ if -d $_; } # spec: If PERL5LIB is defined, PERLLIB is not used. @@ -540,6 +536,13 @@ sub configure_pm_tests { my ($file, $module, $subdir, $status) = @$entry; my @args = (); + my $file_display; + { + $file_display=$file; + my $topdir=$self->{vars}->{top_dir}; + $file_display=~s!^\Q$topdir\E(.)(?:\1)*!!; + } + $self->postamble("\n# included from $file_display"); my $directives = $self->add_module_config($file, \@args); $module =~ s,\.pm$,,; $module =~ s/^[a-z]://i; #strip drive if any @@ -568,10 +571,7 @@ sub configure_pm_tests { debug "configuring $module"; - if ($directives->{noautoconfig}) { - $self->postamble(""); # which adds "\n" - } - else { + unless ($directives->{noautoconfig}) { if (my $cv = $add_hook_config{$hook}) { $self->$cv($module, \@args); } @@ -595,6 +595,7 @@ sub configure_pm_tests { $self->postamble(IfModule => 'mod_perl.c', $cfg); } } + $self->postamble("# end of $file_display\n"); $self->write_pm_test($module, lc $sub, map { lc } @base); } diff --git a/Apache-Test/lib/Apache/TestHandler.pm b/Apache-Test/lib/Apache/TestHandler.pm index d96cc94..6b1e691 100644 --- a/Apache-Test/lib/Apache/TestHandler.pm +++ b/Apache-Test/lib/Apache/TestHandler.pm @@ -27,7 +27,8 @@ use Apache2::Const -compile => qw(OK NOT_FOUND SERVER_ERROR); #see modperl-2.0/t/hooks/TestHooks/authen.pm if ($ENV{MOD_PERL} && require mod_perl2) { - require Apache2::RequestIO; # puts + require Apache2::RequestRec; # content_type + require Apache2::RequestIO; # puts } #compat with 1.xx @@ -35,17 +36,17 @@ my $send_http_header = Apache->can('send_http_header') || sub {}; my $print = Apache2->can('print') || Apache2::RequestRec->can('puts'); sub ok { - my $r = shift; + my ($r, $boolean) = @_; $r->$send_http_header; $r->content_type('text/plain'); - $r->$print("ok"); + $r->$print((@_>1 && !$boolean ? "not " : '')."ok"); 0; } sub ok1 { - my $r = shift; + my ($r, $boolean) = @_; Apache::Test::plan($r, tests => 1); - Apache::Test::ok(1); + Apache::Test::ok(@_==1 || $boolean); 0; } @@ -101,3 +102,74 @@ sub same_interp_fixup { 1; __END__ + +=encoding utf8 + +=head1 NAME + +Apache::TestHandler - a few response handlers and helpers + +=head1 SYNOPSIS + + package My::Test; + use Apache::TestHandler (); + sub handler { + my ($r) = @_; + my $result = do_my_test; + Apache::TestHandler::ok1 $r, $result; + } + + sub handler2 { + my ($r) = @_; + my $result = do_my_test; + Apache::TestHandler::ok $r, $result; + } + +=head1 DESCRIPTION + +C provides 2 very simple response handler. + +=head1 FUNCTIONS + +=over 4 + +=item ok $r, $boolean + +The handler simply prints out C or C depending on the +optional C<$boolean> parameter. + +If C<$boolean> is omitted C is assumed. + +=item ok1 $r, $boolean + +This handler implements a simple response-only test. It can be used on its +own to check if for a certain URI the response phase is reached. Or it +can be called like a normal function to print out the test result. The +client side is automatically created as described in +L. + +C<$boolean> is optional. If omitted C is assumed. + +=item same_interp_counter + +=item same_interp_fixup + +TODO + +=back + +=head1 SEE ALSO + +The Apache-Test tutorial: +L. + +L. + +=head1 AUTHOR + +Doug MacEachern, Geoffrey Young, Stas Bekman, Torsten Förtsch and others. + +Questions can be asked at the test-dev httpd.apache.org list +For more information see: http://httpd.apache.org/test/. + +=cut diff --git a/Apache-Test/lib/Apache/TestRequest.pm b/Apache-Test/lib/Apache/TestRequest.pm index c68780c..73c1490 100644 --- a/Apache-Test/lib/Apache/TestRequest.pm +++ b/Apache-Test/lib/Apache/TestRequest.pm @@ -159,6 +159,16 @@ sub user_agent { }; } + # in LWP 6, verify_hostname defaults to on, so SSL_ca_file + # needs to be set accordingly + if ($have_lwp and $LWP::VERSION >= 6.0 and not exists $args->{ssl_opts}->{SSL_ca_file}) { + my $vars = Apache::Test::vars(); + my $cafile = "$vars->{sslca}/$vars->{sslcaorg}/certs/ca.crt"; + $args->{ssl_opts}->{SSL_ca_file} = $cafile; + # Net:SSL compatibility (legacy) + $ENV{HTTPS_CA_FILE} = $cafile; + } + eval { $UA ||= __PACKAGE__->new(%$args); }; } @@ -352,7 +362,7 @@ sub prepare { } push @$pass, content => $content; } - if ($keep->{cert}) { + if (exists $keep->{cert}) { set_client_cert($keep->{cert}); } @@ -618,13 +628,27 @@ sub set_client_cert { my $dir = join '/', $vars->{sslca}, $vars->{sslcaorg}; if ($name) { - $ENV{HTTPS_CERT_FILE} = "$dir/certs/$name.crt"; - $ENV{HTTPS_KEY_FILE} = "$dir/keys/$name.pem"; + my ($cert, $key) = ("$dir/certs/$name.crt", "$dir/keys/$name.pem"); + @ENV{qw/HTTPS_CERT_FILE HTTPS_KEY_FILE/} = ($cert, $key); + if ($LWP::VERSION >= 6.0) { + # IO::Socket:SSL doesn't look at environment variables + if ($UA) { + $UA->ssl_opts(SSL_cert_file => $cert); + $UA->ssl_opts(SSL_key_file => $key); + } else { + user_agent(ssl_opts => { SSL_cert_file => $cert, + SSL_key_file => $key }); + } + } } else { for (qw(CERT KEY)) { delete $ENV{"HTTPS_${_}_FILE"}; } + if ($LWP::VERSION >= 6.0 and $UA) { + $UA->ssl_opts(SSL_cert_file => undef); + $UA->ssl_opts(SSL_key_file => undef); + } } } diff --git a/Apache-Test/lib/Apache/TestUtil.pm b/Apache-Test/lib/Apache/TestUtil.pm index a63915e..cfd8229 100644 --- a/Apache-Test/lib/Apache/TestUtil.pm +++ b/Apache-Test/lib/Apache/TestUtil.pm @@ -43,7 +43,7 @@ $VERSION = '0.02'; ); @EXPORT_OK = qw(t_write_perl_script t_write_shell_script t_chown - t_catfile_apache t_catfile + t_catfile_apache t_catfile t_file_watch_for t_start_error_log_watch t_finish_error_log_watch t_start_file_watch t_read_file_watch t_finish_file_watch); @@ -101,6 +101,33 @@ use constant INDENT => 4; return readline $fh; } + sub t_file_watch_for ($$$) { + my ($name, $re, $timeout) = @_; + local $/ = "\n"; + $re = qr/$re/ unless ref $re; + $timeout *= 10; + my $buf = ''; + my @acc; + while ($timeout >= 0) { + my $line = t_read_file_watch $name; + unless (defined $line) { # EOF + select undef, undef, undef, 0.1; + $timeout--; + next; + } + $buf .= $line; + next unless $buf =~ /\n$/; # incomplete line + + # found a complete line + $line = $buf; + $buf = ''; + + push @acc, $line; + return wantarray ? @acc : $line if $line =~ $re; + } + return; + } + sub t_start_error_log_watch { t_start_file_watch; } @@ -917,6 +944,36 @@ record length use this: @lines=t_finish_file_watch($name); } +=item t_file_watch_for() + + @lines=Apache::TestUtil::t_file_watch_for('access_log', + qr/condition/, + $timeout); + +This function reads the file from the current position and looks for the +first line that matches C. If no such line could be found +until end of file the function pauses and retries until either such a line +is found or the timeout (in seconds) is reached. + +In scalar or void context only the matching line is returned. In list +context all read lines are returned with the matching one in last position. + +The function uses C<\n> and end-of-line marker and waits for complete lines. + +The timeout although it can be specified with sub-second precision is not very +accurate. It is simply multiplied by 10. The result is used as a maximum loop +count. For the intented purpose this should be good enough. + +Use this function to check for logfile entries when you cannot be sure that +they are already written when the test program reaches the point, for example +to check for messages that are written in a PerlCleanupHandler or a +PerlLogHandler. + + ok t_file_watch_for 'access_log', qr/expected log entry/, 2; + +This call reads the C and waits for maximum 2 seconds for the +expected entry to appear. + =back =head1 AUTHOR diff --git a/Apache-Test/lib/Bundle/ApacheTest.pm b/Apache-Test/lib/Bundle/ApacheTest.pm index 42802d6..4c5b78c 100644 --- a/Apache-Test/lib/Bundle/ApacheTest.pm +++ b/Apache-Test/lib/Bundle/ApacheTest.pm @@ -15,7 +15,7 @@ # package Bundle::ApacheTest; -$VERSION = '0.01'; +$VERSION = '0.02'; 1; @@ -31,29 +31,31 @@ Bundle::ApacheTest - A bundle to install all Apache-Test related modules =head1 CONTENTS -Crypt::SSLeay - For https support +Crypt::SSLeay - For https support -Devel::CoreStack - For getting core stack info +Devel::CoreStack - For getting core stack info -Devel::Symdump - For, uh, dumping symbols +Devel::Symdump - For, uh, dumping symbols -Digest::MD5 - Needed for Digest authentication +Digest::MD5 - Needed for Digest authentication -URI - There are URIs everywhere +URI - There are URIs everywhere -Net::Cmd - For libnet +Net::Cmd - For libnet -MIME::Base64 - Used in authentication headers +MIME::Base64 - Used in authentication headers -HTML::Tagset - Needed by HTML::Parser +HTML::Tagset - Needed by HTML::Parser -HTML::Parser - Need by HTML::HeadParser +HTML::Parser - Need by HTML::HeadParser -HTML::HeadParser - To get the correct $res->base +HTML::HeadParser - To get the correct $res->base -LWP - For libwww-perl +LWP - For libwww-perl -IPC::Run3 - Used in Apache::TestSmoke +LWP::Protocol::https - LWP plug-in for the https protocol + +IPC::Run3 - Used in Apache::TestSmoke =head1 DESCRIPTION diff --git a/docs/api/APR/Pool.pod b/docs/api/APR/Pool.pod index 40fc752..5333c03 100644 --- a/docs/api/APR/Pool.pod +++ b/docs/api/APR/Pool.pod @@ -103,12 +103,23 @@ To pass more than one argument, use an ARRAY or a HASH reference =item excpt: -if the registered callback fails, it happens when the pool is -destroyed. The destruction is performed by Apache and it ignores any -failures. Even if it didn't ignore the failures, most of the time the -pool is destroyed when a request or connection handlers are long gone. -However the error B logged to F, so if you monitor that -file you will spot if there are any problems with it. +If a registered callback dies or throws an exception C<$@> is stringified +and passed to C. Usually, this results in printing it to the +F. However, a C<$SIG{__WARN__}> handler can be used to catch +them. + + $pool->cleanup_register(sub {die "message1\n"}); + $pool->cleanup_register(sub {die "message2\n"}); + my @warnings; + { + local $SIG{__WARN__}=sub {push @warnings, @_}; + $pool->destroy; # or simply undef $pool + } + +Both of the cleanups above are executed at the time C<$pool-Edestroy> +is called. C<@warnings> contains C and C afterwards. +C<$pool-Edestroy> itself does not throw an exception. Any value of C<$@> +is preserved. =item since: 2.0.00 diff --git a/docs/api/Apache2/RequestUtil.pod b/docs/api/Apache2/RequestUtil.pod index 127ccd2..10d67b8 100644 --- a/docs/api/Apache2/RequestUtil.pod +++ b/docs/api/Apache2/RequestUtil.pod @@ -279,6 +279,8 @@ The default type =item since: 2.0.00 +=item removed from the C API in version 2.3.2 + =back @@ -810,7 +812,7 @@ What's wrong with this code: } Nothing, except it doesn't work as expected due to this pnotes bug: If the -same code is called in a sub-request then the pnote of $r->prev is magically +same code is called in a sub-request then the pnote of $r-Eprev is magically updated at a distance to the same value! Try explain why that is to anyone not deeply familar with perl internals! diff --git a/docs/api/Apache2/ServerUtil.pod b/docs/api/Apache2/ServerUtil.pod index e50ae60..ccd079b 100644 --- a/docs/api/Apache2/ServerUtil.pod +++ b/docs/api/Apache2/ServerUtil.pod @@ -841,6 +841,9 @@ F. The function will croak if run after the C> phase. +Values returned from cleanup functions are ignored. If a cleanup dies the +exception is stringified and passed to C. Usually, this results in +printing it to the F. diff --git a/lib/Apache2/Build.pm b/lib/Apache2/Build.pm index 38978ef..1b5ac35 100644 --- a/lib/Apache2/Build.pm +++ b/lib/Apache2/Build.pm @@ -27,6 +27,42 @@ use File::Basename; use ExtUtils::Embed (); use File::Copy (); +BEGIN { # check for a sane ExtUtils::Embed + unless ($ENV{MP_USE_MY_EXTUTILS_EMBED}) { + my ($version, $path)=(ExtUtils::Embed->VERSION, + $INC{q{ExtUtils/Embed.pm}}); + my $msg=<<"EOF"; +I have found ExtUtils::Embed $version at + + $path + +This is probably not the right one for this perl version. Please make sure +there is only one version of this module installed and that it is the one +that comes with this perl version. + +If you insist on using the ExtUtils::Embed as is set the environment +variable MP_USE_MY_EXTUTILS_EMBED=1 and try again. + +EOF + if (eval {require Module::CoreList}) { + my $req=$Module::CoreList::version{$]}->{q/ExtUtils::Embed/}; + die "Please repair your Module::CoreList" unless $req; + unless ($version eq $req) { + $msg.=("Details: expecting ExtUtils::Embed $req ". + "(according to Module::CoreList)\n\n"); + die $msg; + } + } + else { + my $req=$Config{privlib}.'/ExtUtils/Embed.pm'; + unless ($path eq $req) { + $msg.="Details: expecting ExtUtils::Embed at $req\n\n"; + die $msg; + } + } + } +} + use constant IS_MOD_PERL_BUILD => grep { -e "$_/Makefile.PL" && -e "$_/lib/mod_perl2.pm" } qw(. ..); @@ -239,12 +275,13 @@ sub caller_package { return ($arg and ref($arg) eq __PACKAGE__) ? $arg : __PACKAGE__; } -my %threaded_mpms = map { $_ => 1 } - qw(worker winnt beos mpmt_os2 netware leader perchild threadpool); +my %threaded_mpms; +undef @threaded_mpms{qw(worker winnt beos mpmt_os2 netware leader perchild + threadpool dynamic)}; sub mpm_is_threaded { my $self = shift; my $mpm_name = $self->mpm_name(); - return $threaded_mpms{$mpm_name} || 0; + return exists $threaded_mpms{$mpm_name} ? 1 : 0; } sub mpm_name { @@ -252,6 +289,11 @@ sub mpm_name { return $self->{mpm_name} if $self->{mpm_name}; + if ($self->httpd_version =~ /^(\d+)\.(\d+)\.(\d+)/) { + delete $threaded_mpms{dynamic} if $self->mp_nonthreaded_ok; + return $self->{mpm_name} = 'dynamic' if ($1*1000+$2)*1000+$3>=2003000; + } + # XXX: hopefully apxs will work on win32 one day return $self->{mpm_name} = 'winnt' if WIN32; @@ -2147,8 +2189,7 @@ sub has_large_files_conflict { # with it is that we didn't have such a case yet, but may need to # deal with it later - return 0; - # $perl_lfs64 ^ $apr_lfs64; + return $perl_lfs64 ^ $apr_lfs64; } # if perl is built with uselargefiles, but apr not, the build won't diff --git a/lib/ModPerl/BuildOptions.pm b/lib/ModPerl/BuildOptions.pm index e99e09b..cd53664 100644 --- a/lib/ModPerl/BuildOptions.pm +++ b/lib/ModPerl/BuildOptions.pm @@ -264,4 +264,4 @@ GENERATE_XS 0 Generate XS code based on httpd version LIBNAME 0 Name of the modperl dso library (default is mod_perl) COMPAT_1X 0 Compile-time mod_perl 1.0 backcompat (default is on) APR_LIB 0 Lib used to build APR::* on Win32 (default is aprext) - +NONTHREADED_OK 0 Using a non-threaded perl is okay with httpd >=2.3 diff --git a/lib/ModPerl/Code.pm b/lib/ModPerl/Code.pm index e43f77c..4dbcc38 100644 --- a/lib/ModPerl/Code.pm +++ b/lib/ModPerl/Code.pm @@ -825,7 +825,8 @@ my %ifdef = map { $_, 1 } qw(AP_MPMQ_STARTING AP_MPMQ_RUNNING AP_MPMQ_STOPPING AP_MPMQ_MPM_STATE), # added in 2.0.49 qw(APR_FPROT_USETID APR_FPROT_GSETID - APR_FPROT_WSTICKY APR_FOPEN_LARGEFILE); # added in 2.0.50? + APR_FPROT_WSTICKY APR_FOPEN_LARGEFILE), # added in 2.0.50? + qw(OPT_INCNOEXEC OPT_INC_WITH_EXEC); sub constants_ifdef { my $name = shift; diff --git a/lib/ModPerl/MapUtil.pm b/lib/ModPerl/MapUtil.pm index 1aa219f..788fcc7 100644 --- a/lib/ModPerl/MapUtil.pm +++ b/lib/ModPerl/MapUtil.pm @@ -103,15 +103,28 @@ sub readline { # #_end_ if (/^\s*#\s*_(if|unless|els(?:e|if)|end)_(?:\s(.+))?/) { my ($cmd, $param) = ($1, $2); + if (defined $param) { + while ($param=~s!\\$!!) { + my $l=<$fh>; + die "$ModPerl::MapUtil::MapFile($.): unexpected EOF\n" + unless defined $l; + chomp $l; + $param.=$l; + } + } if ($cmd eq 'if') { - unshift @condition, 0+!!eval $param; + unshift @condition, + 0+!!eval "#line $. $ModPerl::MapUtil::MapFile\n".$param; + die $@ if $@; } elsif ($cmd eq 'elsif') { die "parse error ($ModPerl::MapUtil::MapFile line $.)". " #_elsif_ without #_if_" unless @condition; if ($condition[0] == 0) { - $condition[0]+=!!eval $param; + $condition[0]+= + !!eval "#line $. $ModPerl::MapUtil::MapFile\n".$param; + die $@ if $@; } else { $condition[0]++; } @@ -123,7 +136,9 @@ sub readline { $condition[0]+=1; } elsif ($cmd eq 'unless') { - unshift @condition, 0+!eval $param; + unshift @condition, + 0+!eval "#line $. $ModPerl::MapUtil::MapFile\n".$param; + die $@ if $@; } elsif ($cmd eq 'end') { shift @condition; @@ -133,6 +148,15 @@ sub readline { if (/^\s*#\s*_(eval)_(?:\s(.+))?/) { my ($cmd, $param) = ($1, $2); + if (defined $param) { + while ($param=~s!\\$!!) { + my $l=<$fh>; + die "$ModPerl::MapUtil::MapFile($.): unexpected EOF\n" + unless defined $l; + chomp $l; + $param.=$l; + } + } if ($cmd eq 'eval') { eval "#line $. $ModPerl::MapUtil::MapFile\n".$param; die $@ if $@; diff --git a/lib/ModPerl/MethodLookup.pm b/lib/ModPerl/MethodLookup.pm index 071debb..e0206f1 100644 --- a/lib/ModPerl/MethodLookup.pm +++ b/lib/ModPerl/MethodLookup.pm @@ -1945,7 +1945,7 @@ my $methods = { 'APR::Socket' ] ], - 'remote_addr' => [ + 'client_addr' => [ [ 'Apache2::Connection', 'Apache2::Connection' @@ -1957,7 +1957,7 @@ my $methods = { 'Apache2::Connection' ] ], - 'remote_ip' => [ + 'client_ip' => [ [ 'Apache2::Connection', 'Apache2::Connection' @@ -2003,6 +2003,18 @@ my $methods = { 'Apache2::RequestRec' ] ], + 'useragent_ip' => [ + [ + 'Apache2::RequestRec', + 'Apache2::RequestRec' + ] + ], + 'useragent_addr' => [ + [ + 'Apache2::RequestRec', + 'Apache2::RequestRec' + ] + ], 'requires' => [ [ 'Apache2::Access', diff --git a/lib/ModPerl/TypeMap.pm b/lib/ModPerl/TypeMap.pm index 50aece4..dfbd6e4 100644 --- a/lib/ModPerl/TypeMap.pm +++ b/lib/ModPerl/TypeMap.pm @@ -442,12 +442,12 @@ sub typedefs_code { $code .= qq{\#include "$_"\n} } - for my $t (sort {$a->[1] cmp $b->[1]} @{ $self->{struct} }) { + for my $t (@{ $self->{struct} }) { next if $seen{ $t->[1] }++; $code .= "typedef $t->[0] * $t->[1];\n"; } - for my $t (sort {$a->[1] cmp $b->[1]} @{ $self->{typedef} }) { + for my $t (@{ $self->{typedef} }) { next if $seen{ $t->[1] }++; $code .= "typedef $t->[0] $t->[1];\n"; } @@ -470,9 +470,7 @@ sub sv_convert_code { my %seen; my $code = ""; - for my $ctype (sort keys %$map) { - my $ptype = $map->{$ctype}; - + while (my ($ctype, $ptype) = each %$map) { next if $self->special($ptype); next if $ctype =~ /\s/; my $class = $ptype; diff --git a/src/modules/perl/mod_perl.c b/src/modules/perl/mod_perl.c index b27f8f4..7cb05b0 100644 --- a/src/modules/perl/mod_perl.c +++ b/src/modules/perl/mod_perl.c @@ -653,6 +653,10 @@ int modperl_is_running(void) int modperl_hook_pre_config(apr_pool_t *p, apr_pool_t *plog, apr_pool_t *ptemp) { +#if AP_MODULE_MAGIC_AT_LEAST(20110329,0) + ap_reserve_module_slots_directive("PerlLoadModule"); +#endif + /* we can't have PerlPreConfigHandler without first configuring mod_perl */ /* perl 5.8.1+ */ diff --git a/src/modules/perl/modperl_apache_compat.h b/src/modules/perl/modperl_apache_compat.h index 78a9cb3..02a16fd 100644 --- a/src/modules/perl/modperl_apache_compat.h +++ b/src/modules/perl/modperl_apache_compat.h @@ -66,12 +66,40 @@ AP_DECLARE(const char *) ap_get_server_version(void); #define MP_HTTPD_OVERRIDE_HTACCESS (OR_LIMIT|OR_OPTIONS|OR_FILEINFO|OR_AUTHCFG|OR_INDEXES) #define MP_HTTPD_OVERRIDE_OPTS_UNSET (-1) + +#if AP_SERVER_MAJORVERSION_NUMBER>2 || AP_SERVER_MINORVERSION_NUMBER>=3 +/* 2.4 API */ + +#define mp_add_loaded_module(modp, pool, name) \ + ap_add_loaded_module((modp), (pool), (name)) + +#define mp_loglevel(s) ((s)->log.level) +#define mp_module_index_ perl_module.module_index, + +#define MP_HTTPD_OVERRIDE_OPTS_DEFAULT (OPT_UNSET | \ + OPT_ALL | \ + OPT_SYM_OWNER | \ + OPT_MULTI) + +#else +/* 2.2 API */ + +#define mp_add_loaded_module(modp, pool, name) \ + ap_add_loaded_module((modp), (pool)) + +#define mp_loglevel(s) ((s)->loglevel) +#define mp_module_index_ + #define MP_HTTPD_OVERRIDE_OPTS_DEFAULT (OPT_UNSET | \ OPT_ALL | \ OPT_INCNOEXEC | \ OPT_SYM_OWNER | \ OPT_MULTI) +#define ap_unixd_config unixd_config + +#endif + #ifndef PROXYREQ_RESPONSE #define PROXYREQ_RESPONSE (3) #endif diff --git a/src/modules/perl/modperl_cmd.h b/src/modules/perl/modperl_cmd.h index d8629e9..efd24b9 100644 --- a/src/modules/perl/modperl_cmd.h +++ b/src/modules/perl/modperl_cmd.h @@ -115,6 +115,10 @@ MP_CMD_SRV_DECLARE(interp_scope); AP_INIT_ITERATE( name, modperl_cmd_##item, NULL, \ RSRC_CONF, desc ) +#define MP_CMD_SRV_ITERATE_ON_READ(name, item, desc) \ + AP_INIT_ITERATE( name, modperl_cmd_##item, NULL, \ + RSRC_CONF|EXEC_ON_READ, desc ) + #define MP_CMD_SRV_ITERATE2(name, item, desc) \ AP_INIT_ITERATE2( name, modperl_cmd_##item, NULL, \ RSRC_CONF, desc ) diff --git a/src/modules/perl/modperl_common_util.h b/src/modules/perl/modperl_common_util.h index bba3403..3dcdaf1 100644 --- a/src/modules/perl/modperl_common_util.h +++ b/src/modules/perl/modperl_common_util.h @@ -22,7 +22,7 @@ #ifdef MP_DEBUG #define MP_INLINE #else -#define MP_INLINE +#define MP_INLINE APR_INLINE #endif #ifdef CYGWIN diff --git a/src/modules/perl/modperl_config.c b/src/modules/perl/modperl_config.c index 4ec135c..f6a9529 100644 --- a/src/modules/perl/modperl_config.c +++ b/src/modules/perl/modperl_config.c @@ -186,7 +186,7 @@ modperl_config_srv_t *modperl_config_srv_new(apr_pool_t *p, server_rec *s) /* make sure httpd's argv[0] is the first argument so $0 is * correctly connected to the real thing */ - modperl_config_srv_argv_push(s->process->short_name); + modperl_config_srv_argv_push(s->process->argv[0]); MP_TRACE_d(MP_FUNC, "new scfg: 0x%lx", (unsigned long)scfg); @@ -479,7 +479,13 @@ typedef struct { PerlInterpreter *perl; } svav_param_t; -static void *svav_getstr(void *buf, size_t bufsiz, void *param) +static +#if AP_MODULE_MAGIC_AT_LEAST(20110329,0) +apr_status_t +#else +void * +#endif +svav_getstr(void *buf, size_t bufsiz, void *param) { svav_param_t *svav_param = (svav_param_t *)param; dTHXa(svav_param->perl); @@ -488,7 +494,11 @@ static void *svav_getstr(void *buf, size_t bufsiz, void *param) STRLEN n_a; if (svav_param->ix > AvFILL(av)) { +#if AP_MODULE_MAGIC_AT_LEAST(20110329,0) + return APR_EOF; +#else return NULL; +#endif } sv = AvARRAY(av)[svav_param->ix++]; @@ -496,7 +506,11 @@ static void *svav_getstr(void *buf, size_t bufsiz, void *param) apr_cpystrn(buf, SvPVX(sv), bufsiz); +#if AP_MODULE_MAGIC_AT_LEAST(20110329,0) + return APR_SUCCESS; +#else return buf; +#endif } const char *modperl_config_insert(pTHX_ server_rec *s, diff --git a/src/modules/perl/modperl_error.h b/src/modules/perl/modperl_error.h index d18849d..cbd693f 100644 --- a/src/modules/perl/modperl_error.h +++ b/src/modules/perl/modperl_error.h @@ -45,4 +45,20 @@ void modperl_croak(pTHX_ apr_status_t rc, const char* func); } \ } STMT_END +#define MP_RUN_CROAK_RESET_OK(s, rc_run, func) STMT_START \ + { \ + apr_status_t rc = rc_run; \ + if (rc != APR_SUCCESS) { \ + if (APR_STATUS_IS_ECONNRESET(rc) || \ + APR_STATUS_IS_ECONNABORTED(rc)) { \ + ap_log_error(APLOG_MARK, APLOG_INFO, 0, s, \ + "%s got: %s", func, \ + modperl_error_strerror(aTHX_ rc)); \ + } \ + else { \ + modperl_croak(aTHX_ rc, func); \ + } \ + } \ + } STMT_END + #endif /* MODPERL_ERROR_H */ diff --git a/src/modules/perl/modperl_filter.c b/src/modules/perl/modperl_filter.c index 8122a3f..3ab5c66 100644 --- a/src/modules/perl/modperl_filter.c +++ b/src/modules/perl/modperl_filter.c @@ -472,24 +472,6 @@ static int modperl_run_filter_init(ap_filter_t *f, return status; } - -#define MP_RUN_CROAK_RESET_OK(func) \ - { \ - apr_status_t rc = func(filter); \ - if (rc != APR_SUCCESS) { \ - if (APR_STATUS_IS_ECONNRESET(rc) || \ - APR_STATUS_IS_ECONNABORTED(rc)) { \ - ap_log_error(APLOG_MARK, APLOG_INFO, 0, s, \ - "Apache2::Filter internal flush got: %s", \ - modperl_error_strerror(aTHX_ rc)); \ - } \ - else { \ - modperl_croak(aTHX_ rc, \ - "Apache2::Filter internal flush"); \ - } \ - } \ - } - int modperl_run_filter(modperl_filter_t *filter) { AV *args = Nullav; @@ -563,10 +545,12 @@ int modperl_run_filter(modperl_filter_t *filter) apr_brigade_destroy(filter->bb_in); filter->bb_in = NULL; } - MP_RUN_CROAK_RESET_OK(modperl_input_filter_flush); + MP_RUN_CROAK_RESET_OK(s, modperl_input_filter_flush(filter), + "Apache2::Filter internal flush"); } else { - MP_RUN_CROAK_RESET_OK(modperl_output_filter_flush); + MP_RUN_CROAK_RESET_OK(s, modperl_output_filter_flush(filter), + "Apache2::Filter internal flush"); } MP_FILTER_RESTORE_ERRSV(errsv); diff --git a/src/modules/perl/modperl_interp.c b/src/modules/perl/modperl_interp.c index dfff32e..56bc820 100644 --- a/src/modules/perl/modperl_interp.c +++ b/src/modules/perl/modperl_interp.c @@ -500,7 +500,7 @@ modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c, "set interp 0x%lx in %s 0x%lx (%s request for %s)\n", (unsigned long)interp, desc, (unsigned long)p, (r ? (is_subrequest ? "sub" : "main") : "conn"), - (r ? r->uri : c->remote_ip)); + (r ? r->uri : c->client_ip)); } /* set context (THX) for this thread */ diff --git a/src/modules/perl/modperl_io_apache.c b/src/modules/perl/modperl_io_apache.c index 53c8cd7..208838e 100644 --- a/src/modules/perl/modperl_io_apache.c +++ b/src/modules/perl/modperl_io_apache.c @@ -169,8 +169,9 @@ PerlIOApache_flush(pTHX_ PerlIO *f) rcfg->wbucket->outbuf, rcfg->wbucket->outcnt)); - MP_RUN_CROAK(modperl_wbucket_flush(rcfg->wbucket, FALSE), - ":Apache2 IO flush"); + MP_RUN_CROAK_RESET_OK(st->r->server, + modperl_wbucket_flush(rcfg->wbucket, FALSE), + ":Apache2 IO flush"); return 0; } diff --git a/src/modules/perl/modperl_module.c b/src/modules/perl/modperl_module.c index 0963935..2e133d9 100644 --- a/src/modules/perl/modperl_module.c +++ b/src/modules/perl/modperl_module.c @@ -741,8 +741,6 @@ static const char *modperl_module_add_cmds(apr_pool_t *p, server_rec *s, static void modperl_module_insert(module *modp) { - module *m; - /* * insert after mod_perl, rather the top of the list. * (see ap_add_module; does not insert into ap_top_module list if @@ -750,14 +748,8 @@ static void modperl_module_insert(module *modp) * this way, modperl config merging happens before this module. */ - for (m = ap_top_module; m; m=m->next) { - if (m == &perl_module) { - module *next = m->next; - m->next = modp; - modp->next = next; - break; - } - } + modp->next = perl_module.next; + perl_module.next = modp; } #define MP_isGV(gv) (gv && isGV(gv)) @@ -840,7 +832,10 @@ const char *modperl_module_add(apr_pool_t *p, server_rec *s, modperl_module_insert(modp); - ap_add_loaded_module(modp, p); + if ((errmsg = mp_add_loaded_module(modp, p, modp->name))) { + perl_module.next = modp->next; + return errmsg; + } apr_pool_cleanup_register(p, modp, modperl_module_remove, apr_pool_cleanup_null); diff --git a/src/modules/perl/modperl_pcw.c b/src/modules/perl/modperl_pcw.c index e83baea..16f8b06 100644 --- a/src/modules/perl/modperl_pcw.c +++ b/src/modules/perl/modperl_pcw.c @@ -27,7 +27,11 @@ void ap_pcw_walk_location_config(apr_pool_t *pconf, server_rec *s, ap_pcw_dir_cb_t dir_cb, void *data) { int i; - ap_conf_vector_t **urls = (ap_conf_vector_t **)sconf->sec_url->elts; + ap_conf_vector_t **urls; + + if( !sconf->sec_url ) return; + + urls = (ap_conf_vector_t **)sconf->sec_url->elts; for (i = 0; i < sconf->sec_url->nelts; i++) { core_dir_config *conf = @@ -46,7 +50,11 @@ void ap_pcw_walk_directory_config(apr_pool_t *pconf, server_rec *s, ap_pcw_dir_cb_t dir_cb, void *data) { int i; - ap_conf_vector_t **dirs = (ap_conf_vector_t **)sconf->sec_dir->elts; + ap_conf_vector_t **dirs; + + if( !sconf->sec_dir ) return; + + dirs = (ap_conf_vector_t **)sconf->sec_dir->elts; for (i = 0; i < sconf->sec_dir->nelts; i++) { core_dir_config *conf = @@ -65,7 +73,11 @@ void ap_pcw_walk_files_config(apr_pool_t *pconf, server_rec *s, ap_pcw_dir_cb_t dir_cb, void *data) { int i; - ap_conf_vector_t **dirs = (ap_conf_vector_t **)dconf->sec_file->elts; + ap_conf_vector_t **dirs; + + if( !dconf->sec_file ) return; + + dirs = (ap_conf_vector_t **)dconf->sec_file->elts; for (i = 0; i < dconf->sec_file->nelts; i++) { core_dir_config *conf = diff --git a/src/modules/perl/modperl_svptr_table.c b/src/modules/perl/modperl_svptr_table.c index c05e0ac..0ca5c95 100644 --- a/src/modules/perl/modperl_svptr_table.c +++ b/src/modules/perl/modperl_svptr_table.c @@ -30,7 +30,7 @@ #ifdef USE_ITHREADS #if MP_PERL_BRANCH(5, 6) -# define my_sv_dup(s, p) sv_dup(s) +# define my_sv_dup(s, p) SvREFCNT_inc(sv_dup(s)) typedef struct { AV *stashes; @@ -39,7 +39,11 @@ typedef struct { } CLONE_PARAMS; #else -# define my_sv_dup(s, p) sv_dup(s, p) +# ifdef sv_dup_inc +# define my_sv_dup(s, p) sv_dup_inc(s, p) +# else +# define my_sv_dup(s, p) SvREFCNT_inc(sv_dup(s, p)) +# endif #endif /* @@ -89,8 +93,7 @@ PTR_TBL_t *modperl_svptr_table_clone(pTHX_ PerlInterpreter *proto_perl, /* key is just a pointer we do not modify, no need to copy */ dst_ent->oldval = src_ent->oldval; - dst_ent->newval = - SvREFCNT_inc(my_sv_dup((SV*)src_ent->newval, &parms)); + dst_ent->newval = my_sv_dup((SV*)src_ent->newval, &parms); } } diff --git a/t/api/err_headers_out.t b/t/api/err_headers_out.t index 006f49f..c9066e6 100644 --- a/t/api/err_headers_out.t +++ b/t/api/err_headers_out.t @@ -19,6 +19,14 @@ my $location = '/TestAPI__err_headers_out'; ok t_cmp $res->code, 200, "OK"; + # HTTP::Headers 6.00 makes the next 2 tests fail. When the response comes + # in the header name is stored as "x-err_headers_out". But when it is to + # be read below it is referred as "x-err-headers-out" and hence not found. + local $HTTP::Headers::TRANSLATE_UNDERSCORE= + $HTTP::Headers::TRANSLATE_UNDERSCORE; + undef $HTTP::Headers::TRANSLATE_UNDERSCORE + if defined HTTP::Headers->VERSION and HTTP::Headers->VERSION==6.00; + ok t_cmp $res->header('X-err_headers_out'), "err_headers_out", "X-err_headers_out: made it"; @@ -36,6 +44,14 @@ my $location = '/TestAPI__err_headers_out'; ok t_cmp $res->code, 404, "not found"; + # HTTP::Headers 6.00 makes this test fail. When the response comes in + # the header name is stored as "x-err_headers_out". But when it is to + # be read below it is referred as "x-err-headers-out" and hence not found. + local $HTTP::Headers::TRANSLATE_UNDERSCORE= + $HTTP::Headers::TRANSLATE_UNDERSCORE; + undef $HTTP::Headers::TRANSLATE_UNDERSCORE + if defined HTTP::Headers->VERSION and HTTP::Headers->VERSION==6.00; + ok t_cmp $res->header('X-err_headers_out'), "err_headers_out", "X-err_headers_out: made it"; diff --git a/t/conf/extra.conf.in b/t/conf/extra.conf.in index 9d4f43e..3e8b005 100644 --- a/t/conf/extra.conf.in +++ b/t/conf/extra.conf.in @@ -73,6 +73,10 @@ PerlModule TestExit::FromPerlModule SetEnv TMPDIR @t_logs@ + + # pass ld_library_path for non standard lib locations + # [rt.cpan.org #66085] + PassEnv LD_LIBRARY_PATH # diff --git a/t/filter/TestFilter/out_str_reverse.pm b/t/filter/TestFilter/out_str_reverse.pm index 737e831..b661ede 100644 --- a/t/filter/TestFilter/out_str_reverse.pm +++ b/t/filter/TestFilter/out_str_reverse.pm @@ -16,12 +16,21 @@ use TestCommon::Utils (); use Apache2::Const -compile => qw(OK M_POST); use constant BUFF_LEN => 2; +use constant signature => "Reversed by mod_perl 2.0\n"; sub handler { my $f = shift; #warn "called\n"; my $leftover = $f->ctx; + + # We are about to change the length of the response body. Hence, we + # have to adjust the content-length header. + unless (defined $leftover) { # 1st invocation + $f->r->headers_out->{'Content-Length'}+=length signature + if exists $f->r->headers_out->{'Content-Length'}; + } + while ($f->read(my $buffer, BUFF_LEN)) { #warn "buffer: [$buffer]\n"; $buffer = $leftover . $buffer if defined $leftover; @@ -34,7 +43,7 @@ sub handler { if ($f->seen_eos) { $f->print(scalar reverse $leftover) if defined $leftover; - $f->print("Reversed by mod_perl 2.0\n"); + $f->print(signature); } else { $f->ctx($leftover) if defined $leftover; diff --git a/t/protocol/TestProtocol/pseudo_http.pm b/t/protocol/TestProtocol/pseudo_http.pm index 713b06a..bb49ec8 100644 --- a/t/protocol/TestProtocol/pseudo_http.pm +++ b/t/protocol/TestProtocol/pseudo_http.pm @@ -165,6 +165,8 @@ __END__ AuthUserFile @ServerRoot@/htdocs/protocols/basic-auth + AuthName TestProtocol::pseudo_http + AuthType Basic Require user stas Satisfy any diff --git a/t/response/TestAPI/add_config.pm b/t/response/TestAPI/add_config.pm index 0347c4c..f02a717 100644 --- a/t/response/TestAPI/add_config.pm +++ b/t/response/TestAPI/add_config.pm @@ -100,7 +100,8 @@ sub handler : method { my $expect = Apache2::Const::OPT_ALL | Apache2::Const::OPT_UNSET | - Apache2::Const::OPT_INCNOEXEC | + (defined &Apache2::Const::OPT_INCNOEXEC + ? Apache2::Const::OPT_INCNOEXEC() : 0) | Apache2::Const::OPT_MULTI | Apache2::Const::OPT_SYM_OWNER; @@ -121,7 +122,7 @@ __END__ # APACHE_TEST_CONFIG_ORDER 950 - PerlModule TestAPI::add_config + PerlLoadModule TestAPI::add_config AccessFileName htaccess SetHandler modperl diff --git a/t/response/TestAPI/request_rec.pm b/t/response/TestAPI/request_rec.pm index 2f20f9f..23d1fae 100644 --- a/t/response/TestAPI/request_rec.pm +++ b/t/response/TestAPI/request_rec.pm @@ -57,8 +57,9 @@ sub handler { ok $r->protocol =~ /http/i; - # HTTP 1.0 - ok t_cmp $r->proto_num, 1000, 't->proto_num'; + # LWP >=6.00 uses HTTP/1.1, other HTTP/1.0 + ok t_cmp $r->proto_num, 1000+substr($r->the_request, -1), + 't->proto_num'; ok t_cmp lc($r->hostname), lc($r->get_server_name), '$r->hostname'; @@ -124,7 +125,12 @@ sub handler { ok t_cmp $r->args, $args, '$r->args'; - ok t_cmp $r->the_request, "GET $base_uri$path_info?$args HTTP/1.0", + # LWP uses HTTP/1.1 since 6.00 + ok t_cmp $r->the_request, qr!GET + \x20 + \Q$base_uri$path_info\E\?\Q$args\E + \x20 + HTTP/1\.\d!x, '$r->the_request'; { diff --git a/t/response/TestAPI/request_util.pm b/t/response/TestAPI/request_util.pm index 39ba311..4737314 100644 --- a/t/response/TestAPI/request_util.pm +++ b/t/response/TestAPI/request_util.pm @@ -24,7 +24,8 @@ sub handler { plan $r, tests => (scalar keys %status_lines) + 11; - ok $r->default_type; + # default_type() is gone as of httpd 2.3.2-dev + ok !defined(&Apache2::RequestRec::default_type) || $r->default_type; my $document_root = $r->document_root; diff --git a/t/response/TestAPI/server_const.pm b/t/response/TestAPI/server_const.pm index 04a190b..d7b17ad 100644 --- a/t/response/TestAPI/server_const.pm +++ b/t/response/TestAPI/server_const.pm @@ -24,7 +24,7 @@ sub handler { my $r = shift; - plan $r, tests => 5; + plan $r, tests => 6; # test Apache2::ServerUtil constant subroutines @@ -36,20 +36,22 @@ sub handler { $built, 'Apache2::ServerUtil::get_server_built()'); - ok t_cmp(Apache2::ServerUtil::get_server_description, - $version, + my $server_descr = Apache2::ServerUtil::get_server_description; + ok t_cmp($server_descr, qr/^\Q$version\E/, 'Apache2::ServerUtil::get_server_description()'); - my $server_version = Apache2::ServerUtil::get_server_version; - ok t_cmp($version, - qr/^$server_version/, - 'Apache2::ServerUtil::get_server_version()'); + # added via $s->add_version_component in t/conf/modperl_extra.pl + ok t_cmp($server_descr, qr!\bworld domination series/2\.0\b!, + 'Apache2::ServerUtil::get_server_description() -- component'); - my $server_banner = Apache2::ServerUtil::get_server_banner; - ok t_cmp($version, - qr/^$server_banner/, + # assuming ServerTokens Full (default) the banner equals description + ok t_cmp(Apache2::ServerUtil::get_server_banner, $server_descr, 'Apache2::ServerUtil::get_server_banner()'); + # version is just an alias for banner + ok t_cmp(Apache2::ServerUtil::get_server_version, $server_descr, + 'Apache2::ServerUtil::get_server_version()'); + Apache2::Const::OK; } diff --git a/t/response/TestDirective/cmdparms.pm b/t/response/TestDirective/cmdparms.pm index 72e0d33..aa155ca 100644 --- a/t/response/TestDirective/cmdparms.pm +++ b/t/response/TestDirective/cmdparms.pm @@ -134,6 +134,8 @@ TestCmdParms "Vhost" TestCmdParms "Location" - - TestCmdParms "Limit" - + + + TestCmdParms "Limit" + + diff --git a/xs/Apache2/Access/Apache2__Access.h b/xs/Apache2/Access/Apache2__Access.h index 539e201..d1a5dcf 100644 --- a/xs/Apache2/Access/Apache2__Access.h +++ b/xs/Apache2/Access/Apache2__Access.h @@ -19,7 +19,12 @@ static MP_INLINE SV *mpxs_ap_requires(pTHX_ request_rec *r) AV *av; HV *hv; register int x; - const apr_array_header_t *reqs_arr = ap_requires(r); + const apr_array_header_t *reqs_arr = +#if AP_SERVER_MAJORVERSION_NUMBER>2 || AP_SERVER_MINORVERSION_NUMBER>=3 + 0; +#else + ap_requires(r); +#endif require_line *reqs; if (!reqs_arr) { diff --git a/xs/Apache2/Log/Apache2__Log.h b/xs/Apache2/Log/Apache2__Log.h index 1866315..82db55a 100644 --- a/xs/Apache2/Log/Apache2__Log.h +++ b/xs/Apache2/Log/Apache2__Log.h @@ -48,13 +48,13 @@ static void mpxs_ap_log_error(pTHX_ int level, SV *sv, SV *msg) s = modperl_global_get_server_rec(); } - if ((lmask == APLOG_DEBUG) && (s->loglevel >= APLOG_DEBUG)) { + if ((lmask >= APLOG_DEBUG) && (mp_loglevel(s) >= APLOG_DEBUG)) { COP *cop = PL_curcop; file = CopFILE(cop); /* (caller)[1] */ line = CopLINE(cop); /* (caller)[2] */ } - if ((s->loglevel >= lmask) && + if ((mp_loglevel(s) >= lmask) && SvROK(msg) && (SvTYPE(SvRV(msg)) == SVt_PVCV)) { dSP; ENTER;SAVETMPS; @@ -72,10 +72,12 @@ static void mpxs_ap_log_error(pTHX_ int level, SV *sv, SV *msg) } if (r) { - ap_log_rerror(file, line, level, 0, r, "%s", str); + ap_log_rerror(file, line, mp_module_index_ level, 0, r, + "%s", str); } else { - ap_log_error(file, line, level, 0, s, "%s", str); + ap_log_error(file, line, mp_module_index_ level, 0, s, + "%s", str); } if (svstr) { @@ -258,10 +260,12 @@ MP_STATIC XS(MPXS_Apache2__Log_log_xerror) msgstr = SvPV(msgsv, n_a); if (r) { - ap_log_rerror(file, line, level, status, r, "%s", msgstr); + ap_log_rerror(file, line, mp_module_index_ level, status, r, + "%s", msgstr); } else { - ap_log_error(file, line, level, status, s, "%s", msgstr); + ap_log_error(file, line, mp_module_index_ level, status, s, + "%s", msgstr); } SvREFCNT_dec(msgsv); diff --git a/xs/Apache2/RequestIO/Apache2__RequestIO.h b/xs/Apache2/RequestIO/Apache2__RequestIO.h index ff586a4..aa2f1f5 100644 --- a/xs/Apache2/RequestIO/Apache2__RequestIO.h +++ b/xs/Apache2/RequestIO/Apache2__RequestIO.h @@ -179,8 +179,9 @@ void mpxs_Apache2__RequestRec_rflush(pTHX_ I32 items, rcfg->wbucket->outcnt, apr_pstrmemdup(rcfg->wbucket->pool, rcfg->wbucket->outbuf, rcfg->wbucket->outcnt)); - MP_RUN_CROAK(modperl_wbucket_flush(rcfg->wbucket, TRUE), - "Apache2::RequestIO::rflush"); + MP_RUN_CROAK_RESET_OK(r->server, + modperl_wbucket_flush(rcfg->wbucket, TRUE), + "Apache2::RequestIO::rflush"); } static MP_INLINE long mpxs_ap_get_client_block(pTHX_ request_rec *r, diff --git a/xs/Apache2/RequestUtil/Apache2__RequestUtil.h b/xs/Apache2/RequestUtil/Apache2__RequestUtil.h index ee3f197..931af4a 100644 --- a/xs/Apache2/RequestUtil/Apache2__RequestUtil.h +++ b/xs/Apache2/RequestUtil/Apache2__RequestUtil.h @@ -154,12 +154,6 @@ int mpxs_Apache2__RequestRec_location_merge(request_rec *r, &core_module); if (strEQ(entry->d, location)) { - if (!entry->ap_auth_type) { - entry->ap_auth_type = "Basic"; - } - if (!entry->ap_auth_name) { - entry->ap_auth_name = apr_pstrdup(p, location); - } r->per_dir_config = ap_merge_per_dir_configs(p, s->lookup_defaults, sec[i]); return 1; diff --git a/xs/Apache2/ServerUtil/Apache2__ServerUtil.h b/xs/Apache2/ServerUtil/Apache2__ServerUtil.h index ced1c38..8965dad 100644 --- a/xs/Apache2/ServerUtil/Apache2__ServerUtil.h +++ b/xs/Apache2/ServerUtil/Apache2__ServerUtil.h @@ -157,8 +157,8 @@ SV *mpxs_Apache2__ServerRec_get_handlers(pTHX_ server_rec *s, #define mpxs_Apache2__ServerUtil_server(classname) modperl_global_get_server_rec() #if !defined(OS2) && !defined(WIN32) && !defined(BEOS) && !defined(NETWARE) -#define mpxs_Apache2__ServerUtil_user_id(classname) unixd_config.user_id -#define mpxs_Apache2__ServerUtil_group_id(classname) unixd_config.group_id +#define mpxs_Apache2__ServerUtil_user_id(classname) ap_unixd_config.user_id +#define mpxs_Apache2__ServerUtil_group_id(classname) ap_unixd_config.group_id #else #define mpxs_Apache2__ServerUtil_user_id(classname) 0 #define mpxs_Apache2__ServerUtil_group_id(classname) 0 @@ -185,6 +185,13 @@ void mpxs_Apache2__ServerRec_add_config(pTHX_ server_rec *s, SV *lines) } } +#define mpxs_Apache2__ServerRec_get_server_banner \ + ap_get_server_banner() +#define mpxs_Apache2__ServerRec_get_server_description \ + ap_get_server_description() +#define mpxs_Apache2__ServerRec_get_server_version \ + ap_get_server_version() + static void mpxs_Apache2__ServerUtil_BOOT(pTHX) { newCONSTSUB(PL_defstash, "Apache2::ServerUtil::server_root", @@ -192,13 +199,4 @@ static void mpxs_Apache2__ServerUtil_BOOT(pTHX) newCONSTSUB(PL_defstash, "Apache2::ServerUtil::get_server_built", newSVpv(ap_get_server_built(), 0)); - - newCONSTSUB(PL_defstash, "Apache2::ServerUtil::get_server_version", - newSVpv(ap_get_server_version(), 0)); - - newCONSTSUB(PL_defstash, "Apache2::ServerUtil::get_server_banner", - newSVpv(ap_get_server_banner(), 0)); - - newCONSTSUB(PL_defstash, "Apache2::ServerUtil::get_server_description", - newSVpv(ap_get_server_description(), 0)); } diff --git a/xs/maps/apache2_functions.map b/xs/maps/apache2_functions.map index 6d1f29b..27d5ef1 100644 --- a/xs/maps/apache2_functions.map +++ b/xs/maps/apache2_functions.map @@ -41,7 +41,14 @@ MODULE=Apache2::RequestUtil MODULE=Apache2::RequestUtil PACKAGE=guess ap_psignature | | r, prefix >ap_finalize_request_protocol +#_if_ do { \ + Apache2::Build->build_config \ + ->httpd_version =~ /^(\d+)\.(\d+)\.(\d+)/ \ + ? ($1*1000+$2)*1000+$3 \ + : die "Cannot get httpd version"; \ + } < 2003000 ap_default_type +#_end_ ap_get_server_name ap_get_server_port !ap_content_type_tolower @@ -165,6 +172,9 @@ MODULE=Apache2::ServerUtil PACKAGE=Apache2::ServerRec BOOT=1 MODULE=Apache2::ServerUtil PACKAGE=Apache2::ServerUtil ap_exists_config_define ap_server_root_relative | | p, fname="" + ap_get_server_banner + ap_get_server_description + ap_get_server_version MODULE=Apache2::ServerUtil PACKAGE=guess ap_error_log2stderr @@ -175,9 +185,6 @@ MODULE=Apache2::ServerUtil PACKAGE=guess #however it is not exported on win32 !ap_get_local_host ~ap_get_server_built -~ap_get_server_version -~ap_get_server_banner -~ap_get_server_description ~ap_server_root diff --git a/xs/tables/current/Apache2/ConstantsTable.pm b/xs/tables/current/Apache2/ConstantsTable.pm index 3f86493..1192611 100644 --- a/xs/tables/current/Apache2/ConstantsTable.pm +++ b/xs/tables/current/Apache2/ConstantsTable.pm @@ -53,6 +53,7 @@ $Apache2::ConstantsTable = { 'OPT_EXECCGI', 'OPT_UNSET', 'OPT_INCNOEXEC', + 'OPT_INC_WITH_EXEC', 'OPT_SYM_OWNER', 'OPT_MULTI', 'OPT_ALL' diff --git a/xs/tables/current/Apache2/StructureTable.pm b/xs/tables/current/Apache2/StructureTable.pm index af50be1..ec134b4 100644 --- a/xs/tables/current/Apache2/StructureTable.pm +++ b/xs/tables/current/Apache2/StructureTable.pm @@ -2708,11 +2708,11 @@ $Apache2::StructureTable = [ }, { 'type' => 'apr_sockaddr_t *', - 'name' => 'remote_addr' + 'name' => 'client_addr' }, { 'type' => 'char *', - 'name' => 'remote_ip' + 'name' => 'client_ip' }, { 'type' => 'char *', @@ -2955,6 +2955,14 @@ $Apache2::StructureTable = [ }, { 'type' => 'char *', + 'name' => 'useragent_ip' + }, + { + 'type' => 'apr_sockaddr_t *', + 'name' => 'useragent_addr' + }, + { + 'type' => 'char *', 'name' => 'the_request' }, { @@ -3245,10 +3253,6 @@ $Apache2::StructureTable = [ }, { 'type' => 'int', - 'name' => 'loglevel' - }, - { - 'type' => 'int', 'name' => 'is_virtual' }, {