Apache-Test
view release on metacpan or search on metacpan
lib/Apache/TestConfig.pm view on Meta::CPAN
use constant DEFAULT_PORT => 8529;
use constant IS_MOD_PERL_2 =>
eval { require mod_perl2 } || 0;
use constant IS_MOD_PERL_2_BUILD => IS_MOD_PERL_2 &&
eval { require Apache2::Build && Apache2::Build::IS_MOD_PERL_BUILD() };
use constant IS_APACHE_TEST_BUILD =>
grep { -e "$_/lib/Apache/TestConfig.pm" }
qw(Apache-Test . .. ../Apache-Test);
use lib ();
use File::Copy ();
use File::Find qw(finddepth);
use File::Basename qw(dirname);
use File::Path ();
use File::Spec::Functions qw(catfile abs2rel splitdir canonpath
catdir file_name_is_absolute devnull);
use Cwd qw(fastcwd);
use Socket ();
use Symbol ();
use Apache::TestConfigPerl ();
use Apache::TestConfigParse ();
use Apache::TestTrace;
use Apache::TestServer ();
use Apache::TestRun ();
use vars qw(%Usage);
%Usage = (
top_dir => 'top-level directory (default is $PWD)',
t_dir => 'the t/ test directory (default is $top_dir/t)',
t_conf => 'the conf/ test directory (default is $t_dir/conf)',
t_logs => 'the logs/ test directory (default is $t_dir/logs)',
t_state => 'the state/ test directory (default is $t_dir/state)',
t_pid_file => 'location of the pid file (default is $t_logs/httpd.pid)',
t_conf_file => 'test httpd.conf file (default is $t_conf/httpd.conf)',
src_dir => 'source directory to look for mod_foos.so',
serverroot => 'ServerRoot (default is $t_dir)',
documentroot => 'DocumentRoot (default is $ServerRoot/htdocs',
port => 'Port [port_number|select] (default ' . DEFAULT_PORT . ')',
servername => 'ServerName (default is localhost)',
user => 'User to run test server as (default is $USER)',
group => 'Group to run test server as (default is $GROUP)',
bindir => 'Apache bin/ dir (default is apxs -q BINDIR)',
sbindir => 'Apache sbin/ dir (default is apxs -q SBINDIR)',
httpd => 'server to use for testing (default is $bindir/httpd)',
target => 'name of server binary (default is apxs -q TARGET)',
apxs => 'location of apxs (default is from Apache2::BuildConfig)',
startup_timeout => 'seconds to wait for the server to start (default is 60)',
httpd_conf => 'inherit config from this file (default is apxs derived)',
httpd_conf_extra => 'inherit additional config from this file',
minclients => 'minimum number of concurrent clients (default is 1)',
maxclients => 'maximum number of concurrent clients (default is minclients+1)',
threadsperchild => 'number of threads per child when using threaded MPMs (default is 10)',
limitrequestline => 'global LimitRequestLine setting (default is 128)',
perlpod => 'location of perl pod documents (for testing downloads)',
proxyssl_url => 'url for testing ProxyPass / https (default is localhost)',
sslca => 'location of SSL CA (default is $t_conf/ssl/ca)',
sslcaorg => 'SSL CA organization to use for tests (default is asf)',
sslproto => 'SSL/TLS protocol version(s) to test',
libmodperl => 'path to mod_perl\'s .so (full or relative to LIBEXECDIR)',
defines => 'values to add as -D defines (for example, "VAR1 VAR2")',
(map { $_ . '_module_name', "$_ module name"} qw(cgi ssl thread access auth php)),
);
my %filepath_conf_opts = map { $_ => 1 }
qw(top_dir t_dir t_conf t_logs t_state t_pid_file t_conf_file src_dir serverroot
documentroot bindir sbindir httpd apxs httpd_conf httpd_conf_extra
perlpod sslca libmodperl);
sub conf_opt_is_a_filepath {
my $opt = shift;
$opt && exists $filepath_conf_opts{$opt};
}
sub usage {
for my $hash (\%Usage) {
for (sort keys %$hash){
printf " -%-18s %s\n", $_, $hash->{$_};
}
}
}
sub filter_args {
my($args, $wanted_args) = @_;
my(@pass, %keep);
my @filter = @$args;
if (ref($filter[0])) {
push @pass, shift @filter;
}
while (@filter) {
my $key = shift @filter;
# optinal - or -- prefix
if (defined $key && $key =~ /^-?-?(.+)/ && exists $wanted_args->{$1}) {
if (@filter) {
$keep{$1} = shift @filter;
}
else {
die "key $1 requires a matching value";
}
}
else {
push @pass, $key;
}
}
return (\@pass, \%keep);
}
my %passenv = map { $_,1 } qw{
APACHE_TEST_APXS
APACHE_TEST_HTTPD
APACHE_TEST_GROUP
APACHE_TEST_USER
APACHE_TEST_PORT
};
sub passenv {
\%passenv;
}
sub passenv_makestr {
my @vars;
for (sort keys %passenv) {
push @vars, "$_=\$($_)";
lib/Apache/TestConfig.pm view on Meta::CPAN
#dont generate any new config
$thaw->{vars}->{$_} = $args->{$_} for keys %$args;
$thaw->{server} = $thaw->new_test_server;
$thaw->add_inc;
return $thaw;
}
#regenerating config, so forget old
if ($args->{save}) {
for (qw(vhosts inherit_config modules inc cmodules)) {
delete $thaw->{$_} if exists $thaw->{$_};
}
}
my $self = bless {
clean => {},
vhosts => {},
inherit_config => {},
modules => {},
inc => [],
%$thaw,
mpm => "",
httpd_defines => {},
vars => $args,
postamble => [],
preamble => [],
postamble_hooks => [],
preamble_hooks => [],
}, ref($class) || $class;
my $vars = $self->{vars}; #things that can be overridden
for (qw(save verbose)) {
next unless exists $args->{$_};
$self->{$_} = delete $args->{$_};
}
$vars->{top_dir} ||= $top_dir;
$self->add_inc;
#help to find libmodperl.so
unless ($vars->{src_dir}) {
my $src_dir = catfile $vars->{top_dir}, qw(.. src modules perl);
if (-d $src_dir) {
$vars->{src_dir} = $src_dir;
} else {
$src_dir = catfile $vars->{top_dir}, qw(src modules perl);
$vars->{src_dir} = $src_dir if -d $src_dir;
}
}
$vars->{t_dir} ||= catfile $vars->{top_dir}, 't';
$vars->{serverroot} ||= $vars->{t_dir};
$vars->{documentroot} ||= catfile $vars->{serverroot}, 'htdocs';
$vars->{perlpod} ||= $self->find_in_inc('pods') ||
$self->find_in_inc('pod');
$vars->{perl} ||= $^X;
$vars->{t_conf} ||= catfile $vars->{serverroot}, 'conf';
$vars->{sslca} ||= catfile $vars->{t_conf}, 'ssl', 'ca';
$vars->{sslcaorg} ||= 'asf';
if (!defined($vars->{sslproto}) and eval { require Apache::TestSSLCA; 1; }) {
$vars->{sslproto} = Apache::TestSSLCA::sslproto();
}
else {
$vars->{sslproto} ||= 'all';
}
$vars->{t_logs} ||= catfile $vars->{serverroot}, 'logs';
$vars->{t_state} ||= catfile $vars->{serverroot}, 'state';
$vars->{t_conf_file} ||= catfile $vars->{t_conf}, 'httpd.conf';
$vars->{t_pid_file} ||= catfile $vars->{t_logs}, 'httpd.pid';
if (WINFU) {
for (keys %$vars) {
$vars->{$_} =~ s|\\|\/|g if defined $vars->{$_};
}
}
$vars->{scheme} ||= 'http';
$vars->{servername} ||= $self->default_servername;
$vars->{port} = $self->select_first_port;
$vars->{remote_addr} ||= $self->our_remote_addr;
$vars->{user} ||= $self->default_user;
$vars->{group} ||= $self->default_group;
$vars->{serveradmin} ||= $self->default_serveradmin;
$vars->{threadsperchild} ||= 10;
$vars->{minclients} ||= 1;
$vars->{maxclients_preset} = $vars->{maxclients} || 0;
# if maxclients wasn't explicitly passed try to
# prevent 'server reached MaxClients setting' errors
$vars->{maxclients} ||= $vars->{minclients} + 1;
# if a preset maxclients valus is smaller than minclients,
# maxclients overrides minclients
if ($vars->{maxclients_preset} &&
$vars->{maxclients_preset} < $vars->{minclients}) {
$vars->{minclients} = $vars->{maxclients_preset};
}
if ($vars->{minclients} < 2) {
$vars->{maxspare} = 2;
} else {
$vars->{maxspare} = $vars->{minclients};
}
if ($vars->{maxclients} < $vars->{maxspare} + 1) {
$vars->{maxclients} = $vars->{maxspare} + 1;
}
# for threaded mpms MinClients and MaxClients must be a
# multiple of ThreadsPerChild
{
use integer;
$vars->{minclientsthreadedmpm} = ($vars->{minclients} + $vars->{threadsperchild} - 1) /
$vars->{threadsperchild} * $vars->{threadsperchild};
$vars->{maxclientsthreadedmpm} = ($vars->{maxclients} + $vars->{threadsperchild} - 1) /
$vars->{threadsperchild} * $vars->{threadsperchild};
$vars->{maxsparethreadedmpm} = ($vars->{maxspare} + $vars->{threadsperchild} - 1) /
$vars->{threadsperchild} * $vars->{threadsperchild};
$vars->{startserversthreadedmpm} = $vars->{minclientsthreadedmpm} / $vars->{threadsperchild};
}
if ($vars->{maxsparethreadedmpm} < 2 * $vars->{threadsperchild}) {
$vars->{maxsparethreadedmpm} = 2 * $vars->{threadsperchild};
}
if ($vars->{maxclientsthreadedmpm} < $vars->{maxsparethreadedmpm} + $vars->{threadsperchild}) {
$vars->{maxclientsthreadedmpm} = $vars->{maxsparethreadedmpm} + $vars->{threadsperchild};
}
$vars->{limitrequestline} ||= 128;
$vars->{limitrequestlinex2} = 2 * $vars->{limitrequestline};
$vars->{proxy} ||= 'off';
$vars->{proxyssl_url} ||= '';
$vars->{defines} ||= '';
$self->{hostport} = $self->hostport;
$self->{server} = $self->new_test_server;
return $self;
}
# figure out where httpd is and run extra config hooks which require
# knowledge of where httpd is
sub httpd_config {
my $self = shift;
$self->configure_apxs;
$self->configure_httpd;
my $vars = $self->{vars};
unless ($vars->{httpd} or $vars->{apxs}) {
# mod_perl 2.0 build (almost) always knows the right httpd
# location (and optionally apxs). if we get here we can't
# continue because the interactive config can't work with
# mod_perl 2.0 build (by design)
if (IS_MOD_PERL_2_BUILD){
my $mp2_build = $self->modperl_build_config();
# if mod_perl 2 was built against the httpd source it
# doesn't know where to find apxs/httpd, so in this case
# fall back to interactive config
unless ($mp2_build->{MP_APXS}) {
die "mod_perl 2 was built against Apache sources, we " .
"don't know where httpd/apxs executables are, therefore " .
"skipping the test suite execution"
}
# not sure what else could go wrong but we can't continue
die "something is wrong, mod_perl 2.0 build should have " .
"supplied all the needed information to run the tests. " .
"Please post lib/Apache2/BuildConfig.pm along with the " .
"bug report";
}
$self->clean(1);
error "You must explicitly specify -httpd and/or -apxs options, " .
"or set \$ENV{APACHE_TEST_HTTPD} and \$ENV{APACHE_TEST_APXS}, " .
"or set your \$PATH to include the httpd and apxs binaries.";
Apache::TestRun::exit_perl(1);
}
else {
debug "Using httpd: $vars->{httpd}";
}
$self->inherit_config; #see TestConfigParse.pm
$self->configure_httpd_eapi; #must come after inherit_config
$self->default_module(cgi => [qw(mod_cgi mod_cgid)]);
$self->default_module(thread => [qw(worker threaded)]);
$self->default_module(ssl => [qw(mod_ssl)]);
$self->default_module(access => [qw(mod_access mod_authz_host)]);
$self->default_module(auth => [qw(mod_auth mod_auth_basic)]);
$self->default_module(php => [qw(sapi_apache2 mod_php4 mod_php5)]);
$self->{server}->post_config;
return $self;
}
sub default_module {
my($self, $name, $choices) = @_;
my $mname = $name . '_module_name';
unless ($self->{vars}->{$mname}) {
($self->{vars}->{$mname}) = grep {
$self->{modules}->{"$_.c"};
} @$choices;
$self->{vars}->{$mname} ||= $choices->[0];
}
$self->{vars}->{$name . '_module'} =
$self->{vars}->{$mname} . '.c'
}
sub configure_apxs {
my $self = shift;
$self->{APXS} = $self->default_apxs;
return unless $self->{APXS};
$self->{APXS} =~ s{/}{\\}g if WIN32;
my $vars = $self->{vars};
$vars->{bindir} ||= $self->apxs('BINDIR', 1);
$vars->{sbindir} ||= $self->apxs('SBINDIR');
$vars->{target} ||= $self->apxs('TARGET');
$vars->{conf_dir} ||= $self->apxs('SYSCONFDIR');
if ($vars->{conf_dir}) {
$vars->{httpd_conf} ||= catfile $vars->{conf_dir}, 'httpd.conf';
}
}
sub configure_httpd {
my $self = shift;
my $vars = $self->{vars};
debug "configuring httpd";
$vars->{target} ||= (WIN32 ? 'Apache.EXE' : 'httpd');
unless ($vars->{httpd}) {
#sbindir should be bin/ with the default layout
#but its eaiser to workaround apxs than fix apxs
for my $dir (map { $vars->{$_} } qw(sbindir bindir)) {
next unless defined $dir;
lib/Apache/TestConfig.pm view on Meta::CPAN
my $port_memoized;
sub select_first_port {
my $self = shift;
my $port ||= $port_memoized || $ENV{APACHE_TEST_PORT}
|| $self->{vars}{port} || DEFAULT_PORT;
# memoize
$port_memoized = $port;
return $port unless $port eq 'select';
# port select mode: try to find another available port, take into
# account that each instance of the test suite may use more than
# one port for virtual hosts, therefore try to check ports in big
# steps (20?).
my $step = 20;
my $tries = 20;
$port = DEFAULT_PORT;
until (Apache::TestServer->port_available($port)) {
unless (--$tries) {
error "no ports available";
error "tried ports @{[DEFAULT_PORT]} - $port in $step increments";
return 0;
}
$port += $step;
}
info "the default base port is used, using base port $port instead"
unless $port == DEFAULT_PORT;
# memoize
$port_memoized = $port;
return $port;
}
my $remote_addr;
sub our_remote_addr {
my $self = shift;
my $name = $self->default_servername;
my $iaddr = (gethostbyname($name))[-1];
unless (defined $iaddr) {
error "Can't resolve host: '$name' (check /etc/hosts)";
exit 1;
}
$remote_addr ||= Socket::inet_ntoa($iaddr);
}
sub default_loopback {
'127.0.0.1';
}
sub port {
my($self, $module) = @_;
unless ($module) {
my $vars = $self->{vars};
return $self->select_first_port() unless $vars->{scheme} eq 'https';
$module = $vars->{ssl_module_name};
}
return $self->{vhosts}->{$module}->{port};
}
sub hostport {
my $self = shift;
my $vars = shift || $self->{vars};
my $module = shift || '';
my $name = $vars->{servername};
join ':', $name , $self->port($module || '');
}
#look for mod_foo.so
sub find_apache_module {
my($self, $module) = @_;
die "find_apache_module: module name argument is required"
unless $module;
my $vars = $self->{vars};
my $sroot = $vars->{serverroot};
my @trys = grep { $_ }
($vars->{src_dir},
$self->apxs('LIBEXECDIR'),
catfile($sroot, 'modules'),
catfile($sroot, 'libexec'));
for (@trys) {
my $file = catfile $_, $module;
if (-e $file) {
debug "found $module => $file";
return $file;
}
}
# if the module wasn't found try to lookup in the list of modules
# inherited from the system-wide httpd.conf
my $name = $module;
$name =~ s/\.s[ol]$/.c/; #mod_info.so => mod_info.c
$name =~ s/^lib/mod_/; #libphp4.so => mod_php4.c
return $self->{modules}->{$name} if $self->{modules}->{$name};
}
#generate files and directories
my %warn_style = (
html => sub { "<!-- @_ -->" },
c => sub { "/* @_ */" },
php => sub { "<?php /* \n@_ \n*/ ?>" },
default => sub { join '', grep {s/^/\# /gm} @_ },
);
my %file_ext = (
map({$_ => 'html'} qw(htm html)),
map({$_ => 'c' } qw(c h)),
map({$_ => 'php' } qw(php)),
lib/Apache/TestConfig.pm view on Meta::CPAN
my $shebang = length $Config{perlpath} < 62
? "#!$Config{perlpath}\n"
: <<EOI;
$Config{'startperl'}
eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
if \$running_under_some_shell;
EOI
return $shebang;
}
sub cpfile {
my($self, $from, $to) = @_;
File::Copy::copy($from, $to);
$self->clean_add_file($to);
}
sub symlink {
my($self, $from, $to) = @_;
CORE::symlink($from, $to);
$self->clean_add_file($to);
}
sub gendir {
my($self, $dir) = @_;
$self->makepath($dir);
}
# returns a list of dirs successfully created
sub makepath {
my($self, $path) = @_;
return if !defined($path) || -e $path;
$self->clean_add_path($path);
return File::Path::mkpath($path, 0, 0755);
}
sub open_cmd {
my($self, $cmd) = @_;
# untaint some %ENV fields
local @ENV{ qw(IFS CDPATH ENV BASH_ENV) };
local $ENV{PATH} = untaint_path($ENV{PATH});
# launder for -T
$cmd = $1 if $cmd =~ /(.*)/;
my $handle = Symbol::gensym();
open $handle, "$cmd|" or die "$cmd failed: $!";
return $handle;
}
sub clean {
my $self = shift;
$self->{clean_level} = shift || 2; #2 == really clean, 1 == reconfigure
$self->new_test_server->clean;
$self->cmodules_clean;
$self->sslca_clean;
for (sort keys %{ $self->{clean}->{files} }) {
if (-e $_) {
debug "unlink $_";
unlink $_;
}
else {
debug "unlink $_: $!";
}
}
# if /foo comes before /foo/bar, /foo will never be removed
# hence ensure that sub-dirs are always treated before a parent dir
for (reverse sort keys %{ $self->{clean}->{dirs} }) {
if (-d $_) {
my $dh = Symbol::gensym();
opendir($dh, $_);
my $notempty = grep { ! /^\.{1,2}$/ } readdir $dh;
closedir $dh;
next if $notempty;
debug "rmdir $_";
rmdir $_;
}
}
}
my %special_tokens = (
nextavailableport => sub { shift->server->select_next_port }
);
sub replace {
my $self = shift;
my $file = $Apache::TestConfig::File
? "in file $Apache::TestConfig::File" : '';
s[@(\w+)@]
[ my $key = lc $1;
if (my $callback = $special_tokens{$key}) {
$self->$callback;
}
elsif (exists $self->{vars}->{$key}) {
$self->{vars}->{$key};
}
else {
die "invalid token: \@$1\@ $file\n";
}
]ge;
}
#need to configure the vhost port for redirects and $ENV{SERVER_PORT}
#to have the correct values
my %servername_config = (
0 => sub {
my($name, $port) = @_;
[ServerName => ''], [Port => 0];
},
1 => sub {
my($name, $port) = @_;
[ServerName => $name], [Port => $port];
},
2 => sub {
my($name, $port) = @_;
[ServerName => "$name:$port"];
},
);
sub servername_config {
my $self = shift;
$self->server->version_of(\%servername_config)->(@_);
}
sub parse_vhost {
my($self, $line) = @_;
my($indent, $module, $namebased);
if ($line =~ /^(\s*)<VirtualHost\s+(?:_default_:|([^:]+):(?!:))?(.*?)\s*>\s*$/) {
$indent = $1 || "";
$namebased = $2 || "";
$module = $3;
}
else {
return undef;
}
my $vars = $self->{vars};
my $mods = $self->{modules};
my $have_module = "$module.c";
my $ssl_module = $vars->{ssl_module};
#if module ends with _ssl and it is not the module that implements ssl,
#then assume this module is a vhost with SSLEngine On (or similar)
#see mod_echo in extra.conf.in for example
if ($module =~ /^(mod_\w+)_ssl$/ and $have_module ne $ssl_module) {
$have_module = "$1.c"; #e.g. s/mod_echo_ssl.c/mod_echo.c/
return undef unless $mods->{$ssl_module};
}
#don't allocate a port if this module is not configured
#assumes the configuration is inside an <IfModule $have_module>
if ($module =~ /^mod_/ and not $mods->{$have_module}) {
return undef;
}
#allocate a port and configure this module into $self->{vhosts}
my $port = $self->new_vhost($module, $namebased);
#extra config that should go *inside* the <VirtualHost ...>
my @in_config = $self->servername_config($namebased
? $namebased
: $vars->{servername},
$port);
my @out_config = ();
if ($self->{vhosts}->{$module}->{namebased} < 2) {
#extra config that should go *outside* the <VirtualHost ...>
@out_config = ([Listen => '0.0.0.0:' . $port]);
if ($self->{vhosts}->{$module}->{namebased}) {
push @out_config => ["<IfVersion < 2.3.11>\n".
"${indent}${indent}NameVirtualHost"
=> "*:$port\n${indent}</IfVersion>"];
}
}
$self->{vars}->{$module . '_port'} = $port;
#there are two ways of building a vhost
#first is when we parse test .pm and .c files
#second is when we scan *.conf.in
my $form_postamble = sub {
my $indent = shift;
for my $pair (@_) {
$self->postamble("$indent@$pair");
}
};
my $form_string = sub {
my $indent = shift;
join "\n", map { "$indent@$_\n" } @_;
};
my $double_indent = $indent ? $indent x 2 : ' ' x 4;
return {
port => $port,
#used when parsing .pm and .c test modules
in_postamble => sub { $form_postamble->($double_indent, @in_config) },
out_postamble => sub { $form_postamble->($indent, @out_config) },
#used when parsing *.conf.in files
in_string => $form_string->($double_indent, @in_config),
out_string => $form_string->($indent, @out_config),
line => "$indent<VirtualHost " . ($namebased ? '*' : '_default_') .
":$port>",
};
}
lib/Apache/TestConfig.pm view on Meta::CPAN
my $self = shift;
my $dir = $self->{vars}->{documentroot};
$self->gendir($dir);
my $file = catfile $dir, 'index.html';
return if -e $file;
my $fh = $self->genfile($file);
print $fh $self->index_html_template;
}
sub types_config_template {
return <<EOF;
text/html html htm
image/gif gif
image/jpeg jpeg jpg jpe
image/png png
text/plain asc txt
EOF
}
sub generate_types_config {
my $self = shift;
# handle the case when mod_mime is built as a shared object
# but wasn't included in the system-wide httpd.conf
$self->find_and_load_module('mod_mime.so');
unless ($self->{inherit_config}->{TypesConfig}) {
my $types = catfile $self->{vars}->{t_conf}, 'mime.types';
unless (-e $types) {
my $fh = $self->genfile($types);
print $fh $self->types_config_template;
close $fh;
}
$self->postamble(<<EOI);
<IfModule mod_mime.c>
TypesConfig "$types"
</IfModule>
EOI
}
}
# various dup bugs in older perl and perlio in perl < 5.8.4 need a
# workaround to explicitly rewind the dupped DATA fh before using it
my $DATA_pos = tell DATA;
sub httpd_conf_template {
my($self, $try) = @_;
my $in = Symbol::gensym();
if (open $in, $try) {
return $in;
}
else {
my $dup = Symbol::gensym();
open $dup, "<&DATA" or die "Can't dup DATA: $!";
seek $dup, $DATA_pos, 0; # rewind to the beginning
return $dup; # so we don't close DATA
}
}
#certain variables may not be available until certain config files
#are generated. for example, we don't know the ssl port until ssl.conf.in
#is parsed. ssl port is needed for proxyssl testing
sub check_vars {
my $self = shift;
my $vars = $self->{vars};
unless ($vars->{proxyssl_url}) {
my $ssl = $self->{vhosts}->{ $vars->{ssl_module_name} };
if ($ssl) {
$vars->{proxyssl_url} ||= $ssl->{hostport};
}
if ($vars->{proxyssl_url}) {
unless ($vars->{maxclients_preset}) {
$vars->{minclients}++;
$vars->{maxclients}++;
$vars->{maxspare}++;
$vars->{startserversthreadedmpm} ++;
$vars->{minclientsthreadedmpm} += $vars->{threadsperchild};
$vars->{maxclientsthreadedmpm} += $vars->{threadsperchild};
$vars->{maxsparethreadedmpm} += $vars->{threadsperchild};
#In addition allow for some backend processes
#in keep-alive state. For threaded MPMs we
#already should be fine.
$vars->{maxclients} += 3;
}
}
}
}
sub extra_conf_files_needing_update {
my $self = shift;
my @need_update = ();
finddepth(sub {
return unless /\.in$/;
(my $generated = $File::Find::name) =~ s/\.in$//;
push @need_update, $generated
unless -e $generated && -M $generated < -M $File::Find::name;
}, $self->{vars}->{t_conf});
return @need_update;
}
sub generate_extra_conf {
my $self = shift;
my(@extra_conf, @conf_in, @conf_files);
finddepth(sub {
return unless /\.in$/;
push @conf_in, catdir $File::Find::dir, $_;
}, $self->{vars}->{t_conf});
#make ssl port always be 8530 when available
for my $file (@conf_in) {
if (basename($file) =~ /^ssl/) {
unshift @conf_files, $file;
}
else {
push @conf_files, $file;
}
}
for my $file (@conf_files) {
(my $generated = $file) =~ s/\.in$//;
debug "Will 'Include' $generated config file";
push @extra_conf, $generated;
}
# regenerate .conf files
for my $file (@conf_files) {
local $Apache::TestConfig::File = $file;
my $in = Symbol::gensym();
open($in, $file) or next;
(my $generated = $file) =~ s/\.in$//;
my $out = $self->genfile($generated, $file);
$self->replace_vars($in, $out);
close $in;
close $out;
$self->check_vars;
}
#we changed order to give ssl the first port after DEFAULT_PORT
#but we want extra.conf Included first so vhosts inherit base config
#such as LimitRequest*
return [ sort @extra_conf ];
}
sub sslca_can {
my($self, $check) = @_;
my $vars = $self->{vars};
return 0 unless $self->{modules}->{ $vars->{ssl_module} };
return 0 unless -d "$vars->{t_conf}/ssl";
require Apache::TestSSLCA;
if ($check) {
my $openssl = Apache::TestSSLCA::openssl();
if (which($openssl)) {
return 1;
}
error "cannot locate '$openssl' program required to generate SSL CA";
exit(1);
}
return 1;
}
sub sslca_generate {
my $self = shift;
my $ca = $self->{vars}->{sslca};
return if $ca and -d $ca; #t/conf/ssl/ca
return unless $self->sslca_can(1);
Apache::TestSSLCA::generate($self);
}
sub sslca_clean {
my $self = shift;
# XXX: httpd config is required, for now just skip ssl clean if
# there is none. should probably add some flag which will tell us
# when httpd_config was already run
return unless $self->{vars}->{httpd} && $self->{vars}->{ssl_module};
return unless $self->sslca_can;
Apache::TestSSLCA::clean($self);
}
#XXX: just a quick hack to support t/TEST -ssl
#outside of httpd-test/perl-framework
sub generate_ssl_conf {
my $self = shift;
my $vars = $self->{vars};
my $conf = "$vars->{t_conf}/ssl";
my $httpd_test_ssl = "../httpd-test/perl-framework/t/conf/ssl";
my $ssl_conf = "$vars->{top_dir}/$httpd_test_ssl";
if (-d $ssl_conf and not -d $conf) {
$self->gendir($conf);
for (qw(ssl.conf.in)) {
$self->cpfile("$ssl_conf/$_", "$conf/$_");
}
for (qw(certs keys crl)) {
$self->symlink("$ssl_conf/$_", "$conf/$_");
}
}
}
sub find_in_inc {
my($self, $dir) = @_;
for my $path (@INC) {
my $location = "$path/$dir";
return $location if -d $location;
}
return "";
}
sub prepare_t_conf {
my $self = shift;
$self->gendir($self->{vars}->{t_conf});
}
my %aliases = (
"perl-pod" => "perlpod",
"binary-httpd" => "httpd",
"binary-perl" => "perl",
);
sub generate_httpd_conf {
my $self = shift;
my $vars = $self->{vars};
#generated httpd.conf depends on these things to exist
$self->generate_types_config;
$self->generate_index_html;
$self->gendir($vars->{t_logs});
$self->gendir($vars->{t_state});
$self->gendir($vars->{t_conf});
my @very_last_postamble = ();
if (my $extra_conf = $self->generate_extra_conf) {
for my $file (@$extra_conf) {
my $entry;
if ($file =~ /\.conf$/) {
next if $file =~ m|/httpd\.conf$|;
$entry = qq(Include "$file");
}
elsif ($file =~ /\.pl$/) {
$entry = qq(<IfModule mod_perl.c>\n PerlRequire "$file"\n</IfModule>\n);
}
else {
next;
}
# put the .last includes very last
if ($file =~ /\.last\.(conf|pl)$/) {
push @very_last_postamble, $entry;
}
else {
$self->postamble($entry);
}
}
}
( run in 2.990 seconds using v1.01-cache-2.11-cpan-acf6aa7dc9e )