summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/Apache-Test/lib/Apache/TestConfig.pm
diff options
context:
space:
mode:
Diffstat (limited to 'debian/perl-framework/Apache-Test/lib/Apache/TestConfig.pm')
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestConfig.pm2299
1 files changed, 2299 insertions, 0 deletions
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestConfig.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestConfig.pm
new file mode 100644
index 0000000..85689b0
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestConfig.pm
@@ -0,0 +1,2299 @@
+# Licensed to the Apache Software Foundation (ASF) under one or more
+# contributor license agreements. See the NOTICE file distributed with
+# this work for additional information regarding copyright ownership.
+# The ASF licenses this file to You under the Apache License, Version 2.0
+# (the "License"); you may not use this file except in compliance with
+# the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+package Apache::TestConfig;
+
+use strict;
+use warnings FATAL => 'all';
+
+use constant WIN32 => $^O eq 'MSWin32';
+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;
+
+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)',
+ 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, "$_=\$($_)";
+ }
+
+ "@vars";
+}
+
+sub server { shift->{server} }
+
+sub modperl_build_config {
+
+ my $self = shift;
+
+ my $server = ref $self ? $self->server : new_test_server();
+
+ # we can't do this if we're using httpd 1.3.X
+ # even if mod_perl2 is installed on the box
+ # similarly, we shouldn't be loading mp2 if we're not
+ # absolutely certain we're in a 2.X environment yet
+ # (such as mod_perl's own build or runtime environment)
+ if (($server->{rev} && $server->{rev} == 2) ||
+ IS_MOD_PERL_2_BUILD || $ENV{MOD_PERL_API_VERSION}) {
+ eval {
+ require Apache2::Build;
+ } or return;
+
+ return Apache2::Build->build_config;
+ }
+
+ return;
+}
+
+sub new_test_server {
+ my($self, $args) = @_;
+ Apache::TestServer->new($args || $self)
+}
+
+# setup httpd-independent components
+# for httpd-specific call $self->httpd_config()
+sub new {
+ my $class = shift;
+
+ my $args;
+
+ $args = shift if $_[0] and ref $_[0];
+
+ $args = $args ? {%$args} : {@_}; #copy
+
+ #see Apache::TestMM::{filter_args,generate_script}
+ #we do this so 'perl Makefile.PL' can be passed options such as apxs
+ #without forcing regeneration of configuration and recompilation of c-modules
+ #as 't/TEST apxs /path/to/apache/bin/apxs' would do
+ while (my($key, $val) = each %Apache::TestConfig::Argv) {
+ $args->{$key} = $val;
+ }
+
+ my $top_dir = fastcwd;
+ $top_dir = pop_dir($top_dir, 't');
+ # untaint as we are going to use it a lot later on in -T sensitive
+ # operations (.e.g @INC)
+ $top_dir = $1 if $top_dir =~ /(.*)/;
+
+ # make sure that t/conf/apache_test_config.pm is found
+ # (unfortunately sometimes we get thrown into / by Apache so we
+ # can't just rely on $top_dir
+ lib->import($top_dir);
+
+ my $thaw = {};
+ #thaw current config
+ for (qw(conf t/conf)) {
+ last if eval {
+ require "$_/apache_test_config.pm";
+ $thaw = 'apache_test_config'->new;
+ delete $thaw->{save};
+ #incase class that generated the config was
+ #something else, which we can't be sure how to load
+ bless $thaw, 'Apache::TestConfig';
+ };
+ }
+
+ if ($args->{thaw} and ref($thaw) ne 'HASH') {
+ #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->{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 || "");
+ }
+
+ return $args;
+}
+
+sub postamble_first {
+ shift->add_config_first(postamble => @_);
+}
+
+sub postamble {
+ shift->add_config_last(postamble => @_);
+}
+
+sub preamble_first {
+ shift->add_config_first(preamble => @_);
+}
+
+sub preamble {
+ shift->add_config_last(preamble => @_);
+}
+
+sub postamble_register {
+ push @{ shift->{postamble_hooks} }, @_;
+}
+
+sub preamble_register {
+ push @{ shift->{preamble_hooks} }, @_;
+}
+
+sub add_config_hooks_run {
+ my($self, $where, $out) = @_;
+
+ for (@{ $self->{"${where}_hooks"} }) {
+ if ((ref($_) and ref($_) eq 'CODE') or $self->can($_)) {
+ $self->$_();
+ }
+ else {
+ error "cannot run configure hook: `$_'";
+ }
+ }
+
+ for (@{ $self->{$where} }) {
+ $self->replace;
+ s/\n?$/\n/;
+ print $out "$_";
+ }
+}
+
+sub postamble_run {
+ shift->add_config_hooks_run(postamble => @_);
+}
+
+sub preamble_run {
+ shift->add_config_hooks_run(preamble => @_);
+}
+
+sub default_group {
+ return if WINFU;
+
+ my $gid = $);
+
+ #use only first value if $) contains more than one
+ $gid =~ s/^(\d+).*$/$1/;
+
+ my $group = $ENV{APACHE_TEST_GROUP} || (getgrgid($gid) || "#$gid");
+
+ if ($group eq 'root') {
+ # similar to default_user, we want to avoid perms problems,
+ # when the server is started with group 'root'. When running
+ # under group root it may fail to create dirs and files,
+ # writable only by user
+ my $user = default_user();
+ my $gid = $user ? (getpwnam($user))[3] : '';
+ $group = (getgrgid($gid) || "#$gid") if $gid;
+ }
+
+ $group;
+}
+
+sub default_user {
+ return if WINFU;
+
+ my $uid = $>;
+
+ my $user = $ENV{APACHE_TEST_USER} || (getpwuid($uid) || "#$uid");
+
+ if ($user eq 'root') {
+ my $other = (getpwnam('nobody'))[0];
+ if ($other) {
+ $user = $other;
+ }
+ else {
+ die "cannot run tests as User root";
+ #XXX: prompt for another username
+ }
+ }
+
+ return $user;
+}
+
+sub default_serveradmin {
+ my $vars = shift->{vars};
+ join '@', ($vars->{user} || 'unknown'), $vars->{servername};
+}
+
+sub default_apxs {
+ my $self = shift;
+
+ return $self->{vars}->{apxs} if $self->{vars}->{apxs};
+
+ if (my $build_config = $self->modperl_build_config()) {
+ return $build_config->{MP_APXS};
+ }
+
+ if ($ENV{APACHE_TEST_APXS}) {
+ return $ENV{APACHE_TEST_APXS};
+ }
+
+ # look in PATH as a last resort
+ if (my $apxs = which('apxs')) {
+ return $apxs;
+ } elsif ($apxs = which('apxs2')) {
+ return $apxs;
+ }
+
+ return;
+}
+
+sub default_httpd {
+ my $self = shift;
+
+ my $vars = $self->{vars};
+
+ if (my $build_config = $self->modperl_build_config()) {
+ if (my $p = $build_config->{MP_AP_PREFIX}) {
+ for my $bindir (qw(bin sbin)) {
+ my $httpd = catfile $p, $bindir, $vars->{target};
+ return $httpd if -e $httpd;
+ # The executable on Win32 in Apache/2.2 is httpd.exe,
+ # so try that if Apache.exe doesn't exist
+ if (WIN32) {
+ $httpd = catfile $p, $bindir, 'httpd.EXE';
+ if (-e $httpd) {
+ $vars->{target} = 'httpd.EXE';
+ return $httpd;
+ }
+ }
+ }
+ }
+ }
+
+ if ($ENV{APACHE_TEST_HTTPD}) {
+ return $ENV{APACHE_TEST_HTTPD};
+ }
+
+ # look in PATH as a last resort
+ if (my $httpd = which('httpd')) {
+ return $httpd;
+ } elsif ($httpd = which('httpd2')) {
+ return $httpd;
+ } elsif ($httpd = which('apache')) {
+ return $httpd;
+ } elsif ($httpd = which('apache2')) {
+ return $httpd;
+ }
+
+ return;
+}
+
+my $localhost;
+
+sub default_localhost {
+ my $localhost_addr = pack('C4', 127, 0, 0, 1);
+ gethostbyaddr($localhost_addr, Socket::AF_INET()) || 'localhost';
+}
+
+sub default_servername {
+ my $self = shift;
+ $localhost ||= $self->default_localhost;
+ die "Can't figure out the default localhost's server name"
+ unless $localhost;
+}
+
+# memoize the selected value (so we make sure that the same port is used
+# via select). The problem is that select_first_port() is called 3 times after
+# -clean, and it's possible that a lower port will get released
+# between calls, leading to various places in the test suite getting a
+# different base port selection.
+#
+# XXX: There is still a problem if two t/TEST's configure at the same
+# time, so they both see the same port free, but only the first one to
+# bind() will actually get the port. So there is a need in another
+# check and reconfiguration just before the server starts.
+#
+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)),
+);
+
+# return the passed file's extension or '' if there is no one
+# note: that '/foo/bar.conf.in' returns an extension: 'conf.in';
+# note: a hidden file .foo will be recognized as an extension 'foo'
+sub filename_ext {
+ my ($self, $filename) = @_;
+ my $ext = (File::Basename::fileparse($filename, '\..*'))[2] || '';
+ $ext =~ s/^\.(.*)/lc $1/e;
+ $ext;
+}
+
+sub warn_style_sub_ref {
+ my ($self, $filename) = @_;
+ my $ext = $self->filename_ext($filename);
+ return $warn_style{ $file_ext{$ext} || 'default' };
+}
+
+sub genwarning {
+ my($self, $filename, $from_filename) = @_;
+ return unless $filename;
+ my $time = scalar localtime;
+ my $warning = "WARNING: this file is generated";
+ $warning .= " (from $from_filename)" if defined $from_filename;
+ $warning .= ", do not edit\n";
+ $warning .= "generated on $time\n";
+ $warning .= calls_trace();
+ return $self->warn_style_sub_ref($filename)->($warning);
+}
+
+sub calls_trace {
+ my $frame = 1;
+ my $trace = '';
+
+ while (1) {
+ my($package, $filename, $line) = caller($frame);
+ last unless $filename;
+ $trace .= sprintf "%02d: %s:%d\n", $frame, $filename, $line;
+ $frame++;
+ }
+
+ return $trace;
+}
+
+sub clean_add_file {
+ my($self, $file) = @_;
+
+ $self->{clean}->{files}->{ rel2abs($file) } = 1;
+}
+
+sub clean_add_path {
+ my($self, $path) = @_;
+
+ $path = rel2abs($path);
+
+ # remember which dirs were created and should be cleaned up
+ while (1) {
+ $self->{clean}->{dirs}->{$path} = 1;
+ $path = dirname $path;
+ last if -e $path;
+ }
+}
+
+sub genfile_trace {
+ my($self, $file, $from_file) = @_;
+ my $name = abs2rel $file, $self->{vars}->{t_dir};
+ my $msg = "generating $name";
+ $msg .= " from $from_file" if defined $from_file;
+ debug $msg;
+}
+
+sub genfile_warning {
+ my($self, $file, $from_file, $fh) = @_;
+
+ if (my $msg = $self->genwarning($file, $from_file)) {
+ print $fh $msg, "\n";
+ }
+}
+
+# $from_file == undef if there was no templates used
+sub genfile {
+ my($self, $file, $from_file, $nowarning) = @_;
+
+ # create the parent dir if it doesn't exist yet
+ my $dir = dirname $file;
+ $self->makepath($dir);
+
+ $self->genfile_trace($file, $from_file);
+
+ my $fh = Symbol::gensym();
+ open $fh, ">$file" or die "open $file: $!";
+
+ $self->genfile_warning($file, $from_file, $fh) unless $nowarning;
+
+ $self->clean_add_file($file);
+
+ return $fh;
+}
+
+# gen + write file
+sub writefile {
+ my($self, $file, $content, $nowarning) = @_;
+
+ my $fh = $self->genfile($file, undef, $nowarning);
+
+ print $fh $content if $content;
+
+ close $fh;
+}
+
+sub perlscript_header {
+
+ require FindBin;
+
+ my @dirs = ();
+
+ # mp2 needs its modper-2.0/lib before blib was created
+ if (IS_MOD_PERL_2_BUILD || $ENV{APACHE_TEST_LIVE_DEV}) {
+ # the live 'lib/' dir of the distro
+ # (e.g. modperl-2.0/ModPerl-Registry/lib)
+ my $dir = canonpath catdir $FindBin::Bin, "lib";
+ push @dirs, $dir if -d $dir;
+
+ # the live dir of the top dir if any (e.g. modperl-2.0/lib)
+ if (-e catfile($FindBin::Bin, "..", "Makefile.PL")) {
+ my $dir = canonpath catdir $FindBin::Bin, "..", "lib";
+ push @dirs, $dir if -d $dir;
+ }
+ }
+
+ for (qw(. ..)) {
+ my $dir = canonpath catdir $FindBin::Bin, $_ , "Apache-Test", "lib";
+ if (-d $dir) {
+ push @dirs, $dir;
+ last;
+ }
+ }
+
+ {
+ my $dir = canonpath catdir $FindBin::Bin, "t", "lib";
+ push @dirs, $dir if -d $dir;
+ }
+
+ push @dirs, canonpath $FindBin::Bin;
+
+ my $dirs = join("\n ", '', @dirs) . "\n";;
+
+ return <<"EOF";
+
+use strict;
+use warnings FATAL => 'all';
+
+use lib qw($dirs);
+
+EOF
+}
+
+# gen + write executable perl script file
+sub write_perlscript {
+ my($self, $file, $content) = @_;
+
+ my $fh = $self->genfile($file, undef, 1);
+
+ my $shebang = make_shebang();
+ print $fh $shebang;
+
+ $self->genfile_warning($file, undef, $fh);
+
+ print $fh $content if $content;
+
+ close $fh;
+ chmod 0755, $file;
+}
+
+sub make_shebang {
+ # if perlpath is longer than 62 chars, some shells on certain
+ # platforms won't be able to run the shebang line, so when seeing
+ # a long perlpath use the eval workaround.
+ # see: http://en.wikipedia.org/wiki/Shebang
+ # http://homepages.cwi.nl/~aeb/std/shebang/
+ 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>",
+ };
+}
+
+sub find_and_load_module {
+ my ($self, $name) = @_;
+ my $mod_path = $self->find_apache_module($name) or return;
+ my ($sym) = $name =~ m/mod_(\w+)\./;
+
+ if ($mod_path && -e $mod_path) {
+ $self->preamble(IfModule => "!mod_$sym.c",
+ qq{LoadModule ${sym}_module "$mod_path"\n});
+ }
+ return 1;
+}
+
+sub replace_vhost_modules {
+ my $self = shift;
+
+ if (my $cfg = $self->parse_vhost($_)) {
+ $_ = '';
+ for my $key (qw(out_string line in_string)) {
+ next unless $cfg->{$key};
+ $_ .= "$cfg->{$key}\n";
+ }
+ }
+}
+
+sub replace_vars {
+ my($self, $in, $out) = @_;
+
+ local $_;
+ while (<$in>) {
+ $self->replace;
+ $self->replace_vhost_modules;
+ print $out $_;
+ }
+}
+
+sub index_html_template {
+ my $self = shift;
+ return "welcome to $self->{server}->{name}\n";
+}
+
+sub generate_index_html {
+ 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);
+ }
+
+ }
+ }
+
+ $self->configure_proxy;
+
+ my $conf_file = $vars->{t_conf_file};
+ my $conf_file_in = join '.', $conf_file, 'in';
+
+ my $in = $self->httpd_conf_template($conf_file_in);
+
+ my $out = $self->genfile($conf_file);
+
+ $self->find_and_load_module('mod_alias.so');
+
+ $self->preamble_run($out);
+
+ for my $name (qw(user group)) { #win32
+ if ($vars->{$name}) {
+ print $out qq[\u$name "$vars->{$name}"\n];
+ }
+ }
+
+ #2.0: ServerName $ServerName:$Port
+ #1.3: ServerName $ServerName
+ # Port $Port
+ my @name_cfg = $self->servername_config($vars->{servername},
+ $vars->{port});
+ for my $pair (@name_cfg) {
+ print $out "@$pair\n";
+ }
+
+ $self->replace_vars($in, $out);
+
+ # handle the case when mod_alias is built as a shared object
+ # but wasn't included in the system-wide httpd.conf
+
+ print $out "<IfModule mod_alias.c>\n";
+ for (sort keys %aliases) {
+ next unless $vars->{$aliases{$_}};
+ print $out " Alias /getfiles-$_ $vars->{$aliases{$_}}\n";
+ }
+ print $out "</IfModule>\n";
+
+ print $out "\n";
+
+ $self->postamble_run($out);
+
+ print $out join "\n", @very_last_postamble;
+
+ close $in;
+ close $out or die "close $conf_file: $!";
+}
+
+sub need_reconfiguration {
+ my($self, $conf_opts) = @_;
+ my @reasons = ();
+ my $vars = $self->{vars};
+
+ # if '-port select' we need to check from scratch which ports are
+ # available
+ if (my $port = $conf_opts->{port} || $Apache::TestConfig::Argv{port}) {
+ if ($port eq 'select') {
+ push @reasons, "'-port $port' requires reconfiguration";
+ }
+ }
+
+ my $exe = $vars->{apxs} || $vars->{httpd} || '';
+ # if httpd.conf is older than executable
+ push @reasons,
+ "$exe is newer than $vars->{t_conf_file}"
+ if -e $exe &&
+ -e $vars->{t_conf_file} &&
+ -M $exe < -M $vars->{t_conf_file};
+
+ # any .in files are newer than their derived versions?
+ if (my @files = $self->extra_conf_files_needing_update) {
+ # invalidate the vhosts cache, since a different port could be
+ # assigned on reparse
+ $self->{vhosts} = {};
+ for my $file (@files) {
+ push @reasons, "$file.in is newer than $file";
+ }
+ }
+
+ # if special env variables are used (since they can change any time)
+ # XXX: may be we could check whether they have changed since the
+ # last run and thus avoid the reconfiguration?
+ {
+ my $passenv = passenv();
+ if (my @env_vars = sort grep { $ENV{$_} } keys %$passenv) {
+ push @reasons, "environment variables (@env_vars) are set";
+ }
+ }
+
+ # if the generated config was created with a version of Apache-Test
+ # less than the current version
+ {
+ my $current = Apache::Test->VERSION;
+ my $config = $self->{apache_test_version};
+
+ if (! $config || $config < $current) {
+ push @reasons, "configuration generated with old Apache-Test";
+ }
+ }
+
+ return @reasons;
+}
+
+sub error_log {
+ my($self, $rel) = @_;
+ my $file = catfile $self->{vars}->{t_logs}, 'error_log';
+ my $rfile = abs2rel $file, $self->{vars}->{top_dir};
+ return wantarray ? ($file, $rfile) :
+ $rel ? $rfile : $file;
+}
+
+#utils
+
+#For Win32 systems, stores the extensions used for executable files
+#They may be . prefixed, so we will strip the leading periods.
+
+my @path_ext = ();
+
+if (WIN32) {
+ if ($ENV{PATHEXT}) {
+ push @path_ext, split ';', $ENV{PATHEXT};
+ for my $ext (@path_ext) {
+ $ext =~ s/^\.*(.+)$/$1/;
+ }
+ }
+ else {
+ #Win9X: doesn't have PATHEXT
+ push @path_ext, qw(com exe bat);
+ }
+}
+
+sub which {
+ my $program = shift;
+
+ return undef unless $program;
+
+ my @dirs = File::Spec->path();
+
+ require Config;
+ my $perl_bin = $Config::Config{bin} || '';
+ push @dirs, $perl_bin if $perl_bin and -d $perl_bin;
+
+ for my $base (map { catfile $_, $program } @dirs) {
+ if ($ENV{HOME} and not WIN32) {
+ # only works on Unix, but that's normal:
+ # on Win32 the shell doesn't have special treatment of '~'
+ $base =~ s/~/$ENV{HOME}/o;
+ }
+
+ return $base if -x $base && -f _;
+
+ if (WIN32) {
+ for my $ext (@path_ext) {
+ return "$base.$ext" if -x "$base.$ext" && -f _;
+ }
+ }
+ }
+}
+
+sub apxs {
+ my($self, $q, $ok_fail) = @_;
+ return unless $self->{APXS};
+ my $val;
+ unless (exists $self->{_apxs}{$q}) {
+ local @ENV{ qw(IFS CDPATH ENV BASH_ENV) };
+ local $ENV{PATH} = untaint_path($ENV{PATH});
+ my $devnull = devnull();
+ my $apxs = shell_ready($self->{APXS});
+ $val = qx($apxs -q $q 2>$devnull);
+ chomp $val if defined $val; # apxs post-2.0.40 adds a new line
+ if ($val) {
+ $self->{_apxs}{$q} = $val;
+ }
+ unless ($val) {
+ if ($ok_fail) {
+ return "";
+ }
+ else {
+ warn "APXS ($self->{APXS}) query for $q failed\n";
+ return $val;
+ }
+ }
+ }
+ $self->{_apxs}{$q};
+}
+
+# return an untainted PATH
+sub untaint_path {
+ my $path = shift;
+ return '' unless defined $path;
+ ($path) = ( $path =~ /(.*)/ );
+ # win32 uses ';' for a path separator, assume others use ':'
+ my $sep = WIN32 ? ';' : ':';
+ # -T disallows relative and empty directories in the PATH
+ return join $sep, grep File::Spec->file_name_is_absolute($_),
+ grep length($_), split /$sep/, $path;
+}
+
+sub pop_dir {
+ my $dir = shift;
+
+ my @chunks = splitdir $dir;
+ while (my $remove = shift) {
+ pop @chunks if $chunks[-1] eq $remove;
+ }
+
+ catfile @chunks;
+}
+
+sub add_inc {
+ my $self = shift;
+ return if $ENV{MOD_PERL}; #already setup by mod_perl
+ require lib;
+ # make sure that Apache-Test/lib will be first in @INC,
+ # followed by modperl-2.0/lib (or some other project's lib/),
+ # followed by blib/ and finally system-wide libs.
+ my $top_dir = $self->{vars}->{top_dir};
+ my @dirs = map { catdir $top_dir, "blib", $_ } qw(lib arch);
+
+ my $apache_test_dir = catdir $top_dir, "Apache-Test";
+ unshift @dirs, $apache_test_dir if -d $apache_test_dir;
+
+ lib::->import(@dirs);
+
+ if ($ENV{APACHE_TEST_LIVE_DEV}) {
+ # add lib/ in a separate call to ensure that it'll end up on
+ # top of @INC
+ my $lib_dir = catdir $top_dir, "lib";
+ lib::->import($lib_dir) if -d $lib_dir;
+ }
+
+ #print join "\n", "add_inc", @INC, "";
+}
+
+#freeze/thaw so other processes can access config
+
+sub thaw {
+ my $class = shift;
+ $class->new({thaw => 1, @_});
+}
+
+sub freeze {
+ require Data::Dumper;
+ local $Data::Dumper::Terse = 1;
+ my $data = Data::Dumper::Dumper(shift);
+ chomp $data;
+ $data;
+}
+
+sub sync_vars {
+ my $self = shift;
+
+ return if $self->{save}; #this is not a cached config
+
+ my $changed = 0;
+ my $thaw = $self->thaw;
+ my $tvars = $thaw->{vars};
+ my $svars = $self->{vars};
+
+ for my $key (@_) {
+ for my $v ($tvars, $svars) {
+ if (exists $v->{$key} and not defined $v->{$key}) {
+ $v->{$key} = ''; #rid undef
+ }
+ }
+ next if exists $tvars->{$key} and exists $svars->{$key} and
+ $tvars->{$key} eq $svars->{$key};
+ $tvars->{$key} = $svars->{$key};
+ $changed = 1;
+ }
+
+ return unless $changed;
+
+ $thaw->{save} = 1;
+ $thaw->save;
+}
+
+sub save {
+ my($self) = @_;
+
+ return unless $self->{save};
+
+ # add in the Apache-Test version for later comparisions
+ $self->{apache_test_version} = Apache::Test->VERSION;
+
+ my $name = 'apache_test_config';
+ my $file = catfile $self->{vars}->{t_conf}, "$name.pm";
+ my $fh = $self->genfile($file);
+
+ debug "saving config data to $name.pm";
+
+ (my $obj = $self->freeze) =~ s/^/ /;
+
+ print $fh <<EOF;
+package $name;
+
+sub new {
+$obj;
+}
+
+1;
+EOF
+
+ close $fh or die "failed to write $file: $!";
+}
+
+sub as_string {
+ my $cfg = '';
+ my $command = '';
+
+ # httpd opts
+ my $test_config = Apache::TestConfig->new({thaw=>1});
+ # XXX: need to run httpd config to get the value of httpd
+ if (my $httpd = $test_config->{vars}->{httpd}) {
+ $httpd = shell_ready($httpd);
+ $command = "$httpd -V";
+ $cfg .= "\n*** $command\n";
+ $cfg .= qx{$command};
+
+ $cfg .= ldd_as_string($httpd);
+ }
+ else {
+ $cfg .= "\n\n*** The httpd binary was not found\n";
+ }
+
+ # perl opts
+ my $perl = shell_ready($^X);
+ $command = "$perl -V";
+ $cfg .= "\n\n*** $command\n";
+ $cfg .= qx{$command};
+
+ return $cfg;
+}
+
+sub ldd_as_string {
+ my $httpd = shift;
+
+ my $command;
+ if (OSX) {
+ my $otool = which('otool');
+ $command = "$otool -L $httpd" if $otool;
+ }
+ elsif (!WIN32) {
+ my $ldd = which('ldd');
+ $command = "$ldd $httpd" if $ldd;
+ }
+
+ my $cfg = '';
+ if ($command) {
+ $cfg .= "\n*** $command\n";
+ $cfg .= qx{$command};
+ }
+
+ return $cfg;
+}
+
+# make a string suitable for feed to shell calls (wrap in quotes and
+# escape quotes)
+sub shell_ready {
+ my $arg = shift;
+ $arg =~ s!\\?"!\\"!g;
+ return qq["$arg"];
+}
+
+
+1;
+
+=head1 NAME
+
+Apache::TestConfig -- Test Configuration setup module
+
+=head1 SYNOPSIS
+
+ use Apache::TestConfig;
+
+ my $cfg = Apache::TestConfig->new(%args)
+ my $fh = $cfg->genfile($file);
+ $cfg->writefile($file, $content);
+ $cfg->gendir($dir);
+ ...
+
+=head1 DESCRIPTION
+
+C<Apache::TestConfig> is used in creating the C<Apache::Test>
+configuration files.
+
+=head1 FUNCTIONS
+
+=over
+
+=item genwarning()
+
+ my $warn = $cfg->genwarning($filename)
+
+genwarning() returns a warning string as a comment, saying that the
+file was autogenerated and that it's not a good idea to modify this
+file. After the warning a perl trace of calls to this this function is
+appended. This trace is useful for finding what code has created the
+file.
+
+ my $warn = $cfg->genwarning($filename, $from_filename)
+
+If C<$from_filename> is specified it'll be used in the warning to tell
+which file it was generated from.
+
+genwarning() automatically recognizes the comment type based on the
+file extension. If the extension is not recognized, the default C<#>
+style is used.
+
+Currently it support C<E<lt>!-- --E<gt>>, C</* ... */> and C<#>
+styles.
+
+=item genfile()
+
+ my $fh = $cfg->genfile($file);
+
+genfile() creates a new file C<$file> for writing and returns a file
+handle.
+
+If parent directories of C<$file> don't exist they will be
+automagically created.
+
+The file C<$file> and any created parent directories (if found empty)
+will be automatically removed on cleanup.
+
+A comment with a warning and calls trace is added to the top of this
+file. See genwarning() for more info about this comment.
+
+ my $fh = $cfg->genfile($file, $from_file);
+
+If C<$from_filename> is specified it'll be used in the warning to tell
+which file it was generated from.
+
+ my $fh = $cfg->genfile($file, $from_file, $nowarning);
+
+If C<$nowarning> is true, the warning won't be added. If using this
+optional argument and there is no C<$from_file> you must pass undef as
+in:
+
+ my $fh = $cfg->genfile($file, undef, $nowarning);
+
+
+=item writefile()
+
+ $cfg->writefile($file, $content, [$nowarning]);
+
+writefile() creates a new file C<$file> with the content of
+C<$content>.
+
+A comment with a warning and calls trace is added to the top of this
+file unless C<$nowarnings> is passed and set to a true value. See
+genwarning() for more info about this comment.
+
+If parent directories of C<$file> don't exist they will be
+automagically created.
+
+The file C<$file> and any created parent directories (if found empty)
+will be automatically removed on cleanup.
+
+=item write_perlscript()
+
+ $cfg->write_perlscript($filename, @lines);
+
+Similar to writefile() but creates an executable Perl script with
+correctly set shebang line.
+
+=item gendir()
+
+ $cfg->gendir($dir);
+
+gendir() creates a new directory C<$dir>.
+
+If parent directories of C<$dir> don't exist they will be
+automagically created.
+
+The directory C<$dir> and any created parent directories will be
+automatically removed on cleanup if found empty.
+
+=back
+
+=head1 Environment Variables
+
+The following environment variables affect the configuration and the
+run-time of the C<Apache::Test> framework:
+
+=head2 APACHE_TEST_COLOR
+
+To aid visual control over the configuration process and the run-time
+phase, C<Apache::Test> uses coloured fonts when the environment
+variable C<APACHE_TEST_COLOR> is set to a true value.
+
+=head2 APACHE_TEST_LIVE_DEV
+
+When using C<Apache::Test> during the project development phase, it's
+often convenient to have the I<project/lib> (live) directory appearing
+first in C<@INC> so any changes to the Perl modules, residing in it,
+immediately affect the server, without a need to rerun C<make> to
+update I<blib/lib>. When the environment variable
+C<APACHE_TEST_LIVE_DEV> is set to a true value during the
+configuration phase (C<t/TEST -config>, C<Apache::Test> will
+automatically unshift the I<project/lib> directory into C<@INC>, via
+the autogenerated I<t/conf/modperl_inc.pl> file.
+
+
+=head1 Special Placeholders
+
+When generating configuration files from the I<*.in> templates,
+special placeholder variables get substituted. To embed a placeholder
+use the C<@foo@> syntax. For example in I<extra.conf.in> you can
+write:
+
+ Include @ServerRoot@/conf/myconfig.conf
+
+When I<extra.conf> is generated, C<@ServerRoot@> will get replaced
+with the location of the server root.
+
+Placeholders are case-insensitive.
+
+Available placeholders:
+
+=head2 Configuration Options
+
+All configuration variables that can be passed to C<t/TEST>, such as
+C<MaxClients>, C<DocumentRoot>, C<ServerRoot>, etc. To see the
+complete list run:
+
+ % t/TEST --help
+
+and you will find them in the C<configuration options> sections.
+
+=head2 NextAvailablePort
+
+Every time this placeholder is encountered it'll be replaced with the
+next available port. This is very useful if you need to allocate a
+special port, but not hardcode it. Later when running:
+
+ % t/TEST -port=select
+
+it's possible to run several concurrent test suites on the same
+machine, w/o having port collisions.
+
+=head1 AUTHOR
+
+=head1 SEE ALSO
+
+perl(1), Apache::Test(3)
+
+=cut
+
+
+__DATA__
+Listen 0.0.0.0:@Port@
+
+ServerRoot "@ServerRoot@"
+DocumentRoot "@DocumentRoot@"
+
+PidFile @t_pid_file@
+ErrorLog @t_logs@/error_log
+LogLevel debug
+
+<IfModule mod_version.c>
+<IfVersion > 2.4.1>
+ DefaultRunTimeDir "@t_logs@"
+ LogLevel trace8
+</IfVersion>
+<IfVersion > 2.4.34>
+<IfDirective DefaultStateDir>
+ DefaultStateDir "@t_state@"
+</IfDirective>
+</IfVersion>
+</IfModule>
+
+<IfModule mod_log_config.c>
+ TransferLog @t_logs@/access_log
+</IfModule>
+
+<IfModule mod_cgid.c>
+ ScriptSock @t_logs@/cgisock
+</IfModule>
+
+ServerAdmin @ServerAdmin@
+
+#needed for http/1.1 testing
+KeepAlive On
+
+HostnameLookups Off
+
+<Directory />
+ Options FollowSymLinks
+ AllowOverride None
+</Directory>
+
+<IfModule @THREAD_MODULE@>
+<IfModule mod_version.c>
+<IfVersion < 2.3.4>
+ LockFile @t_logs@/accept.lock
+</IfVersion>
+</IfModule>
+ StartServers @StartServersThreadedMPM@
+ MinSpareThreads @ThreadsPerChild@
+ MaxSpareThreads @MaxSpareThreadedMPM@
+ ThreadsPerChild @ThreadsPerChild@
+ MaxClients @MaxClientsThreadedMPM@
+ MaxRequestsPerChild 0
+</IfModule>
+
+<IfModule perchild.c>
+<IfModule mod_version.c>
+<IfVersion < 2.3.4>
+ LockFile @t_logs@/accept.lock
+</IfVersion>
+</IfModule>
+ NumServers 1
+ StartThreads @MinClients@
+ MinSpareThreads 1
+ MaxSpareThreads @MaxSpare@
+ MaxThreadsPerChild @MaxClients@
+ MaxRequestsPerChild 0
+</IfModule>
+
+<IfModule prefork.c>
+<IfModule mod_version.c>
+<IfVersion < 2.3.4>
+ LockFile @t_logs@/accept.lock
+</IfVersion>
+</IfModule>
+ StartServers @MinClients@
+ MinSpareServers 1
+ MaxSpareServers @MaxSpare@
+ MaxClients @MaxClients@
+ MaxRequestsPerChild 0
+</IfModule>
+
+<IfDefine APACHE1>
+ LockFile @t_logs@/accept.lock
+ StartServers @MinClients@
+ MinSpareServers 1
+ MaxSpareServers @MaxSpare@
+ MaxClients @MaxClients@
+ MaxRequestsPerChild 0
+</IfDefine>
+
+<IfModule mpm_winnt.c>
+ ThreadsPerChild 50
+ MaxRequestsPerChild 0
+</IfModule>
+
+<Location /server-info>
+ SetHandler server-info
+</Location>
+
+<Location /server-status>
+ SetHandler server-status
+</Location>
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-05 21:34:49 +0000