← Back to branch summary

~ubuntu-branches/ubuntu/edgy/libapache2-mod-perl2/edgy-updates

« back to all changes in this revision

Viewing changes to Apache-Test/lib/Apache/TestConfig.pm

  • Committer: Bazaar Package Importer
  • Author(s): Adam Conrad
  • Date: 2004-08-19 06:23:48 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20040819062348-jxl4koqbtvgm8v2t
Tags: 1.99.14-4
Remove the LFS CFLAGS, and build-dep against apache2-*-dev (>= 2.0.50-10)
as we're backing out of the apache2/apr ABI transition.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Apache-Test/lib/Apache/TestConfig.pm
 
1
# Copyright 2001-2004 The Apache Software Foundation
 
2
#
 
3
# Licensed under the Apache License, Version 2.0 (the "License");
 
4
# you may not use this file except in compliance with the License.
 
5
# You may obtain a copy of the License at
 
6
#
 
7
#     http://www.apache.org/licenses/LICENSE-2.0
 
8
#
 
9
# Unless required by applicable law or agreed to in writing, software
 
10
# distributed under the License is distributed on an "AS IS" BASIS,
 
11
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 
12
# See the License for the specific language governing permissions and
 
13
# limitations under the License.
 
14
#
1
15
package Apache::TestConfig;
2
16
 
3
17
use strict;
4
18
use warnings FATAL => 'all';
5
19
 
6
20
use constant WIN32   => $^O eq 'MSWin32';
 
21
use constant OSX     => $^O eq 'darwin';
7
22
use constant CYGWIN  => $^O eq 'cygwin';
8
23
use constant NETWARE => $^O eq 'NetWare';
 
24
use constant SOLARIS => $^O eq 'solaris';
9
25
use constant WINFU   => WIN32 || CYGWIN || NETWARE;
10
26
use constant COLOR   => ($ENV{APACHE_TEST_COLOR} && -t STDOUT) ? 1 : 0;
11
27
 
12
28
use constant DEFAULT_PORT => 8529;
13
29
 
14
30
use constant IS_MOD_PERL_2       =>
15
 
    eval { require mod_perl } && $mod_perl::VERSION >= 1.99;
 
31
    eval { require mod_perl && $mod_perl::VERSION >= 1.99 } || 0;
16
32
 
17
33
use constant IS_MOD_PERL_2_BUILD => IS_MOD_PERL_2 &&
18
34
    require Apache::Build && Apache::Build::IS_MOD_PERL_BUILD();
19
35
 
 
36
use constant IS_APACHE_TEST_BUILD =>
 
37
    grep { -e "$_/lib/Apache/TestConfig.pm" } qw(Apache-Test . ..);
 
38
 
20
39
use Symbol ();
21
40
use File::Copy ();
22
41
use File::Find qw(finddepth);
30
49
use Apache::TestConfigParse ();
31
50
use Apache::TestTrace;
32
51
use Apache::TestServer ();
 
52
use Apache::TestRun ();
33
53
use Socket ();
34
54
 
35
55
use vars qw(%Usage);
54
74
   apxs            => 'location of apxs (default is from Apache::BuildConfig)',
55
75
   startup_timeout => 'seconds to wait for the server to start (default is 60)',
56
76
   httpd_conf      => 'inherit config from this file (default is apxs derived)',
57
 
   maxclients      => 'maximum number of concurrent clients (default is 1)',
 
77
   httpd_conf_extra=> 'inherit additional config from this file',
 
78
   minclients      => 'minimum number of concurrent clients (default is 1)',
 
79
   maxclients      => 'maximum number of concurrent clients (default is minclients+1)',
58
80
   perlpod         => 'location of perl pod documents (for testing downloads)',
59
81
   proxyssl_url    => 'url for testing ProxyPass / https (default is localhost)',
60
82
   sslca           => 'location of SSL CA (default is $t_conf/ssl/ca)',
61
83
   sslcaorg        => 'SSL CA organization to use for tests (default is asf)',
62
84
   libmodperl      => 'path to mod_perl\'s .so (full or relative to LIBEXECDIR)',
 
85
   defines         => 'values to add as -D defines (for example, "VAR1 VAR2")',
63
86
   (map { $_ . '_module_name', "$_ module name"} qw(cgi ssl thread access auth)),
64
87
);
65
88
 
 
89
my %filepath_conf_opts = map { $_ => 1 }
 
90
    qw(top_dir t_dir t_conf t_logs t_conf_file src_dir serverroot
 
91
       documentroot bindir sbindir httpd apxs httpd_conf httpd_conf_extra
 
92
       perlpod sslca libmodperl);
 
93
 
 
94
sub conf_opt_is_a_filepath {
 
95
    my $opt = shift;
 
96
    $opt && exists $filepath_conf_opts{$opt};
 
97
}
 
98
 
66
99
sub usage {
67
100
    for my $hash (\%Usage) {
68
101
        for (sort keys %$hash){
101
134
}
102
135
 
103
136
my %passenv = map { $_,1 } qw{
104
 
APXS APACHE APACHE_GROUP APACHE_USER APACHE_PORT
 
137
    APACHE_TEST_APXS
 
138
    APACHE_TEST_HTTPD
 
139
    APACHE_TEST_GROUP
 
140
    APACHE_TEST_USER
 
141
    APACHE_TEST_PORT
105
142
};
106
143
 
107
144
sub passenv {
181
218
        }
182
219
    }
183
220
 
 
221
    # custom config options from Apache::TestConfigData
 
222
    # again, this should force reconfiguration
 
223
    Apache::TestRun::custom_config_add_conf_opts($args);
 
224
 
184
225
    my $self = bless {
185
226
        clean => {},
186
227
        vhosts => {},
227
268
 
228
269
    if (WINFU) {
229
270
        for (keys %$vars) {
230
 
            $vars->{$_} =~ s|\\|\/|g;
 
271
            $vars->{$_} =~ s|\\|\/|g if defined $vars->{$_};
231
272
        }
232
273
    }
233
274
 
239
280
    $vars->{user}         ||= $self->default_user;
240
281
    $vars->{group}        ||= $self->default_group;
241
282
    $vars->{serveradmin}  ||= $self->default_serveradmin;
242
 
    $vars->{maxclients}   ||= 1;
 
283
 
 
284
    $vars->{minclients}   ||= 1;
 
285
    # prevent 'server reached MaxClients setting' errors
 
286
    $vars->{maxclients}   ||= $vars->{minclients} + 1;
 
287
 
243
288
    $vars->{proxy}        ||= 'off';
244
289
    $vars->{proxyssl_url} ||= '';
 
290
    $vars->{defines}      ||= '';
245
291
 
246
292
    $self->configure_apxs;
247
293
    $self->configure_httpd;
303
349
    my $self = shift;
304
350
    my $vars = $self->{vars};
305
351
 
306
 
    $vars->{target} ||= (WIN32 ? 'Apache.exe' : 'httpd');
 
352
    $vars->{target} ||= (WIN32 ? 'Apache.EXE' : 'httpd');
307
353
 
308
354
    unless ($vars->{httpd}) {
309
355
        #sbindir should be bin/ with the default layout
362
408
 
363
409
    #if we proxy to ourselves, must bump the maxclients
364
410
    if ($vars->{proxy} =~ /^on$/i) {
 
411
        $vars->{minclients}++;
365
412
        $vars->{maxclients}++;
366
413
        $vars->{proxy} = $self->{vhosts}->{'mod_proxy'}->{hostport};
367
414
        return $vars->{proxy};
370
417
    return undef;
371
418
}
372
419
 
373
 
sub add_config {
374
 
    my $self = shift;
375
 
    my $where = shift;
 
420
# adds the config to the head of the group instead of the tail
 
421
# XXX: would be even better to add to a different sub-group
 
422
# (e.g. preamble_first) of only those that want to be first and then,
 
423
# make sure that they are dumped to the config file first in the same
 
424
# group (e.g. preamble)
 
425
sub add_config_first {
 
426
    my $self = shift;
 
427
    my $where = shift;
 
428
    unshift @{ $self->{$where} }, $self->massage_config_args(@_);
 
429
}
 
430
 
 
431
sub add_config_last {
 
432
    my $self = shift;
 
433
    my $where = shift;
 
434
    push @{ $self->{$where} }, $self->massage_config_args(@_);
 
435
}
 
436
 
 
437
sub massage_config_args {
 
438
    my $self = shift;
376
439
    my($directive, $arg, $data) = @_;
377
440
    my $args = "";
378
441
 
403
466
          (ref($arg) && (ref($arg) eq 'ARRAY') ? "@$arg" : $arg || "");
404
467
    }
405
468
 
406
 
    push @{ $self->{$where} }, $args;
 
469
    return $args;
 
470
}
 
471
 
 
472
sub postamble_first {
 
473
    shift->add_config_first(postamble => @_);
407
474
}
408
475
 
409
476
sub postamble {
410
 
    shift->add_config(postamble => @_);
 
477
    shift->add_config_last(postamble => @_);
 
478
}
 
479
 
 
480
sub preamble_first {
 
481
    shift->add_config_first(preamble => @_);
411
482
}
412
483
 
413
484
sub preamble {
414
 
    shift->add_config(preamble => @_);
 
485
    shift->add_config_last(preamble => @_);
415
486
}
416
487
 
417
488
sub postamble_register {
456
527
    #use only first value if $) contains more than one
457
528
    $gid =~ s/^(\d+).*$/$1/;
458
529
 
459
 
    my $group = $ENV{APACHE_GROUP} || (getgrgid($gid) || "#$gid");
 
530
    my $group = $ENV{APACHE_TEST_GROUP} || (getgrgid($gid) || "#$gid");
460
531
 
461
532
    if ($group eq 'root') {
462
533
        # similar to default_user, we want to avoid perms problems,
476
547
 
477
548
    my $uid = $>;
478
549
 
479
 
    my $user = $ENV{APACHE_USER} || (getpwuid($uid) || "#$uid");
 
550
    my $user = $ENV{APACHE_TEST_USER} || (getpwuid($uid) || "#$uid");
480
551
 
481
552
    if ($user eq 'root') {
482
553
        my $other = (getpwnam('nobody'))[0];
506
577
        return $build_config->{MP_APXS};
507
578
    }
508
579
 
509
 
    $ENV{APXS} || which('apxs');
 
580
    $ENV{APACHE_TEST_APXS};
510
581
}
511
582
 
512
583
sub default_httpd {
515
586
    if (my $build_config = modperl_build_config()) {
516
587
        if (my $p = $build_config->{MP_AP_PREFIX}) {
517
588
            for my $bindir (qw(bin sbin)) {
518
 
                my $httpd = "$p/$bindir/$vars->{target}";
 
589
                my $httpd = catfile $p, $bindir, $vars->{target};
519
590
                return $httpd if -e $httpd;
520
591
            }
521
592
        }
522
593
    }
523
594
 
524
 
    $ENV{APACHE} || which($vars->{target});
 
595
    $ENV{APACHE_TEST_HTTPD};
525
596
}
526
597
 
527
598
my $localhost;
549
620
# bind() will actually get the port. So there is a need in another
550
621
# check and reconfiguration just before the server starts.
551
622
#
 
623
my $port_memoized;
552
624
sub select_first_port {
553
625
    my $self = shift;
554
626
 
555
 
    my $port ||= $ENV{APACHE_PORT} || $self->{vars}{port} || DEFAULT_PORT;
 
627
    my $port ||= $port_memoized || $ENV{APACHE_TEST_PORT} 
 
628
        || $self->{vars}{port} || DEFAULT_PORT;
556
629
 
557
630
    # memoize
558
 
    $ENV{APACHE_PORT} = $port;
 
631
    $port_memoized = $port;
559
632
 
560
633
    return $port unless $port eq 'select';
561
634
 
579
652
        unless $port == DEFAULT_PORT;
580
653
 
581
654
    # memoize
582
 
    $ENV{APACHE_PORT} = $port;
 
655
    $port_memoized = $port;
583
656
 
584
657
    return $port;
585
658
}
618
691
    my $module = shift || '';
619
692
 
620
693
    my $name = $vars->{servername};
621
 
    my $resolve = \$self->{resolved}->{$name};
622
 
 
623
 
    unless ($$resolve) {
624
 
        if (gethostbyname $name) {
625
 
            $$resolve = $name;
626
 
        }
627
 
        else {
628
 
            $$resolve = $self->default_loopback;
629
 
            warn "lookup $name failed, using $$resolve for client tests\n";
630
 
        }
631
 
    }
632
 
 
633
 
    join ':', $$resolve || 'localhost', $self->port($module || '');
 
694
 
 
695
    join ':', $name , $self->port($module || '');
634
696
}
635
697
 
636
698
#look for mod_foo.so
988
1050
    my @out_config = ();
989
1051
    if ($self->{vhosts}->{$module}->{namebased} < 2) {
990
1052
        #extra config that should go *outside* the <VirtualHost ...>
991
 
        @out_config = ([Listen => $port]);
 
1053
        @out_config = ([Listen => '0.0.0.0:' . $port]);
992
1054
 
993
1055
        if ($self->{vhosts}->{$module}->{namebased}) {
994
1056
            push @out_config => [NameVirtualHost => "*:$port"];
1094
1156
    }
1095
1157
}
1096
1158
 
 
1159
# various dup bugs in older perl and perlio in perl < 5.8.4 need a
 
1160
# workaround to explicitly rewind the dupped DATA fh before using it
 
1161
my $DATA_pos = tell DATA;
1097
1162
sub httpd_conf_template {
1098
1163
    my($self, $try) = @_;
1099
1164
 
1102
1167
        return $in;
1103
1168
    }
1104
1169
    else {
1105
 
        return \*DATA;
 
1170
        my $dup = Symbol::gensym();
 
1171
        open $dup, "<&DATA" or die "Can't dup DATA: $!";
 
1172
        seek $dup, $DATA_pos, 0; # rewind to the beginning
 
1173
        return $dup; # so we don't close DATA
1106
1174
    }
1107
1175
}
1108
1176
 
1121
1189
        }
1122
1190
 
1123
1191
        if ($vars->{proxyssl_url}) {
 
1192
            $vars->{minclients}++;
1124
1193
            $vars->{maxclients}++;
1125
1194
        }
1126
1195
    }
1127
1196
}
1128
1197
 
 
1198
sub extra_conf_files_needing_update {
 
1199
    my $self = shift;
 
1200
 
 
1201
    my @need_update = ();
 
1202
    finddepth(sub {
 
1203
        return unless /\.in$/;
 
1204
        (my $generated = $File::Find::name) =~ s/\.in$//;
 
1205
        push @need_update, $generated 
 
1206
            unless -e $generated && -M $generated < -M $File::Find::name;
 
1207
    }, $self->{vars}->{t_conf});
 
1208
 
 
1209
    return @need_update;
 
1210
}
 
1211
 
1129
1212
sub generate_extra_conf {
1130
1213
    my $self = shift;
1131
1214
 
1147
1230
    }
1148
1231
 
1149
1232
    for my $file (@conf_files) {
1150
 
        local $Apache::TestConfig::File = $file;
1151
 
 
1152
1233
        (my $generated = $file) =~ s/\.in$//;
 
1234
        debug "Will 'Include' $generated config file";
1153
1235
        push @extra_conf, $generated;
1154
 
 
1155
 
        debug "Including $generated config file";
1156
 
 
1157
 
        next if -e $generated
1158
 
            && -M $generated < -M $file;
1159
 
 
1160
 
        my $in = Symbol::gensym();
1161
 
        open($in, $file) or next;
1162
 
 
1163
 
        my $out = $self->genfile($generated, $file);
1164
 
        $self->replace_vars($in, $out);
1165
 
 
1166
 
        close $in;
1167
 
        close $out;
1168
 
 
1169
 
        $self->check_vars;
 
1236
    }
 
1237
 
 
1238
    # if at least one .in file was modified or the derivative is
 
1239
    # missing, regenerate them all (so information like assigned port
 
1240
    # numbers will be correct)
 
1241
    if ($self->extra_conf_files_needing_update) {
 
1242
        for my $file (@conf_files) {
 
1243
            local $Apache::TestConfig::File = $file;
 
1244
 
 
1245
            my $in = Symbol::gensym();
 
1246
            open($in, $file) or next;
 
1247
 
 
1248
            (my $generated = $file) =~ s/\.in$//;
 
1249
            my $out = $self->genfile($generated, $file);
 
1250
            $self->replace_vars($in, $out);
 
1251
 
 
1252
            close $in;
 
1253
            close $out;
 
1254
 
 
1255
            $self->check_vars;
 
1256
        }
1170
1257
    }
1171
1258
 
1172
1259
    #we changed order to give ssl the first port after DEFAULT_PORT
1264
1351
    $self->generate_index_html;
1265
1352
 
1266
1353
    $self->gendir($vars->{t_logs});
 
1354
    $self->gendir($vars->{t_conf});
1267
1355
 
1268
1356
    my @very_last_postamble = ();
1269
1357
    if (my $extra_conf = $self->generate_extra_conf) {
1352
1440
    my @reasons = ();
1353
1441
    my $vars = $self->{vars};
1354
1442
 
 
1443
    # if '-port select' we need to check from scratch which ports are
 
1444
    # available
1355
1445
    if (my $port = $conf_opts->{port} || $Apache::TestConfig::Argv{port}) {
1356
 
        push @reasons, "'-port $port' requires reconfiguration";
 
1446
        if ($port eq 'select') {
 
1447
            push @reasons, "'-port $port' requires reconfiguration";
 
1448
        }
1357
1449
    }
1358
1450
 
1359
 
    my $exe = $vars->{apxs} || $vars->{httpd};
 
1451
    my $exe = $vars->{apxs} || $vars->{httpd} || '';
1360
1452
    # if httpd.conf is older than executable
1361
 
    push @reasons, 
 
1453
    push @reasons,
1362
1454
        "$exe is newer than $vars->{t_conf_file}"
1363
1455
            if -e $exe && 
1364
1456
               -e $vars->{t_conf_file} &&
1365
1457
               -M $exe < -M $vars->{t_conf_file};
1366
1458
 
1367
 
    # if .in files are newer than their derived versions
1368
 
    if (my $extra_conf = $self->generate_extra_conf) {
1369
 
        for my $file (@$extra_conf) {
1370
 
            push @reasons, "$file.in is newer than $file"
1371
 
                if -e $file && -M "$file.in" < -M $file;
 
1459
    # any .in files are newer than their derived versions?
 
1460
    if (my @files = $self->extra_conf_files_needing_update) {
 
1461
        # invalidate the vhosts cache, since a different port could be
 
1462
        # assigned on reparse
 
1463
        $self->{vhosts} = {};
 
1464
        for my $file (@files) {
 
1465
            push @reasons, "$file.in is newer than $file";
 
1466
        }
 
1467
    }
 
1468
 
 
1469
    # if special env variables are used (since they can change any time)
 
1470
    # XXX: may be we could check whether they have changed since the
 
1471
    # last run and thus avoid the reconfiguration?
 
1472
    {
 
1473
        my $passenv = passenv();
 
1474
        if (my @env_vars = grep { $ENV{$_} } keys %$passenv) {
 
1475
            push @reasons, "environment variables (@env_vars) are set";
1372
1476
        }
1373
1477
    }
1374
1478
 
1408
1512
 
1409
1513
    return undef unless $program;
1410
1514
 
1411
 
    my @results = ();
1412
 
 
1413
1515
    for my $base (map { catfile($_, $program) } File::Spec->path()) {
1414
1516
        if ($ENV{HOME} and not WIN32) {
1415
1517
            # only works on Unix, but that's normal:
1417
1519
            $base =~ s/~/$ENV{HOME}/o;
1418
1520
        }
1419
1521
 
1420
 
        return $base if -x $base;
 
1522
        return $base if -x $base && -f _;
1421
1523
 
1422
1524
        if (WIN32) {
1423
1525
            for my $ext (@path_ext) {
1424
 
                return "$base.$ext" if -x "$base.$ext";
 
1526
                return "$base.$ext" if -x "$base.$ext" && -f _;
1425
1527
            }
1426
1528
        }
1427
1529
    }
1431
1533
    my($self, $q, $ok_fail) = @_;
1432
1534
    return unless $self->{APXS};
1433
1535
    my $devnull = devnull();
1434
 
    my $val = qx($self->{APXS} -q $q 2>$devnull);
 
1536
    my $apxs = shell_ready($self->{APXS});
 
1537
    my $val = qx($apxs -q $q 2>$devnull);
1435
1538
    chomp $val if defined $val; # apxs post-2.0.40 adds a new line
1436
1539
    unless ($val) {
1437
1540
        if ($ok_fail) {
1553
1656
    # httpd opts
1554
1657
    my $test_config = Apache::TestConfig->new({thaw=>1});
1555
1658
    if (my $httpd = $test_config->{vars}->{httpd}) {
 
1659
        $httpd = shell_ready($httpd);
1556
1660
        $command = "$httpd -V";
1557
1661
        $cfg .= "\n*** $command\n";
1558
1662
        $cfg .= qx{$command};
1561
1665
    }
1562
1666
 
1563
1667
    # perl opts
1564
 
    my $perl = $^X;
 
1668
    my $perl = shell_ready($^X);
1565
1669
    $command = "$perl -V";
1566
1670
    $cfg .= "\n\n*** $command\n";
1567
1671
    $cfg .= qx{$command};
1569
1673
    return $cfg;
1570
1674
}
1571
1675
 
 
1676
# make a string suitable for feed to shell calls (wrap in quotes and
 
1677
# escape quotes)
 
1678
sub shell_ready {
 
1679
    my $arg = shift;
 
1680
    $arg =~ s/"/\"/g;
 
1681
    return qq["$arg"];
 
1682
}
 
1683
 
1572
1684
1;
1573
1685
 
1574
1686
=head1 NAME
1717
1829
 
1718
1830
 
1719
1831
__DATA__
1720
 
Listen     @Port@
 
1832
Listen     0.0.0.0:@Port@
1721
1833
 
1722
1834
ServerRoot   "@ServerRoot@"
1723
1835
DocumentRoot "@DocumentRoot@"
1744
1856
 
1745
1857
<IfModule @THREAD_MODULE@>
1746
1858
    StartServers         1
 
1859
    MinSpareThreads      @MinClients@
 
1860
    MaxSpareThreads      @MinClients@
 
1861
    ThreadsPerChild      @MinClients@
1747
1862
    MaxClients           @MaxClients@
1748
 
    MinSpareThreads      @MaxClients@
1749
 
    MaxSpareThreads      @MaxClients@
1750
 
    ThreadsPerChild      @MaxClients@
1751
1863
    MaxRequestsPerChild  0
1752
1864
</IfModule>
1753
1865
 
1754
1866
<IfModule perchild.c>
1755
1867
    NumServers           1
1756
 
    StartThreads         @MaxClients@
1757
 
    MinSpareThreads      @MaxClients@
1758
 
    MaxSpareThreads      @MaxClients@
 
1868
    StartThreads         @MinClients@
 
1869
    MinSpareThreads      @MinClients@
 
1870
    MaxSpareThreads      @MinClients@
1759
1871
    MaxThreadsPerChild   @MaxClients@
1760
1872
    MaxRequestsPerChild  0
1761
1873
</IfModule>
1762
1874
 
1763
1875
<IfModule prefork.c>
1764
 
    StartServers         1
 
1876
    StartServers         @MinClients@
 
1877
    MinSpareServers      @MinClients@
 
1878
    MaxSpareServers      @MinClients@
1765
1879
    MaxClients           @MaxClients@
1766
1880
    MaxRequestsPerChild  0
1767
1881
</IfModule>
1768
1882
 
1769
1883
<IfDefine APACHE1>
1770
 
    StartServers         1
 
1884
    StartServers         @MinClients@
 
1885
    MinSpareServers      @MinClients@
 
1886
    MaxSpareServers      @MinClients@
1771
1887
    MaxClients           @MaxClients@
1772
1888
    MaxRequestsPerChild  0
1773
1889
</IfDefine>