Apache-Test
view release on metacpan or search on metacpan
lib/Apache/TestConfig.pm view on Meta::CPAN
use constant AIX => $^O eq 'aix';
use constant WINFU => WIN32 || NETWARE;
use constant COLOR => ($ENV{APACHE_TEST_COLOR} && -t STDOUT) ? 1 : 0;
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;
}
lib/Apache/TestConfig.pm view on Meta::CPAN
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;
my $httpd = catfile $dir, $vars->{target};
next unless -x $httpd;
$vars->{httpd} = $httpd;
last;
}
$vars->{httpd} ||= $self->default_httpd;
}
if ($vars->{httpd}) {
my @chunks = splitdir $vars->{httpd};
#handle both $prefix/bin/httpd and $prefix/Apache.exe
for (1,2) {
pop @chunks;
last unless @chunks;
$self->{httpd_basedir} = catfile @chunks;
last if -d "$self->{httpd_basedir}/bin";
}
}
#cleanup httpd droppings
my $sem = catfile $vars->{t_logs}, 'apache_runtime_status.sem';
unless (-e $sem) {
$self->clean_add_file($sem);
}
}
sub configure_httpd_eapi {
my $self = shift;
my $vars = $self->{vars};
#deal with EAPI_MM_CORE_PATH if defined.
if (defined($self->{httpd_defines}->{EAPI_MM_CORE_PATH})) {
my $path = $self->{httpd_defines}->{EAPI_MM_CORE_PATH};
#ensure the directory exists
my @chunks = splitdir $path;
pop @chunks; #the file component of the path
$path = catdir @chunks;
unless (file_name_is_absolute $path) {
$path = catdir $vars->{serverroot}, $path;
}
$self->gendir($path);
}
}
sub configure_proxy {
my $self = shift;
my $vars = $self->{vars};
#if we proxy to ourselves, must bump the maxclients
if ($vars->{proxy} =~ /^on$/i) {
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;
}
$vars->{proxy} = $self->{vhosts}->{'mod_proxy'}->{hostport};
return $vars->{proxy};
}
return undef;
}
# adds the config to the head of the group instead of the tail
# XXX: would be even better to add to a different sub-group
# (e.g. preamble_first) of only those that want to be first and then,
# make sure that they are dumped to the config file first in the same
# group (e.g. preamble)
sub add_config_first {
my $self = shift;
my $where = shift;
unshift @{ $self->{$where} }, $self->massage_config_args(@_);
}
sub add_config_last {
my $self = shift;
my $where = shift;
push @{ $self->{$where} }, $self->massage_config_args(@_);
}
sub massage_config_args {
my $self = shift;
my($directive, $arg, $data) = @_;
my $args = "";
if ($data) {
$args = "<$directive $arg>\n";
if (ref($data) eq 'HASH') {
while (my($k,$v) = each %$data) {
$args .= " $k $v\n";
}
}
elsif (ref($data) eq 'ARRAY') {
# balanced (key=>val) list
my $pairs = @$data / 2;
for my $i (0..($pairs-1)) {
$args .= sprintf " %s %s\n", $data->[$i*2], $data->[$i*2+1];
}
}
else {
$data=~s/\n(?!\z)/\n /g;
$args .= " $data";
}
$args .= "</$directive>\n";
}
elsif (ref($directive) eq 'ARRAY') {
$args = join "\n", @$directive;
}
else {
$args = join " ", grep length($_), $directive,
(ref($arg) && (ref($arg) eq 'ARRAY') ? "@$arg" : $arg || "");
}
lib/Apache/TestConfig.pm view on Meta::CPAN
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;
( run in 0.660 second using v1.01-cache-2.11-cpan-df04353d9ac )