File Coverage

blib/lib/Apache/TestConfig.pm

Criterion	Covered	Total	%
statement	274	1084	25.3
branch	55	446	12.3
condition	33	328	10.1
subroutine	59	140	42.1
pod	5	104	4.8
total	426	2102	20.3

line	stmt	bran	cond	sub	pod	time	code
1							# Licensed to the Apache Software Foundation (ASF) under one or more
2							# contributor license agreements. See the NOTICE file distributed with
3							# this work for additional information regarding copyright ownership.
4							# The ASF licenses this file to You under the Apache License, Version 2.0
5							# (the "License"); you may not use this file except in compliance with
6							# the License. You may obtain a copy of the License at
7							#
8							# http://www.apache.org/licenses/LICENSE-2.0
9							#
10							# Unless required by applicable law or agreed to in writing, software
11							# distributed under the License is distributed on an "AS IS" BASIS,
12							# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13							# See the License for the specific language governing permissions and
14							# limitations under the License.
15							#
16							package Apache::TestConfig;
17
18	6			6		74	use strict;
	6					52
	6					79
19	6			6		115	use warnings FATAL => 'all';
	6					55
	6					81
20
21	6			6		87	use constant WIN32 => $^O eq 'MSWin32';
	6					53
	6					159
22	6			6		97	use constant OSX => $^O eq 'darwin';
	6					72
	6					86
23	6			6		89	use constant CYGWIN => $^O eq 'cygwin';
	6					52
	6					77
24	6			6		1028	use constant NETWARE => $^O eq 'NetWare';
	6					72
	6					259
25	6			6		99	use constant SOLARIS => $^O eq 'solaris';
	6					56
	6					85
26	6			6		107	use constant WINFU => WIN32 \|\| NETWARE;
	6					54
	6					74
27	6	50	33	6		388	use constant COLOR => ($ENV{APACHE_TEST_COLOR} && -t STDOUT) ? 1 : 0;
	6					59
	6					442
28
29	6			6		96	use constant DEFAULT_PORT => 8529;
	6					51
	6					75
30
31							use constant IS_MOD_PERL_2 =>
32	6		50	6		115	eval { require mod_perl2 } \|\| 0;
	6					61
	6					59
	6					218
33
34	6		33			237	use constant IS_MOD_PERL_2_BUILD => IS_MOD_PERL_2 &&
35	6			6		108	require Apache2::Build && Apache2::Build::IS_MOD_PERL_BUILD();
	6					55
36
37	18					467	use constant IS_APACHE_TEST_BUILD =>
38	6			6		123	grep { -e "$_/lib/Apache/TestConfig.pm" } qw(Apache-Test . ..);
	6					54
	6					79
39
40	6			6		106	use constant CUSTOM_CONFIG_FILE => 'Apache/TestConfigData.pm';
	6					56
	6					224
41
42	6			6		347	use lib ();
	6					123
	6					63
43	6			6		103	use File::Copy ();
	6					55
	6					57
44	6			6		92	use File::Find qw(finddepth);
	6					89
	6					129
45	6			6		96	use File::Basename qw(dirname);
	6					90
	6					141
46	6			6		96	use File::Path ();
	6					55
	6					56
47	6					112	use File::Spec::Functions qw(catfile abs2rel splitdir canonpath
48	6			6		91	catdir file_name_is_absolute devnull);
	6					55
49	6			6		101	use Cwd qw(fastcwd);
	6					57
	6					103
50	6			6		7654	use Socket ();
	6					66
	6					62
51	6			6		113	use Symbol ();
	6					57
	6					58
52
53	6			6		160	use Apache::TestConfigPerl ();
	6					60
	6					59
54	6			6		172	use Apache::TestConfigParse ();
	6					66
	6					61
55	6			6		124	use Apache::TestTrace;
	6					56
	6					122
56	6			6		213	use Apache::TestServer ();
	6					63
	6					66
57	6			6		150	use Apache::TestRun ();
	6					63
	6					236
58
59	6			6		91	use vars qw(%Usage);
	6					55
	6					115
60
61							# variables stored in $Apache::TestConfigData::vars
62							my @data_vars_must = qw(httpd apxs);
63							my @data_vars_opt = qw(user group port);
64							# mapping from $Apache::TestConfigData::vars to $ENV settings
65							my %vars_to_env = (
66							httpd => 'APACHE_TEST_HTTPD',
67							apxs => 'APACHE_TEST_APXS',
68							user => 'APACHE_TEST_USER',
69							group => 'APACHE_TEST_GROUP',
70							port => 'APACHE_TEST_PORT',
71							);
72
73							%Usage = (
74							top_dir => 'top-level directory (default is $PWD)',
75							t_dir => 'the t/ test directory (default is $top_dir/t)',
76							t_conf => 'the conf/ test directory (default is $t_dir/conf)',
77							t_logs => 'the logs/ test directory (default is $t_dir/logs)',
78							t_pid_file => 'location of the pid file (default is $t_logs/httpd.pid)',
79							t_conf_file => 'test httpd.conf file (default is $t_conf/httpd.conf)',
80							src_dir => 'source directory to look for mod_foos.so',
81							serverroot => 'ServerRoot (default is $t_dir)',
82							documentroot => 'DocumentRoot (default is $ServerRoot/htdocs',
83							port => 'Port [port_number\|select] (default ' . DEFAULT_PORT . ')',
84							servername => 'ServerName (default is localhost)',
85							user => 'User to run test server as (default is $USER)',
86							group => 'Group to run test server as (default is $GROUP)',
87							bindir => 'Apache bin/ dir (default is apxs -q BINDIR)',
88							sbindir => 'Apache sbin/ dir (default is apxs -q SBINDIR)',
89							httpd => 'server to use for testing (default is $bindir/httpd)',
90							target => 'name of server binary (default is apxs -q TARGET)',
91							apxs => 'location of apxs (default is from Apache2::BuildConfig)',
92							startup_timeout => 'seconds to wait for the server to start (default is 60)',
93							httpd_conf => 'inherit config from this file (default is apxs derived)',
94							httpd_conf_extra=> 'inherit additional config from this file',
95							minclients => 'minimum number of concurrent clients (default is 1)',
96							maxclients => 'maximum number of concurrent clients (default is minclients+1)',
97							perlpod => 'location of perl pod documents (for testing downloads)',
98							proxyssl_url => 'url for testing ProxyPass / https (default is localhost)',
99							sslca => 'location of SSL CA (default is $t_conf/ssl/ca)',
100							sslcaorg => 'SSL CA organization to use for tests (default is asf)',
101							libmodperl => 'path to mod_perl\'s .so (full or relative to LIBEXECDIR)',
102							defines => 'values to add as -D defines (for example, "VAR1 VAR2")',
103							(map { $_ . '_module_name', "$_ module name"} qw(cgi ssl thread access auth php)),
104							);
105
106							my %filepath_conf_opts = map { $_ => 1 }
107							qw(top_dir t_dir t_conf t_logs t_pid_file t_conf_file src_dir serverroot
108							documentroot bindir sbindir httpd apxs httpd_conf httpd_conf_extra
109							perlpod sslca libmodperl);
110
111							sub conf_opt_is_a_filepath {
112	0			0	0	0	my $opt = shift;
113	0	0				0	$opt && exists $filepath_conf_opts{$opt};
114							}
115
116							sub usage {
117	0			0	0	0	for my $hash (\%Usage) {
118	0					0	for (sort keys %$hash){
119	0					0	printf " -%-18s %s\n", $_, $hash->{$_};
120							}
121							}
122							}
123
124							sub filter_args {
125	15			15	0	232	my($args, $wanted_args) = @_;
126	15					133	my(@pass, %keep);
127
128	15					147	my @filter = @$args;
129
130	15	50				227	if (ref($filter[0])) {
131	0					0	push @pass, shift @filter;
132							}
133
134	15					169	while (@filter) {
135	5					49	my $key = shift @filter;
136							# optinal - or -- prefix
137	5	100	33			209	if (defined $key && $key =~ /^-?-?(.+)/ && exists $wanted_args->{$1}) {
			66
138	3	50				34	if (@filter) {
139	3					43	$keep{$1} = shift @filter;
140							}
141							else {
142	0					0	die "key $1 requires a matching value";
143							}
144							}
145							else {
146	2					23	push @pass, $key;
147							}
148							}
149
150	15					299	return (\@pass, \%keep);
151							}
152
153							my %passenv = map { $_,1 } qw{
154							APACHE_TEST_APXS
155							APACHE_TEST_HTTPD
156							APACHE_TEST_GROUP
157							APACHE_TEST_USER
158							APACHE_TEST_PORT
159							};
160
161							sub passenv {
162	0			0	0	0	\%passenv;
163							}
164
165							sub passenv_makestr {
166	0			0	0	0	my @vars;
167
168	0					0	for (keys %passenv) {
169	0					0	push @vars, "$_=\$($_)";
170							}
171
172	0					0	"@vars";
173							}
174
175	7			7	0	142	sub server { shift->{server} }
176
177							sub modperl_build_config {
178
179	6			6	0	58	my $self = shift;
180
181	6	50				93	my $server = ref $self ? $self->server : new_test_server();
182
183							# we don't want to get mp2 preconfigured data in order to be able
184							# to get the interactive tests running.
185	6	50				81	return undef if $ENV{APACHE_TEST_INTERACTIVE_CONFIG_TEST};
186
187							# we can't do this if we're using httpd 1.3.X
188							# even if mod_perl2 is installed on the box
189							# similarly, we shouldn't be loading mp2 if we're not
190							# absolutely certain we're in a 2.X environment yet
191							# (such as mod_perl's own build or runtime environment)
192	6	50	33			165	if (($server->{rev} && $server->{rev} == 2) \|\|
			33
			33
193							IS_MOD_PERL_2_BUILD \|\| $ENV{MOD_PERL_API_VERSION}) {
194	0	0				0	eval {
195	0					0	require Apache2::Build;
196							} or return;
197	0					0	return Apache2::Build->build_config;
198							}
199
200	6					166	return;
201							}
202
203							sub new_test_server {
204	6			6	0	68	my($self, $args) = @_;
205	6		33			208	Apache::TestServer->new($args \|\| $self)
206							}
207
208							# setup httpd-independent components
209							# for httpd-specific call $self->httpd_config()
210							sub new {
211	6			6	0	65	my $class = shift;
212
213	6					57	my $args;
214
215	6	50	33			1000	$args = shift if $_[0] and ref $_[0];
216
217	6	50				305	$args = $args ? {%$args} : {@_}; #copy
218
219							#see Apache::TestMM::{filter_args,generate_script}
220							#we do this so 'perl Makefile.PL' can be passed options such as apxs
221							#without forcing regeneration of configuration and recompilation of c-modules
222							#as 't/TEST apxs /path/to/apache/bin/apxs' would do
223	6					102	while (my($key, $val) = each %Apache::TestConfig::Argv) {
224	0					0	$args->{$key} = $val;
225							}
226
227	6					165	my $top_dir = fastcwd;
228	6					74	$top_dir = pop_dir($top_dir, 't');
229							# untaint as we are going to use it a lot later on in -T sensitive
230							# operations (.e.g @INC)
231	6	50				125	$top_dir = $1 if $top_dir =~ /(.*)/;
232
233							# make sure that t/conf/apache_test_config.pm is found
234							# (unfortunately sometimes we get thrown into / by Apache so we
235							# can't just rely on $top_dir
236	6					114	lib->import($top_dir);
237
238	6					1766	my $thaw = {};
239							#thaw current config
240	6					138	for (qw(conf t/conf)) {
241	12	100				116	last if eval {
242	12					7476	require "$_/apache_test_config.pm";
243	6					379	$thaw = 'apache_test_config'->new;
244	6					95	delete $thaw->{save};
245							#incase class that generated the config was
246							#something else, which we can't be sure how to load
247	6					95	bless $thaw, 'Apache::TestConfig';
248							};
249							}
250
251	6	50	33			139	if ($args->{thaw} and ref($thaw) ne 'HASH') {
252							#dont generate any new config
253	6					58	$thaw->{vars}->{$_} = $args->{$_} for keys %$args;
	6					101
254	6					85	$thaw->{server} = $thaw->new_test_server;
255	6					384	$thaw->add_inc;
256	6					113	return $thaw;
257							}
258
259							#regenerating config, so forget old
260	0	0				0	if ($args->{save}) {
261	0					0	for (qw(vhosts inherit_config modules inc cmodules)) {
262	0	0				0	delete $thaw->{$_} if exists $thaw->{$_};
263							}
264							}
265
266							# custom config options from Apache::TestConfigData
267							# again, this should force reconfiguration
268	0					0	custom_config_add_conf_opts($args);
269
270	0		0			0	my $self = bless {
271							clean => {},
272							vhosts => {},
273							inherit_config => {},
274							modules => {},
275							inc => [],
276							%$thaw,
277							mpm => "",
278							httpd_defines => {},
279							vars => $args,
280							postamble => [],
281							preamble => [],
282							postamble_hooks => [],
283							preamble_hooks => [],
284							}, ref($class) \|\| $class;
285
286	0					0	my $vars = $self->{vars}; #things that can be overridden
287
288	0					0	for (qw(save verbose)) {
289	0	0				0	next unless exists $args->{$_};
290	0					0	$self->{$_} = delete $args->{$_};
291							}
292
293	0		0			0	$vars->{top_dir} \|\|= $top_dir;
294
295	0					0	$self->add_inc;
296
297							#help to find libmodperl.so
298	0					0	my $src_dir = catfile $vars->{top_dir}, qw(src modules perl);
299	0	0	0			0	$vars->{src_dir} \|\|= $src_dir if -d $src_dir;
300
301	0		0			0	$vars->{t_dir} \|\|= catfile $vars->{top_dir}, 't';
302	0		0			0	$vars->{serverroot} \|\|= $vars->{t_dir};
303	0		0			0	$vars->{documentroot} \|\|= catfile $vars->{serverroot}, 'htdocs';
304	0		0			0	$vars->{perlpod} \|\|= $self->find_in_inc('pods') \|\|
			0
305							$self->find_in_inc('pod');
306	0		0			0	$vars->{perl} \|\|= $^X;
307	0		0			0	$vars->{t_conf} \|\|= catfile $vars->{serverroot}, 'conf';
308	0		0			0	$vars->{sslca} \|\|= catfile $vars->{t_conf}, 'ssl', 'ca';
309	0		0			0	$vars->{sslcaorg} \|\|= 'asf';
310	0		0			0	$vars->{t_logs} \|\|= catfile $vars->{serverroot}, 'logs';
311	0		0			0	$vars->{t_conf_file} \|\|= catfile $vars->{t_conf}, 'httpd.conf';
312	0		0			0	$vars->{t_pid_file} \|\|= catfile $vars->{t_logs}, 'httpd.pid';
313
314	0					0	if (WINFU) {
315							for (keys %$vars) {
316							$vars->{$_} =~ s\|\\\|\/\|g if defined $vars->{$_};
317							}
318							}
319
320	0		0			0	$vars->{scheme} \|\|= 'http';
321	0		0			0	$vars->{servername} \|\|= $self->default_servername;
322	0					0	$vars->{port} = $self->select_first_port;
323	0		0			0	$vars->{remote_addr} \|\|= $self->our_remote_addr;
324
325	0		0			0	$vars->{user} \|\|= $self->default_user;
326	0		0			0	$vars->{group} \|\|= $self->default_group;
327	0		0			0	$vars->{serveradmin} \|\|= $self->default_serveradmin;
328
329	0		0			0	$vars->{minclients} \|\|= 1;
330	0		0			0	$vars->{maxclients_preset} = $vars->{maxclients} \|\| 0;
331							# if maxclients wasn't explicitly passed try to
332							# prevent 'server reached MaxClients setting' errors
333	0		0			0	$vars->{maxclients} \|\|= $vars->{minclients} + 1;
334
335							# if a preset maxclients valus is smaller than minclients,
336							# maxclients overrides minclients
337	0	0	0			0	if ($vars->{maxclients_preset} &&
338							$vars->{maxclients_preset} < $vars->{minclients}) {
339	0					0	$vars->{minclients} = $vars->{maxclients_preset};
340							}
341
342							# for threaded mpms MaxClients must be a multiple of
343							# ThreadsPerChild (i.e. maxclients % minclients == 0)
344							# so unless -maxclients was explicitly specified use a double of
345							# minclients
346	0		0			0	$vars->{maxclientsthreadedmpm} =
347							$vars->{maxclients_preset} \|\| $vars->{minclients} * 2;
348
349	0		0			0	$vars->{proxy} \|\|= 'off';
350	0		0			0	$vars->{proxyssl_url} \|\|= '';
351	0		0			0	$vars->{defines} \|\|= '';
352
353	0					0	$self->{hostport} = $self->hostport;
354	0					0	$self->{server} = $self->new_test_server;
355
356	0					0	return $self;
357
358							}
359
360							# figure out where httpd is and run extra config hooks which require
361							# knowledge of where httpd is
362							sub httpd_config {
363	6			6	0	64	my $self = shift;
364
365	6					77	$self->configure_apxs;
366	6					71	$self->configure_httpd;
367
368	6					652	my $vars = $self->{vars};
369	6	50	33			146	unless ($vars->{httpd} or $vars->{apxs}) {
370
371							# mod_perl 2.0 build (almost) always knows the right httpd
372
373							# location (and optionally apxs). if we get here we can't
374							# continue because the interactive config can't work with
375							# mod_perl 2.0 build (by design)
376	0	0				0	if (IS_MOD_PERL_2_BUILD){
377	0					0	my $mp2_build = $self->modperl_build_config();
378							# if mod_perl 2 was built against the httpd source it
379							# doesn't know where to find apxs/httpd, so in this case
380							# fall back to interactive config
381	0	0				0	unless ($mp2_build->{MP_APXS}) {
382	0					0	die "mod_perl 2 was built against Apache sources, we " .
383							"don't know where httpd/apxs executables are, therefore " .
384							"skipping the test suite execution"
385							}
386
387							# not sure what else could go wrong but we can't continue
388	0					0	die "something is wrong, mod_perl 2.0 build should have " .
389							"supplied all the needed information to run the tests. " .
390							"Please post lib/Apache/BuildConfig.pm along with the " .
391							"bug report";
392							}
393
394	0	0				0	if ($ENV{APACHE_TEST_NO_STICKY_PREFERENCES}) {
395	0					0	error "You specified APACHE_TEST_NO_STICKY_PREFERENCES=1 " .
396							"in which case you must explicitly specify -httpd " .
397							"and/or -apxs options";
398	0					0	Apache::TestRun::exit_perl(0);
399							}
400
401	0					0	$self->clean(1);
402							# this method restarts the whole program via exec
403							# so it never returns
404	0					0	$self->custom_config_first_time($self->{vars});
405							}
406							else {
407	6					154	debug "Using httpd: $vars->{httpd}";
408							}
409
410							# if we have gotten that far we know at least about the location
411							# of httpd and or apxs, so let's save it if we haven't saved any
412							# custom configs yet
413	6	50				89	unless (custom_config_exists()) {
414	0					0	$self->custom_config_save($self->{vars});
415							}
416
417	6					696	$self->inherit_config; #see TestConfigParse.pm
418	6					348	$self->configure_httpd_eapi; #must come after inherit_config
419
420	6					279	$self->default_module(cgi => [qw(mod_cgi mod_cgid)]);
421	6					93	$self->default_module(thread => [qw(worker threaded)]);
422	6					81	$self->default_module(ssl => [qw(mod_ssl)]);
423	6					81	$self->default_module(access => [qw(mod_access mod_authz_host)]);
424	6					95	$self->default_module(auth => [qw(mod_auth mod_auth_basic)]);
425	6					176	$self->default_module(php => [qw(sapi_apache2 mod_php4 mod_php5)]);
426
427	6					436	$self->{server}->post_config;
428
429	6					886	$self;
430							}
431
432							sub default_module {
433	36			36	0	429	my($self, $name, $choices) = @_;
434
435	36					398	my $mname = $name . '_module_name';
436
437	36	50				417	unless ($self->{vars}->{$mname}) {
438	0					0	($self->{vars}->{$mname}) = grep {
439	0					0	$self->{modules}->{"$_.c"};
440							} @$choices;
441
442	0		0			0	$self->{vars}->{$mname} \|\|= $choices->[0];
443							}
444
445	36					549	$self->{vars}->{$name . '_module'} =
446							$self->{vars}->{$mname} . '.c'
447							}
448
449							sub configure_apxs {
450	6			6	0	57	my $self = shift;
451
452	6					77	$self->{APXS} = $self->default_apxs;
453
454	6	50				76	return unless $self->{APXS};
455
456	6					57	$self->{APXS} =~ s{/}{\\}g if WIN32;
457
458	6					90	my $vars = $self->{vars};
459
460	6		50			75	$vars->{bindir} \|\|= $self->apxs('BINDIR', 1);
461	6		50			138	$vars->{sbindir} \|\|= $self->apxs('SBINDIR');
462	6		50			74	$vars->{target} \|\|= $self->apxs('TARGET');
463	6		50			76	$vars->{conf_dir} \|\|= $self->apxs('SYSCONFDIR');
464
465	6	50				81	if ($vars->{conf_dir}) {
466	6		50			84	$vars->{httpd_conf} \|\|= catfile $vars->{conf_dir}, 'httpd.conf';
467							}
468							}
469
470							sub configure_httpd {
471	6			6	0	58	my $self = shift;
472	6					62	my $vars = $self->{vars};
473
474	6					85	debug "configuring httpd";
475
476	6		50			72	$vars->{target} \|\|= (WIN32 ? 'Apache.EXE' : 'httpd');
477
478	6	50				79	unless ($vars->{httpd}) {
479							#sbindir should be bin/ with the default layout
480							#but its eaiser to workaround apxs than fix apxs
481	0					0	for my $dir (map { $vars->{$_} } qw(sbindir bindir)) {
	0					0
482	0	0				0	next unless defined $dir;
483	0					0	my $httpd = catfile $dir, $vars->{target};
484	0	0				0	next unless -x $httpd;
485	0					0	$vars->{httpd} = $httpd;
486	0					0	last;
487							}
488
489	0		0			0	$vars->{httpd} \|\|= $self->default_httpd;
490							}
491
492	6	50				79	if ($vars->{httpd}) {
493	6					85	my @chunks = splitdir $vars->{httpd};
494							#handle both $prefix/bin/httpd and $prefix/Apache.exe
495	6					200	for (1,2) {
496	12					106	pop @chunks;
497	12	50				133	last unless @chunks;
498	12					139	$self->{httpd_basedir} = catfile @chunks;
499	12	100				320	last if -d "$self->{httpd_basedir}/bin";
500							}
501							}
502
503							#cleanup httpd droppings
504	6					86	my $sem = catfile $vars->{t_logs}, 'apache_runtime_status.sem';
505	6	50				175	unless (-e $sem) {
506	6					80	$self->clean_add_file($sem);
507							}
508							}
509
510							sub configure_httpd_eapi {
511	6			6	0	60	my $self = shift;
512	6					432	my $vars = $self->{vars};
513
514							#deal with EAPI_MM_CORE_PATH if defined.
515	6	50				126	if (defined($self->{httpd_defines}->{EAPI_MM_CORE_PATH})) {
516	0					0	my $path = $self->{httpd_defines}->{EAPI_MM_CORE_PATH};
517
518							#ensure the directory exists
519	0					0	my @chunks = splitdir $path;
520	0					0	pop @chunks; #the file component of the path
521	0					0	$path = catdir @chunks;
522	0	0				0	unless (file_name_is_absolute $path) {
523	0					0	$path = catdir $vars->{serverroot}, $path;
524							}
525	0					0	$self->gendir($path);
526							}
527							}
528
529							sub configure_proxy {
530	5			5	0	52	my $self = shift;
531	5					55	my $vars = $self->{vars};
532
533							#if we proxy to ourselves, must bump the maxclients
534	5	50				155	if ($vars->{proxy} =~ /^on$/i) {
535	0	0				0	unless ($vars->{maxclients_preset}) {
536	0					0	$vars->{minclients}++;
537	0					0	$vars->{maxclients}++;
538							}
539	0					0	$vars->{proxy} = $self->{vhosts}->{'mod_proxy'}->{hostport};
540	0					0	return $vars->{proxy};
541							}
542
543	5					78	return undef;
544							}
545
546							# adds the config to the head of the group instead of the tail
547							# XXX: would be even better to add to a different sub-group
548							# (e.g. preamble_first) of only those that want to be first and then,
549							# make sure that they are dumped to the config file first in the same
550							# group (e.g. preamble)
551							sub add_config_first {
552	0			0	0	0	my $self = shift;
553	0					0	my $where = shift;
554	0					0	unshift @{ $self->{$where} }, $self->massage_config_args(@_);
	0					0
555							}
556
557							sub add_config_last {
558	12			12	0	220	my $self = shift;
559	12					479	my $where = shift;
560	12					114	push @{ $self->{$where} }, $self->massage_config_args(@_);
	12					278
561							}
562
563							sub massage_config_args {
564	12			12	0	200	my $self = shift;
565	12					137	my($directive, $arg, $data) = @_;
566	12					112	my $args = "";
567
568	12	100				173	if ($data) {
		50
569	6					84	$args = "<$directive $arg>\n";
570	6	50				380	if (ref($data) eq 'HASH') {
		50
571	0					0	while (my($k,$v) = each %$data) {
572	0					0	$args .= " $k $v\n";
573							}
574							}
575							elsif (ref($data) eq 'ARRAY') {
576							# balanced (key=>val) list
577	0					0	my $pairs = @$data / 2;
578	0					0	for my $i (0..($pairs-1)) {
579	0					0	$args .= sprintf " %s %s\n", $data->[$i2], $data->[$i2+1];
580							}
581							}
582							else {
583	6					87	$args .= " $data";
584							}
585	6					76	$args .= "</$directive>\n";
586							}
587							elsif (ref($directive) eq 'ARRAY') {
588	0					0	$args = join "\n", @$directive;
589							}
590							else {
591	6	50	33			287	$args = join " ", grep length($_), $directive,
			50
592							(ref($arg) && (ref($arg) eq 'ARRAY') ? "@$arg" : $arg \|\| "");
593							}
594
595	12					381	return $args;
596							}
597
598							sub postamble_first {
599	0			0	0	0	shift->add_config_first(postamble => @_);
600							}
601
602							sub postamble {
603	6			6	0	80	shift->add_config_last(postamble => @_);
604							}
605
606							sub preamble_first {
607	0			0	0	0	shift->add_config_first(preamble => @_);
608							}
609
610							sub preamble {
611	6			6	0	313	shift->add_config_last(preamble => @_);
612							}
613
614							sub postamble_register {
615	0			0	0	0	push @{ shift->{postamble_hooks} }, @_;
	0					0
616							}
617
618							sub preamble_register {
619	0			0	0	0	push @{ shift->{preamble_hooks} }, @_;
	0					0
620							}
621
622							sub add_config_hooks_run {
623	0			0	0	0	my($self, $where, $out) = @_;
624
625	0					0	for (@{ $self->{"${where}_hooks"} }) {
	0					0
626	0	0	0			0	if ((ref($_) and ref($_) eq 'CODE') or $self->can($_)) {
			0
627	0					0	$self->$_();
628							}
629							else {
630	0					0	error "cannot run configure hook: `$_'";
631							}
632							}
633
634	0					0	for (@{ $self->{$where} }) {
	0					0
635	0					0	$self->replace;
636	0					0	print $out "$_\n";
637							}
638							}
639
640							sub postamble_run {
641	0			0	0	0	shift->add_config_hooks_run(postamble => @_);
642							}
643
644							sub preamble_run {
645	0			0	0	0	shift->add_config_hooks_run(preamble => @_);
646							}
647
648							sub default_group {
649	0			0	0	0	return if WINFU;
650
651	0					0	my $gid = $);
652
653							#use only first value if $) contains more than one
654	0					0	$gid =~ s/^(\d+).*$/$1/;
655
656	0		0			0	my $group = $ENV{APACHE_TEST_GROUP} \|\| (getgrgid($gid) \|\| "#$gid");
			0
657
658	0	0				0	if ($group eq 'root') {
659							# similar to default_user, we want to avoid perms problems,
660							# when the server is started with group 'root'. When running
661							# under group root it may fail to create dirs and files,
662							# writable only by user
663	0					0	my $user = default_user();
664	0	0				0	my $gid = $user ? (getpwnam($user))[3] : '';
665	0	0	0			0	$group = (getgrgid($gid) \|\| "#$gid") if $gid;
666							}
667
668	0					0	$group;
669							}
670
671							sub default_user {
672	0			0	0	0	return if WINFU;
673
674	0					0	my $uid = $>;
675
676	0		0			0	my $user = $ENV{APACHE_TEST_USER} \|\| (getpwuid($uid) \|\| "#$uid");
			0
677
678	0	0				0	if ($user eq 'root') {
679	0					0	my $other = (getpwnam('nobody'))[0];
680	0	0				0	if ($other) {
681	0					0	$user = $other;
682							}
683							else {
684	0					0	die "cannot run tests as User root";
685							#XXX: prompt for another username
686							}
687							}
688
689	0					0	$user;
690							}
691
692							sub default_serveradmin {
693	0			0	0	0	my $vars = shift->{vars};
694	0		0			0	join '@', ($vars->{user} \|\| 'unknown'), $vars->{servername};
695							}
696
697							sub default_apxs {
698	6			6	0	59	my $self = shift;
699
700	6	50				83	return $self->{vars}->{apxs} if $self->{vars}->{apxs};
701
702	6	50				75	if (my $build_config = $self->modperl_build_config()) {
703	0					0	return $build_config->{MP_APXS};
704							}
705
706	6					82	$ENV{APACHE_TEST_APXS};
707							}
708
709							sub default_httpd {
710	0			0	0	0	my $self = shift;
711
712	0					0	my $vars = $self->{vars};
713
714	0	0				0	if (my $build_config = $self->modperl_build_config()) {
715	0	0				0	if (my $p = $build_config->{MP_AP_PREFIX}) {
716	0					0	for my $bindir (qw(bin sbin)) {
717	0					0	my $httpd = catfile $p, $bindir, $vars->{target};
718	0	0				0	return $httpd if -e $httpd;
719							# The executable on Win32 in Apache/2.2 is httpd.exe,
720							# so try that if Apache.exe doesn't exist
721	0					0	if (WIN32) {
722							$httpd = catfile $p, $bindir, 'httpd.EXE';
723							if (-e $httpd) {
724							$vars->{target} = 'httpd.EXE';
725							return $httpd;
726							}
727							}
728							}
729							}
730							}
731
732	0					0	$ENV{APACHE_TEST_HTTPD};
733							}
734
735							my $localhost;
736
737							sub default_localhost {
738	0			0	0	0	my $localhost_addr = pack('C4', 127, 0, 0, 1);
739	0	0				0	gethostbyaddr($localhost_addr, Socket::AF_INET()) \|\| 'localhost';
740							}
741
742							sub default_servername {
743	0			0	0	0	my $self = shift;
744	0		0			0	$localhost \|\|= $self->default_localhost;
745	0	0				0	die "Can't figure out the default localhost's server name"
746							unless $localhost;
747							}
748
749							# memoize the selected value (so we make sure that the same port is used
750							# via select). The problem is that select_first_port() is called 3 times after
751							# -clean, and it's possible that a lower port will get released
752							# between calls, leading to various places in the test suite getting a
753							# different base port selection.
754							#
755							# XXX: There is still a problem if two t/TEST's configure at the same
756							# time, so they both see the same port free, but only the first one to
757							# bind() will actually get the port. So there is a need in another
758							# check and reconfiguration just before the server starts.
759							#
760							my $port_memoized;
761							sub select_first_port {
762	15			15	0	139	my $self = shift;
763
764	15		66			307	my $port \|\|= $port_memoized \|\| $ENV{APACHE_TEST_PORT}
			66
			50
			33
765							\|\| $self->{vars}{port} \|\| DEFAULT_PORT;
766
767							# memoize
768	15					132	$port_memoized = $port;
769
770	15	50				324	return $port unless $port eq 'select';
771
772							# port select mode: try to find another available port, take into
773							# account that each instance of the test suite may use more than
774							# one port for virtual hosts, therefore try to check ports in big
775							# steps (20?).
776	0					0	my $step = 20;
777	0					0	my $tries = 20;
778	0					0	$port = DEFAULT_PORT;
779	0					0	until (Apache::TestServer->port_available($port)) {
780	0	0				0	unless (--$tries) {
781	0					0	error "no ports available";
782	0					0	error "tried ports @{[DEFAULT_PORT]} - $port in $step increments";
	0					0
783	0					0	return 0;
784							}
785	0					0	$port += $step;
786							}
787
788	0	0				0	info "the default base port is used, using base port $port instead"
789							unless $port == DEFAULT_PORT;
790
791							# memoize
792	0					0	$port_memoized = $port;
793
794	0					0	return $port;
795							}
796
797							my $remote_addr;
798
799							sub our_remote_addr {
800	0			0	0	0	my $self = shift;
801	0					0	my $name = $self->default_servername;
802	0					0	my $iaddr = (gethostbyname($name))[-1];
803	0	0				0	unless (defined $iaddr) {
804	0					0	error "Can't resolve host: '$name' (check /etc/hosts)";
805	0					0	exit 1;
806							}
807	0		0			0	$remote_addr \|\|= Socket::inet_ntoa($iaddr);
808							}
809
810							sub default_loopback {
811	0			0	0	0	'127.0.0.1';
812							}
813
814							sub port {
815	15			15	0	147	my($self, $module) = @_;
816
817	15	50				155	unless ($module) {
818	15					134	my $vars = $self->{vars};
819	15	50				339	return $self->select_first_port() unless $vars->{scheme} eq 'https';
820	0					0	$module = $vars->{ssl_module_name};
821							}
822	0					0	return $self->{vhosts}->{$module}->{port};
823							}
824
825							sub hostport {
826	15			15	0	136	my $self = shift;
827	15		33			250	my $vars = shift \|\| $self->{vars};
828	15		50			193	my $module = shift \|\| '';
829
830	15					145	my $name = $vars->{servername};
831
832	15		50			281	join ':', $name , $self->port($module \|\| '');
833							}
834
835							#look for mod_foo.so
836							sub find_apache_module {
837	0			0	0	0	my($self, $module) = @_;
838
839	0	0				0	die "find_apache_module: module name argument is required"
840							unless $module;
841
842	0					0	my $vars = $self->{vars};
843	0					0	my $sroot = $vars->{serverroot};
844
845	0					0	my @trys = grep { $_ }
	0					0
846							($vars->{src_dir},
847							$self->apxs('LIBEXECDIR'),
848							catfile($sroot, 'modules'),
849							catfile($sroot, 'libexec'));
850
851	0					0	for (@trys) {
852	0					0	my $file = catfile $_, $module;
853	0	0				0	if (-e $file) {
854	0					0	debug "found $module => $file";
855	0					0	return $file;
856							}
857							}
858
859							# if the module wasn't found try to lookup in the list of modules
860							# inherited from the system-wide httpd.conf
861	0					0	my $name = $module;
862	0					0	$name =~ s/\.s[ol]$/.c/; #mod_info.so => mod_info.c
863	0					0	$name =~ s/^lib/mod_/; #libphp4.so => mod_php4.c
864	0	0				0	return $self->{modules}->{$name} if $self->{modules}->{$name};
865
866							}
867
868							#generate files and directories
869
870							my %warn_style = (
871							html => sub { "<!-- @_ -->" },
872							c => sub { "/* @_ */" },
873							default => sub { join '', grep {s/^/\# /gm} @_ },
874							);
875
876							my %file_ext = (
877							map({$_ => 'html'} qw(htm html)),
878							map({$_ => 'c' } qw(c h)),
879							);
880
881							# return the passed file's extension or '' if there is no one
882							# note: that '/foo/bar.conf.in' returns an extension: 'conf.in';
883							# note: a hidden file .foo will be recognized as an extension 'foo'
884							sub filename_ext {
885	0			0	0	0	my ($self, $filename) = @_;
886	0		0			0	my $ext = (File::Basename::fileparse($filename, '\..*'))[2] \|\| '';
887	0					0	$ext =~ s/^\.(.*)/lc $1/e;
	0					0
888	0					0	$ext;
889							}
890
891							sub warn_style_sub_ref {
892	0			0	0	0	my ($self, $filename) = @_;
893	0					0	my $ext = $self->filename_ext($filename);
894	0		0			0	return $warn_style{ $file_ext{$ext} \|\| 'default' };
895							}
896
897							sub genwarning {
898	0			0	1	0	my($self, $filename, $from_filename) = @_;
899	0	0				0	return unless $filename;
900	0					0	my $time = scalar localtime;
901	0					0	my $warning = "WARNING: this file is generated";
902	0	0				0	$warning .= " (from $from_filename)" if defined $from_filename;
903	0					0	$warning .= ", do not edit\n";
904	0					0	$warning .= "generated on $time\n";
905	0					0	$warning .= calls_trace();
906	0					0	return $self->warn_style_sub_ref($filename)->($warning);
907							}
908
909							sub calls_trace {
910	0			0	0	0	my $frame = 1;
911	0					0	my $trace = '';
912
913	0					0	while (1) {
914	0					0	my($package, $filename, $line) = caller($frame);
915	0	0				0	last unless $filename;
916	0					0	$trace .= sprintf "%02d: %s:%d\n", $frame, $filename, $line;
917	0					0	$frame++;
918							}
919
920	0					0	return $trace;
921							}
922
923							sub clean_add_file {
924	6			6	0	69	my($self, $file) = @_;
925
926	6					109	$self->{clean}->{files}->{ rel2abs($file) } = 1;
927							}
928
929							sub clean_add_path {
930	0			0	0	0	my($self, $path) = @_;
931
932	0					0	$path = rel2abs($path);
933
934							# remember which dirs were created and should be cleaned up
935	0					0	while (1) {
936	0					0	$self->{clean}->{dirs}->{$path} = 1;
937	0					0	$path = dirname $path;
938	0	0				0	last if -e $path;
939							}
940							}
941
942							sub genfile_trace {
943	0			0	0	0	my($self, $file, $from_file) = @_;
944	0					0	my $name = abs2rel $file, $self->{vars}->{t_dir};
945	0					0	my $msg = "generating $name";
946	0	0				0	$msg .= " from $from_file" if defined $from_file;
947	0					0	debug $msg;
948							}
949
950							sub genfile_warning {
951	0			0	0	0	my($self, $file, $from_file, $fh) = @_;
952
953	0	0				0	if (my $msg = $self->genwarning($file, $from_file)) {
954	0					0	print $fh $msg, "\n";
955							}
956							}
957
958							# $from_file == undef if there was no templates used
959							sub genfile {
960	0			0	1	0	my($self, $file, $from_file, $nowarning) = @_;
961
962							# create the parent dir if it doesn't exist yet
963	0					0	my $dir = dirname $file;
964	0					0	$self->makepath($dir);
965
966	0					0	$self->genfile_trace($file, $from_file);
967
968	0					0	my $fh = Symbol::gensym();
969	0	0				0	open $fh, ">$file" or die "open $file: $!";
970
971	0	0				0	$self->genfile_warning($file, $from_file, $fh) unless $nowarning;
972
973	0					0	$self->clean_add_file($file);
974
975	0					0	return $fh;
976							}
977
978							# gen + write file
979							sub writefile {
980	0			0	1	0	my($self, $file, $content, $nowarning) = @_;
981
982	0					0	my $fh = $self->genfile($file, undef, $nowarning);
983
984	0	0				0	print $fh $content if $content;
985
986	0					0	close $fh;
987							}
988
989							sub perlscript_header {
990
991	0			0	0	0	require FindBin;
992
993	0					0	my @dirs = ();
994
995							# mp2 needs its modper-2.0/lib before blib was created
996	0	0	0			0	if (IS_MOD_PERL_2_BUILD \|\| $ENV{APACHE_TEST_LIVE_DEV}) {
997							# the live 'lib/' dir of the distro
998							# (e.g. modperl-2.0/ModPerl-Registry/lib)
999	0					0	my $dir = canonpath catdir $FindBin::Bin, "lib";
1000	0	0				0	push @dirs, $dir if -d $dir;
1001
1002							# the live dir of the top dir if any (e.g. modperl-2.0/lib)
1003	0	0				0	if (-e catfile($FindBin::Bin, "..", "Makefile.PL")) {
1004	0					0	my $dir = canonpath catdir $FindBin::Bin, "..", "lib";
1005	0	0				0	push @dirs, $dir if -d $dir;
1006							}
1007							}
1008
1009	0					0	for (qw(. ..)) {
1010	0					0	my $dir = canonpath catdir $FindBin::Bin, $_ , "Apache-Test", "lib";
1011	0	0				0	if (-d $dir) {
1012	0					0	push @dirs, $dir;
1013	0					0	last;
1014							}
1015							}
1016
1017							{
1018	0					0	my $dir = canonpath catdir $FindBin::Bin, "t", "lib";
	0					0
1019	0	0				0	push @dirs, $dir if -d $dir;
1020							}
1021
1022	0					0	my $dirs = join("\n ", '', @dirs) . "\n";;
1023
1024	0					0	return <<"EOF";
1025
1026							use strict;
1027							use warnings FATAL => 'all';
1028
1029							use lib qw($dirs);
1030
1031							EOF
1032							}
1033
1034							# gen + write executable perl script file
1035							sub write_perlscript {
1036	0			0	1	0	my($self, $file, $content) = @_;
1037
1038	0					0	my $fh = $self->genfile($file, undef, 1);
1039
1040	0					0	my $shebang = make_shebang();
1041	0					0	print $fh $shebang;
1042
1043	0					0	$self->genfile_warning($file, undef, $fh);
1044
1045	0	0				0	print $fh $content if $content;
1046
1047	0					0	close $fh;
1048	0					0	chmod 0755, $file;
1049							}
1050
1051							sub make_shebang {
1052							# if perlpath is longer than 62 chars, some shells on certain
1053							# platforms won't be able to run the shebang line, so when seeing
1054							# a long perlpath use the eval workaround.
1055							# see: http://en.wikipedia.org/wiki/Shebang
1056							# http://homepages.cwi.nl/~aeb/std/shebang/
1057	0	0		0	0	0	my $shebang = length $Config{perlpath} < 62
1058							? "#!$Config{perlpath}\n"
1059							: <<EOI;
1060							$Config{'startperl'}
1061							eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
1062							if \$running_under_some_shell;
1063							EOI
1064
1065	0					0	return $shebang;
1066							}
1067
1068							sub cpfile {
1069	0			0	0	0	my($self, $from, $to) = @_;
1070	0					0	File::Copy::copy($from, $to);
1071	0					0	$self->clean_add_file($to);
1072							}
1073
1074							sub symlink {
1075	0			0	0	0	my($self, $from, $to) = @_;
1076	0					0	CORE::symlink($from, $to);
1077	0					0	$self->clean_add_file($to);
1078							}
1079
1080							sub gendir {
1081	0			0	1	0	my($self, $dir) = @_;
1082	0					0	$self->makepath($dir);
1083							}
1084
1085							# returns a list of dirs successfully created
1086							sub makepath {
1087	0			0	0	0	my($self, $path) = @_;
1088
1089	0	0	0			0	return if !defined($path) \|\| -e $path;
1090
1091	0					0	$self->clean_add_path($path);
1092
1093	0					0	return File::Path::mkpath($path, 0, 0755);
1094							}
1095
1096							sub open_cmd {
1097	18			18	0	305	my($self, $cmd) = @_;
1098							# untaint some %ENV fields
1099	18					1027	local @ENV{ qw(IFS CDPATH ENV BASH_ENV) };
1100	18					620	local $ENV{PATH} = untaint_path($ENV{PATH});
1101
1102							# launder for -T
1103	18	50				794	$cmd = $1 if $cmd =~ /(.*)/;
1104
1105	18					936	my $handle = Symbol::gensym();
1106	18	50				558486	open $handle, "$cmd\|" or die "$cmd failed: $!";
1107
1108	18					24079	return $handle;
1109							}
1110
1111							sub clean {
1112	0			0	0	0	my $self = shift;
1113	0		0			0	$self->{clean_level} = shift \|\| 2; #2 == really clean, 1 == reconfigure
1114
1115	0					0	$self->new_test_server->clean;
1116	0					0	$self->cmodules_clean;
1117	0					0	$self->sslca_clean;
1118
1119	0					0	for (keys %{ $self->{clean}->{files} }) {
	0					0
1120	0	0				0	if (-e $_) {
1121	0					0	debug "unlink $_";
1122	0					0	unlink $_;
1123							}
1124							else {
1125	0					0	debug "unlink $_: $!";
1126							}
1127							}
1128
1129							# if /foo comes before /foo/bar, /foo will never be removed
1130							# hence ensure that sub-dirs are always treated before a parent dir
1131	0					0	for (reverse sort keys %{ $self->{clean}->{dirs} }) {
	0					0
1132	0	0				0	if (-d $_) {
1133	0					0	my $dh = Symbol::gensym();
1134	0					0	opendir($dh, $_);
1135	0					0	my $notempty = grep { ! /^\.{1,2}$/ } readdir $dh;
	0					0
1136	0					0	closedir $dh;
1137	0	0				0	next if $notempty;
1138	0					0	debug "rmdir $_";
1139	0					0	rmdir $_;
1140							}
1141							}
1142							}
1143
1144							my %special_tokens = (
1145							nextavailableport => sub { shift->server->select_next_port }
1146							);
1147
1148							sub replace {
1149	0			0	0	0	my $self = shift;
1150	0	0				0	my $file = $Apache::TestConfig::File
1151							? "in file $Apache::TestConfig::File" : '';
1152
1153	0					0	s[@(\w+)@]
	0					0
1154	0	0				0	[ my $key = lc $1;
		0
1155	0					0	if (my $callback = $special_tokens{$key}) {
1156							$self->$callback;
1157							}
1158	0					0	elsif (exists $self->{vars}->{$key}) {
1159							$self->{vars}->{$key};
1160							}
1161	0					0	else {
1162							die "invalid token: \@$1\@ $file\n";
1163							}
1164							]ge;
1165							}
1166
1167							#need to configure the vhost port for redirects and $ENV{SERVER_PORT}
1168							#to have the correct values
1169							my %servername_config = (
1170							0 => sub {
1171							my($name, $port) = @_;
1172							[ServerName => ''], [Port => 0];
1173							},
1174							1 => sub {
1175							my($name, $port) = @_;
1176							[ServerName => $name], [Port => $port];
1177							},
1178							2 => sub {
1179							my($name, $port) = @_;
1180							[ServerName => "$name:$port"];
1181							},
1182							);
1183
1184							sub servername_config {
1185	0			0	0	0	my $self = shift;
1186	0					0	$self->server->version_of(\%servername_config)->(@_);
1187							}
1188
1189							sub parse_vhost {
1190	0			0	0	0	my($self, $line) = @_;
1191
1192	0					0	my($indent, $module, $namebased);
1193	0	0				0	if ($line =~ /^(\s)<VirtualHost\s+(?:_default_:\|([^:]+):(?!:))?(.?)\s>\s$/) {
1194	0		0			0	$indent = $1 \|\| "";
1195	0		0			0	$namebased = $2 \|\| "";
1196	0					0	$module = $3;
1197							}
1198							else {
1199	0					0	return undef;
1200							}
1201
1202	0					0	my $vars = $self->{vars};
1203	0					0	my $mods = $self->{modules};
1204	0					0	my $have_module = "$module.c";
1205	0					0	my $ssl_module = $vars->{ssl_module};
1206
1207							#if module ends with _ssl and it is not the module that implements ssl,
1208							#then assume this module is a vhost with SSLEngine On (or similar)
1209							#see mod_echo in extra.conf.in for example
1210	0	0	0			0	if ($module =~ /^(mod_\w+)_ssl$/ and $have_module ne $ssl_module) {
1211	0					0	$have_module = "$1.c"; #e.g. s/mod_echo_ssl.c/mod_echo.c/
1212	0	0				0	return undef unless $mods->{$ssl_module};
1213							}
1214
1215							#don't allocate a port if this module is not configured
1216							#assumes the configuration is inside an <IfModule $have_module>
1217	0	0	0			0	if ($module =~ /^mod_/ and not $mods->{$have_module}) {
1218	0					0	return undef;
1219							}
1220
1221							#allocate a port and configure this module into $self->{vhosts}
1222	0					0	my $port = $self->new_vhost($module, $namebased);
1223
1224							#extra config that should go inside the <VirtualHost ...>
1225	0	0				0	my @in_config = $self->servername_config($namebased
1226							? $namebased
1227							: $vars->{servername},
1228							$port);
1229
1230	0					0	my @out_config = ();
1231	0	0				0	if ($self->{vhosts}->{$module}->{namebased} < 2) {
1232							#extra config that should go outside the <VirtualHost ...>
1233	0					0	@out_config = ([Listen => '0.0.0.0:' . $port]);
1234
1235	0	0				0	if ($self->{vhosts}->{$module}->{namebased}) {
1236	0					0	push @out_config => [NameVirtualHost => "*:$port"];
1237							}
1238							}
1239
1240	0					0	$self->{vars}->{$module . '_port'} = $port;
1241
1242							#there are two ways of building a vhost
1243							#first is when we parse test .pm and .c files
1244							#second is when we scan *.conf.in
1245							my $form_postamble = sub {
1246	0			0		0	my $indent = shift;
1247	0					0	for my $pair (@_) {
1248	0					0	$self->postamble("$indent@$pair");
1249							}
1250	0					0	};
1251
1252							my $form_string = sub {
1253	0			0		0	my $indent = shift;
1254	0					0	join "\n", map { "$indent@$_\n" } @_;
	0					0
1255	0					0	};
1256
1257	0	0				0	my $double_indent = $indent ? $indent x 2 : ' ' x 4;
1258							return {
1259							port => $port,
1260							#used when parsing .pm and .c test modules
1261	0			0		0	in_postamble => sub { $form_postamble->($double_indent, @in_config) },
1262	0			0		0	out_postamble => sub { $form_postamble->($indent, @out_config) },
1263							#used when parsing *.conf.in files
1264	0	0				0	in_string => $form_string->($double_indent, @in_config),
1265							out_string => $form_string->($indent, @out_config),
1266							line => "$indent<VirtualHost " . ($namebased ? '*' : '_default_')