summaryrefslogtreecommitdiffstats
path: root/debian/perl-framework/Apache-Test/lib/Apache
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-07 02:04:07 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-05-07 02:04:07 +0000
commit1221c736f9a90756d47ea6d28320b6b83602dd2a (patch)
treeb453ba7b1393205258c9b098a773b4330984672f /debian/perl-framework/Apache-Test/lib/Apache
parentAdding upstream version 2.4.38. (diff)
downloadapache2-1221c736f9a90756d47ea6d28320b6b83602dd2a.tar.xz
apache2-1221c736f9a90756d47ea6d28320b6b83602dd2a.zip
Adding debian version 2.4.38-3+deb10u8.debian/2.4.38-3+deb10u8
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'debian/perl-framework/Apache-Test/lib/Apache')
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/Test.pm1214
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/Test5005compat.pm85
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestBuild.pm699
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestClient.pm203
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestCommon.pm109
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestCommonPost.pm199
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestConfig.pm2253
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestConfigC.pm492
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestConfigPHP.pm781
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestConfigParrot.pm92
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestConfigParse.pm558
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm654
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestHandler.pm175
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestHarness.pm199
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestHarnessPHP.pm139
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestMB.pm410
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestMM.pm258
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestPerlDB.pm53
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestReport.pm181
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestReportPerl.pm40
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm1258
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestRun.pm1220
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestRunPHP.pm332
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestRunParrot.pm68
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestRunPerl.pm139
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestSSLCA.pm593
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestServer.pm724
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestSmoke.pm949
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestSmokePerl.pm34
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm76
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestTrace.pm256
-rw-r--r--debian/perl-framework/Apache-Test/lib/Apache/TestUtil.pm989
32 files changed, 15432 insertions, 0 deletions
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/Test.pm b/debian/perl-framework/Apache-Test/lib/Apache/Test.pm
new file mode 100644
index 0000000..e748c83
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/Test.pm
@@ -0,0 +1,1214 @@
+# 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::Test;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Exporter ();
+use Config;
+use Apache::TestConfig ();
+use Test qw/ok skip/;
+
+BEGIN {
+ # Apache::Test loads a bunch of mp2 stuff while getting itself
+ # together. because we need to choose one of mp1 or mp2 to load
+ # check first (and we choose mp2) $mod_perl::VERSION == 2.0
+ # just because someone loaded Apache::Test. This Is Bad. so,
+ # let's try to correct for that here by removing mod_perl from
+ # %INC after the above use() statements settle in. nobody
+ # should be relying on us loading up mod_perl.pm anyway...
+
+ delete $INC{'mod_perl.pm'};
+}
+
+use vars qw(@ISA @EXPORT %EXPORT_TAGS $VERSION %SubTests @SkipReasons);
+
+$VERSION = '1.41';
+
+my @need = qw(need_lwp need_http11 need_cgi need_access need_auth
+ need_module need_apache need_min_apache_version need_min_apache_fix
+ need_apache_version need_perl need_min_perl_version
+ need_min_module_version need_threads need_fork need_apache_mpm
+ need_php need_php4 need_ssl need_imagemap need_cache_disk);
+
+my @have = map { (my $need = $_) =~ s/need/have/; $need } @need;
+
+@ISA = qw(Exporter);
+@EXPORT = (qw(sok plan skip_reason under_construction need),
+ @need, @have);
+
+%SubTests = ();
+@SkipReasons = ();
+
+sub cp {
+ my @l;
+ for( my $i=1; (@l=caller $i)[0] eq __PACKAGE__; $i++ ) {};
+ return wantarray ? @l : $l[0];
+}
+
+my $Config;
+my %wtm;
+sub import {
+ my $class=$_[0];
+ my $wtm=0;
+ my @base_exp;
+ my @exp;
+ my %my_exports;
+ undef @my_exports{@EXPORT};
+
+ my ($caller,$f,$l)=cp;
+
+ for( my $i=1; $i<@_; $i++ ) {
+ if( $_[$i] eq '-withtestmore' ) {
+ $wtm=1;
+ }
+ elsif( $_[$i] eq ':DEFAULT' ) {
+ push @exp, $_[$i];
+ push @base_exp, $_[$i];
+ }
+ elsif( $_[$i] eq '!:DEFAULT' ) {
+ push @exp, $_[$i];
+ push @base_exp, $_[$i];
+ }
+ elsif( $_[$i]=~m@^[:/!]@ ) {
+ warn("Ignoring import spec $_[$i] ".
+ "at $f line $l\n")
+ }
+ elsif( exists $my_exports{$_[$i]} ) {
+ push @exp, $_[$i];
+ }
+ else {
+ push @base_exp, $_[$i];
+ }
+ }
+ if (!@exp and @base_exp) {
+ @exp=('!:DEFAULT');
+ }
+ elsif (@exp and !@base_exp) {
+ @base_exp=('!:DEFAULT');
+ }
+
+ $wtm{$caller}=[$wtm,$f,$l] unless exists $wtm{$caller};
+
+ warn("Ignoring -withtestmore due to a previous call ".
+ "($wtm{$caller}->[1]:$wtm{$caller}->[2]) without it ".
+ "at $f line $l\n")
+ if $wtm{$caller}->[0]==0 and $wtm==1;
+
+ $class->export_to_level(1, $class, @exp);
+
+ push @base_exp, '!plan';
+ if( $wtm{$caller}->[0] ) { # -withtestmore
+ eval <<"EVAL"
+package $caller;
+#line $l $f
+use Test::More import=>\\\@base_exp;
+EVAL
+ }
+ else { # -withouttestmore
+ eval <<"EVAL";
+package $caller;
+#line $l $f
+use Test \@base_exp;
+EVAL
+ }
+ die $@ if $@;
+}
+
+sub config {
+ $Config ||= Apache::TestConfig->thaw->httpd_config;
+}
+
+my $Basic_config;
+
+# config bits which doesn't require httpd to be found
+sub basic_config {
+ $Basic_config ||= Apache::TestConfig->thaw();
+}
+
+sub vars {
+ @_ ? @{ config()->{vars} }{ @_ } : config()->{vars};
+}
+
+sub sok (&;$) {
+ my $sub = shift;
+ my $nok = shift || 1; #allow sok to have 'ok' within
+
+ my ($caller,$f,$l)=cp;
+
+ if (exists $wtm{$caller} and $wtm{$caller}->[0]==1) { # -withtestmore
+ require Test::Builder;
+ my $tb=Test::Builder->new;
+
+ if (%SubTests and not $SubTests{ 1+$tb->current_test }) {
+ $tb->skip("skipping this subtest") for (1..$nok);
+ return;
+ }
+
+ # trick ok() into reporting the caller filename/line when a
+ # sub-test fails in sok()
+ return eval <<EOE;
+#line $l $f
+ Test::More::ok(\$sub->());
+EOE
+ }
+ else {
+ if (%SubTests and not $SubTests{ $Test::ntest }) {
+ skip("skipping this subtest", 0) for (1..$nok);
+ return;
+ }
+
+ # trick ok() into reporting the caller filename/line when a
+ # sub-test fails in sok()
+ return eval <<EOE;
+#line $l $f
+ Test::ok(\$sub->());
+EOE
+ }
+}
+
+#so Perl's Test.pm can be run inside mod_perl
+sub test_pm_refresh {
+ my ($caller,$f,$l)=cp;
+
+ if (exists $wtm{$caller} and $wtm{$caller}->[0]==1) { # -withtestmore
+ require Test::Builder;
+ my $builder = Test::Builder->new;
+
+ $builder->reset;
+
+ $builder->output(\*STDOUT);
+ $builder->todo_output(\*STDOUT);
+
+ # this is STDOUT because Test::More seems to put
+ # most of the stuff we want on STDERR, so it ends
+ # up in the error_log instead of where the user can
+ # see it. consider leaving it alone based on
+ # later user reports.
+ $builder->failure_output(\*STDOUT);
+ }
+ else { # -withouttestmore
+ unless (exists $wtm{$caller}) {
+ warn "You forgot to 'use Apache::Test' in package $caller\n";
+ $wtm{$caller}=[0,$f,$l];
+ }
+ if (defined &Test::_reset_globals) {
+ Test::_reset_globals();
+ # Test.pm uses $TESTOUT=*STDOUT{IO}. We cannot do that
+ # due to the way SetupEnv works.
+ $Test::TESTOUT = \*STDOUT;
+ }
+ else {
+ $Test::TESTOUT = \*STDOUT;
+ $Test::planned = 0;
+ $Test::ntest = 1;
+ %Test::todo = ();
+ }
+ }
+}
+
+sub init_test_pm {
+ my $r = shift;
+
+ # needed to load Apache2::RequestRec::TIEHANDLE
+ eval {require Apache2::RequestIO};
+ if (defined &Apache2::RequestRec::TIEHANDLE) {
+ untie *STDOUT;
+ tie *STDOUT, $r;
+ require Apache2::RequestRec; # $r->pool
+ require APR::Pool;
+ $r->pool->cleanup_register(sub { untie *STDOUT });
+ }
+ else {
+ $r->send_http_header; #1.xx
+ }
+
+ $r->content_type('text/plain');
+}
+
+sub plan {
+ init_test_pm(shift) if ref $_[0];
+ test_pm_refresh();
+
+ # extending Test::plan's functionality, by using the optional
+ # single value in @_ coming after a ballanced %hash which
+ # Test::plan expects
+ if (@_ % 2) {
+ my $condition = pop @_;
+ my $ref = ref $condition;
+ my $meets_condition = 0;
+ if ($ref) {
+ if ($ref eq 'CODE') {
+ #plan tests $n, \&has_lwp
+ $meets_condition = $condition->();
+ }
+ elsif ($ref eq 'ARRAY') {
+ #plan tests $n, [qw(php4 rewrite)];
+ $meets_condition = need_module($condition);
+ }
+ else {
+ die "don't know how to handle a condition of type $ref";
+ }
+ }
+ else {
+ # we have the verdict already: true/false
+ $meets_condition = $condition ? 1 : 0;
+ }
+
+ # trying to emulate a dual variable (ala errno)
+ unless ($meets_condition) {
+ my $reason = join ', ',
+ @SkipReasons ? @SkipReasons : "no reason given";
+ print "1..0 # skipped: $reason\n";
+ @SkipReasons = (); # reset
+ exit; #XXX: Apache->exit
+ }
+ }
+ @SkipReasons = (); # reset
+
+ my ($caller,$f,$l)=cp;
+
+ %SubTests=();
+ if (my $subtests=$ENV{HTTPD_TEST_SUBTESTS}) {
+ %SubTests=map { $_, 1 } split /\s+/, $subtests;
+ }
+
+ if (exists $wtm{$caller} and $wtm{$caller}->[0]==1) { # -withtestmore
+ Test::More::plan(@_);
+ }
+ else { # -withouttestmore
+ unless (exists $wtm{$caller}) {
+ warn "You forgot to 'use Apache::Test' in package $caller\n";
+ $wtm{$caller}=[0,$f,$l];
+ }
+ Test::plan(@_);
+ }
+
+ # add to Test.pm verbose output
+ print "# Using Apache/Test.pm version $VERSION\n";
+}
+
+sub need_http11 {
+ require Apache::TestRequest;
+ if (Apache::TestRequest::install_http11()) {
+ return 1;
+ }
+ else {
+ push @SkipReasons,
+ "LWP version 5.60+ required for HTTP/1.1 support";
+ return 0;
+ }
+}
+
+sub need_ssl {
+ my $vars = vars();
+ need_module([$vars->{ssl_module_name}, 'IO::Socket::SSL']);
+}
+
+sub need_lwp {
+ require Apache::TestRequest;
+ if (Apache::TestRequest::has_lwp()) {
+ return 1;
+ }
+ else {
+ push @SkipReasons, "libwww-perl is not installed";
+ return 0;
+ }
+}
+
+sub need {
+ my $need_all = 1;
+ for my $cond (@_) {
+ if (ref $cond eq 'HASH') {
+ while (my($reason, $value) = each %$cond) {
+ $value = $value->() if ref $value eq 'CODE';
+ next if $value;
+ push @SkipReasons, $reason;
+ $need_all = 0;
+ }
+ }
+ elsif ($cond =~ /^(0|1)$/) {
+ $need_all = 0 if $cond == 0;
+ }
+ else {
+ $need_all = 0 unless need_module($cond);
+ }
+ }
+ return $need_all;
+
+}
+
+sub need_module {
+ my $cfg = config();
+
+ my @modules = grep defined $_,
+ ref($_[0]) eq 'ARRAY' ? @{ $_[0] } : @_;
+
+ my @reasons = ();
+ for (@modules) {
+ if (/^[a-z0-9_.]+$/) {
+ my $mod = $_;
+ $mod .= '.c' unless $mod =~ /\.c$/;
+ next if $cfg->{modules}->{$mod};
+ $mod = 'mod_' . $mod unless $mod =~ /^mod_/;
+ next if $cfg->{modules}->{$mod};
+ if (exists $cfg->{cmodules_disabled}->{$mod}) {
+ push @reasons, $cfg->{cmodules_disabled}->{$mod};
+ next;
+ }
+ }
+ die "bogus module name $_" unless /^[\w:.]+$/;
+
+ # if the module was explicitly passed with a .c extension,
+ # do not try to eval it as a Perl module
+ my $not_found = 1;
+ unless (/\.c$/) {
+ eval "require $_";
+ $not_found = 0 unless $@;
+ #print $@ if $@;
+ }
+ push @reasons, "cannot find module '$_'" if $not_found;
+
+ }
+ if (@reasons) {
+ push @SkipReasons, @reasons;
+ return 0;
+ }
+ else {
+ return 1;
+ }
+}
+
+sub need_min_perl_version {
+ my $version = shift;
+
+ return 1 if $] >= $version;
+
+ push @SkipReasons, "perl >= $version is required";
+ return 0;
+}
+
+# currently supports only perl modules
+sub need_min_module_version {
+ my($module, $version) = @_;
+
+ # need_module requires the perl module
+ return 0 unless need_module($module);
+
+ # support dev versions like 0.18_01
+ return 1
+ if eval { no warnings qw(numeric); $module->VERSION($version) };
+
+ push @SkipReasons, "$module version $version or higher is required";
+ return 0;
+}
+
+sub need_cgi {
+ return _need_multi(qw(cgi.c cgid.c));
+}
+
+sub need_cache_disk {
+ return _need_multi(qw(cache_disk.c disk_cache.c));
+}
+
+
+sub need_php {
+ return _need_multi(qw(php4 php5 sapi_apache2.c));
+}
+
+sub need_php4 {
+ return _need_multi(qw(php4 sapi_apache2.c));
+}
+
+sub need_access {
+ return _need_multi(qw(access authz_host));
+}
+
+sub need_auth {
+ return _need_multi(qw(auth auth_basic));
+}
+
+sub need_imagemap {
+ return need_module("imagemap") || need_module("imap");
+}
+
+sub _need_multi {
+
+ my @check = @_;
+
+ my $rc = 0;
+
+ {
+ local @SkipReasons;
+
+ foreach my $module (@check) {
+ $rc ||= need_module($module);
+ }
+ }
+
+ my $reason = join ' or ', @check;
+
+ push @SkipReasons, "cannot find one of $reason"
+ unless $rc;
+
+ return $rc;
+}
+
+sub need_apache {
+ my $version = shift;
+ my $cfg = Apache::Test::config();
+ my $rev = $cfg->{server}->{rev};
+
+ if ($rev == $version) {
+ return 1;
+ }
+ else {
+ push @SkipReasons,
+ "apache version $version required, this is version $rev";
+ return 0;
+ }
+}
+
+sub need_min_apache_version {
+ my $wanted = shift;
+ my $cfg = Apache::Test::config();
+ (my $current) = $cfg->{server}->{version} =~ m:^Apache/(\d\.\d+\.\d+):;
+
+ if (normalize_vstring($current) < normalize_vstring($wanted)) {
+ push @SkipReasons,
+ "apache version $wanted or higher is required," .
+ " this is version $current";
+ return 0;
+ }
+ else {
+ return 1;
+ }
+}
+
+sub need_min_apache_fix {
+ my @wantlevels = @_;
+ my $cfg = Apache::Test::config();
+ (my $current) = $cfg->{server}->{version} =~ m:^Apache/((\d)\.(\d+)\.(\d+)):;
+ my $current_major = $2;
+ my $current_minor = $3;
+ my $current_micro = $4;
+
+ foreach(@wantlevels) {
+ if ($_ =~ m/(\d)\.(\d+)\.(\d+)/) {
+ my $wanted_major = $1;
+ my $wanted_minor = $2;
+ my $wanted_micro = $3;
+ if ($wanted_major eq $current_major && $wanted_minor eq $current_minor) {
+ if ($wanted_micro > $current_micro) {
+ push @SkipReasons,
+ "apache version $_ or higher is required," .
+ " this is version $current";
+ return 0;
+ }
+ else {
+ return 1;
+ }
+ }
+ }
+ }
+
+ # We didn't match major+minor, run the test and let the author sort it out
+ return 1;
+}
+
+sub need_apache_version {
+ my $wanted = shift;
+ my $cfg = Apache::Test::config();
+ (my $current) = $cfg->{server}->{version} =~ m:^Apache/(\d\.\d+\.\d+):;
+
+ if (normalize_vstring($current) != normalize_vstring($wanted)) {
+ push @SkipReasons,
+ "apache version $wanted or higher is required," .
+ " this is version $current";
+ return 0;
+ }
+ else {
+ return 1;
+ }
+}
+
+sub need_apache_mpm {
+ my $wanted = shift;
+ my $cfg = Apache::Test::config();
+ my $current = $cfg->{server}->{mpm};
+
+ if ($current ne $wanted) {
+ push @SkipReasons,
+ "apache $wanted mpm is required," .
+ " this is the $current mpm";
+ return 0;
+ }
+ else {
+ return 1;
+ }
+}
+
+sub config_enabled {
+ my $key = shift;
+ defined $Config{$key} and $Config{$key} eq 'define';
+}
+
+sub need_perl_iolayers {
+ if (my $ext = $Config{extensions}) {
+ #XXX: better test? might need to test patchlevel
+ #if support depends bugs fixed in bleedperl
+ return $ext =~ m:PerlIO/scalar:;
+ }
+ 0;
+}
+
+sub need_perl {
+ my $thing = shift;
+ #XXX: $thing could be a version
+ my $config;
+
+ my $have = \&{"need_perl_$thing"};
+ if (defined &$have) {
+ return 1 if $have->();
+ }
+ else {
+ for my $key ($thing, "use$thing") {
+ if (exists $Config{$key}) {
+ $config = $key;
+ return 1 if config_enabled($key);
+ }
+ }
+ }
+
+ push @SkipReasons, $config ?
+ "Perl was not built with $config enabled" :
+ "$thing is not available with this version of Perl";
+
+ return 0;
+}
+
+sub need_threads {
+ my $status = 1;
+
+ # check APR support
+ my $build_config = Apache::TestConfig->modperl_build_config;
+
+ if ($build_config) {
+ my $apr_config = $build_config->get_apr_config();
+ unless ($apr_config->{HAS_THREADS}) {
+ $status = 0;
+ push @SkipReasons, "Apache/APR was built without threads support";
+ }
+ }
+
+ # check Perl's useithreads
+ my $key = 'useithreads';
+ unless (exists $Config{$key} and config_enabled($key)) {
+ $status = 0;
+ push @SkipReasons, "Perl was not built with 'ithreads' enabled";
+ }
+
+ return $status;
+}
+
+sub need_fork {
+ my $have_fork = $Config{d_fork} ||
+ $Config{d_pseudofork} ||
+ (($^O eq 'MSWin32' || $^O eq 'NetWare') &&
+ $Config{useithreads} &&
+ $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
+
+ if (!$have_fork) {
+ push @SkipReasons, 'The fork function is unimplemented';
+ return 0;
+ }
+ else {
+ return 1;
+ }
+}
+
+sub under_construction {
+ push @SkipReasons, "This test is under construction";
+ return 0;
+}
+
+sub skip_reason {
+ my $reason = shift || 'no reason specified';
+ push @SkipReasons, $reason;
+ return 0;
+}
+
+# normalize Apache-style version strings (2.0.48, 0.9.4)
+# for easy numeric comparison. note that 2.1 and 2.1.0
+# are considered equivalent.
+sub normalize_vstring {
+
+ my @digits = shift =~ m/(\d+)\.?(\d*)\.?(\d*)/;
+
+ return join '', map { sprintf("%03d", $_ || 0) } @digits;
+}
+
+# have_ functions are the same as need_ but they don't populate
+# @SkipReasons
+for my $func (@have) {
+ no strict 'refs';
+ (my $real_func = $func) =~ s/^have_/need_/;
+ *$func = sub {
+ # be nice to poor souls calling functions with $_ argument in
+ # the foreach loop, etc.!
+ local $_;
+ local @SkipReasons;
+ return $real_func->(@_);
+ };
+}
+
+package Apache::TestToString;
+
+Apache::Test->import('!:DEFAULT');
+
+sub TIEHANDLE {
+ my $string = "";
+ bless \$string;
+}
+
+sub PRINT {
+ my $string = shift;
+ $$string .= join '', @_;
+}
+
+sub start {
+ tie *STDOUT, __PACKAGE__;
+ Apache::Test::test_pm_refresh();
+}
+
+sub finish {
+ my $s;
+ {
+ my $o = tied *STDOUT;
+ $s = $$o;
+ }
+ untie *STDOUT;
+ $s;
+}
+
+1;
+__END__
+
+
+=head1 NAME
+
+Apache::Test - Test.pm wrapper with helpers for testing Apache
+
+=head1 SYNOPSIS
+
+ use Apache::Test;
+
+=head1 DESCRIPTION
+
+B<Apache::Test> is a wrapper around the standard C<Test.pm> with
+helpers for testing an Apache server.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item plan
+
+This function is a wrapper around C<Test::plan>:
+
+ plan tests => 3;
+
+just like using Test.pm, plan 3 tests.
+
+If the first argument is an object, such as an C<Apache::RequestRec>
+object, C<STDOUT> will be tied to it. The C<Test.pm> global state will
+also be refreshed by calling C<Apache::Test::test_pm_refresh>. For
+example:
+
+ plan $r, tests => 7;
+
+ties STDOUT to the request object C<$r>.
+
+If there is a last argument that doesn't belong to C<Test::plan>
+(which expects a balanced hash), it's used to decide whether to
+continue with the test or to skip it all-together. This last argument
+can be:
+
+=over
+
+=item * a C<SCALAR>
+
+the test is skipped if the scalar has a false value. For example:
+
+ plan tests => 5, 0;
+
+But this won't hint the reason for skipping therefore it's better to
+use need():
+
+ plan tests => 5,
+ need 'LWP',
+ { "not Win32" => sub { $^O eq 'MSWin32'} };
+
+see C<need()> for more info.
+
+=item * an C<ARRAY> reference
+
+need_module() is called for each value in this array. The test is
+skipped if need_module() returns false (which happens when at least
+one C or Perl module from the list cannot be found).
+
+Watch out for case insensitive file systems or duplicate modules
+with the same name. I.E. If you mean mod_env.c
+ need_module('mod_env.c')
+Not
+ need_module('env')
+
+=item * a C<CODE> reference
+
+the tests will be skipped if the function returns a false value. For
+example:
+
+ plan tests => 5, need_lwp;
+
+the test will be skipped if LWP is not available
+
+=back
+
+All other arguments are passed through to I<Test::plan> as is.
+
+=item ok
+
+Same as I<Test::ok>, see I<Test.pm> documentation.
+
+=item sok
+
+Allows to skip a sub-test, controlled from the command line. The
+argument to sok() is a CODE reference or a BLOCK whose return value
+will be passed to ok(). By default behaves like ok(). If all sub-tests
+of the same test are written using sok(), and a test is executed as:
+
+ % ./t/TEST -v skip_subtest 1 3
+
+only sub-tests 1 and 3 will be run, the rest will be skipped.
+
+=item skip
+
+Same as I<Test::skip>, see I<Test.pm> documentation.
+
+=item test_pm_refresh
+
+Normally called by I<Apache::Test::plan>, this function will refresh
+the global state maintained by I<Test.pm>, allowing C<plan> and
+friends to be called more than once per-process. This function is not
+exported.
+
+=back
+
+Functions that can be used as a last argument to the extended plan().
+Note that for each C<need_*> function there is a C<have_*> equivalent
+that performs the exact same function except that it is designed to
+be used outside of C<plan()>. C<need_*> functions have the side effect
+of generating skip messages, if the test is skipped. C<have_*> functions
+don't have this side effect. In other words, use C<need_apache()>
+with C<plan()> to decide whether a test will run, but C<have_apache()>
+within test logic to adjust expectations based on older or newer
+server versions.
+
+=over
+
+=item need_http11
+
+ plan tests => 5, need_http11;
+
+Require HTTP/1.1 support.
+
+=item need_ssl
+
+ plan tests => 5, need_ssl;
+
+Require SSL support.
+
+Not exported by default.
+
+=item need_lwp
+
+ plan tests => 5, need_lwp;
+
+Require LWP support.
+
+=item need_cgi
+
+ plan tests => 5, need_cgi;
+
+Requires mod_cgi or mod_cgid to be installed.
+
+=item need_cache_disk
+
+ plan tests => 5, need_cache_disk
+
+Requires mod_cache_disk or mod_disk_cache to be installed.
+
+
+=item need_php
+
+ plan tests => 5, need_php;
+
+Requires a PHP module to be installed (version 4 or 5).
+
+=item need_php4
+
+ plan tests => 5, need_php4;
+
+Requires a PHP version 4 module to be installed.
+
+=item need_imagemap
+
+ plan tests => 5, need_imagemap;
+
+Requires a mod_imagemap or mod_imap be installed
+
+=item need_apache
+
+ plan tests => 5, need_apache 2;
+
+Requires Apache 2nd generation httpd-2.x.xx
+
+ plan tests => 5, need_apache 1;
+
+Requires Apache 1st generation (apache-1.3.xx)
+
+See also C<need_min_apache_version()>.
+
+=item need_min_apache_version
+
+Used to require a minimum version of Apache.
+
+For example:
+
+ plan tests => 5, need_min_apache_version("2.0.40");
+
+requires Apache 2.0.40 or higher.
+
+=item need_apache_version
+
+Used to require a specific version of Apache.
+
+For example:
+
+ plan tests => 5, need_apache_version("2.0.40");
+
+requires Apache 2.0.40.
+
+=item need_min_apache_fix
+
+Used to require a particular micro version from corresponding minor release
+
+For example:
+
+ plan tests => 5, need_min_apache_fix("2.0.40", "2.2.30", "2.4.18");
+
+requires Apache 2.0.40 or higher.
+
+=item need_apache_mpm
+
+Used to require a specific Apache Multi-Processing Module.
+
+For example:
+
+ plan tests => 5, need_apache_mpm('prefork');
+
+requires the prefork MPM.
+
+=item need_perl
+
+ plan tests => 5, need_perl 'iolayers';
+ plan tests => 5, need_perl 'ithreads';
+
+Requires a perl extension to be present, or perl compiled with certain
+capabilities.
+
+The first example tests whether C<PerlIO> is available, the second
+whether:
+
+ $Config{useithread} eq 'define';
+
+=item need_min_perl_version
+
+Used to require a minimum version of Perl.
+
+For example:
+
+ plan tests => 5, need_min_perl_version("5.008001");
+
+requires Perl 5.8.1 or higher.
+
+=item need_fork
+
+Requires the perl built-in function C<fork> to be implemented.
+
+=item need_module
+
+ plan tests => 5, need_module 'CGI';
+ plan tests => 5, need_module qw(CGI Find::File);
+ plan tests => 5, need_module ['CGI', 'Find::File', 'cgid'];
+
+Requires Apache C and Perl modules. The function accept a list of
+arguments or a reference to a list.
+
+In case of C modules, depending on how the module name was passed it
+may pass through the following completions:
+
+=over
+
+=item 1 need_module 'proxy_http.c'
+
+If there is the I<.c> extension, the module name will be looked up as
+is, i.e. I<'proxy_http.c'>.
+
+=item 2 need_module 'mod_cgi'
+
+The I<.c> extension will be appended before the lookup, turning it into
+I<'mod_cgi.c'>.
+
+=item 3 need_module 'cgi'
+
+The I<.c> extension and I<mod_> prefix will be added before the
+lookup, turning it into I<'mod_cgi.c'>.
+
+=back
+
+=item need_min_module_version
+
+Used to require a minimum version of a module
+
+For example:
+
+ plan tests => 5, need_min_module_version(CGI => 2.81);
+
+requires C<CGI.pm> version 2.81 or higher.
+
+Currently works only for perl modules.
+
+=item need
+
+ plan tests => 5,
+ need 'LWP',
+ { "perl >= 5.8.0 and w/ithreads is required" =>
+ ($Config{useperlio} && $] >= 5.008) },
+ { "not Win32" => sub { $^O eq 'MSWin32' },
+ "foo is disabled" => \&is_foo_enabled,
+ },
+ 'cgid';
+
+need() is more generic function which can impose multiple requirements
+at once. All requirements must be satisfied.
+
+need()'s argument is a list of things to test. The list can include
+scalars, which are passed to need_module(), and hash references. If
+hash references are used, the keys, are strings, containing a reason
+for a failure to satisfy this particular entry, the values are the
+condition, which are satisfaction if they return true. If the value is
+0 or 1, it used to decide whether the requirements very satisfied, so
+you can mix special C<need_*()> functions that return 0 or 1. For
+example:
+
+ plan tests => 1, need 'Compress::Zlib', 'deflate',
+ need_min_apache_version("2.0.49");
+
+If the scalar value is a string, different from 0 or 1, it's passed to
+I<need_module()>. If the value is a code reference, it gets executed
+at the time of check and its return value is used to check the
+condition. If the condition check fails, the provided (in a key)
+reason is used to tell user why the test was skipped.
+
+In the presented example, we require the presence of the C<LWP> Perl
+module, C<mod_cgid>, that we run under perl E<gt>= 5.7.3 on Win32.
+
+It's possible to put more than one requirement into a single hash
+reference, but be careful that the keys will be different.
+
+It's also important to mention to avoid using:
+
+ plan tests => 1, requirement1 && requirement2;
+
+technique. While test-wise that technique is equivalent to:
+
+ plan tests => 1, need requirement1, requirement2;
+
+since the test will be skipped, unless all the rules are satisfied,
+it's not equivalent for the end users. The second technique, deploying
+C<need()> and a list of requirements, always runs all the requirement
+checks and reports all the missing requirements. In the case of the
+first technique, if the first requirement fails, the second is not
+run, and the missing requirement is not reported. So let's say all the
+requirements are missing Apache modules, and a user wants to satisfy
+all of these and run the test suite again. If all the unsatisfied
+requirements are reported at once, she will need to rebuild Apache
+once. If only one requirement is reported at a time, she will have to
+rebuild Apache as many times as there are elements in the C<&&>
+statement.
+
+Also see plan().
+
+=item under_construction
+
+ plan tests => 5, under_construction;
+
+skip all tests, noting that the tests are under construction
+
+=item skip_reason
+
+ plan tests => 5, skip_reason('my custom reason');
+
+skip all tests. the reason you specify will be given at runtime.
+if no reason is given a default reason will be used.
+
+=back
+
+=head1 Additional Configuration Variables
+
+=over 4
+
+=item basic_config
+
+ my $basic_cfg = Apache::Test::basic_config();
+ $basic_cfg->write_perlscript($file, $content);
+
+C<basic_config()> is similar to C<config()>, but doesn't contain any
+httpd-specific information and should be used for operations that
+don't require any httpd-specific knowledge.
+
+=item config
+
+ my $cfg = Apache::Test::config();
+ my $server_rev = $cfg->{server}->{rev};
+ ...
+
+C<config()> gives an access to the configuration object.
+
+=item vars
+
+ my $serverroot = Apache::Test::vars->{serverroot};
+ my $serverroot = Apache::Test::vars('serverroot');
+ my($top_dir, $t_dir) = Apache::Test::vars(qw(top_dir t_dir));
+
+C<vars()> gives an access to the configuration variables, otherwise
+accessible as:
+
+ $vars = Apache::Test::config()->{vars};
+
+If no arguments are passed, the reference to the variables hash is
+returned. If one or more arguments are passed the corresponding values
+are returned.
+
+=back
+
+=head1 Test::More Integration
+
+There are a few caveats if you want to use I<Apache::Test> with
+I<Test::More> instead of the default I<Test> backend. The first is
+that I<Test::More> requires you to use its own C<plan()> function
+and not the one that ships with I<Apache::Test>. I<Test::More> also
+defines C<ok()> and C<skip()> functions that are different, and
+simply C<use>ing both modules in your test script will lead to redefined
+warnings for these subroutines.
+
+To assist I<Test::More> users we have created a special I<Apache::Test>
+import tag, C<:withtestmore>, which will export all of the standard
+I<Apache::Test> symbols into your namespace except the ones that collide
+with I<Test::More>.
+
+ use Apache::Test qw(:withtestmore);
+ use Test::More;
+
+ plan tests => 1; # Test::More::plan()
+
+ ok ('yes', 'testing ok'); # Test::More::ok()
+
+Now, while this works fine for standard client-side tests
+(such as C<t/basic.t>), the more advanced features of I<Apache::Test>
+require using I<Test::More> as the sole driver behind the scenes.
+
+Should you choose to use I<Test::More> as the backend for
+server-based tests (such as C<t/response/TestMe/basic.pm>) you will
+need to use the C<-withtestmore> action tag:
+
+ use Apache::Test qw(-withtestmore);
+
+ sub handler {
+
+ my $r = shift;
+
+ plan $r, tests => 1; # Test::More::plan() with
+ # Apache::Test features
+
+ ok ('yes', 'testing ok'); # Test::More::ok()
+ }
+
+C<-withtestmore> tells I<Apache::Test> to use I<Test::More>
+instead of I<Test.pm> behind the scenes. Note that you are not
+required to C<use Test::More> yourself with the C<-withtestmore>
+option and that the C<use Test::More tests =E<gt> 1> syntax
+may have unexpected results.
+
+Note that I<Test::More> version 0.49, available within the
+I<Test::Simple> 0.49 distribution on CPAN, or greater is required
+to use this feature.
+
+Because I<Apache:Test> was initially developed using I<Test> as
+the framework driver, complete I<Test::More> integration is
+considered experimental at this time - it is supported as best as
+possible but is not guaranteed to be as stable as the default I<Test>
+interface at this time.
+
+=head1 Apache::TestToString Class
+
+The I<Apache::TestToString> class is used to capture I<Test.pm> output
+into a string. Example:
+
+ Apache::TestToString->start;
+
+ plan tests => 4;
+
+ ok $data eq 'foo';
+
+ ...
+
+ # $tests will contain the Test.pm output: 1..4\nok 1\n...
+ my $tests = Apache::TestToString->finish;
+
+=head1 SEE ALSO
+
+The Apache-Test tutorial:
+L<http://perl.apache.org/docs/general/testing/testing.html>.
+
+L<Apache::TestRequest|Apache::TestRequest> subclasses LWP::UserAgent and
+exports a number of useful functions for sending request to the Apache test
+server. You can then test the results of those requests.
+
+Use L<Apache::TestMM|Apache::TestMM> in your F<Makefile.PL> to set up your
+distribution for testing.
+
+=head1 AUTHOR
+
+Doug MacEachern with contributions from Geoffrey Young, Philippe
+M. Chiasson, Stas Bekman and others.
+
+Questions can be asked at the test-dev <at> httpd.apache.org list
+For more information see: http://httpd.apache.org/test/.
+
+=cut
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/Test5005compat.pm b/debian/perl-framework/Apache-Test/lib/Apache/Test5005compat.pm
new file mode 100644
index 0000000..8f59a88
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/Test5005compat.pm
@@ -0,0 +1,85 @@
+# 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::Test5005compat;
+
+use strict;
+use Symbol ();
+use File::Basename;
+use File::Path;
+
+$Apache::Test5005compat::VERSION = '0.01';
+
+my %compat_files = (
+ 'lib/warnings.pm' => \&warnings_pm,
+);
+
+sub import {
+ if ($] >= 5.006) {
+ #make sure old compat stubs dont wipe out installed versions
+ unlink for keys %compat_files;
+ return;
+ }
+
+ eval { require File::Spec::Functions; } or
+ die "this is only Perl $], you need to install File-Spec from CPAN";
+
+ my $min_version = 0.82;
+ unless ($File::Spec::VERSION >= $min_version) {
+ die "you need to install File-Spec-$min_version or higher from CPAN";
+ }
+
+ while (my($file, $sub) = each %compat_files) {
+ $sub->($file);
+ }
+}
+
+sub open_file {
+ my $file = shift;
+
+ unless (-d 'lib') {
+ $file = "Apache-Test/$file";
+ }
+
+ my $dir = dirname $file;
+
+ unless (-d $dir) {
+ mkpath([$dir], 0, 0755);
+ }
+
+ my $fh = Symbol::gensym();
+ print "creating $file\n";
+ open $fh, ">$file" or die "open $file: $!";
+
+ return $fh;
+}
+
+sub warnings_pm {
+ return if eval { require warnings };
+
+ my $fh = open_file(shift);
+
+ print $fh <<'EOF';
+package warnings;
+
+sub import {}
+
+1;
+EOF
+
+ close $fh;
+}
+
+1;
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestBuild.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestBuild.pm
new file mode 100644
index 0000000..f0004e6
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestBuild.pm
@@ -0,0 +1,699 @@
+# 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::TestBuild;
+
+use strict;
+use warnings FATAL => 'all';
+
+use subs qw(system chdir
+ info warning);
+
+use Config;
+use File::Spec::Functions;
+use File::Path ();
+use Cwd ();
+
+use constant DRYRUN => 0;
+
+my @min_modules = qw(access auth log-config env mime setenvif
+ mime autoindex dir alias);
+
+my %shared_modules = (
+ min => join(' ', @min_modules),
+);
+
+my %configs = (
+ all => {
+ 'apache-1.3' => [],
+ 'httpd-2.0' => enable20(qw(modules=all proxy)),
+ },
+ most => {
+ 'apache-1.3' => [],
+ 'httpd-2.0' => enable20(qw(modules=most)),
+ },
+ min => {
+ 'apache-1.3' => [],
+ 'httpd-2.0' => enable20(@min_modules),
+ },
+ exp => {
+ 'apache-1.3' => [],
+ 'httpd-2.0' => enable20(qw(example case_filter
+ case_filter_in cache
+ echo deflate bucketeer)),
+ },
+);
+
+my %builds = (
+ default => {
+ cflags => '-Wall',
+ config => {
+ 'apache-1.3' => [],
+ 'httpd-2.0' => [],
+ },
+ },
+ debug => {
+ cflags => '-g',
+ config => {
+ 'apache-1.3' => [],
+ 'httpd-2.0' => [qw(--enable-maintainer-mode)],
+ },
+ },
+ prof => {
+ cflags => '-pg -DGPROF',
+ },
+ shared => {
+ config => {
+ 'apache-1.3' => [],
+ 'httpd-2.0' => enable20_shared('all'),
+ },
+ },
+ mostshared => {
+ config => {
+ 'apache-1.3' => [],
+ 'httpd-2.0' => enable20_shared('most'),
+ },
+ },
+ minshared => {
+ config => {
+ 'apache-1.3' => [],
+ 'httpd-2.0' => enable20_shared('min'),
+ },
+ },
+ static => {
+ },
+);
+
+my %mpms = (
+ default => [qw(prefork worker)],
+ MSWin32 => [qw(winnt)],
+);
+
+my @cvs = qw(httpd-2.0 apache-1.3);
+
+my @dirs = qw(build tar src install);
+
+sub enable20 {
+ [ map { "--enable-$_" } @_ ];
+}
+
+sub enable20_shared {
+ my $name = shift;
+ my $modules = $shared_modules{$name} || $name;
+ enable20(qq(mods-shared="$modules"));
+}
+
+sub default_mpms {
+ $mpms{ $^O } || $mpms{'default'};
+}
+
+sub default_dir {
+ my($self, $dir) = @_;
+ $self->{$dir} ||= catdir $self->{prefix}, $dir,
+}
+
+sub new {
+ my $class = shift;
+
+ #XXX: not generating a BUILD script yet
+ #this way we can run:
+ #perl Apache-Test/lib/Apache/TestBuild.pm --cvsroot=anon --foo=...
+
+ require Apache::TestConfig;
+ require Apache::TestTrace;
+ Apache::TestTrace->import;
+
+ my $self = bless {
+ prefix => '/usr/local/apache',
+ cwd => Cwd::cwd(),
+ cvsroot => 'cvs.apache.org:/home/cvs',
+ cvs => \@cvs,
+ cvstag => "",
+ ssldir => "",
+ mpms => default_mpms(),
+ make => $Config{make},
+ builds => {},
+ name => "",
+ extra_config => {
+ 'httpd-2.0' => [],
+ },
+ @_,
+ }, $class;
+
+ #XXX
+ if (my $c = $self->{extra_config}->{'2.0'}) {
+ $self->{extra_config}->{'httpd-2.0'} = $c;
+ }
+
+ for my $dir (@dirs) {
+ $self->default_dir($dir);
+ }
+
+ if ($self->{ssldir}) {
+ push @{ $self->{extra_config}->{'httpd-2.0'} },
+ '--enable-ssl', "--with-ssl=$self->{ssldir}";
+ }
+
+ $self;
+}
+
+sub init {
+ my $self = shift;
+
+ for my $dir (@dirs) {
+ mkpath($self->{$dir});
+ }
+}
+
+use subs qw(symlink unlink);
+use File::Basename;
+use File::Find;
+
+sub symlink_tree {
+ my $self = shift;
+
+ my $httpd = 'httpd';
+ my $install = "$self->{install}/bin/$httpd";
+ my $source = "$self->{build}/.libs/$httpd";
+
+ unlink $install;
+ symlink $source, $install;
+
+ my %dir = (apr => 'apr',
+ aprutil => 'apr-util');
+
+ for my $libname (qw(apr aprutil)) {
+ my $lib = "lib$libname.so.0.0.0";
+ my $install = "$self->{install}/lib/$lib";
+ my $source = "$self->{build}/srclib/$dir{$libname}/.libs/$lib";
+
+ unlink $install;
+ symlink $source, $install;
+ }
+
+ $install = "$self->{install}/modules";
+ $source = "$self->{build}/modules";
+
+ for (<$install/*.so>) {
+ unlink $_;
+ }
+
+ finddepth(sub {
+ return unless /\.so$/;
+ my $file = "$File::Find::dir/$_";
+ symlink $file, "$install/$_";
+ }, $source);
+}
+
+sub unlink {
+ my $file = shift;
+
+ if (-e $file) {
+ print "unlink $file\n";
+ }
+ else {
+ print "$file does not exist\n";
+ }
+ CORE::unlink($file);
+}
+
+sub symlink {
+ my($from, $to) = @_;
+ print "symlink $from => $to\n";
+ unless (-e $from) {
+ print "source $from does not exist\n";
+ }
+ my $base = dirname $to;
+ unless (-e $base) {
+ print "target dir $base does not exist\n";
+ }
+ CORE::symlink($from, $to) or die $!;
+}
+
+sub cvs {
+ my $self = shift;
+
+ my $cmd = "cvs -d $self->{cvsroot} @_";
+
+ if (DRYRUN) {
+ info "$cmd";
+ }
+ else {
+ system $cmd;
+ }
+}
+
+my %cvs_names = (
+ '2.0' => 'httpd-2.0',
+ '1.3' => 'apache-1.3',
+);
+
+my %cvs_snames = (
+ '2.0' => 'httpd',
+ '1.3' => 'apache',
+);
+
+sub cvs_up {
+ my($self, $version) = @_;
+
+ my $name = $cvs_names{$version};
+
+ my $dir = $self->srcdir($version);
+
+ if ($self->{cvsroot} eq 'anon') {
+ $self->{cvsroot} = ':pserver:anoncvs@cvs.apache.org:/home/cvspublic';
+ unless (-d $dir) {
+ #XXX do something better than doesn't require prompt if
+ #we already have an entry in ~/.cvspass
+ #$self->cvs('login');
+
+ warning "may need to run the following command ",
+ "(password is 'anoncvs')";
+ warning "cvs -d $self->{cvsroot} login";
+ }
+ }
+
+ if (-d $dir) {
+ chdir $dir;
+ $self->cvs(up => "-dP $self->{cvstag}");
+ return;
+ }
+
+ my $co = checkout($name);
+ $self->$co($name, $dir);
+
+ my $post = post_checkout($name);
+ $self->$post($name, $dir);
+}
+
+sub checkout_httpd_2_0 {
+ my($self, $name, $dir) = @_;
+
+ my $tag = $self->{cvstag};
+
+ $self->cvs(co => "-d $dir $tag $name");
+ chdir "$dir/srclib";
+ $self->cvs(co => "$tag apr apr-util");
+}
+
+sub checkout_apache_1_3 {
+ my($self, $name, $dir) = @_;
+
+ $self->cvs(co => "-d $dir $self->{cvstag} $name");
+}
+
+sub post_checkout_httpd_2_0 {
+ my($self, $name, $dir) = @_;
+}
+
+sub post_checkout_apache_1_3 {
+}
+
+sub canon {
+ my $name = shift;
+ return $name unless $name;
+ $name =~ s/[.-]/_/g;
+ $name;
+}
+
+sub checkout {
+ my $name = canon(shift);
+ \&{"checkout_$name"};
+}
+
+sub post_checkout {
+ my $name = canon(shift);
+ \&{"post_checkout_$name"};
+}
+
+sub cvs_update {
+ my $self = shift;
+
+ my $cvs = shift || $self->{cvs};
+
+ chdir $self->{src};
+
+ for my $name (@$cvs) {
+ $self->cvs_up($name);
+ }
+}
+
+sub merge_build {
+ my($self, $version, $builds, $configs) = @_;
+
+ my $b = {
+ cflags => $builds{default}->{cflags},
+ config => [ @{ $builds{default}->{config}->{$version} } ],
+ };
+
+ for my $name (@$builds) {
+ next if $name eq 'default'; #already have this
+
+ if (my $flags = $builds{$name}->{cflags}) {
+ $b->{cflags} .= " $flags";
+ }
+ if (my $cfg = $builds{$name}->{config}) {
+ if (my $vcfg = $cfg->{$version}) {
+ push @{ $b->{config} }, @$vcfg;
+ }
+ }
+ }
+
+ for my $name (@$configs) {
+ my $cfg = $configs{$name}->{$version};
+ next unless $cfg;
+ push @{ $b->{config} }, @$cfg;
+ }
+
+ if (my $ex = $self->{extra_config}->{$version}) {
+ push @{ $b->{config} }, @$ex;
+ }
+
+ if (my $ex = $self->{extra_cflags}->{$version}) {
+ $b->{config} .= " $ex";
+ }
+
+ $b;
+}
+
+my @srclib_dirs = qw(
+ apr apr-util apr-util/xml/expat pcre
+);
+
+sub install_name {
+ my($self, $builds, $configs, $mpm) = @_;
+
+ return $self->{name} if $self->{name};
+
+ my $name = join '-', $mpm, @$builds, @$configs;
+
+ if (my $tag = $self->cvs_name) {
+ $name .= "-$tag";
+ }
+
+ $name;
+}
+
+#currently the httpd-2.0 build does not properly support static linking
+#of ssl libs, force the issue
+sub add_ssl_libs {
+ my $self = shift;
+
+ my $ssldir = $self->{ssldir};
+
+ return unless $ssldir and -d $ssldir;
+
+ my $name = $self->{current_install_name};
+
+ my $ssl_mod = "$name/modules/ssl";
+ info "editing $ssl_mod/modules.mk";
+
+ if (DRYRUN) {
+ return;
+ }
+
+ my $ssl_mk = "$self->{build}/$ssl_mod/modules.mk";
+
+ open my $fh, $ssl_mk or die "open $ssl_mk: $!";
+ my @lines = <$fh>;
+ close $fh;
+
+ for (@lines) {
+ next unless /SH_LINK/;
+ chomp;
+ $_ .= " -L$ssldir -lssl -lcrypto\n";
+ info 'added ssl libs';
+ last;
+ }
+
+ open $fh, '>', $ssl_mk or die $!;
+ print $fh join "\n", @lines;
+ close $fh;
+}
+
+sub cvs_name {
+ my $self = shift;
+
+ if (my $tag = $self->{cvstag}) {
+ $tag =~ s/^-[DAr]//;
+ $tag =~ s/\"//g;
+ $tag =~ s,[/ :],_,g; #-D"03/29/02 07:00pm"
+ return $tag;
+ }
+
+ return "";
+}
+
+sub srcdir {
+ my($self, $src) = @_;
+
+ my $prefix = "";
+ if ($src =~ s/^(apache|httpd)-//) {
+ $prefix = $1;
+ }
+ else {
+ $prefix = $cvs_snames{$src};
+ }
+
+ if ($src =~ /^\d\.\d$/) {
+ #release version will be \d\.\d\.\d+
+ if (my $tag = $self->cvs_name) {
+ $src .= "-$tag";
+ }
+ $src .= '-cvs';
+ }
+
+ join '-', $prefix, $src;
+}
+
+sub configure_httpd_2_0 {
+ my($self, $src, $builds, $configs, $mpm) = @_;
+
+ $src = $self->srcdir($src);
+
+ chdir $self->{build};
+
+ my $name = $self->install_name($builds, $configs, $mpm);
+
+ $self->{current_install_name} = $name;
+
+ $self->{builds}->{$name} = 1;
+
+ if ($self->{fresh}) {
+ rmtree($name);
+ }
+ else {
+ if (-e "$name/.DONE") {
+ warning "$name already configured";
+ warning "rm $name/.DONE to force";
+ return;
+ }
+ }
+
+ my $build = $self->merge_build('httpd-2.0', $builds, $configs);
+
+ $ENV{CFLAGS} = $build->{cflags};
+ info "CFLAGS=$ENV{CFLAGS}";
+
+ my $prefix = "$self->{install}/$name";
+
+ rmtree($prefix) if $self->{fresh};
+
+ my $source = "$self->{src}/$src";
+
+ my @args = ("--prefix=$prefix",
+ "--with-mpm=$mpm",
+ "--srcdir=$source",
+ @{ $build->{config} });
+
+ chdir $source;
+ system "./buildconf";
+
+ my $cmd = "$source/configure @args";
+
+ chdir $self->{build};
+
+ mkpath($name);
+ chdir $name;
+
+ for my $dir (@srclib_dirs) {
+ mkpath("srclib/$dir");
+ }
+
+ for my $dir (qw(build docs/conf)) {
+ mkpath($dir);
+ }
+
+ system $cmd;
+
+ open FH, ">.DONE" or die "open .DONE: $!";
+ print FH scalar localtime;
+ close FH;
+
+ chdir $self->{prefix};
+
+ $self->add_ssl_libs;
+}
+
+sub make {
+ my($self, @cmds) = @_;
+
+ push @cmds, 'all' unless @cmds;
+
+ for my $name (keys %{ $self->{builds} }) {
+ chdir "$self->{build}/$name";
+ for my $cmd (@cmds) {
+ system "$self->{make} $cmd";
+ }
+ }
+}
+
+sub system {
+ my $cmd = "@_";
+
+ info $cmd;
+ return if DRYRUN;
+
+ unless (CORE::system($cmd) == 0) {
+ my $status = $? >> 8;
+ die "system $cmd failed (exit status=$status)";
+ }
+}
+
+sub chdir {
+ my $dir = shift;
+ info "chdir $dir";
+ CORE::chdir $dir;
+}
+
+sub mkpath {
+ my $dir = shift;
+
+ return if -d $dir;
+ info "mkpath $dir";
+
+ return if DRYRUN;
+ File::Path::mkpath([$dir], 1, 0755);
+}
+
+sub rmtree {
+ my $dir = shift;
+
+ return unless -d $dir;
+ info "rmtree $dir";
+
+ return if DRYRUN;
+ File::Path::rmtree([$dir], 1, 1);
+}
+
+sub generate_script {
+ my($class, $file) = @_;
+
+ $file ||= catfile 't', 'BUILD';
+
+ my $content = join '', <DATA>;
+
+ Apache::Test::basic_config()->write_perlscript($file, $content);
+}
+
+unless (caller) {
+ $INC{'Apache/TestBuild.pm'} = __FILE__;
+ eval join '', <DATA>;
+ die $@ if $@;
+}
+
+1;
+__DATA__
+use strict;
+use warnings FATAL => 'all';
+
+use lib qw(Apache-Test/lib);
+use Apache::TestBuild ();
+use Getopt::Long qw(GetOptions);
+use Cwd ();
+
+my %options = (
+ prefix => "checkout/build/install prefix",
+ ssldir => "enable ssl with given directory",
+ cvstag => "checkout with given cvs tag",
+ cvsroot => "use 'anon' for anonymous cvs",
+ version => "apache version (e.g. '2.0')",
+ mpms => "MPMs to build (e.g. 'prefork')",
+ flavor => "build flavor (e.g. 'debug shared')",
+ modules => "enable modules (e.g. 'all exp')",
+ name => "change name of the build/install directory",
+);
+
+my %opts;
+
+Getopt::Long::Configure(qw(pass_through));
+#XXX: could be smarter here, being lazy for the moment
+GetOptions(\%opts, map "$_=s", sort keys %options);
+
+if (@ARGV) {
+ print "passing extra args to configure: @ARGV\n";
+}
+
+my $home = $ENV{HOME};
+
+$opts{prefix} ||= join '/', Cwd::cwd(), 'farm';
+#$opts{ssldir} ||= '';
+#$opts{cvstag} ||= '';
+#$opts{cvsroot} ||= '';
+$opts{version} ||= '2.0';
+$opts{mpms} ||= 'prefork';
+$opts{flavor} ||= 'debug-shared';
+$opts{modules} ||= 'all-exp';
+
+#my @versions = qw(2.0);
+
+#my @mpms = qw(prefork worker perchild);
+
+#my @flavors = ([qw(debug shared)], [qw(prof shared)],
+# [qw(debug static)], [qw(prof static)]);
+
+#my @modules = ([qw(all exp)]);
+
+my $split = sub { split '-', delete $opts{ $_[0] } };
+
+my @versions = $opts{version};
+
+my @mpms = $split->('mpms');
+
+my @flavors = ([ $split->('flavor') ]);
+
+my @modules = ([ $split->('modules') ]);
+
+my $tb = Apache::TestBuild->new(fresh => 1,
+ %opts,
+ extra_config => {
+ $opts{version} => \@ARGV,
+ });
+
+$tb->init;
+
+for my $version (@versions) {
+ $tb->cvs_update([ $version ]);
+
+ for my $mpm (@mpms) {
+ for my $flavor (@flavors) {
+ for my $mods (@modules) {
+ $tb->configure_httpd_2_0($version, $flavor,
+ $mods, $mpm);
+ $tb->make(qw(all install));
+ }
+ }
+ }
+}
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestClient.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestClient.pm
new file mode 100644
index 0000000..bd2d328
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestClient.pm
@@ -0,0 +1,203 @@
+# 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::TestClient;
+
+#this module provides some fallback for when libwww-perl is not installed
+#it is by no means an LWP replacement, just enough for very simple requests
+
+#this module does not and will never support certain features such as:
+#file upload, http/1.1 (byteranges, keepalive, etc.), following redirects,
+#authentication, GET body callbacks, SSL, etc.
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestRequest ();
+
+my $CRLF = "\015\012";
+
+sub request {
+ my($method, $url, @headers) = @_;
+
+ my @real_headers = ();
+ my $content;
+
+ for (my $i = 0; $i < scalar @headers; $i += 2) {
+ if ($headers[$i] =~ /^content$/i) {
+ $content = $headers[$i+1];
+ }
+ else {
+ push @real_headers, ($headers[$i], $headers[$i+1]);
+ }
+ }
+
+ ## XXX:
+ ## This is not a FULL URL encode mapping
+ ## space ' '; however is very common, so this
+ ## is useful to convert
+ $url =~ s/ /%20/g;
+
+ my $config = Apache::Test::config();
+
+ $method ||= 'GET';
+ $url ||= '/';
+ my %headers = ();
+
+ my $hostport = Apache::TestRequest::hostport($config);
+ $headers{Host} = (split ':', $hostport)[0];
+
+ my $s = Apache::TestRequest::vhost_socket();
+
+ unless ($s) {
+ warn "cannot connect to $hostport: $!";
+ return undef;
+ }
+
+ if ($content) {
+ $headers{'Content-Length'} ||= length $content;
+ $headers{'Content-Type'} ||= 'application/x-www-form-urlencoded';
+ }
+
+ #for modules/setenvif
+ $headers{'User-Agent'} ||= 'libwww-perl/0.00';
+
+ my $request = join $CRLF,
+ "$method $url HTTP/1.0",
+ (map { "$_: $headers{$_}" } keys %headers);
+
+ $request .= $CRLF;
+
+ for (my $i = 0; $i < scalar @real_headers; $i += 2) {
+ $request .= "$real_headers[$i]: $real_headers[$i+1]$CRLF";
+ }
+
+ $request .= $CRLF;
+
+ # using send() avoids the need to use SIGPIPE if the server aborts
+ # the connection
+ $s->send($request);
+ $s->send($content) if $content;
+
+ $request =~ s/\015//g; #for as_string
+
+ my $res = {
+ request => (bless {
+ headers_as_string => $request,
+ content => $content || '',
+ }, 'Apache::TestClientRequest'),
+ headers_as_string => '',
+ method => $method,
+ code => -1, # unknown
+ };
+
+ my($response_line, $header_term);
+ my $eol = "\015?\012";
+
+ local $_;
+
+ while (<$s>) {
+ $res->{headers_as_string} .= $_;
+ if (m:^(HTTP/\d+\.\d+)[ \t]+(\d+)[ \t]*(.*?)$eol:io) {
+ $res->{protocol} = $1;
+ $res->{code} = $2;
+ $res->{message} = $3;
+ $response_line = 1;
+ }
+ elsif (/^([a-zA-Z0-9_\-]+)\s*:\s*(.*?)$eol/o) {
+ $res->{headers}->{lc $1} = $2;
+ }
+ elsif (/^$eol$/o) {
+ $header_term = 1;
+ last;
+ }
+ }
+
+ unless ($response_line and $header_term) {
+ warn "malformed response";
+ }
+
+ {
+ local $/;
+ $res->{content} = <$s>;
+ }
+ close $s;
+
+ # an empty body is a valid response
+ $res->{content} = ''
+ unless exists $res->{content} and defined $res->{content};
+
+ $res->{headers_as_string} =~ s/\015//g; #for as_string
+
+ bless $res, 'Apache::TestClientResponse';
+}
+
+for my $method (qw(GET HEAD POST PUT)) {
+ no strict 'refs';
+ *$method = sub {
+ my $url = shift;
+ request($method, $url, @_);
+ };
+}
+
+package Apache::TestClientResponse;
+
+sub header {
+ my($self, $key) = @_;
+ $self->{headers}->{lc $key};
+}
+
+my @headers = qw(Last-Modified Content-Type);
+
+for my $header (@headers) {
+ no strict 'refs';
+ (my $method = lc $header) =~ s/-/_/g;
+ *$method = sub { shift->{headers}->{lc $header} };
+}
+
+sub is_success {
+ my $code = shift->{code};
+ return 0 unless defined $code && $code;
+ $code >= 200 && $code < 300;
+}
+
+sub status_line {
+ my $self = shift;
+ "$self->{code} $self->{message}";
+}
+
+sub as_string {
+ my $self = shift;
+ $self->{headers_as_string} . ($self->{content} || '');
+}
+
+my @methods = qw(
+request protocol code message method
+headers_as_string headers content
+);
+
+for my $method (@methods) {
+ no strict 'refs';
+ *$method = sub {
+ my($self, $val) = @_;
+ $self->{$method} = $val if $val;
+ $self->{$method};
+ };
+}
+
+#inherit headers_as_string, as_string, protocol, content, etc. methods
+@Apache::TestClientRequest::ISA = qw(Apache::TestClientResponse);
+
+1;
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestCommon.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestCommon.pm
new file mode 100644
index 0000000..e65d1d3
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestCommon.pm
@@ -0,0 +1,109 @@
+# 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::TestCommon;
+
+use strict;
+use warnings FATAL => 'all';
+
+use File::Basename;
+
+use Apache::Test;
+use Apache::TestRequest;
+use Apache::TestUtil;
+use Apache::TestCommonPost ();
+
+#this module contains common tests that are called from different .t files
+
+#t/apache/passbrigade.t
+#t/apache/rwrite.t
+
+sub run_write_test {
+ my $module = shift;
+
+ #1k..9k, 10k..50k, 100k, 300k, 500k, 2Mb, 4Mb, 6Mb, 10Mb
+ my @sizes = (1..9, 10..50, 100, 300, 500, 2000, 4000, 6000, 10_000);
+ my @buff_sizes = (1024, 8192);
+
+ plan tests => @sizes * @buff_sizes, [$module, 'LWP'];
+
+ my $location = "/$module";
+ my $ua = Apache::TestRequest::user_agent();
+
+ for my $buff_size (@buff_sizes) {
+ for my $size (@sizes) {
+ my $length = $size * 1024;
+ my $received = 0;
+
+ $ua->do_request(GET => "$location?$buff_size,$length",
+ sub {
+ my($chunk, $res) = @_;
+ $received += length $chunk;
+ });
+
+ ok t_cmp($length, $received, 'bytes in body');
+ }
+ }
+}
+
+sub run_files_test {
+ my($verify, $skip_other) = @_;
+
+ my $vars = Apache::Test::vars();
+ my $perlpod = $vars->{perlpod};
+
+ my %pod = (
+ files => [],
+ num => 0,
+ url => '/getfiles-perl-pod',
+ dir => "",
+ );
+
+ if (-d $perlpod) {
+ my @files = map { basename $_ } <$perlpod/*.pod>;
+ $pod{files} = \@files;
+ $pod{num} = scalar @files;
+ $pod{dir} = $perlpod;
+ }
+ else {
+ push @Apache::Test::SkipReasons,
+ "dir $vars->{perlpod} does not exist";
+ }
+
+ my %other_files = ();
+
+ unless ($skip_other) { #allow to skip the large binary files
+ %other_files = map {
+ ("/getfiles-binary-$_", $vars->{$_})
+ } qw(httpd perl);
+ }
+
+ my $tests = $pod{num} + keys(%other_files);
+
+ plan tests => $tests, sub { $pod{num} and have_lwp() };
+
+ my $ua = Apache::TestRequest::user_agent();
+
+ for my $file (@{ $pod{files} }) {
+ $verify->($ua, "$pod{url}/$file", "$pod{dir}/$file");
+ }
+
+ for my $url (sort keys %other_files) {
+ $verify->($ua, $url, $other_files{$url});
+ }
+}
+
+1;
+__END__
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestCommonPost.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestCommonPost.pm
new file mode 100644
index 0000000..dda2b31
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestCommonPost.pm
@@ -0,0 +1,199 @@
+# 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::TestCommonPost;
+
+use strict;
+use warnings FATAL => 'all';
+
+use constant POST_HUGE => $ENV{APACHE_TEST_POST_HUGE} || 0;
+
+use Apache::TestRequest ();
+use Apache::TestUtil qw(t_cmp t_debug);
+use Apache::Test qw(sok);
+
+BEGIN {
+ my $use_inline = 0;
+
+ eval {
+ #if Inline.pm and libcurl are available
+ #we can make this test about 3x faster,
+ #after the inlined code is compiled that is.
+ require Inline;
+ Inline->import(C => 'DATA', LIBS => ['-lcurl'],
+ #CLEAN_AFTER_BUILD => 0,
+ PREFIX => 'aptest_post_');
+ *request_init = \&curl_init;
+ *request_do = \&curl_do;
+ $use_inline = 1;
+ } if POST_HUGE;
+
+ if (POST_HUGE) {
+ if ($@) {
+ t_debug "tests will run faster with Inline and curl installed";
+ print $@;
+ }
+ else {
+ t_debug "using Inline and curl client";
+ }
+ }
+
+ unless ($use_inline) {
+ t_debug "using LWP client";
+ #fallback to lwp
+ *request_init = \&lwp_init;
+ *request_do = \&lwp_do;
+ }
+}
+
+sub lwp_init {
+ use vars qw($UA $Location);
+ $UA = Apache::TestRequest::user_agent();
+ $Location = shift;
+}
+
+sub lwp_do {
+ my $length = shift;
+
+ my $request = HTTP::Request->new(POST => $Location);
+ $request->header('Content-length' => $length);
+
+ if (LWP->VERSION >= 5.800) {
+ $request->content_ref(\('a' x $length));
+ } else {
+ # before LWP 5.800 there was no way to tell HTTP::Message not
+ # to copy the string, there is a settable content_ref since
+ # 5.800
+ use constant BUF_SIZE => 8192;
+
+ my $remain = $length;
+ my $content = sub {
+ my $bytes = $remain < BUF_SIZE ? $remain : BUF_SIZE;
+ my $buf = 'a' x $bytes;
+ $remain -= $bytes;
+ $buf;
+ };
+
+ $request->content($content);
+ }
+
+
+
+ my $response = $UA->request($request);
+
+ Apache::TestRequest::lwp_trace($response);
+
+ return $response->content;
+}
+
+my @run_post_test_small_sizes =
+ #1k..9k, 10k..50k, 100k
+ (1..9, 10..50, 100);
+
+my @run_post_test_sizes = @run_post_test_small_sizes;
+
+if (POST_HUGE) {
+ push @run_post_test_sizes,
+ #300k, 500k, 2Mb, 4Mb, 6Mb, 10Mb
+ 300, 500, 2000, 4000, 6000, 10_000;
+}
+
+sub Apache::TestCommon::run_post_test_sizes { @run_post_test_sizes }
+
+sub Apache::TestCommon::run_post_test {
+ my $module = shift;
+ my $sizes = shift || \@run_post_test_sizes;
+
+ my $location = Apache::TestRequest::resolve_url("/$module");
+
+ request_init($location);
+
+ for my $size (@$sizes) {
+ sok {
+ my $length = ($size * 1024);
+
+ my $str = request_do($length);
+ chomp $str;
+
+ t_cmp($length, $str, "length posted");
+ };
+ }
+}
+
+1;
+__DATA__
+
+__C__
+
+#include <curl/curl.h>
+#include <curl/easy.h>
+
+static CURL *curl = NULL;
+static SV *response = (SV *)NULL;
+static long total = 0;
+
+static size_t my_curl_read(char *buffer, size_t size,
+ size_t nitems, void *data)
+{
+ size_t bytes = nitems < total ? nitems : total;
+ memset(buffer, 'a', bytes);
+ total -= bytes;
+ return bytes;
+}
+
+static size_t my_curl_write(char *buffer, size_t size,
+ size_t nitems, void *data)
+{
+ sv_catpvn(response, buffer, nitems);
+ return nitems;
+}
+
+void aptest_post_curl_init(char *url)
+{
+ char *proto = "HTTP/1.1"; /* curl default */
+ curl = curl_easy_init();
+ curl_easy_setopt(curl, CURLOPT_MUTE, 1);
+ curl_easy_setopt(curl, CURLOPT_URL, url);
+ curl_easy_setopt(curl, CURLOPT_CUSTOMREQUEST, "POST");
+ curl_easy_setopt(curl, CURLOPT_UPLOAD, 1);
+ curl_easy_setopt(curl, CURLOPT_READFUNCTION, my_curl_read);
+ curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, my_curl_write);
+ if (!getenv("APACHE_TEST_HTTP11")) {
+ curl_easy_setopt(curl, CURLOPT_HTTP_VERSION, CURL_HTTP_VERSION_1_0);
+ proto = "HTTP/1.0";
+ }
+ fprintf(stdout, "#CURL using protocol %s\n", proto);
+ fflush(stdout);
+ response = newSV(0);
+}
+
+SV *aptest_post_curl_do(long len)
+{
+ sv_setpv(response, "");
+ total = len;
+ curl_easy_setopt(curl, CURLOPT_INFILESIZE, len);
+ curl_easy_perform(curl);
+ return SvREFCNT_inc(response);
+}
+
+void aptest_post_END(void)
+{
+ if (response) {
+ SvREFCNT_dec(response);
+ }
+ if (curl) {
+ curl_easy_cleanup(curl);
+ }
+}
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..ad0b02c
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestConfig.pm
@@ -0,0 +1,2253 @@
+# 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_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)',
+ 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_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})) {
+ require Apache::TestSSLCA;
+
+ $vars->{sslproto} = Apache::TestSSLCA::sslproto();
+ }
+ else {
+ $vars->{sslproto} ||= 'all';
+ }
+
+ $vars->{t_logs} ||= catfile $vars->{serverroot}, 'logs';
+ $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->{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};
+ }
+
+ # for threaded mpms MaxClients must be a multiple of
+ # ThreadsPerChild (i.e. maxclients % minclients == 0)
+ # so unless -maxclients was explicitly specified use a double of
+ # minclients
+ $vars->{maxclientsthreadedmpm} =
+ $vars->{maxclients_preset} || $vars->{minclients} * 2;
+
+ $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->{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}++;
+ }
+ }
+ }
+}
+
+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_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>
+</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 1
+ MinSpareThreads @MinClients@
+ MaxSpareThreads @MinClients@
+ ThreadsPerChild @MinClients@
+ 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 @MinClients@
+ MaxSpareThreads @MinClients@
+ 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 @MinClients@
+ MaxSpareServers @MinClients@
+ MaxClients @MaxClients@
+ MaxRequestsPerChild 0
+</IfModule>
+
+<IfDefine APACHE1>
+ LockFile @t_logs@/accept.lock
+ StartServers @MinClients@
+ MinSpareServers @MinClients@
+ MaxSpareServers @MinClients@
+ 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>
+
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestConfigC.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestConfigC.pm
new file mode 100644
index 0000000..c9d8fd1
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestConfigC.pm
@@ -0,0 +1,492 @@
+# 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; #not TestConfigC on purpose
+
+use strict;
+use warnings FATAL => 'all';
+
+use Config;
+use Apache::TestConfig ();
+use Apache::TestConfigPerl ();
+use Apache::TestTrace;
+use File::Find qw(finddepth);
+
+sub cmodule_find {
+ my($self, $mod) = @_;
+
+ return unless $mod =~ /^mod_(\w+)\.c$/;
+ my $sym = $1;
+
+ my $dir = $File::Find::dir;
+ my $file = catfile $dir, $mod;
+
+ unless ($self->{APXS}) {
+ $self->{cmodules_disabled}->{$mod} = "no apxs configured";
+ return;
+ }
+
+ my $fh = Symbol::gensym();
+ open $fh, $file or die "open $file: $!";
+ my $v = <$fh>;
+ if ($v =~ /^\#define\s+HTTPD_TEST_REQUIRE_APACHE\s+(\d+)\s*$/) {
+ #define HTTPD_TEST_REQUIRE_APACHE 1
+ unless ($self->{server}->{rev} == $1) {
+ my $reason = "requires Apache version $1";
+ $self->{cmodules_disabled}->{$mod} = $reason;
+ notice "$mod $reason, skipping.";
+ return;
+ }
+ }
+ elsif ($v =~ /^\#define\s+HTTPD_TEST_REQUIRE_APACHE\s+(\d\.\d+(\.\d+)?)/) {
+ #define HTTPD_TEST_REQUIRE_APACHE 2.1
+ my $wanted = $1;
+ (my $current) = $self->{server}->{version} =~ m:^Apache/(\d\.\d+\.\d+):;
+
+ if (Apache::Test::normalize_vstring($current) <
+ Apache::Test::normalize_vstring($wanted)) {
+ my $reason = "requires Apache version $wanted";
+ $self->{cmodules_disabled}->{$mod} = $reason;
+ notice "$mod $reason, skipping.";
+ return;
+ }
+ }
+ close $fh;
+
+ push @{ $self->{cmodules} }, {
+ name => "mod_$sym",
+ sym => "${sym}_module",
+ dir => $dir,
+ subdir => basename $dir,
+ };
+}
+
+sub cmodules_configure {
+ my($self, $dir) = @_;
+
+ $self->{cmodules_disabled} = {}; #for have_module to check
+
+ $dir ||= catfile $self->{vars}->{top_dir}, 'c-modules';
+
+ unless (-d $dir) {
+ return;
+ }
+
+ $self->{cmodules_dir} = $dir;
+
+ finddepth(sub { cmodule_find($self, $_) }, $dir);
+
+ unless ($self->{APXS}) {
+ warning "cannot build c-modules without apxs";
+ return;
+ }
+
+ $self->cmodules_generate_include;
+ $self->cmodules_write_makefiles;
+ $self->cmodules_compile;
+ $self->cmodules_httpd_conf;
+}
+
+sub cmodules_makefile_vars {
+ return <<EOF;
+MAKE = $Config{make}
+EOF
+}
+
+my %lib_dir = Apache::TestConfig::WIN32
+ ? (1 => "", 2 => "")
+ : (1 => "", 2 => ".libs/");
+
+sub cmodules_build_so {
+ my($self, $name) = @_;
+ $name = "mod_$name" unless $name =~ /^mod_/;
+ my $libdir = $self->server->version_of(\%lib_dir);
+ my $lib = "$libdir$name.so";
+}
+
+sub cmodules_write_makefiles {
+ my $self = shift;
+
+ my $modules = $self->{cmodules};
+
+ for (@$modules) {
+ $self->cmodules_write_makefile($_);
+ }
+
+ my $file = catfile $self->{cmodules_dir}, 'Makefile';
+ my $fh = $self->genfile($file);
+
+ print $fh $self->cmodules_makefile_vars;
+
+ my @dirs = map { $_->{subdir} } @$modules;
+
+ my @targets = qw(clean);
+ my @libs;
+
+ for my $dir (@dirs) {
+ for my $targ (@targets) {
+ print $fh "$dir-$targ:\n\tcd $dir && \$(MAKE) $targ\n\n";
+ }
+
+ my $lib = $self->cmodules_build_so($dir);
+ my $cfile = "$dir/mod_$dir.c";
+ push @libs, "$dir/$lib";
+ print $fh "$libs[-1]: $cfile\n\tcd $dir && \$(MAKE) $lib\n\n";
+ }
+
+ for my $targ (@targets) {
+ print $fh "$targ: ", (map { "$_-$targ " } @dirs), "\n\n";
+ }
+
+ print $fh "all: @libs\n\n";
+
+ close $fh or die "close $file: $!";
+}
+
+sub cmodules_write_makefile {
+ my ($self, $mod) = @_;
+ my $write = \&{"cmodules_write_makefile_$^O"};
+ $write = \&cmodules_write_makefile_default unless defined &$write;
+ $write->($self, $mod);
+}
+
+sub cmodules_write_makefile_default {
+ my($self, $mod) = @_;
+
+ my $dversion = $self->server->dversion;
+ my $name = $mod->{name};
+ my $makefile = catfile $mod->{dir}, 'Makefile';
+
+ my $extra = $ENV{EXTRA_CFLAGS} || '';
+
+ debug "writing $makefile";
+
+ my $lib = $self->cmodules_build_so($name);
+
+ my $fh = $self->genfile($makefile);
+
+ print $fh <<EOF;
+APXS=$self->{APXS}
+all: $lib
+
+$lib: $name.c
+ \$(APXS) $dversion $extra -I$self->{cmodules_dir} -c $name.c
+
+clean:
+ -rm -rf $name.o $name.lo $name.slo $name.la $name.i $name.s $name.gcno .libs
+EOF
+
+ close $fh or die "close $makefile: $!";
+}
+
+sub cmodules_write_makefile_aix {
+ my($self, $mod) = @_;
+
+ my $dversion = $self->server->dversion;
+ my $name = $mod->{name};
+ my $makefile = catfile $mod->{dir}, 'Makefile';
+ my $apxsflags = '';
+
+ #
+ # Only do this for Apache 1.*
+ #
+ if ($self->server->{rev} == 1) {
+ $apxsflags = "-Wl,-bE:$name.exp";
+ my $expfile = catfile $mod->{dir}, "$name.exp";
+ if (! -f $expfile) {
+ my $fh = Symbol::gensym();
+ $name =~ /^mod_(\w+)(?:\.c)?$/;
+ my $sym = $1 . '_module';
+ open $fh, ">$expfile" or die "open $expfile: $!";
+ print $fh "$sym\n";
+ close $fh;
+ }
+ }
+
+ my $extra = $ENV{EXTRA_CFLAGS} || '';
+
+ debug "writing $makefile";
+
+ my $lib = $self->cmodules_build_so($name);
+
+ my $fh = Symbol::gensym();
+ open $fh, ">$makefile" or die "open $makefile: $!";
+
+ print $fh <<EOF;
+APXS=$self->{APXS}
+APXSFLAGS=$apxsflags
+all: $lib
+
+$lib: $name.c
+ \$(APXS) $dversion $extra -I$self->{cmodules_dir} \$(APXSFLAGS) -c $name.c
+
+clean:
+ -rm -rf $name.o $name.lo $name.slo $name.la .libs
+EOF
+
+ close $fh or die "close $makefile: $!";
+}
+
+sub cmodules_write_makefile_MSWin32 {
+ my($self, $mod) = @_;
+
+ my $dversion = $self->server->dversion;
+ my $name = $mod->{name};
+ my $makefile = "$mod->{dir}/Makefile";
+ debug "writing $makefile";
+ my $extras = '';
+
+ my $lib = $self->cmodules_build_so($name);
+ $extras = ' -llibhttpd -p ' if ($self->server->{rev} != 1);
+ my $goners = join ' ', (map {$name . '.' . $_} qw(exp lib so lo));
+
+ my $fh = Symbol::gensym();
+ open $fh, ">$makefile" or die "open $makefile: $!";
+
+ my $extra = $ENV{EXTRA_CFLAGS} || '';
+
+ debug "writing $makefile";
+
+ print $fh <<EOF;
+APXS=$self->{APXS}
+all: $lib
+
+$lib: $name.c
+ \$(APXS) $dversion $extra -I$self->{cmodules_dir} $extras -c $name.c
+
+clean:
+ -erase $goners
+EOF
+
+ close $fh or die "close $makefile: $!";
+}
+
+sub cmodules_make {
+ my $self = shift;
+ my $targ = shift || 'all';
+
+ my $cmd = "cd $self->{cmodules_dir} && $Config{make} $targ";
+ debug $cmd;
+ system $cmd;
+ if ($?) {
+ die "Failed to build c-modules";
+ }
+}
+
+sub cmodules_compile {
+ shift->cmodules_make('all');
+}
+
+sub cmodules_httpd_conf {
+ my $self = shift;
+
+ my @args;
+
+ for my $mod (@{ $self->{cmodules} }) {
+ my $dir = $mod->{dir};
+ my $lib = $self->cmodules_build_so($mod->{name});
+ my $so = "$dir/$lib";
+
+ next unless -e $so;
+
+ $self->preamble(LoadModule => "$mod->{sym} $so");
+
+ my $cname = "$mod->{name}.c";
+ my $cfile = "$dir/$cname";
+ $self->{modules}->{$cname} = 1;
+
+ $self->add_module_config($cfile, \@args);
+ }
+
+ $self->postamble(\@args) if @args;
+}
+
+sub cmodules_clean {
+ my $self = shift;
+
+ my $dir = $self->{cmodules_dir};
+ return unless $dir and -e "$dir/Makefile";
+
+ unless ($self->{clean_level} > 1) {
+ #skip t/TEST -conf
+ warning "skipping rebuild of c-modules; run t/TEST -clean to force";
+ return;
+ }
+
+ $self->cmodules_make('clean');
+
+ for my $mod (@{ $self->{cmodules} }) {
+ my $makefile = "$mod->{dir}/Makefile";
+ debug "unlink $makefile";
+ unlink $makefile;
+ }
+
+ unlink "$dir/Makefile";
+}
+
+#try making it easier for test modules to compile with both 1.x and 2.x
+sub cmodule_define_name {
+ my $name = shift;
+ $name eq 'NULL' ? $name : "APACHE_HTTPD_TEST_\U$name";
+}
+
+sub cmodule_define {
+ my $hook = cmodule_define_name(@_);
+ "#ifndef $hook\n#define $hook NULL\n#endif\n";
+}
+
+my @cmodule_config_names = qw(per_dir_create per_dir_merge
+ per_srv_create per_srv_merge
+ commands);
+
+my @cmodule_config_defines = map {
+ cmodule_define($_);
+} @cmodule_config_names;
+
+my $cmodule_config_extra =
+ "#ifndef APACHE_HTTPD_TEST_EXTRA_HOOKS\n".
+ "#define APACHE_HTTPD_TEST_EXTRA_HOOKS(p) do { } while (0)\n".
+ "#endif\n";
+
+my $cmodule_config_hooks = join ",\n ", map {
+ cmodule_define_name($_);
+} @cmodule_config_names;
+
+my @cmodule_phases = qw(post_read_request translate_name header_parser
+ access_checker check_user_id auth_checker
+ type_checker fixups handler log_transaction
+ child_init);
+
+my $cmodule_hooks_1 = join ",\n ", map {
+ cmodule_define_name($_);
+} qw(translate_name check_user_id auth_checker access_checker
+ type_checker fixups log_transaction header_parser
+ child_init NULL post_read_request);
+
+my $cmodule_template_1 = <<"EOF",
+static const handler_rec name ## _handlers[] =
+{
+ {#name, APACHE_HTTPD_TEST_HANDLER}, /* ok if handler is NULL */
+ {NULL}
+};
+
+module MODULE_VAR_EXPORT name ## _module =
+{
+ STANDARD_MODULE_STUFF,
+ NULL, /* initializer */
+ $cmodule_config_hooks,
+ name ## _handlers, /* handlers */
+ $cmodule_hooks_1
+}
+EOF
+
+my @cmodule_hooks = map {
+ my $hook = cmodule_define_name($_);
+ <<EOF;
+ if ($hook != NULL)
+ ap_hook_$_($hook,
+ NULL, NULL,
+ APACHE_HTTPD_TEST_HOOK_ORDER);
+EOF
+} @cmodule_phases;
+
+my @cmodule_hook_defines = map {
+ cmodule_define($_);
+} @cmodule_phases;
+
+my $cmodule_template_2 = <<"EOF";
+static void name ## _register_hooks(apr_pool_t *p)
+{
+@cmodule_hooks
+ APACHE_HTTPD_TEST_EXTRA_HOOKS(p);
+}
+
+module AP_MODULE_DECLARE_DATA name ## _module = {
+ STANDARD20_MODULE_STUFF,
+ $cmodule_config_hooks,
+ name ## _register_hooks, /* register hooks */
+}
+EOF
+
+my %cmodule_templates = (1 => $cmodule_template_1, 2 => $cmodule_template_2);
+
+sub cmodules_module_template {
+ my $self = shift;
+ my $template = $self->server->version_of(\%cmodule_templates);
+ chomp $template;
+
+ $template =~ s,$, \\,mg;
+ $template =~ s, \\$,,s;
+
+ local $" = ', ';
+
+ return <<EOF;
+#define APACHE_HTTPD_TEST_MODULE(name) \\
+ $template
+EOF
+}
+
+sub cmodules_generate_include {
+ my $self = shift;
+
+ my $file = "$self->{cmodules_dir}/apache_httpd_test.h";
+ my $fh = $self->genfile($file);
+
+ while (read Apache::TestConfigC::DATA, my $buf, 1024) {
+ print $fh $buf;
+ }
+
+ print $fh @cmodule_hook_defines, @cmodule_config_defines;
+
+ print $fh $cmodule_config_extra;
+
+ print $fh $self->cmodules_module_template;
+
+ close $fh;
+}
+
+package Apache::TestConfigC; #Apache/TestConfig.pm also has __DATA__
+1;
+__DATA__
+#ifndef APACHE_HTTPD_TEST_H
+#define APACHE_HTTPD_TEST_H
+
+/* headers present in both 1.x and 2.x */
+#include "httpd.h"
+#include "http_config.h"
+#include "http_protocol.h"
+#include "http_request.h"
+#include "http_log.h"
+#include "http_main.h"
+#include "http_core.h"
+#include "ap_config.h"
+
+#ifdef APACHE1
+#define AP_METHOD_BIT 1
+typedef size_t apr_size_t;
+typedef array_header apr_array_header_t;
+#define APR_OFF_T_FMT "ld"
+#define APR_SIZE_T_FMT "lu"
+#endif /* APACHE1 */
+
+#ifdef APACHE2
+#ifndef APACHE_HTTPD_TEST_HOOK_ORDER
+#define APACHE_HTTPD_TEST_HOOK_ORDER APR_HOOK_MIDDLE
+#endif
+#include "ap_compat.h"
+#endif /* APACHE2 */
+
+#endif /* APACHE_HTTPD_TEST_H */
+
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestConfigPHP.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestConfigPHP.pm
new file mode 100644
index 0000000..1c79865
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestConfigPHP.pm
@@ -0,0 +1,781 @@
+# 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::TestConfigPHP;
+
+#things specific to php
+
+use strict;
+use warnings FATAL => 'all';
+use File::Spec::Functions qw(catfile splitdir abs2rel);
+use File::Find qw(finddepth);
+use Apache::TestTrace;
+use Apache::TestRequest;
+use Apache::TestConfig;
+use Apache::TestConfigPerl;
+use Config;
+
+@Apache::TestConfigPHP::ISA = qw(Apache::TestConfig);
+
+my ($php_ini, $test_more);
+
+{
+ # __DATA__ contains both php.ini and test-more.php
+
+ local $/ = "END_OF_FILE\n";
+
+ $php_ini = <DATA>;
+ chomp $php_ini;
+
+ $test_more = <DATA>;
+ chomp $test_more;
+}
+
+sub new {
+ return shift->SUPER::new(@_);
+}
+
+my %warn_style = (
+ html => sub { "<!-- @_ -->" },
+ c => sub { "/* @_ */" },
+ ini => sub { join '', grep {s/^/; /gm} @_ },
+ php => sub { join '', "<?php\n", grep {s/^/# /gm} @_ },
+ default => sub { join '', grep {s/^/\# /gm} @_ },
+);
+
+my %file_ext = (
+ map({$_ => 'html'} qw(htm html)),
+ map({$_ => 'c' } qw(c h)),
+ map({$_ => 'ini' } qw(ini)),
+ map({$_ => 'php' } qw(php)),
+);
+
+sub warn_style_sub_ref {
+ my ($self, $filename) = @_;
+ my $ext = $self->filename_ext($filename);
+ return $warn_style{ $file_ext{$ext} || 'default' };
+}
+
+sub configure_php_tests_pick {
+ my($self, $entries) = @_;
+
+ for my $subdir (qw(Response)) {
+ my $dir = catfile $self->{vars}->{t_dir}, lc $subdir;
+ next unless -d $dir;
+
+ finddepth(sub {
+ return unless /\.php$/;
+
+ my $file = catfile $File::Find::dir, $_;
+ my $module = abs2rel $file, $dir;
+ my $status = $self->run_apache_test_config_scan($file);
+ push @$entries, [$file, $module, $subdir, $status];
+ }, $dir);
+ }
+}
+
+sub write_php_test {
+ my($self, $location, $test) = @_;
+
+ (my $path = $location) =~ s/test//i;
+ (my $file = $test) =~ s/php$/t/i;
+
+ my $dir = catfile $self->{vars}->{t_dir}, lc $path;
+ my $t = catfile $dir, $file;
+ my $php_t = catfile $dir, $test;
+ return if -e $t;
+
+ # don't write out foo.t if foo.php already exists
+ return if -e $php_t;
+
+ $self->gendir($dir);
+ my $fh = $self->genfile($t);
+
+ print $fh <<EOF;
+use Apache::TestRequest 'GET_BODY_ASSERT';
+print GET_BODY_ASSERT "/$location/$test";
+EOF
+
+ close $fh or die "close $t: $!";
+
+ # write out an all.t file for the directory
+ # that will skip running all PHP test unless have_php
+
+ my $all = catfile $dir, 'all.t';
+
+ unless (-e $all) {
+ my $fh = $self->genfile($all);
+
+ print $fh <<EOF;
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+
+# skip all tests in this directory unless a php module is enabled
+plan tests => 1, need_php;
+
+ok 1;
+EOF
+ }
+}
+
+sub configure_php_inc {
+ my $self = shift;
+
+ my $serverroot = $self->{vars}->{serverroot};
+
+ my $path = catfile $serverroot, 'conf';
+
+ # make sure that require() or include() calls can find
+ # the generated test-more.php without using absolute paths
+ my $cfg = { php_value => "include_path $path", };
+ $self->postamble(IfModule => $self->{vars}->{php_module}, $cfg);
+
+ # give test-more.php access to the ServerRoot directive
+ $self->postamble("SetEnv SERVER_ROOT $serverroot\n");
+}
+
+sub configure_php_functions {
+ my $self = shift;
+
+ my $dir = catfile $self->{vars}->{serverroot}, 'conf';
+ my $file = catfile $dir, 'test-more.php';
+
+ $self->gendir($dir);
+ my $fh = $self->genfile($file);
+
+ print $fh $test_more;
+
+ close $fh or die "close $file: $!";
+
+ $self->clean_add_file($file);
+}
+
+sub configure_php_ini {
+ my $self = shift;
+
+ my $dir = catfile $self->{vars}->{serverroot}, 'conf';
+ my $file = catfile $dir, 'php.ini';
+
+ return if -e $file;
+
+ my $log = catfile $self->{vars}->{t_logs}, 'error_log';
+
+ $self->gendir($dir);
+ my $fh = $self->genfile($file);
+
+ $php_ini =~ s/\@error_log\@/error_log $log/;
+ print $fh $php_ini;
+
+ close $fh or die "close $file: $!";
+
+ $self->clean_add_file($file);
+}
+
+sub configure_php_tests {
+ my $self = shift;
+
+ my @entries = ();
+ $self->configure_php_tests_pick(\@entries);
+ $self->configure_pm_tests_sort(\@entries);
+
+ my %seen = ();
+
+ for my $entry (@entries) {
+ my ($file, $module, $subdir, $status) = @$entry;
+
+ my @args = ();
+
+ my $directives = $self->add_module_config($file, \@args);
+
+ my @parts = splitdir $file;
+ my $test = pop @parts;
+ my $location = $parts[-1];
+
+ debug "configuring PHP test file $file";
+
+ if ($directives->{noautoconfig}) {
+ $self->postamble(""); # which adds "\n"
+ }
+ else {
+ unless ($seen{$location}++) {
+ $self->postamble(Alias => [ catfile('', $parts[-1]), catfile(@parts) ]);
+
+ my @args = (AddType => 'application/x-httpd-php .php');
+
+ $self->postamble(Location => "/$location", \@args);
+ }
+ }
+
+ $self->write_php_test($location, $test);
+ }
+}
+
+1;
+
+__DATA__
+; This is php.ini-recommended from php 5.0.2,
+; used in place of your locally installed php.ini file
+; as part of the pristine environment Apache-Test creates
+; for you
+; [NOTE]: cat php.ini-recommended | grep -v '^;' | sed -e '/^$/d'
+;
+; exceptions to php.ini-recommended are as follows:
+display_startup_errors = On
+html_errors = Off
+@error_log@
+output_buffering = Off
+
+; the rest of php.ini-recommended, unaltered, save for
+; some tidying like the removal of comments and blank lines
+
+[PHP]
+engine = On
+zend.ze1_compatibility_mode = Off
+short_open_tag = Off
+asp_tags = Off
+precision = 14
+y2k_compliance = On
+zlib.output_compression = Off
+implicit_flush = Off
+unserialize_callback_func=
+serialize_precision = 100
+allow_call_time_pass_reference = Off
+safe_mode = Off
+safe_mode_gid = Off
+safe_mode_include_dir =
+safe_mode_exec_dir =
+safe_mode_allowed_env_vars = PHP_
+safe_mode_protected_env_vars = LD_LIBRARY_PATH
+disable_functions =
+disable_classes =
+expose_php = On
+max_execution_time = 30 ; Maximum execution time of each script, in seconds
+max_input_time = 60 ; Maximum amount of time each script may spend parsing request data
+memory_limit = 128M ; Maximum amount of memory a script may consume (128MB)
+error_reporting = E_ALL
+display_errors = Off
+log_errors = On
+log_errors_max_len = 1024
+ignore_repeated_errors = Off
+ignore_repeated_source = Off
+report_memleaks = On
+track_errors = Off
+variables_order = "GPCS"
+register_globals = Off
+register_long_arrays = Off
+register_argc_argv = Off
+auto_globals_jit = On
+post_max_size = 8M
+magic_quotes_gpc = Off
+magic_quotes_runtime = Off
+magic_quotes_sybase = Off
+auto_prepend_file =
+auto_append_file =
+default_mimetype = "text/html"
+doc_root =
+user_dir =
+enable_dl = On
+file_uploads = On
+upload_max_filesize = 2M
+allow_url_fopen = On
+allow_url_include = Off
+default_socket_timeout = 60
+[Date]
+[filter]
+[iconv]
+[sqlite]
+[xmlrpc]
+[Pcre]
+[Syslog]
+define_syslog_variables = Off
+[mail function]
+SMTP = localhost
+smtp_port = 25
+[SQL]
+sql.safe_mode = Off
+[ODBC]
+odbc.allow_persistent = On
+odbc.check_persistent = On
+odbc.max_persistent = -1
+odbc.max_links = -1
+odbc.defaultlrl = 4096
+odbc.defaultbinmode = 1
+[MySQL]
+mysql.allow_persistent = On
+mysql.max_persistent = -1
+mysql.max_links = -1
+mysql.default_port =
+mysql.default_socket =
+mysql.default_host =
+mysql.default_user =
+mysql.default_password =
+mysql.connect_timeout = 60
+mysql.trace_mode = Off
+[MySQLi]
+mysqli.max_links = -1
+mysqli.default_port = 3306
+mysqli.default_socket =
+mysqli.default_host =
+mysqli.default_user =
+mysqli.default_pw =
+mysqli.reconnect = Off
+[mSQL]
+msql.allow_persistent = On
+msql.max_persistent = -1
+msql.max_links = -1
+[OCI8]
+[PostgresSQL]
+pgsql.allow_persistent = On
+pgsql.auto_reset_persistent = Off
+pgsql.max_persistent = -1
+pgsql.max_links = -1
+pgsql.ignore_notice = 0
+pgsql.log_notice = 0
+[Sybase]
+sybase.allow_persistent = On
+sybase.max_persistent = -1
+sybase.max_links = -1
+sybase.min_error_severity = 10
+sybase.min_message_severity = 10
+sybase.compatability_mode = Off
+[Sybase-CT]
+sybct.allow_persistent = On
+sybct.max_persistent = -1
+sybct.max_links = -1
+sybct.min_server_severity = 10
+sybct.min_client_severity = 10
+[bcmath]
+bcmath.scale = 0
+[browscap]
+[Informix]
+ifx.default_host =
+ifx.default_user =
+ifx.default_password =
+ifx.allow_persistent = On
+ifx.max_persistent = -1
+ifx.max_links = -1
+ifx.textasvarchar = 0
+ifx.byteasvarchar = 0
+ifx.charasvarchar = 0
+ifx.blobinfile = 0
+ifx.nullformat = 0
+[Session]
+session.save_handler = files
+session.use_cookies = 1
+session.name = PHPSESSID
+session.auto_start = 0
+session.cookie_lifetime = 0
+session.cookie_path = /
+session.cookie_domain =
+session.cookie_httponly =
+session.serialize_handler = php
+session.gc_probability = 1
+session.gc_divisor = 1000
+session.gc_maxlifetime = 1440
+session.bug_compat_42 = 0
+session.bug_compat_warn = 1
+session.referer_check =
+session.entropy_length = 0
+session.entropy_file =
+session.cache_limiter = nocache
+session.cache_expire = 180
+session.use_trans_sid = 0
+session.hash_function = 0
+session.hash_bits_per_character = 5
+url_rewriter.tags = "a=href,area=href,frame=src,input=src,form=fakeentry"
+[MSSQL]
+mssql.allow_persistent = On
+mssql.max_persistent = -1
+mssql.max_links = -1
+mssql.min_error_severity = 10
+mssql.min_message_severity = 10
+mssql.compatability_mode = Off
+mssql.secure_connection = Off
+[Assertion]
+[COM]
+[mbstring]
+[FrontBase]
+[gd]
+[exif]
+[Tidy]
+tidy.clean_output = Off
+[soap]
+soap.wsdl_cache_enabled=1
+soap.wsdl_cache_dir="/tmp"
+soap.wsdl_cache_ttl=86400
+END_OF_FILE
+/*******************************************************************\
+* PROJECT INFORMATION *
+* *
+* Project: Apache-Test *
+* URL: http://perl.apache.org/Apache-Test/ *
+* Notice: Copyright (c) 2006 The Apache Software Foundation *
+* *
+*********************************************************************
+* LICENSE INFORMATION *
+* *
+* Licensed 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. *
+* *
+*********************************************************************
+* MODULE INFORMATION *
+* *
+* This is a PHP implementation of Test::More: *
+* *
+* http://search.cpan.org/dist/Test-Simple/lib/Test/More.pm *
+* *
+*********************************************************************
+* CREDITS *
+* *
+* Originally inspired by work from Andy Lester. Written and *
+* maintained by Chris Shiflett. For contact information, see: *
+* *
+* http://shiflett.org/ *
+* *
+\*******************************************************************/
+
+header('Content-Type: text/plain');
+register_shutdown_function('_test_end');
+
+$_no_plan = FALSE;
+$_num_failures = 0;
+$_num_skips = 0;
+$_test_num = 0;
+
+function plan($plan)
+{
+ /*
+ plan('no_plan');
+ plan('skip_all');
+ plan(array('skip_all' => 'My reason is...'));
+ plan(23);
+ */
+
+ global $_no_plan;
+ global $_skip_all;
+ global $_skip_reason;
+
+ switch ($plan)
+ {
+ case 'no_plan':
+ $_no_plan = TRUE;
+ break;
+
+ case 'skip_all':
+ echo "1..0\n";
+ break;
+
+ default:
+ if (is_array($plan))
+ {
+ echo "1..0 # Skip {$plan['skip_all']}\n";
+ exit;
+ }
+
+ echo "1..$plan\n";
+ break;
+ }
+}
+
+function ok($pass, $test_name = '')
+{
+ global $_test_num;
+ global $_num_failures;
+ global $_num_skips;
+
+ $_test_num++;
+
+ if ($_num_skips)
+ {
+ $_num_skips--;
+ return TRUE;
+ }
+
+ if (!empty($test_name) && $test_name[0] != '#')
+ {
+ $test_name = "- $test_name";
+ }
+
+ if ($pass)
+ {
+ echo "ok $_test_num $test_name\n";
+ }
+ else
+ {
+ echo "not ok $_test_num $test_name\n";
+
+ $_num_failures++;
+ $caller = debug_backtrace();
+
+ if (strstr($caller['0']['file'], $_SERVER['PHP_SELF']))
+ {
+ $file = $caller['0']['file'];
+ $line = $caller['0']['line'];
+ }
+ else
+ {
+ $file = $caller['1']['file'];
+ $line = $caller['1']['line'];
+ }
+
+ $file = str_replace($_SERVER['SERVER_ROOT'], 't', $file);
+
+ diag(" Failed test ($file at line $line)");
+ }
+
+ return $pass;
+}
+
+function is($this, $that, $test_name = '')
+{
+ $pass = ($this == $that);
+
+ ok($pass, $test_name);
+
+ if (!$pass)
+ {
+ diag(" got: '$this'");
+ diag(" expected: '$that'");
+ }
+
+ return $pass;
+}
+
+function isnt($this, $that, $test_name = '')
+{
+ $pass = ($this != $that);
+
+ ok($pass, $test_name);
+
+ if (!$pass)
+ {
+ diag(" '$this'");
+ diag(' !=');
+ diag(" '$that'");
+ }
+
+ return $pass;
+}
+
+function like($string, $pattern, $test_name = '')
+{
+ $pass = preg_match($pattern, $string);
+
+ ok($pass, $test_name);
+
+ if (!$pass)
+ {
+ diag(" '$string'");
+ diag(" doesn't match '$pattern'");
+ }
+
+ return $pass;
+}
+
+function unlike($string, $pattern, $test_name = '')
+{
+ $pass = !preg_match($pattern, $string);
+
+ ok($pass, $test_name);
+
+ if (!$pass)
+ {
+ diag(" '$string'");
+ diag(" matches '$pattern'");
+ }
+
+ return $pass;
+}
+
+function cmp_ok($this, $operator, $that, $test_name = '')
+{
+ eval("\$pass = (\$this $operator \$that);");
+
+ ok($pass, $test_name);
+
+ if (!$pass)
+ {
+ diag(" got: '$this'");
+ diag(" expected: '$that'");
+ }
+
+ return $pass;
+}
+
+function can_ok($object, $methods)
+{
+ $pass = TRUE;
+ $errors = array();
+
+ foreach ($methods as $method)
+ {
+ if (!method_exists($object, $method))
+ {
+ $pass = FALSE;
+ $errors[] = " method_exists(\$object, $method) failed";
+ }
+ }
+
+ if ($pass)
+ {
+ ok(TRUE, "method_exists(\$object, ...)");
+ }
+ else
+ {
+ ok(FALSE, "method_exists(\$object, ...)");
+ diag($errors);
+ }
+
+ return $pass;
+}
+
+function isa_ok($object, $expected_class, $object_name = 'The object')
+{
+ $got_class = get_class($object);
+
+ if (version_compare(php_version(), '5', '>='))
+ {
+ $pass = ($got_class == $expected_class);
+ }
+ else
+ {
+ $pass = ($got_class == strtolower($expected_class));
+ }
+
+ if ($pass)
+ {
+ ok(TRUE, "$object_name isa $expected_class");
+ }
+ else
+ {
+ ok(FALSE, "$object_name isn't a '$expected_class' it's a '$got_class'");
+ }
+
+ return $pass;
+}
+
+function pass($test_name = '')
+{
+ return ok(TRUE, $test_name);
+}
+
+function fail($test_name = '')
+{
+ return ok(FALSE, $test_name);
+}
+
+function diag($message)
+{
+ if (is_array($message))
+ {
+ foreach($message as $current)
+ {
+ echo "# $current\n";
+ }
+ }
+ else
+ {
+ echo "# $message\n";
+ }
+}
+
+function include_ok($module)
+{
+ $pass = ((include $module) == 'OK');
+ return ok($pass);
+}
+
+function require_ok($module)
+{
+ $pass = ((require $module) == 'OK');
+ return ok($pass);
+}
+
+function skip($message, $num)
+{
+ global $_num_skips;
+
+ if ($num < 0)
+ {
+ $num = 0;
+ }
+
+ for ($i = 0; $i < $num; $i++)
+ {
+ pass("# SKIP $message");
+ }
+
+ $_num_skips = $num;
+}
+
+/*
+
+TODO:
+
+function todo()
+{
+}
+
+function todo_skip()
+{
+}
+
+function is_deeply()
+{
+}
+
+function eq_array()
+{
+}
+
+function eq_hash()
+{
+}
+
+function eq_set()
+{
+}
+
+*/
+
+function _test_end()
+{
+ global $_no_plan;
+ global $_num_failures;
+ global $_test_num;
+
+ if ($_no_plan)
+ {
+ echo "1..$_test_num\n";
+ }
+
+ if ($_num_failures)
+ {
+ diag("Looks like you failed $_num_failures tests of $_test_num.");
+ }
+}
+
+?>
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestConfigParrot.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestConfigParrot.pm
new file mode 100644
index 0000000..e13a7dc
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestConfigParrot.pm
@@ -0,0 +1,92 @@
+# 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::TestConfigParrot;
+
+#things specific to mod_parrot
+
+use strict;
+use warnings FATAL => 'all';
+use File::Spec::Functions qw(catfile splitdir abs2rel);
+use File::Find qw(finddepth);
+use Apache::TestTrace;
+use Apache::TestRequest;
+use Apache::TestConfig;
+use Apache::TestConfigPerl;
+use Config;
+
+@Apache::TestConfigParrot::ISA = qw(Apache::TestConfig);
+
+sub new {
+ return shift->SUPER::new(@_);
+}
+
+sub configure_parrot_tests_pick {
+ my($self, $entries) = @_;
+
+ for my $subdir (qw(Response)) {
+ my $dir = catfile $self->{vars}->{t_dir}, lc $subdir;
+ next unless -d $dir;
+
+ finddepth(sub {
+ return unless /\.pir$/;
+
+ my $file = catfile $File::Find::dir, $_;
+ my $module = abs2rel $file, $dir;
+ my $status = $self->run_apache_test_config_scan($file);
+ push @$entries, [$file, $module, $subdir, $status];
+ }, $dir);
+ }
+}
+
+sub configure_parrot_tests {
+ my $self = shift;
+
+ my @entries = ();
+ $self->configure_parrot_tests_pick(\@entries);
+ $self->configure_pm_tests_sort(\@entries);
+
+ my %seen = ();
+
+ for my $entry (@entries) {
+ my ($file, $module, $subdir, $status) = @$entry;
+
+ my @args = ();
+
+ my $directives = $self->add_module_config($file, \@args);
+
+ $module =~ s,\.pir$,,;
+ $module =~ s/^[a-z]://i; #strip drive if any
+ $module = join '::', splitdir $module;
+
+ my @base = map { s/^test//i; $_ } split '::', $module;
+
+ my $sub = pop @base;
+
+ debug "configuring mod_parrot test file $file";
+
+ push @args, SetHandler => 'parrot-code';
+ push @args, ParrotHandler => $module;
+
+ $self->postamble(ParrotLoad => $file);
+ $self->postamble($self->location_container($module), \@args);
+
+ $self->write_pm_test($module, lc $sub, map { lc } @base);
+ }
+}
+
+1;
+
+__DATA__
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestConfigParse.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestConfigParse.pm
new file mode 100644
index 0000000..fa26f34
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestConfigParse.pm
@@ -0,0 +1,558 @@
+# 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; #not TestConfigParse on purpose
+
+#dont really want/need a full-blown parser
+#but do want something somewhat generic
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestTrace;
+
+use File::Spec::Functions qw(rel2abs splitdir file_name_is_absolute);
+use File::Basename qw(dirname basename);
+
+sub strip_quotes {
+ local $_ = shift || $_;
+ s/^\"//; s/\"$//; $_;
+}
+
+my %wanted_config = (
+ TAKE1 => {map { $_, 1 } qw(ServerRoot ServerAdmin TypesConfig DocumentRoot)},
+ TAKE2 => {map { $_, 1 } qw(LoadModule LoadFile)},
+);
+
+my %spec_init = (
+ TAKE1 => sub { shift->{+shift} = "" },
+ TAKE2 => sub { shift->{+shift} = [] },
+);
+
+my %spec_apply = (
+ TypesConfig => \&inherit_server_file,
+ ServerRoot => sub {}, #dont override $self->{vars}->{serverroot}
+ DocumentRoot => \&inherit_directive_var,
+ LoadModule => \&inherit_load_module,
+ LoadFile => \&inherit_load_file,
+);
+
+#where to add config, default is preamble
+my %spec_postamble = map { $_, 'postamble' } qw(TypesConfig);
+
+# need to enclose the following directives into <IfModule
+# mod_foo.c>..</IfModule>, since mod_foo might be unavailable
+my %ifmodule = (
+ TypesConfig => 'mod_mime.c',
+);
+
+sub spec_add_config {
+ my($self, $directive, $val) = @_;
+
+ my $where = $spec_postamble{$directive} || 'preamble';
+
+ if (my $ifmodule = $ifmodule{TypesConfig}) {
+ $self->postamble(<<EOI);
+<IfModule $ifmodule>
+ $directive $val
+</IfModule>
+EOI
+ }
+ else {
+ $self->$where($directive => $val);
+ }
+}
+
+# resolve relative files like Apache->server_root_relative
+# this function doesn't test whether the resolved file exists
+sub server_file_rel2abs {
+ my($self, $file, $base) = @_;
+
+ my ($serverroot, $result) = ();
+
+ # order search sequence
+ my @tries = ([ $base,
+ 'user-supplied $base' ],
+ [ $self->{inherit_config}->{ServerRoot},
+ 'httpd.conf inherited ServerRoot' ],
+ [ $self->apxs('PREFIX', 1),
+ 'apxs-derived ServerRoot' ]);
+
+ # remove surrounding quotes if any
+ # e.g. Include "/tmp/foo.html"
+ $file =~ s/^\s*["']?//;
+ $file =~ s/["']?\s*$//;
+
+ if (file_name_is_absolute($file)) {
+ debug "$file is already absolute";
+ $result = $file;
+ }
+ else {
+ foreach my $try (@tries) {
+ next unless defined $try->[0];
+
+ if (-d $try->[0]) {
+ $serverroot = $try->[0];
+ debug "using $try->[1] to resolve $file";
+ last;
+ }
+ }
+
+ if ($serverroot) {
+ $result = rel2abs $file, $serverroot;
+ }
+ else {
+ warning "unable to resolve $file - cannot find a suitable ServerRoot";
+ warning "please specify a ServerRoot in your httpd.conf or use apxs";
+
+ # return early, skipping file test below
+ return $file;
+ }
+ }
+
+ my $dir = dirname $result;
+ # $file might not exist (e.g. if it's a glob pattern like
+ # "conf/*.conf" but what we care about here is to check whether
+ # the base dir was successfully resolved. we don't check whether
+ # the file exists at all. it's the responsibility of the caller to
+ # do this check
+ if (defined $dir && -e $dir && -d _) {
+ if (-e $result) {
+ debug "$file successfully resolved to existing file $result";
+ }
+ else {
+ debug "base dir of '$file' successfully resolved to $dir";
+ }
+
+ }
+ else {
+ $dir ||= '';
+ warning "dir '$dir' does not exist (while resolving '$file')";
+
+ # old behavior was to return the resolved but non-existent
+ # file. preserve that behavior and return $result anyway.
+ }
+
+ return $result;
+}
+
+sub server_file {
+ my $f = shift->server_file_rel2abs(@_);
+ return qq("$f");
+}
+
+sub inherit_directive_var {
+ my($self, $c, $directive) = @_;
+
+ $self->{vars}->{"inherit_\L$directive"} = $c->{$directive};
+}
+
+sub inherit_server_file {
+ my($self, $c, $directive) = @_;
+
+ $self->spec_add_config($directive,
+ $self->server_file($c->{$directive}));
+}
+
+#so we have the same names if these modules are linked static or shared
+my %modname_alias = (
+ 'mod_pop.c' => 'pop_core.c',
+ 'mod_proxy_ajp.c' => 'proxy_ajp.c',
+ 'mod_proxy_http.c' => 'proxy_http.c',
+ 'mod_proxy_ftp.c' => 'proxy_ftp.c',
+ 'mod_proxy_balancer.c' => 'proxy_balancer.c',
+ 'mod_proxy_connect.c' => 'proxy_connect.c',
+ 'mod_modperl.c' => 'mod_perl.c',
+);
+
+# Block modules which inhibit testing:
+# - mod_jk requires JkWorkerFile or JkWorker to be configured
+# skip it for now, tomcat has its own test suite anyhow.
+# - mod_casp2 requires other settings in addition to LoadModule
+# - mod_bwshare and mod_evasive20 block fast requests that tests are doing
+# - mod_fcgid causes https://rt.cpan.org/Public/Bug/Display.html?id=54476
+# - mod_modnss.c and mod_rev.c require further configuration
+my @autoconfig_skip_module = qw(mod_jk.c mod_casp2.c mod_bwshare.c
+ mod_fcgid.c mod_evasive20.c mod_modnss.c mod_rev.c);
+
+# add modules to be not inherited from the existing config.
+# e.g. prevent from LoadModule perl_module to be included twice, when
+# mod_perl already configures LoadModule and it's certainly found in
+# the existing httpd.conf installed system-wide.
+sub autoconfig_skip_module_add {
+ push @autoconfig_skip_module, @_;
+}
+
+sub should_skip_module {
+ my($self, $name) = @_;
+
+ for (@autoconfig_skip_module) {
+ if (UNIVERSAL::isa($_, 'Regexp')) {
+ return 1 if $name =~ /$_/;
+ }
+ else {
+ return 1 if $name eq $_;
+ }
+ }
+ return 0;
+}
+
+#inherit LoadModule
+sub inherit_load_module {
+ my($self, $c, $directive) = @_;
+
+ for my $args (@{ $c->{$directive} }) {
+ my $modname = $args->[0];
+ my $file = $self->server_file_rel2abs($args->[1]);
+
+ unless (-e $file) {
+ debug "$file does not exist, skipping LoadModule";
+ next;
+ }
+
+ my $name = basename $args->[1];
+ $name =~ s/\.(s[ol]|dll)$/.c/; #mod_info.so => mod_info.c
+ $name =~ s/^lib/mod_/; #libphp4.so => mod_php4.c
+
+ $name = $modname_alias{$name} if $modname_alias{$name};
+
+ # remember all found modules
+ $self->{modules}->{$name} = $file;
+ debug "Found: $modname => $name";
+
+ if ($self->should_skip_module($name)) {
+ debug "Skipping LoadModule of $name";
+ next;
+ }
+
+ debug "LoadModule $modname $name";
+
+ # sometimes people have broken system-wide httpd.conf files,
+ # which include LoadModule of modules, which are built-in, but
+ # won't be skipped above if they are found in the modules/
+ # directory. this usually happens when httpd is built once
+ # with its modules built as shared objects and then again with
+ # static ones: the old httpd.conf still has the LoadModule
+ # directives, even though the modules are now built-in
+ # so we try to workaround this problem using <IfModule>
+ $self->preamble(IfModule => "!$name",
+ qq{LoadModule $modname "$file"\n});
+ }
+}
+
+#inherit LoadFile
+sub inherit_load_file {
+ my($self, $c, $directive) = @_;
+
+ for my $args (@{ $c->{$directive} }) {
+ my $file = $self->server_file_rel2abs($args->[0]);
+
+ unless (-e $file) {
+ debug "$file does not exist, skipping LoadFile";
+ next;
+ }
+
+ if ($self->should_skip_module($args->[0])) {
+ debug "Skipping LoadFile of $args->[0]";
+ next;
+ }
+
+ # remember all found modules
+ push @{$self->{load_file}}, $file;
+
+ debug "LoadFile $file";
+
+ $self->preamble_first(qq{LoadFile "$file"\n});
+ }
+}
+
+sub parse_take1 {
+ my($self, $c, $directive) = @_;
+ $c->{$directive} = strip_quotes;
+}
+
+sub parse_take2 {
+ my($self, $c, $directive) = @_;
+ push @{ $c->{$directive} }, [map { strip_quotes } split];
+}
+
+sub apply_take1 {
+ my($self, $c, $directive) = @_;
+
+ if (exists $self->{vars}->{lc $directive}) {
+ #override replacement @Variables@
+ $self->{vars}->{lc $directive} = $c->{$directive};
+ }
+ else {
+ $self->spec_add_config($directive, qq("$c->{$directive}"));
+ }
+}
+
+sub apply_take2 {
+ my($self, $c, $directive) = @_;
+
+ for my $args (@{ $c->{$directive} }) {
+ $self->spec_add_config($directive => [map { qq("$_") } @$args]);
+ }
+}
+
+sub inherit_config_file_or_directory {
+ my ($self, $item) = @_;
+
+ if (-d $item) {
+ my $dir = $item;
+ debug "descending config directory: $dir";
+
+ for my $entry (glob "$dir/*") {
+ $self->inherit_config_file_or_directory($entry);
+ }
+ return;
+ }
+
+ my $file = $item;
+ debug "inheriting config file: $file";
+
+ my $fh = Symbol::gensym();
+ open($fh, $file) or return;
+
+ my $c = $self->{inherit_config};
+ while (<$fh>) {
+ s/^\s*//; s/\s*$//; s/^\#.*//;
+ next if /^$/;
+
+ # support continuous config lines (which use \ to break the line)
+ while (s/\\$//) {
+ my $cont = <$fh>;
+ $cont =~ s/^\s*//;
+ $cont =~ s/\s*$//;
+ $_ .= $cont;
+ }
+
+ (my $directive, $_) = split /\s+/, $_, 2;
+
+ if ($directive eq "Include") {
+ foreach my $include (glob($self->server_file_rel2abs($_))) {
+ $self->inherit_config_file_or_directory($include);
+ }
+ }
+
+ #parse what we want
+ while (my($spec, $wanted) = each %wanted_config) {
+ next unless $wanted->{$directive};
+ my $method = "parse_\L$spec";
+ $self->$method($c, $directive);
+ }
+ }
+
+ close $fh;
+}
+
+sub inherit_config {
+ my $self = shift;
+
+ $self->get_httpd_static_modules;
+ $self->get_httpd_defines;
+
+ #may change after parsing httpd.conf
+ $self->{vars}->{inherit_documentroot} =
+ catfile $self->{httpd_basedir}, 'htdocs';
+
+ my $file = $self->{vars}->{httpd_conf};
+ my $extra_file = $self->{vars}->{httpd_conf_extra};
+
+ unless ($file and -e $file) {
+ if (my $base = $self->{httpd_basedir}) {
+ my $default_conf = $self->{httpd_defines}->{SERVER_CONFIG_FILE};
+ $default_conf ||= catfile qw(conf httpd.conf);
+ $file = catfile $base, $default_conf;
+
+ # SERVER_CONFIG_FILE might be an absolute path
+ unless (-e $file) {
+ if (-e $default_conf) {
+ $file = $default_conf;
+ }
+ else {
+ # try a little harder
+ if (my $root = $self->{httpd_defines}->{HTTPD_ROOT}) {
+ debug "using HTTPD_ROOT to resolve $default_conf";
+ $file = catfile $root, $default_conf;
+ }
+ }
+ }
+ }
+ }
+
+ unless ($extra_file and -e $extra_file) {
+ if ($extra_file and my $base = $self->{httpd_basedir}) {
+ my $default_conf = catfile qw(conf $extra_file);
+ $extra_file = catfile $base, $default_conf;
+ # SERVER_CONFIG_FILE might be an absolute path
+ $extra_file = $default_conf if !-e $extra_file and -e $default_conf;
+ }
+ }
+
+ return unless $file or $extra_file;
+
+ my $c = $self->{inherit_config};
+
+ #initialize array refs and such
+ while (my($spec, $wanted) = each %wanted_config) {
+ for my $directive (keys %$wanted) {
+ $spec_init{$spec}->($c, $directive);
+ }
+ }
+
+ $self->inherit_config_file_or_directory($file) if $file;
+ $self->inherit_config_file_or_directory($extra_file) if $extra_file;
+
+ #apply what we parsed
+ while (my($spec, $wanted) = each %wanted_config) {
+ for my $directive (keys %$wanted) {
+ next unless $c->{$directive};
+ my $cv = $spec_apply{$directive} ||
+ $self->can("apply_\L$directive") ||
+ $self->can("apply_\L$spec");
+ $cv->($self, $c, $directive);
+ }
+ }
+}
+
+sub get_httpd_static_modules {
+ my $self = shift;
+
+ my $httpd = $self->{vars}->{httpd};
+ return unless $httpd;
+
+ $httpd = shell_ready($httpd);
+ my $cmd = "$httpd -l";
+ my $list = $self->open_cmd($cmd);
+
+ while (<$list>) {
+ s/\s+$//;
+ next unless /\.c$/;
+ chomp;
+ s/^\s+//;
+ $self->{modules}->{$_} = 1;
+ }
+
+ close $list;
+}
+
+sub get_httpd_defines {
+ my $self = shift;
+
+ my $httpd = $self->{vars}->{httpd};
+ return unless $httpd;
+
+ $httpd = shell_ready($httpd);
+ my $cmd = "$httpd -V";
+
+ my $httpdconf = $self->{vars}->{httpd_conf};
+ $cmd .= " -f $httpdconf" if $httpdconf;
+
+ my $serverroot = $self->{vars}->{serverroot};
+ $cmd .= " -d $serverroot" if $serverroot;
+
+ my $proc = $self->open_cmd($cmd);
+
+ while (<$proc>) {
+ chomp;
+ if( s/^\s*-D\s*//) {
+ s/\s+$//;
+ my($key, $val) = split '=', $_, 2;
+ $self->{httpd_defines}->{$key} = $val ? strip_quotes($val) : 1;
+ debug "isolated httpd_defines $key = " . $self->{httpd_defines}->{$key};
+ }
+ elsif (/(version|built|module magic number|server mpm):\s+(.*)/i) {
+ my $val = $2;
+ (my $key = uc $1) =~ s/\s/_/g;
+ $self->{httpd_info}->{$key} = $val;
+ debug "isolated httpd_info $key = " . $val;
+ }
+ }
+
+ close $proc;
+
+ if (my $mmn = $self->{httpd_info}->{MODULE_MAGIC_NUMBER}) {
+ @{ $self->{httpd_info} }
+ {qw(MODULE_MAGIC_NUMBER_MAJOR
+ MODULE_MAGIC_NUMBER_MINOR)} = split ':', $mmn;
+ }
+
+ # get the mpm information where available
+ # lowercase for consistency across the two extraction methods
+ # XXX or maybe consider making have_apache_mpm() case-insensitive?
+ if (my $mpm = $self->{httpd_info}->{SERVER_MPM}) {
+ # 2.1
+ $self->{mpm} = lc $mpm;
+ }
+ elsif (my $mpm_dir = $self->{httpd_defines}->{APACHE_MPM_DIR}) {
+ # 2.0
+ $self->{mpm} = lc basename $mpm_dir;
+ }
+ else {
+ # Apache 1.3 - no mpm to speak of
+ $self->{mpm} = '';
+ }
+
+ my $version = $self->{httpd_info}->{VERSION} || '';
+
+ if ($version =~ qr,Apache/2,) {
+ # PHP 4.x on httpd-2.x needs a special modname alias:
+ $modname_alias{'mod_php4.c'} = 'sapi_apache2.c';
+ }
+
+ unless ($version =~ qr,Apache/(2.0|1.3),) {
+ # for 2.1 and later, mod_proxy_* are really called mod_proxy_*
+ delete @modname_alias{grep {/^mod_proxy_/} keys %modname_alias};
+ }
+}
+
+sub httpd_version {
+ my $self = shift;
+
+ my $httpd = $self->{vars}->{httpd};
+ return unless $httpd;
+
+ my $version;
+ $httpd = shell_ready($httpd);
+ my $cmd = "$httpd -v";
+
+ my $v = $self->open_cmd($cmd);
+
+ local $_;
+ while (<$v>) {
+ next unless s/^Server\s+version:\s*//i;
+ chomp;
+ my @parts = split;
+ foreach (@parts) {
+ next unless /^Apache\//;
+ $version = $_;
+ last;
+ }
+ $version ||= $parts[0];
+ last;
+ }
+
+ close $v;
+
+ return $version;
+}
+
+sub httpd_mpm {
+ return shift->{mpm};
+}
+
+1;
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm
new file mode 100644
index 0000000..152ef58
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm
@@ -0,0 +1,654 @@
+# 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; #not TestConfigPerl on purpose
+
+#things specific to mod_perl
+
+use strict;
+use warnings FATAL => 'all';
+use File::Spec::Functions qw(catfile splitdir abs2rel file_name_is_absolute);
+use File::Find qw(finddepth);
+use Apache::TestTrace;
+use Apache::TestRequest;
+use Config;
+
+my %libmodperl = (1 => 'libperl.so', 2 => 'mod_perl.so');
+
+sub configure_libmodperl {
+ my $self = shift;
+
+ my $server = $self->{server};
+ my $libname = $server->version_of(\%libmodperl);
+ my $vars = $self->{vars};
+
+ if ($vars->{libmodperl}) {
+ # if set, libmodperl was specified from the command line and
+ # should be used instead of the one that is looked up
+
+ # resolve a non-absolute path
+ $vars->{libmodperl} = $self->find_apache_module($vars->{libmodperl})
+ unless file_name_is_absolute($vars->{libmodperl});
+ }
+ # $server->{rev} could be set to 2 as a fallback, even when
+ # the wanted version is 1. So check that we use mod_perl 2
+ elsif ($server->{rev} >= 2 && IS_MOD_PERL_2) {
+
+ if (my $build_config = $self->modperl_build_config()) {
+ if ($build_config->{MODPERL_LIB_SHARED}) {
+ $libname = $build_config->{MODPERL_LIB_SHARED};
+ $vars->{libmodperl} ||= $self->find_apache_module($libname);
+ } else {
+ $vars->{libmodperl} ||= $self->find_apache_module('mod_perl.so');
+ }
+ # XXX: we have a problem with several perl trees pointing
+ # to the same httpd tree. So it's possible that we
+ # configure the test suite to run with mod_perl.so built
+ # against perl which it wasn't built with. Should we use
+ # something like ldd to check the match?
+ #
+ # For now, we'll default to the first mod_perl.so found.
+ }
+ else {
+ # XXX: can we test whether mod_perl was linked statically
+ # so we don't need to preload it
+ # if (!linked statically) {
+ # die "can't find mod_perl built for perl version $]"
+ # }
+ error "can't find mod_perl.so built for perl version $]";
+ }
+ # don't use find_apache_module or we may end up with the wrong
+ # shared object, built against different perl
+ }
+ else {
+ # mod_perl 1.0
+ $vars->{libmodperl} ||= $self->find_apache_module($libname);
+ # XXX: how do we find out whether we have a static or dynamic
+ # mod_perl build? die if its dynamic and can't find the module
+ }
+
+ my $cfg = '';
+
+ if ($vars->{libmodperl} && -e $vars->{libmodperl}) {
+ if (Apache::TestConfig::WIN32) {
+ my $lib = "$Config{installbin}\\$Config{libperl}";
+ $lib =~ s/lib$/dll/;
+ $cfg = 'LoadFile ' . qq("$lib"\n) if -e $lib;
+ }
+ # add the module we found to the cached modules list
+ # otherwise have_module('mod_perl') doesn't work unless
+ # we have a LoadModule in our base config
+ $self->{modules}->{'mod_perl.c'} = $vars->{libmodperl};
+
+ $cfg .= 'LoadModule ' . qq(perl_module "$vars->{libmodperl}"\n);
+ }
+ else {
+ my $msg = "unable to locate $libname (could be a static build)\n";
+ $cfg = "#$msg";
+ debug $msg;
+ }
+
+ $self->preamble(IfModule => '!mod_perl.c', $cfg);
+
+}
+
+sub configure_inc {
+ my $self = shift;
+
+ my $top = $self->{vars}->{top_dir};
+
+ my $inc = $self->{inc};
+
+ for (catdir($top, qw(blib lib)), catdir($top, qw(blib arch))) {
+ if (-d $_) {
+ push @$inc, $_;
+ }
+ }
+
+ # try ../blib as well for Apache::Reload & Co
+ for (catdir($top, qw(.. blib lib)), catdir($top, qw(.. blib arch))) {
+ push @$inc, $_ if -d $_;
+ }
+
+ # spec: If PERL5LIB is defined, PERLLIB is not used.
+ for (qw(PERL5LIB PERLLIB)) {
+ next unless exists $ENV{$_};
+ push @$inc, split /$Config{path_sep}/, $ENV{$_};
+ last;
+ }
+
+ # enable live testing of the Apache-Test dev modules if they are
+ # located at the project's root dir
+ my $apache_test_dev_dir = catfile($top, 'Apache-Test', 'lib');
+ unshift @$inc, $apache_test_dev_dir if -d $apache_test_dev_dir;
+}
+
+sub write_pm_test {
+ my($self, $module, $sub, @base) = @_;
+
+ my $dir = catfile $self->{vars}->{t_dir}, @base;
+ my $t = catfile $dir, "$sub.t";
+ return if -e $t;
+
+ $self->gendir($dir);
+ my $fh = $self->genfile($t);
+
+ my $path = Apache::TestRequest::module2path($module);
+
+ print $fh <<EOF;
+use Apache::TestRequest 'GET_BODY_ASSERT';
+print GET_BODY_ASSERT "/$path";
+EOF
+
+ close $fh or die "close $t: $!";
+}
+
+# propogate PerlPassEnv settings to the server
+sub configure_env {
+ my $self = shift;
+ $self->preamble(IfModule => 'mod_perl.c',
+ [ qw(PerlPassEnv APACHE_TEST_TRACE_LEVEL
+ PerlPassEnv HARNESS_PERL_SWITCHES
+ PerlPassEnv APACHE_TEST_NO_STICKY_PREFERENCES)
+ ]);
+}
+
+sub startup_pl_code {
+ my $self = shift;
+ my $serverroot = $self->{vars}->{serverroot};
+
+ my $cover = <<'EOF';
+ if (($ENV{HARNESS_PERL_SWITCHES}||'') =~ m/Devel::Cover/) {
+ eval {
+ # 0.48 is the first version of Devel::Cover that can
+ # really generate mod_perl coverage statistics
+ require Devel::Cover;
+ Devel::Cover->VERSION(0.48);
+
+ # this ignores coverage data for some generated files
+ Devel::Cover->import('+inc' => 't/response/',);
+
+ 1;
+ } or die "Devel::Cover error: $@";
+ }
+EOF
+
+ return <<"EOF";
+BEGIN {
+ use lib '$serverroot';
+ for my \$file (qw(modperl_inc.pl modperl_extra.pl)) {
+ eval { require "conf/\$file" } or
+ die if grep { -e "\$_/conf/\$file" } \@INC;
+ }
+
+$cover
+}
+
+1;
+EOF
+}
+
+sub configure_startup_pl {
+ my $self = shift;
+
+ #for 2.0 we could just use PerlSwitches -Mlib=...
+ #but this will work for both 2.0 and 1.xx
+ if (my $inc = $self->{inc}) {
+ my $include_pl = catfile $self->{vars}->{t_conf}, 'modperl_inc.pl';
+ my $fh = $self->genfile($include_pl);
+ for (reverse @$inc) {
+ next unless $_;
+ print $fh "use lib '$_';\n";
+ }
+ my $tlib = catdir $self->{vars}->{t_dir}, 'lib';
+ if (-d $tlib) {
+ print $fh "use lib '$tlib';\n";
+ }
+
+ # directory for temp packages which can change during testing
+ # we use require here since a circular dependency exists
+ # between Apache::TestUtil and Apache::TestConfigPerl, so
+ # use does not work here
+ eval { require Apache::TestUtil; };
+ if ($@) {
+ die "could not require Apache::TestUtil: $@";
+ } else {
+ print $fh "use lib '" . Apache::TestUtil::_temp_package_dir() . "';\n";
+ }
+
+ # if Apache::Test is used to develop a project, we want the
+ # project/lib directory to be first in @INC (loaded last)
+ if ($ENV{APACHE_TEST_LIVE_DEV}) {
+ my $dev_lib = catdir $self->{vars}->{top_dir}, "lib";
+ print $fh "use lib '$dev_lib';\n" if -d $dev_lib;
+ }
+
+ print $fh "1;\n";
+ }
+
+ if ($self->server->{rev} >= 2) {
+ $self->postamble(IfModule => 'mod_perl.c',
+ "PerlSwitches -Mlib=$self->{vars}->{serverroot}\n");
+ }
+
+ my $startup_pl = catfile $self->{vars}->{t_conf}, 'modperl_startup.pl';
+
+ unless (-e $startup_pl) {
+ my $fh = $self->genfile($startup_pl);
+ print $fh $self->startup_pl_code;
+ close $fh;
+ }
+
+ $self->postamble(IfModule => 'mod_perl.c',
+ "PerlRequire $startup_pl\n");
+}
+
+my %sethandler_modperl = (1 => 'perl-script', 2 => 'modperl');
+
+sub set_handler {
+ my($self, $module, $args) = @_;
+ return if grep { $_ eq 'SetHandler' } @$args;
+
+ push @$args,
+ SetHandler =>
+ $self->server->version_of(\%sethandler_modperl);
+}
+
+sub set_connection_handler {
+ my($self, $module, $args) = @_;
+ my $port = $self->new_vhost($module);
+ my $vars = $self->{vars};
+ $self->postamble(Listen => '0.0.0.0:' . $port);
+}
+
+my %add_hook_config = (
+ Response => \&set_handler,
+ ProcessConnection => \&set_connection_handler,
+ PreConnection => \&set_connection_handler,
+);
+
+my %container_config = (
+ ProcessConnection => \&vhost_container,
+ PreConnection => \&vhost_container,
+);
+
+sub location_container {
+ my($self, $module) = @_;
+ my $path = Apache::TestRequest::module2path($module);
+ Location => "/$path";
+}
+
+sub vhost_container {
+ my($self, $module) = @_;
+ my $port = $self->{vhosts}->{$module}->{port};
+ my $namebased = $self->{vhosts}->{$module}->{namebased};
+
+ VirtualHost => ($namebased ? '*' : '_default_') . ":$port";
+}
+
+sub new_vhost {
+ my($self, $module, $namebased) = @_;
+ my($port, $servername, $vhost);
+
+ unless ($namebased and exists $self->{vhosts}->{$module}) {
+ $port = $self->server->select_next_port;
+ $vhost = $self->{vhosts}->{$module} = {};
+
+ $vhost->{port} = $port;
+ $vhost->{namebased} = $namebased ? 1 : 0;
+ }
+ else {
+ $vhost = $self->{vhosts}->{$module};
+ $port = $vhost->{port};
+ # remember the already configured Listen/NameVirtualHost
+ $vhost->{namebased}++;
+ }
+
+ $servername = $self->{vars}->{servername};
+
+ $vhost->{servername} = $servername;
+ $vhost->{name} = join ':', $servername, $port;
+ $vhost->{hostport} = $self->hostport($vhost, $module);
+
+ $port;
+}
+
+my %outside_container = map { $_, 1 } qw{
+Alias AliasMatch AddType
+PerlChildInitHandler PerlTransHandler PerlPostReadRequestHandler
+PerlSwitches PerlRequire PerlModule
+};
+
+my %strip_tags = map { $_ => 1} qw(base noautoconfig);
+
+#test .pm's can have configuration after the __DATA__ token
+sub add_module_config {
+ my($self, $module, $args) = @_;
+ my $fh = Symbol::gensym();
+ open($fh, $module) or return;
+
+ while (<$fh>) {
+ last if /^(__(DATA|END)__|\#if CONFIG_FOR_HTTPD_TEST)/;
+ }
+
+ my %directives;
+
+ while (<$fh>) {
+ last if /^\#endif/; #for .c modules
+ next unless /\S+/;
+ chomp;
+ s/^\s+//;
+ $self->replace;
+ if (/^#/) {
+ # preserve comments
+ $self->postamble($_);
+ next;
+ }
+ my($directive, $rest) = split /\s+/, $_, 2;
+ $directives{$directive}++ unless $directive =~ /^</;
+ $rest = '' unless defined $rest;
+
+ if ($outside_container{$directive}) {
+ $self->postamble($directive => $rest);
+ }
+ elsif ($directive =~ /IfModule/) {
+ $self->postamble($_);
+ }
+ elsif ($directive =~ m/^<(\w+)/) {
+ # strip special container directives like <Base> and </Base>
+ my $strip_container = exists $strip_tags{lc $1} ? 1 : 0;
+
+ $directives{noautoconfig}++ if lc($1) eq 'noautoconfig';
+
+ my $indent = '';
+ $self->process_container($_, $fh, lc($1),
+ $strip_container, $indent);
+ }
+ else {
+ push @$args, $directive, $rest;
+ }
+ }
+
+ \%directives;
+}
+
+
+# recursively process the directives including nested containers,
+# re-indent 4 and ucfirst the closing tags letter
+sub process_container {
+ my($self, $first_line, $fh, $directive, $strip_container, $indent) = @_;
+
+ my $new_indent = $indent;
+
+ unless ($strip_container) {
+ $new_indent .= " ";
+
+ local $_ = $first_line;
+ s/^\s*//;
+ $self->replace;
+
+ if (/<VirtualHost/) {
+ $self->process_vhost_open_tag($_, $indent);
+ }
+ else {
+ $self->postamble($indent . $_);
+ }
+ }
+
+ $self->process_container_remainder($fh, $directive, $new_indent);
+
+ unless ($strip_container) {
+ $self->postamble($indent . "</\u$directive>");
+ }
+
+}
+
+
+# processes the body of the container without the last line, including
+# the end tag
+sub process_container_remainder {
+ my($self, $fh, $directive, $indent) = @_;
+
+ my $end_tag = "</$directive>";
+
+ while (<$fh>) {
+ chomp;
+ last if m|^\s*\Q$end_tag|i;
+ s/^\s*//;
+ $self->replace;
+
+ if (m/^\s*<(\w+)/) {
+ $self->process_container($_, $fh, $1, 0, $indent);
+ }
+ else {
+ $self->postamble($indent . $_);
+ }
+ }
+}
+
+# does the necessary processing to create a vhost container header
+sub process_vhost_open_tag {
+ my($self, $line, $indent) = @_;
+
+ my $cfg = $self->parse_vhost($line);
+
+ if ($cfg) {
+ my $port = $cfg->{port};
+ $cfg->{out_postamble}->();
+ $self->postamble($cfg->{line});
+ $cfg->{in_postamble}->();
+ } else {
+ $self->postamble("$indent$line");
+ }
+}
+
+#the idea for each group:
+# Response: there will be many of these, mostly modules to test the API
+# that plan tests => ... and output with ok()
+# the naming allows grouping, making it easier to run an
+# individual set of tests, e.g. t/TEST t/apr
+# the PerlResponseHandler and SetHandler modperl is auto-configured
+# Hooks: for testing the simpler Perl*Handlers
+# auto-generates the Perl*Handler config
+# Protocol: protocol modules need their own port/vhost to listen on
+
+#@INC is auto-modified so each test .pm can be found
+#modules can add their own configuration using __DATA__
+
+my %hooks = map { $_, ucfirst $_ }
+ qw(init trans headerparser access authen authz type fixup log);
+$hooks{Protocol} = 'ProcessConnection';
+$hooks{Filter} = 'OutputFilter';
+
+my @extra_subdirs = qw(Response Protocol PreConnection Hooks Filter);
+
+# add the subdirs to @INC early, in case mod_perl is started earlier
+sub configure_pm_tests_inc {
+ my $self = shift;
+ for my $subdir (@extra_subdirs) {
+ my $dir = catfile $self->{vars}->{t_dir}, lc $subdir;
+ next unless -d $dir;
+
+ push @{ $self->{inc} }, $dir;
+ }
+}
+
+# @status fields
+use constant APACHE_TEST_CONFIGURE => 0;
+use constant APACHE_TEST_CONFIG_ORDER => 1;
+
+sub configure_pm_tests_pick {
+ my($self, $entries) = @_;
+
+ for my $subdir (@extra_subdirs) {
+ my $dir = catfile $self->{vars}->{t_dir}, lc $subdir;
+ next unless -d $dir;
+
+ finddepth(sub {
+ return unless /\.pm$/;
+
+ my $file = catfile $File::Find::dir, $_;
+ my $module = abs2rel $file, $dir;
+ my $status = $self->run_apache_test_config_scan($file);
+ push @$entries, [$file, $module, $subdir, $status];
+ }, $dir);
+ }
+}
+
+
+# a simple numerical order is performed and configuration sections are
+# inserted using that order. If the test package specifies no special
+# token that matches /APACHE_TEST_CONFIG_ORDER\s+([+-]?\d+)/ anywhere
+# in the file, 0 is assigned as its order. If the token is specified,
+# config section with negative values will be inserted first, with
+# positive last. By using different values you can arrange for the
+# test configuration sections to be inserted in any desired order
+sub configure_pm_tests_sort {
+ my($self, $entries) = @_;
+
+ @$entries = sort {
+ $a->[3]->[APACHE_TEST_CONFIG_ORDER] <=>
+ $b->[3]->[APACHE_TEST_CONFIG_ORDER]
+ } @$entries;
+
+}
+
+sub configure_pm_tests {
+ my $self = shift;
+
+ my @entries = ();
+ $self->configure_pm_tests_pick(\@entries);
+ $self->configure_pm_tests_sort(\@entries);
+
+ for my $entry (@entries) {
+ my ($file, $module, $subdir, $status) = @$entry;
+ my @args = ();
+
+ my $file_display;
+ {
+ $file_display=$file;
+ my $topdir=$self->{vars}->{top_dir};
+ $file_display=~s!^\Q$topdir\E(.)(?:\1)*!!;
+ }
+ $self->postamble("\n# included from $file_display");
+ my $directives = $self->add_module_config($file, \@args);
+ $module =~ s,\.pm$,,;
+ $module =~ s/^[a-z]://i; #strip drive if any
+ $module = join '::', splitdir $module;
+
+ $self->run_apache_test_configure($file, $module, $status);
+
+ my @base =
+ map { s/^test//i; $_ } split '::', $module;
+
+ my $sub = pop @base;
+
+ my $hook = ($subdir eq 'Hooks' ? $hooks{$sub} : '')
+ || $hooks{$subdir} || $subdir;
+
+ if ($hook eq 'OutputFilter' and $module =~ /::i\w+$/) {
+ #XXX: tmp hack
+ $hook = 'InputFilter';
+ }
+
+ my $handler = join $hook, qw(Perl Handler);
+
+ if ($self->server->{rev} < 2 and lc($hook) eq 'response') {
+ $handler =~ s/response//i; #s/PerlResponseHandler/PerlHandler/
+ }
+
+ debug "configuring $module";
+
+ unless ($directives->{noautoconfig}) {
+ if (my $cv = $add_hook_config{$hook}) {
+ $self->$cv($module, \@args);
+ }
+
+ my $container = $container_config{$hook} || \&location_container;
+
+ #unless the .pm test already configured the Perl*Handler
+ unless ($directives->{$handler}) {
+ my @handler_cfg = ($handler => $module);
+
+ if ($outside_container{$handler}) {
+ my $cfg = $self->massage_config_args(@handler_cfg);
+ $self->postamble(IfModule => 'mod_perl.c', $cfg);
+ } else {
+ push @args, @handler_cfg;
+ }
+ }
+
+ if (@args) {
+ my $cfg = $self->massage_config_args($self->$container($module), \@args);
+ $self->postamble(IfModule => 'mod_perl.c', $cfg);
+ }
+ }
+ $self->postamble("# end of $file_display\n");
+
+ $self->write_pm_test($module, lc $sub, map { lc } @base);
+ }
+}
+
+# scan tests for interesting information
+sub run_apache_test_config_scan {
+ my ($self, $file) = @_;
+
+ my @status = ();
+ $status[APACHE_TEST_CONFIGURE] = 0;
+ $status[APACHE_TEST_CONFIG_ORDER] = 0;
+
+ my $fh = Symbol::gensym();
+ if (open $fh, $file) {
+ local $/;
+ my $content = <$fh>;
+ close $fh;
+ # XXX: optimize to match once?
+ if ($content =~ /APACHE_TEST_CONFIGURE/m) {
+ $status[APACHE_TEST_CONFIGURE] = 1;
+ }
+ if ($content =~ /APACHE_TEST_CONFIG_ORDER\s+([+-]?\d+)/m) {
+ $status[APACHE_TEST_CONFIG_ORDER] = int $1;
+ }
+ }
+ else {
+ error "cannot open $file: $!";
+ }
+
+ return \@status;
+}
+
+# We have to test whether tests have APACHE_TEST_CONFIGURE() in them
+# and run it if found at this stage, so when the server starts
+# everything is ready.
+# XXX: however we cannot use a simple require() because some tests
+# won't require() outside of mod_perl environment. Therefore we scan
+# the slurped file in. and if APACHE_TEST_CONFIGURE has been found we
+# require the file and run this function.
+sub run_apache_test_configure {
+ my ($self, $file, $module, $status) = @_;
+
+ return unless $status->[APACHE_TEST_CONFIGURE];
+
+ eval { require $file };
+ warn $@ if $@;
+ # double check that it's a real sub
+ if ($module->can('APACHE_TEST_CONFIGURE')) {
+ eval { $module->APACHE_TEST_CONFIGURE($self); };
+ warn $@ if $@;
+ }
+}
+
+
+1;
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestHandler.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestHandler.pm
new file mode 100644
index 0000000..6b1e691
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestHandler.pm
@@ -0,0 +1,175 @@
+# 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::TestHandler;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test qw/!:DEFAULT/; # call import() to tell about -withouttestmore
+use Apache::TestRequest ();
+
+use Apache2::Const -compile => qw(OK NOT_FOUND SERVER_ERROR);
+
+#some utility handlers for testing hooks other than response
+#see modperl-2.0/t/hooks/TestHooks/authen.pm
+
+if ($ENV{MOD_PERL} && require mod_perl2) {
+ require Apache2::RequestRec; # content_type
+ require Apache2::RequestIO; # puts
+}
+
+#compat with 1.xx
+my $send_http_header = Apache->can('send_http_header') || sub {};
+my $print = Apache2->can('print') || Apache2::RequestRec->can('puts');
+
+sub ok {
+ my ($r, $boolean) = @_;
+ $r->$send_http_header;
+ $r->content_type('text/plain');
+ $r->$print((@_>1 && !$boolean ? "not " : '')."ok");
+ 0;
+}
+
+sub ok1 {
+ my ($r, $boolean) = @_;
+ Apache::Test::plan($r, tests => 1);
+ Apache::Test::ok(@_==1 || $boolean);
+ 0;
+}
+
+# a fixup handler to be used when a few requests need to be run
+# against the same perl interpreter, in situations where there is more
+# than one client running. For an example of use see
+# modperl-2.0/t/response/TestModperl/interp.pm and
+# modperl-2.0/t/modperl/interp.t
+#
+# this handler expects the header X-PerlInterpreter in the request
+# - if none is set, Apache::SERVER_ERROR is returned
+# - if its value eq 'tie', instance's global UUID is assigned and
+# returned via the same header
+# - otherwise if its value is not the same the stored instance's
+# global UUID Apache::NOT_FOUND is returned
+#
+# in addition $same_interp_counter counts how many times this instance of
+# pi has been called after the reset 'tie' request (inclusive), this
+# value can be retrieved with Apache::TestHandler::same_interp_counter()
+my $same_interp_id = "";
+# keep track of how many times this instance was called after the reset
+my $same_interp_counter = 0;
+sub same_interp_counter { $same_interp_counter }
+sub same_interp_fixup {
+ my $r = shift;
+ my $interp = $r->headers_in->get(Apache::TestRequest::INTERP_KEY);
+
+ unless ($interp) {
+ # shouldn't be requesting this without an INTERP header
+ die "can't find the interpreter key";
+ }
+
+ my $id = $same_interp_id;
+ if ($interp eq 'tie') { #first request for an interpreter instance
+ # unique id for this instance
+ $same_interp_id = $id =
+ unpack "H*", pack "Nnn", time, $$, int(rand(60000));
+ $same_interp_counter = 0; #reset the counter
+ }
+ elsif ($interp ne $same_interp_id) {
+ # this is not the request interpreter instance
+ return Apache2::Const::NOT_FOUND;
+ }
+
+ $same_interp_counter++;
+
+ # so client can save the created instance id or check the existing
+ # value
+ $r->headers_out->set(Apache::TestRequest::INTERP_KEY, $id);
+
+ return Apache2::Const::OK;
+}
+
+1;
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+Apache::TestHandler - a few response handlers and helpers
+
+=head1 SYNOPSIS
+
+ package My::Test;
+ use Apache::TestHandler ();
+ sub handler {
+ my ($r) = @_;
+ my $result = do_my_test;
+ Apache::TestHandler::ok1 $r, $result;
+ }
+
+ sub handler2 {
+ my ($r) = @_;
+ my $result = do_my_test;
+ Apache::TestHandler::ok $r, $result;
+ }
+
+=head1 DESCRIPTION
+
+C<Apache::TestHandler> provides 2 very simple response handler.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item ok $r, $boolean
+
+The handler simply prints out C<ok> or C<not ok> depending on the
+optional C<$boolean> parameter.
+
+If C<$boolean> is omitted C<true> is assumed.
+
+=item ok1 $r, $boolean
+
+This handler implements a simple response-only test. It can be used on its
+own to check if for a certain URI the response phase is reached. Or it
+can be called like a normal function to print out the test result. The
+client side is automatically created as described in
+L<http://perl.apache.org/docs/general/testing/testing.html#Developing_Response_only_Part_of_a_Test>.
+
+C<$boolean> is optional. If omitted C<true> is assumed.
+
+=item same_interp_counter
+
+=item same_interp_fixup
+
+TODO
+
+=back
+
+=head1 SEE ALSO
+
+The Apache-Test tutorial:
+L<http://perl.apache.org/docs/general/testing/testing.html>.
+
+L<Apache::Test>.
+
+=head1 AUTHOR
+
+Doug MacEachern, Geoffrey Young, Stas Bekman, Torsten Förtsch and others.
+
+Questions can be asked at the test-dev <at> httpd.apache.org list
+For more information see: http://httpd.apache.org/test/.
+
+=cut
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestHarness.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestHarness.pm
new file mode 100644
index 0000000..4128a43
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestHarness.pm
@@ -0,0 +1,199 @@
+# 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::TestHarness;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Test::Harness ();
+use Apache::Test ();
+use Apache::TestSort ();
+use Apache::TestTrace;
+use File::Spec::Functions qw(catfile catdir);
+use File::Find qw(finddepth);
+use File::Basename qw(dirname);
+
+sub inc_fixup {
+ # use blib
+ unshift @INC, map "blib/$_", qw(lib arch);
+
+ # fix all relative library locations
+ for (@INC) {
+ $_ = "../$_" unless m,^(/)|([a-f]:),i;
+ }
+}
+
+#skip tests listed in t/SKIP
+sub skip {
+ my($self, $file) = @_;
+ $file ||= catfile Apache::Test::vars('serverroot'), 'SKIP';
+
+ return unless -e $file;
+
+ my $fh = Symbol::gensym();
+ open $fh, $file or die "open $file: $!";
+ my @skip;
+ local $_;
+
+ while (<$fh>) {
+ chomp;
+ s/^\s+//; s/\s+$//; s/^\#.*//;
+ next unless $_;
+ s/\*/.*/g;
+ push @skip, $_;
+ }
+
+ close $fh;
+ return join '|', @skip;
+}
+
+#test if all.t would skip tests or not
+{
+ my $source_lib = '';
+
+ sub run_t {
+ my($self, $file) = @_;
+ my $ran = 0;
+
+ if (Apache::TestConfig::IS_APACHE_TEST_BUILD and !length $source_lib) {
+ # so we can find Apache/Test.pm from both the perl-framework/
+ # and Apache-Test/
+
+ my $top_dir = Apache::Test::vars('top_dir');
+ foreach my $lib (catfile($top_dir, qw(Apache-Test lib)),
+ catfile($top_dir, qw(.. Apache-Test lib)),
+ catfile($top_dir, 'lib')) {
+
+ if (-d $lib) {
+ info "adding source lib $lib to \@INC";
+ $source_lib = qq[-Mlib="$lib"];
+ last;
+ }
+ }
+ }
+
+ my $cmd = qq[$^X $source_lib $file];
+
+ my $h = Symbol::gensym();
+ open $h, "$cmd|" or die "open $cmd: $!";
+
+ local $_;
+ while (<$h>) {
+ if (/^1\.\.(\d)/) {
+ $ran = $1;
+ last;
+ }
+ }
+
+ close $h;
+
+ $ran;
+ }
+}
+
+#if a directory has an all.t test
+#skip all tests in that directory if all.t prints "1..0\n"
+sub prune {
+ my($self, @tests) = @_;
+ my(@new_tests, %skip_dirs);
+
+ foreach my $test (@tests) {
+ next if $test =~ /\.#/; # skip temp emacs files
+ my $dir = dirname $test;
+ if ($test =~ m:\Wall\.t$:) {
+ unless (__PACKAGE__->run_t($test)) {
+ $skip_dirs{$dir} = 1;
+ @new_tests = grep { m:\Wall\.t$: ||
+ not $skip_dirs{dirname $_} } @new_tests;
+ push @new_tests, $test;
+ }
+ }
+ elsif (!$skip_dirs{$dir}) {
+ push @new_tests, $test;
+ }
+ }
+
+ @new_tests;
+}
+
+sub get_tests {
+ my $self = shift;
+ my $args = shift;
+ my @tests = ();
+
+ my $base = -d 't' ? catdir('t', '.') : '.';
+
+ my $ts = $args->{tests} || [];
+
+ if (@$ts) {
+ for (@$ts) {
+ if (-d $_) {
+ push(@tests, sort <$base/$_/*.t>);
+ }
+ else {
+ $_ .= ".t" unless /\.t$/;
+ push(@tests, $_);
+ }
+ }
+ }
+ else {
+ if ($args->{tdirs}) {
+ push @tests, map { sort <$base/$_/*.t> } @{ $args->{tdirs} };
+ }
+ else {
+ finddepth(sub {
+ return unless /\.t$/;
+ my $t = catfile $File::Find::dir, $_;
+ my $dotslash = catfile '.', "";
+ $t =~ s:^\Q$dotslash::;
+ push @tests, $t
+ }, $base);
+ @tests = sort @tests;
+ }
+ }
+
+ @tests = $self->prune(@tests);
+
+ if (my $skip = $self->skip) {
+ # Allow / \ and \\ path delimiters in SKIP file
+ $skip =~ s![/\\\\]+![/\\\\]!g;
+
+ @tests = grep { not /(?:$skip)/ } @tests;
+ }
+
+ Apache::TestSort->run(\@tests, $args);
+
+ #when running 't/TEST t/dir' shell tab completion adds a /
+ #dir//foo output is annoying, fix that.
+ s:/+:/:g for @tests;
+
+ return @tests;
+}
+
+sub run {
+ my $self = shift;
+ my $args = shift || {};
+
+ $Test::Harness::verbose ||= $args->{verbose};
+
+ if (my(@subtests) = @{ $args->{subtests} || [] }) {
+ $ENV{HTTPD_TEST_SUBTESTS} = "@subtests";
+ }
+
+ Test::Harness::runtests($self->get_tests($args, @_));
+}
+
+1;
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestHarnessPHP.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestHarnessPHP.pm
new file mode 100644
index 0000000..90fdedc
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestHarnessPHP.pm
@@ -0,0 +1,139 @@
+# 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::TestHarnessPHP;
+
+use strict;
+use warnings FATAL => 'all';
+
+use File::Spec::Functions qw(catfile catdir);
+use File::Find qw(finddepth);
+use Apache::TestHarness ();
+use Apache::TestTrace;
+use Apache::TestConfig ();
+
+use vars qw(@ISA);
+@ISA = qw(Apache::TestHarness);
+use TAP::Formatter::Console;
+use TAP::Harness;
+
+sub get_tests {
+
+ my $self = shift;
+ my $args = shift;
+ my @tests = ();
+
+ my $base = -d 't' ? catdir('t', '.') : '.';
+
+ my $ts = $args->{tests} || [];
+
+ if (@$ts) {
+ for (@$ts) {
+ if (-d $_) {
+ push(@tests, sort <$base/$_/*.t>);
+ push(@tests, sort <$base/$_/*.php>);
+ }
+ else {
+ $_ .= ".t" unless /(\.t|\.php)$/;
+ push(@tests, $_);
+ }
+ }
+ }
+ else {
+ if ($args->{tdirs}) {
+ push @tests, map { sort <$base/$_/*.t> } @{ $args->{tdirs} };
+ push @tests, map { sort <$base/$_/*.php> } @{ $args->{tdirs} };
+ }
+ else {
+ finddepth(sub {
+ return unless /\.(t|php)$/;
+ return if $File::Find::dir =~ m/\b(conf|htdocs|logs|response)\b/;
+ my $t = catfile $File::Find::dir, $_;
+ my $dotslash = catfile '.', "";
+ $t =~ s:^\Q$dotslash::;
+ push @tests, $t
+ }, $base);
+ @tests = sort @tests;
+ }
+ }
+
+ @tests = $self->prune(@tests);
+
+ if (my $skip = $self->skip) {
+ # Allow / \ and \\ path delimiters in SKIP file
+ $skip =~ s![/\\\\]+![/\\\\]!g;
+
+ @tests = grep { not /(?:$skip)/ } @tests;
+ }
+
+ Apache::TestSort->run(\@tests, $args);
+
+ #when running 't/TEST t/dir' shell tab completion adds a /
+ #dir//foo output is annoying, fix that.
+ s:/+:/:g for @tests;
+
+ # remove *.php tests unless we can run them with php
+ if (! Apache::TestConfig::which('php')) {
+ warning(join ' - ', 'skipping *.php tests',
+ 'make sure php is in your PATH');
+ @tests = grep { not /\.php$/ } @tests;
+ }
+ elsif (! $phpclient) {
+ warning(join ' - ', 'skipping *.php tests',
+ 'Test::Harness 2.38 not available');
+ @tests = grep { not /\.php$/ } @tests;
+ }
+
+ return @tests;
+}
+
+sub run {
+ my $self = shift;
+ my $args = shift || {};
+ my $formatter = TAP::Formatter::Console->new;
+ my $agg = TAP::Parser::Aggregator->new;
+ my $verbose = $args->{verbose} && $args->{verbose};
+ my $php_harness = TAP::Harness->new
+ ({exec => $self->command_line(),
+ verbosity => $verbose});
+ my $perl_harness = TAP::Harness->new
+ ({verbosity => $verbose});
+ my @tests = $self->get_tests($args, @_);
+
+ $agg->start();
+ $php_harness->aggregate_tests($agg, grep {m{\.php$}} @tests);
+ $perl_harness->aggregate_tests($agg, grep {m{\.t$}} @tests);
+ $agg->stop();
+
+ $formatter->summary($agg);
+}
+
+sub command_line {
+ my $self = shift;
+
+ my $server_root = Apache::Test::vars('serverroot');
+
+ my $conf = catfile($server_root, 'conf');
+
+ my $ini = catfile($conf, 'php.ini');
+
+ my $php = Apache::TestConfig::which('php') ||
+ die 'no php executable found in ' . $ENV{PATH};
+
+ return ["env", "SERVER_ROOT=$server_root",
+ $php, "--php-ini", $ini, "--define", "include_path=$conf"];
+}
+
+1;
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestMB.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestMB.pm
new file mode 100644
index 0000000..51254a8
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestMB.pm
@@ -0,0 +1,410 @@
+# 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::TestMB;
+
+use strict;
+use vars qw(@ISA);
+use Module::Build 0.18;
+use Apache::Test ();
+use Apache::TestConfig ();
+@ISA = qw(Module::Build);
+
+sub new {
+ my $pkg = shift;
+ my($argv, $vars) =
+ Apache::TestConfig::filter_args(\@ARGV, \%Apache::TestConfig::Usage);
+ @ARGV = @$argv;
+ my $self = $pkg->SUPER::new(@_);
+ $self->{properties}{apache_test_args} = $vars;
+ $self->{properties}{apache_test_script} ||= 't/TEST';
+ $self->generate_script;
+ return $self;
+}
+
+sub valid_property {
+ return 1 if defined $_[1] &&
+ ($_[1] eq 'apache_test_args' || $_[1] eq 'apache_test_script');
+ shift->SUPER::valid_property(@_);
+}
+
+sub apache_test_args {
+ my $self = shift;
+ $self->{properties}{apache_test_args} = shift if @_;
+ return $self->{properties}{apache_test_args};
+}
+
+sub apache_test_script {
+ my $self = shift;
+ $self->{properties}{apache_test_script} = shift if @_;
+ return $self->{properties}{apache_test_script};
+}
+
+sub ACTION_test_clean {
+ my $self = shift;
+ # XXX I'd love to do this without t/TEST.
+ $self->do_system( $self->perl, $self->_bliblib,
+ $self->localize_file_path($self->apache_test_script),
+ '-clean');
+}
+
+sub ACTION_clean {
+ my $self = shift;
+ $self->depends_on('test_clean');
+ $self->SUPER::ACTION_clean(@_);
+}
+
+sub ACTION_run_tests {
+ my $self = shift;
+ $self->depends_on('test_clean');
+ # XXX I'd love to do this without t/TEST.
+ $self->do_system($self->perl, $self->_bliblib,
+ $self->localize_file_path($self->apache_test_script),
+ '-bugreport', '-verbose=' . ($self->verbose || 0));
+}
+
+sub ACTION_testcover {
+ my $self = shift;
+
+ unless ($self->find_module_by_name('Devel::Cover', \@INC)) {
+ warn("Cannot run testcover action unless Devel::Cover "
+ . "is installed.\n" .
+ "Don't forget to rebuild your Makefile after "
+ . "installing Devel::Cover\n");
+ return;
+ }
+
+ $self->add_to_cleanup('coverage', 'cover_db');
+
+ my $atdir = $self->localize_file_path("$ENV{HOME}/.apache-test");
+ local $Test::Harness::switches =
+ local $Test::Harness::Switches =
+ local $ENV{HARNESS_PERL_SWITCHES} = "-MDevel::Cover=+inc,'$atdir'";
+ local $ENV{APACHE_TEST_EXTRA_ARGS} = "-one-process";
+
+ $self->depends_on('test');
+ $self->do_system('cover');
+}
+
+sub ACTION_test_config {
+ my $self = shift;
+ $self->do_system($self->perl, $self->_bliblib,
+ $self->localize_file_path($self->apache_test_script),
+ '-conf', '-verbose=' . ($self->verbose || 0));
+}
+
+sub _bliblib {
+ my $self = shift;
+ return (
+ '-I', File::Spec->catdir($self->base_dir, $self->blib, 'lib'),
+ '-I', File::Spec->catdir($self->base_dir, $self->blib, 'arch'),
+ );
+}
+
+sub ACTION_test {
+ my $self = shift;
+ $self->depends_on('code');
+ $self->depends_on('run_tests');
+ $self->depends_on('test_clean');
+}
+
+sub _cmodules {
+ my ($self, $action) = @_;
+ die "The cmodules" . ( $action ne 'all' ? "_$action" : '')
+ . " action is not yet implemented";
+ # XXX TBD.
+ $self->depends_on('test_config');
+ my $start_dir = $self->cwd;
+ chdir $self->localize_file_path('c-modules');
+ # XXX How do we get Build.PL to be generated instead of Makefile?
+ # Subclass Apache::TestConfigC, perhaps?
+ $self->do_system('Build.PL', $action);
+ chdir $start_dir;
+}
+
+sub ACTION_cmodules { shift->_cmodues('all') }
+sub ACTION_cmodules_clean { shift->_cmodues('clean') }
+
+# XXX I'd love to make this optional.
+sub generate_script {
+ my $self = shift;
+
+ # If a file name has been passed in, use it. Otherwise, use the
+ # one set up when the Apache::TestMB object was created.
+ my $script = $self->localize_file_path($_[0]
+ ? $self->apache_test_script(shift)
+ : $self->apache_test_script
+ );
+
+ # We need a class to run the tests from t/TEST.
+ my $class = pop || 'Apache::TestRunPerl';
+
+ # Delete any existing instance of the file.
+ unlink $script if -e $script;
+
+ # Start the contents of t/TEST.
+ my $body = "BEGIN { eval { require blib && blib->import; } }\n";
+
+ # Configure the arguments for t/TEST.
+ while (my($k, $v) = each %{ $self->apache_test_args }) {
+ $v =~ s/\|/\\|/g;
+ $body .= "\n\$Apache::TestConfig::Argv{'$k'} = q|$v|;\n";
+ }
+
+ my $infile = "$script.PL";
+ if (-f $infile) {
+ # Use the existing t/TEST.PL.
+ my $in = Symbol::gensym();
+ open $in, "$infile" or die "Couldn't open $infile: $!";
+ local $/;
+ $body .= <$in>;
+ close $in;
+ } else {
+ # Create t/TEST from scratch.
+ $body .= join "\n",
+ Apache::TestConfig->perlscript_header,
+ "use $class ();",
+ "$class->new->run(\@ARGV);";
+ }
+
+ # Make it so!
+ print "Generating test running script $script\n" if $self->verbose;
+ Apache::Test::basic_config()->write_perlscript($script, $body);
+ $self->add_to_cleanup($self->apache_test_script);
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+Apache::TestMB - Subclass of Module::Build to support Apache::Test
+
+=head1 SYNOPSIS
+
+Standard process for building & installing modules:
+
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
+
+Or, if you're on a platform (like DOS or Windows) that doesn't like the "./"
+notation, you can do this:
+
+ perl Build.PL
+ perl Build
+ perl Build test
+ perl Build install
+
+=head1 DESCRIPTION
+
+This class subclasses C<Module::Build> to add support for testing
+Apache integration with Apache::Test. It is broadly based on
+C<Apache::TestMM>, and as such adds a number of build actions to a the
+F<Build> script, while simplifying the process of creating F<Build.PL>
+scripts.
+
+Here's how to use C<Apache::TestMB> in a F<Build.PL> script:
+
+ use Module::Build;
+
+ my $build_pkg = eval { require Apache::TestMB }
+ ? 'Apache::TestMB' : 'Module::Build';
+
+ my $build = $build_pkg->new(
+ module_name => 'My::Module',
+ );
+ $build->create_build_script;
+
+This is identical to how C<Module::Build> is used. Not all target
+systems may have C<Apache::Test> (and therefore C<Apache::TestMB>
+installed, so we test for it to be installed, first. But otherwise,
+its use can be exactly the same. Consult the
+L<Module::Build|Module::Build> documentation for more information on
+how to use it; L<Module::Build::Cookbook|Module::Build::Cookbook> may
+be especially useful for those looking to migrate from
+C<ExtUtils::MakeMaker>.
+
+=head1 INTERFACE
+
+=head2 Build
+
+With the above script, users can build your module in the usual
+C<Module::Build> way:
+
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
+
+If C<Apache::TestMB> is installed, then Apache will be started before
+tests are run by the C<test> action, and shut down when the tests
+complete. Note that C<Build.PL> can be called C<Apache::Test>-specific
+options in addition to the usual C<Module::Build> options. For
+example:
+
+ perl Build.PL -apxs /usr/local/apache/bin/apxs
+
+Consult the L<Apache::Test|Apache::Test> documentation for a complete
+list of options.
+
+In addition to the actions provided by C<Module::Build> (C<build>,
+C<clean>, C<code>, C<test>, etc.), C<Apache::TestMB> adds a few extra
+actions:
+
+=over 4
+
+=item test_clean
+
+This action cleans out the files generated by the test script,
+F<t/TEST>. It is also executed by the C<clean> action.
+
+=item run_tests
+
+This action actually the tests by executing the test script,
+F<t/TEST>. It is executed by the C<test> action, so most of the time
+it won't be executed directly.
+
+=item testcover
+
+C<Apache::TestMB> overrides this action from C<Module::Build> in order to
+prevent the C<Apache::Test> preference files from being included in the test
+coverage.
+
+=back
+
+=head2 Constructor
+
+=head3 new
+
+The C<new()> constructor takes all the same arguments as its parent in
+C<Module::Build>, but can optionally accept one other parameter:
+
+=over
+
+=item apache_test_script
+
+The name of the C<Apache::Test> test script. The default value is
+F<t/TEST>, which will work in the vast majority of cases. If you wish
+to specify your own file name, do so with a relative file name using
+Unix-style paths; the file name will automatically be converted for
+the local platform.
+
+=back
+
+When C<new()> is called it does the following:
+
+=over 4
+
+=item *
+
+Processes the C<Apache::Test>-specific options in C<@ARGV>. See the
+L<Apache::Test|Apache::Test> documentation for a complete list of
+options.
+
+=item *
+
+Sets the name of the C<Apache::Test> test script to F<t/TEST>, unless
+it was explicitly specified by the C<apache_test_script> parameter.
+
+=item *
+
+Calls C<generate_script()> to generate C<Apache::Test> test script,
+usually F<t/TEST>.
+
+=back
+
+=head2 Instance Methods
+
+=head3 apache_test_args
+
+Returns a hash reference containing all of the settings specified by
+options passed to F<Build.PL>, or explicitly added to C<@ARGV> in
+F<Build.PL>. Consult the L<Apache::Test|Apache::Test> documentation
+for a complete list of options.
+
+=head3 apache_test_script
+
+Gets or sets the file name of the C<Apache::Test> test script.
+
+=head3 generate_script
+
+ $build->generate_script;
+ $build->generate_script('t/FOO');
+ $build->generate_script(undef, 'Apache::TestRun');
+
+This method is called by C<new()>, so in most cases it can be
+ignored. If you'd like it to use other than the default arguments, you
+can call it explicitly in F<Build.PL> and pass it the arguments you
+desire. It takes two optional arguments:
+
+=over 4
+
+=item *
+
+The name of the C<Apache::Test> test script. Defaults to the value
+returned by C<apache_test_script()>.
+
+=item *
+
+The name of an C<Apache::Test> test running class. Defaults to
+C<Apache::TestRunPerl>.
+
+=back
+
+If there is an existing F<t/TEST.PL> (or a script with the same name
+as specified by the C<apache_test_script> parameter but with F<.PL>
+appended to it), then that script will be used as the template for the
+test script. Otherwise, a simple test script will be written similar
+to what would be written by C<Apache::TestRun::generate_script()>
+(although that function is not aware of the arguments passed to
+F<Build.PL>, so use this one instead!).
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Apache::TestRequest|Apache::TestRequest>
+
+Demonstrates how to write tests to send requests to the Apache server
+run by C<./Build test>.
+
+=item L<Module::Build|Module::Build>
+
+The parent class for C<Apache::TestMB>; consult it's documentation for
+more on its interface.
+
+=item L<http://www.perl.com/pub/a/2003/05/22/testing.html>
+
+This article by Geoffrey Young explains how to configure Apache and
+write tests for your module using Apache::Test. Just use
+C<Apache::TestMB> instead of C<Apache::TestMM> to update it for use
+with C<Module::Build>.
+
+=back
+
+=head1 AUTHOR
+
+David Wheeler
+
+Questions can be asked at the test-dev <at> httpd.apache.org list. For
+more information see: I<http://httpd.apache.org/test/> and
+I<http://perl.apache.org/docs/general/testing/testing.html>.
+
+=cut
+
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestMM.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestMM.pm
new file mode 100644
index 0000000..f9b862f
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestMM.pm
@@ -0,0 +1,258 @@
+# 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::TestMM;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Config;
+use Apache::TestConfig ();
+use Apache::TestTrace;
+use Apache::TestSmoke;
+
+sub import {
+ my $class = shift;
+
+ for my $section (@_) {
+ unless (defined &$section) {
+ die "unknown Apache::TestMM section: $section";
+ }
+ no strict 'refs';
+ my $sub = "MY::$section";
+ # Force aliasing, since previous WriteMakefile might have
+ # moved it
+ undef &$sub if defined &$sub;
+ *$sub = \&{$section};
+ }
+}
+
+sub add_dep {
+ my($string, $targ, $add) = @_;
+ $$string =~ s/($targ\s+::)/$1 $add /;
+}
+
+sub clean {
+ my $self = shift;
+ my $string = $self->MM::clean(@_);
+ add_dep(\$string, clean => 'test_clean');
+ $string;
+}
+
+sub test {
+ my $self = shift;
+ my $env = Apache::TestConfig->passenv_makestr();
+
+ my $tests = "TEST_FILES =\n";
+
+ if (ref $self && exists $self->{'test'}) {
+ $tests = 'TEST_FILES = ' . $self->{'test'}->{'TESTS'} . "\n";
+ }
+
+ my $preamble = Apache::TestConfig::WIN32 ? "" : <<EOF;
+PASSENV = $env
+EOF
+
+ my $cover;
+
+ if (eval { require Devel::Cover }) {
+ my $atdir = File::Spec->catfile($ENV{HOME}, '.apache-test');
+
+ my $cover_exec = Apache::TestConfig::which("cover");
+
+ my @cover = ("", "testcover :", );
+ push @cover, "\t-\@$cover_exec -delete" if $cover_exec;
+ push @cover, "\t-HARNESS_PERL_SWITCHES=-MDevel::Cover=+inc,$atdir \\",
+ "\tAPACHE_TEST_EXTRA_ARGS=-one-process \$(MAKE) test";
+ push @cover, "\t-\@$cover_exec" if $cover_exec;
+ $cover = join "\n", @cover, "";
+ }
+ else {
+
+ $cover = <<'EOF';
+
+testcover :
+ @echo "Cannot run testcover action unless Devel::Cover is installed"
+ @echo "Don't forget to rebuild your Makefile after installing Devel::Cover"
+EOF
+ }
+
+ return $preamble . $tests . <<'EOF' . $cover;
+TEST_VERBOSE = 0
+
+test_clean :
+ $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) \
+ t/TEST $(APACHE_TEST_EXTRA_ARGS) -clean
+
+run_tests :
+ $(PASSENV) \
+ $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) \
+ t/TEST $(APACHE_TEST_EXTRA_ARGS) -bugreport -verbose=$(TEST_VERBOSE) $(TEST_FILES)
+
+test :: pure_all test_clean run_tests
+
+test_config :
+ $(PASSENV) \
+ $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) \
+ t/TEST $(APACHE_TEST_EXTRA_ARGS) -conf
+
+cmodules: test_config
+ cd c-modules && $(MAKE) all
+
+cmodules_clean: test_config
+ cd c-modules && $(MAKE) clean
+EOF
+
+}
+
+sub generate_script {
+ my $file = shift;
+
+ unlink $file if -e $file;
+
+ my $body = "BEGIN { eval { require blib && blib->import; } }\n";
+
+ my %args = @Apache::TestMM::Argv;
+ while (my($k, $v) = each %args) {
+ $v =~ s/\|/\\|/g;
+ $body .= "\n\$Apache::TestConfig::Argv{'$k'} = q|$v|;\n";
+ }
+
+ my $in = Symbol::gensym();
+ open $in, "$file.PL" or die "Couldn't open $file.PL: $!";
+ {
+ local $/;
+ $body .= <$in>;
+ }
+ close $in;
+
+ info "generating script $file";
+ Apache::Test::basic_config()->write_perlscript($file, $body);
+ Apache::TestSmoke->generate_script;
+}
+
+sub filter_args {
+ my($argv, $vars) =
+ Apache::TestConfig::filter_args(\@ARGV, \%Apache::TestConfig::Usage);
+ @ARGV = @$argv;
+ @Apache::TestMM::Argv = %$vars;
+}
+
+1;
+
+=head1 NAME
+
+Apache::TestMM - Provide MakeMaker Wrapper Methods
+
+=head1 SYNOPSIS
+
+ require Apache::TestMM;
+
+ # import MY::test and MY::clean overrides for MM
+ Apache::TestMM->import(qw(test clean));
+
+ # parse command line args
+ Apache::TestMM::filter_args();
+
+ # autogenerate the script
+ Apache::TestMM::generate_script('t/TEST');
+
+=head1 DESCRIPTION
+
+C<Apache::TestMM> provides wrappers for the C<ExtUtils::MakeMaker>
+craft, making it easier to extend the autogenerated F<Makefile> with
+C<Apache::Test>.
+
+=head1 FUNCTIONS
+
+=head2 C<import>
+
+ use Apache::TestMM qw(test clean);
+
+or:
+
+ Apache::TestMM->import(qw(test clean));
+
+Imports C<MY::> overrides for the default C<ExtUtils::MakeMaker>
+I<test> and I<clean> targets, as if you have defined:
+
+ sub MY::test {...}
+ sub MY::clean {...}
+
+in F<Makefile.PL>. C<Apache::TestMM> does this for you so that these Makefile
+targets will run the Apache server and the tests for it, and clean up after
+its mess.
+
+=head2 C<filter_args>
+
+ push @ARGV, '-apxs', $apxs_path;
+ Apache::TestMM::filter_args();
+ WriteMakefile(...);
+
+When C<WriteMakefile()> is called it parses C<@ARGV>, hoping to find
+special options like C<PREFIX=/home/stas/perl>. C<Apache::Test>
+accepts a lot of configuration options of its own. When
+C<Apache::TestMM::filter_args()> is called, it removes any
+C<Apache::Test>-specific options from C<@ARGV> and stores them
+internally, so when C<WriteMakefile()> is called they aren't in
+C<@ARGV> and thus won't be processed by C<WriteMakefile()>.
+
+The options can be set when F<Makefile.PL> is called:
+
+ % perl Makefile.PL -apxs /path/to/apxs
+
+Or you can push them manually to C<@ARGV> from the code:
+
+ push @ARGV, '-apxs', $apxs_path;
+
+When:
+
+ Apache::TestMM::generate_script('t/TEST');
+
+is called, C<Apache::Test>-specific options extracted by
+C<Apache::TestMM::filter_args()> are written to the autogenerated
+file. In our example, the autogenerated F<t/TEST> will include:
+
+ %Apache::TestConfig::Argv = qw(apxs /path/to/apxs);
+
+which is going to be used by the C<Apache::Test> runtime.
+
+The other frequently used options are: C<-httpd>, telling where to
+find the httpd (usually when the C<-apxs> option is not used),
+C<-libmodperl> to use a specific mod_perl shared object (if your
+mod_perl is built as DSO), C<-maxclients> to change the default number
+of the configured C<MaxClients> directive, C<-port> to start the
+server on a specific port, etc. To get the complete list of available
+configuration options and their purpose and syntax, run:
+
+ % perl -MApache::TestConfig -le 'Apache::TestConfig::usage()'
+
+You may wish to document some of these in your application's F<README>
+file, especially the C<-apxs> and C<-httpd> options.
+
+
+=head2 C<generate_script>
+
+ Apache::TestMM::generate_script('t/TEST');
+
+C<generate_script()> accepts the name of the script to generate and
+will look for a template with the same name and suffix I<.PL>. So in
+our example it'll look for F<t/TEST.PL>. The autogenerated script
+F<t/TEST> will include the contents of F<t/TEST.PL>, and special
+directives, including any configuration options passed via
+C<L<filter_args()|/C_filter_args_>> called from F<Makefile.PL>, special
+fixup code, etc.
+
+=cut
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestPerlDB.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestPerlDB.pm
new file mode 100644
index 0000000..ba2e810
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestPerlDB.pm
@@ -0,0 +1,53 @@
+# 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.
+#
+#no 'package Apache::TestPerlDB.pm' here, else we change perldb's package
+use strict;
+
+sub Apache::TestPerlDB::lwpd {
+ print Apache::TestRequest::lwp_debug(shift || 1);
+}
+
+sub Apache::TestPerlDB::bok {
+ my $n = shift || 1;
+ print "breakpoint set at test $n\n";
+ DB::cmd_b_sub('ok', "\$Test::ntest == $n");
+}
+
+my %help = (
+ lwpd => 'Set the LWP debug level for Apache::TestRequest',
+ bok => 'Set breakpoint at test n',
+);
+
+my $setup_db_aliases = sub {
+ my $package = 'Apache::TestPerlDB';
+ my @cmds;
+ no strict 'refs';
+
+ while (my($name, $val) = each %{"$package\::"}) {
+ next unless defined &$val;
+ *{"main::$name"} = \&{$val};
+ push @cmds, $name;
+ }
+
+ print "$package added perldb commands:\n",
+ map { " $_ - $help{$_}\n" } @cmds;
+
+};
+
+$setup_db_aliases->();
+
+1;
+__END__
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestReport.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestReport.pm
new file mode 100644
index 0000000..eb575ea
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestReport.pm
@@ -0,0 +1,181 @@
+# 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::TestReport;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test ();
+use Apache::TestConfig ();
+
+use File::Spec::Functions qw(catfile);
+use File::Find;
+
+sub new {
+ my $class = shift;
+ bless { @_ }, $class;
+}
+
+# generate t/REPORT script (or a different filename) which will drive
+# Apache::TestReport
+sub generate_script {
+ my ($class, $file) = @_;
+
+ $file ||= catfile 't', 'REPORT';
+
+ my $content = join "\n",
+ "BEGIN { eval { require blib && blib->import; } }",
+ Apache::TestConfig->perlscript_header,
+ "use $class;",
+ "$class->new(\@ARGV)->run;";
+
+ Apache::Test::basic_config()->write_perlscript($file, $content);
+}
+
+sub replace {
+ my($self, $template) = @_;
+
+ $template =~ s{\@(\w+)\@} {
+ my $method = lc $1;
+ eval { $self->$method() } || $self->{$1} || '';
+ }eg;
+
+ $template;
+}
+
+sub run {
+ my $self = shift;
+
+ print $self->replace($self->template);
+}
+
+sub config { Apache::TestConfig::as_string() }
+
+sub report_to { 'test-dev@httpd.apache.org' }
+
+sub postit_note {
+ my $self = shift;
+
+ my($to, $where) = split '@', $self->report_to;
+
+ return <<EOF;
+Note: Complete the rest of the details and post this bug report to
+$to <at> $where. To subscribe to the list send an empty
+email to $to-subscribe\@$where.
+EOF
+}
+
+sub executable { $0 }
+
+my $core_dump;
+sub core_dump {
+ my $self = shift;
+
+ $core_dump = "";
+
+ if (eval { require Devel::GDB }) {
+ find(\&dump_core_file, 't')
+ }
+
+ $core_dump || ' [CORE TRACE COMES HERE]';
+}
+
+sub dump_core_file {
+ return unless /^core(\.\d+)?$/;
+
+ my $core = $_;
+ my $gdb = new Devel::GDB ();
+ my $test_config = Apache::TestConfig->new({thaw=>1});
+ my $httpd = $test_config->{vars}->{httpd};
+
+ return unless defined $httpd;
+
+ $core_dump .= join '',
+ $gdb->get("file $httpd"),
+ $gdb->get('sharedlibrary'),
+ $gdb->get("core $core"),
+ $gdb->get('info threads'),
+ $gdb->get('thread apply all bt');
+}
+
+sub date { scalar gmtime() . " GMT" }
+
+sub template {
+<<'EOI'
+-------------8<---------- Start Bug Report ------------8<----------
+1. Problem Description:
+
+ [DESCRIBE THE PROBLEM HERE]
+
+2. Used Components and their Configuration:
+
+@CONFIG@
+
+3. This is the core dump trace: (if you get a core dump):
+
+@CORE_DUMP@
+
+This report was generated by @EXECUTABLE@ on @DATE@.
+
+-------------8<---------- End Bug Report --------------8<----------
+
+@POSTIT_NOTE@
+
+EOI
+
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Apache::TestReport - A parent class for generating bug/success reports
+
+=head1 Synopsis
+
+ use Apache::TestReport;
+ Apache::TestReport->new(@ARGV)->run;
+
+=head1 Description
+
+This class is used to generate a bug or a success report, providing
+information about the system the code was running on.
+
+=head1 Overridable Methods
+
+=head2 config
+
+return the information about user's system
+
+=head2 report_to
+
+return a string containing the email address the report should be sent
+to
+
+=head2 postit_note
+
+return a string to close the report with, e.g.:
+
+ my($to, $where) = split '@', $self->report_to;
+ return <<EOF;
+ Note: Complete the rest of the details and post this bug report to
+ $to <at> $where. To subscribe to the list send an empty
+ email to $to-subscribe\@$where.
+
+
+=cut
+
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestReportPerl.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestReportPerl.pm
new file mode 100644
index 0000000..befd8ff
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestReportPerl.pm
@@ -0,0 +1,40 @@
+# 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::TestReportPerl;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestReport ();
+use ModPerl::Config ();
+
+# a subclass of Apache::TestReport that generates a bug report script
+use vars qw(@ISA);
+@ISA = qw(Apache::TestReport);
+
+sub config {
+ ModPerl::Config::as_string();
+}
+
+sub report_to {
+ my $self = shift;
+ my $pkg = ref $self;
+ die "you need to implement $pkg\::report_to() to return the " .
+ "contact email address of your project";
+}
+
+1;
+__END__
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm
new file mode 100644
index 0000000..55d32c8
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestRequest.pm
@@ -0,0 +1,1258 @@
+# 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::TestRequest;
+
+use strict;
+use warnings FATAL => 'all';
+
+BEGIN {
+ $ENV{PERL_LWP_USE_HTTP_10} = 1; # default to http/1.0
+ $ENV{APACHE_TEST_HTTP_09_OK} ||= 0; # 0.9 responses are ok
+}
+
+use Apache::Test ();
+use Apache::TestConfig ();
+
+use Carp;
+
+use constant TRY_TIMES => 200;
+use constant INTERP_KEY => 'X-PerlInterpreter';
+use constant UA_TIMEOUT => 60 * 10; #longer timeout for debugging
+
+my $have_lwp = 0;
+
+# APACHE_TEST_PRETEND_NO_LWP=1 pretends that LWP is not available so
+# one can test whether the test suite survives if the user doesn't
+# have lwp installed
+unless ($ENV{APACHE_TEST_PRETEND_NO_LWP}) {
+ $have_lwp = eval {
+ require LWP::UserAgent;
+ require HTTP::Request::Common;
+
+ unless (defined &HTTP::Request::Common::OPTIONS) {
+ package HTTP::Request::Common;
+ no strict 'vars';
+ *OPTIONS = sub { _simple_req(OPTIONS => @_) };
+ push @EXPORT, 'OPTIONS';
+ }
+ 1;
+ };
+}
+
+unless ($have_lwp) {
+ require Apache::TestClient;
+}
+
+sub has_lwp { $have_lwp }
+
+unless ($have_lwp) {
+ #need to define the shortcuts even though the wont be used
+ #so Perl can parse test scripts
+ @HTTP::Request::Common::EXPORT = qw(GET HEAD POST PUT OPTIONS);
+}
+
+sub install_http11 {
+ eval {
+ die "no LWP" unless $have_lwp;
+ LWP->VERSION(5.60); #minimal version
+ require LWP::Protocol::http;
+ #LWP::Protocol::http10 is used by default
+ LWP::Protocol::implementor('http', 'LWP::Protocol::http');
+ };
+}
+
+use vars qw(@EXPORT @ISA $RedirectOK $DebugLWP);
+
+require Exporter;
+*import = \&Exporter::import;
+@EXPORT = @HTTP::Request::Common::EXPORT;
+
+@ISA = qw(LWP::UserAgent);
+
+my $UA;
+my $REDIR = $have_lwp ? undef : 1;
+my $conn_opts = {};
+
+sub module {
+ my $module = shift;
+ $Apache::TestRequest::Module = $module if $module;
+ $Apache::TestRequest::Module;
+}
+
+sub scheme {
+ my $scheme = shift;
+ $Apache::TestRequest::Scheme = $scheme if $scheme;
+ $Apache::TestRequest::Scheme;
+}
+
+sub module2path {
+ my $package = shift;
+
+ # httpd (1.3 && 2) / winFU have problems when the first path's
+ # segment includes ':' (security precaution which breaks the rfc)
+ # so we can't use /TestFoo::bar as path_info
+ (my $path = $package) =~ s/::/__/g;
+
+ return $path;
+}
+
+sub module2url {
+ my $module = shift;
+ my $opt = shift || {};
+ my $scheme = $opt->{scheme} || 'http';
+ my $path = exists $opt->{path} ? $opt->{path} : module2path($module);
+
+ module($module);
+
+ my $config = Apache::Test::config();
+ my $hostport = hostport($config);
+
+ $path =~ s|^/||;
+ return "$scheme://$hostport/$path";
+}
+
+sub user_agent {
+ my $args = {@_};
+
+ if (delete $args->{reset}) {
+ $UA = undef;
+ }
+
+ if (exists $args->{requests_redirectable}) {
+ my $redir = $args->{requests_redirectable};
+ if (ref $redir and (@$redir > 1 or $redir->[0] ne 'POST')) {
+ # Set our internal flag if there's no LWP.
+ $REDIR = $have_lwp ? undef : 1;
+ } elsif ($redir) {
+ if ($have_lwp) {
+ $args->{requests_redirectable} = [ qw/GET HEAD POST/ ];
+ $REDIR = undef;
+ } else {
+ # Set our internal flag.
+ $REDIR = 1;
+ }
+ } else {
+ # Make sure our internal flag is false if there's no LWP.
+ $REDIR = $have_lwp ? undef : 0;
+ }
+ }
+
+ $args->{keep_alive} ||= $ENV{APACHE_TEST_HTTP11};
+
+ if ($args->{keep_alive}) {
+ install_http11();
+ eval {
+ require LWP::Protocol::https; #https10 is the default
+ LWP::Protocol::implementor('https', 'LWP::Protocol::https');
+ };
+ }
+
+ # in LWP 6, verify_hostname defaults to on, so SSL_ca_file
+ # needs to be set accordingly
+ if ($have_lwp and $LWP::VERSION >= 6.0 and not exists $args->{ssl_opts}->{SSL_ca_file}) {
+ my $vars = Apache::Test::vars();
+ my $cafile = "$vars->{sslca}/$vars->{sslcaorg}/certs/ca.crt";
+ $args->{ssl_opts}->{SSL_ca_file} = $cafile;
+ # IO::Socket:SSL raw socket compatibility
+ $conn_opts->{SSL_ca_file} = $cafile;
+ }
+
+ eval { $UA ||= __PACKAGE__->new(%$args); };
+}
+
+sub user_agent_request_num {
+ my $res = shift;
+ $res->header('Client-Request-Num') || #lwp 5.60
+ $res->header('Client-Response-Num'); #lwp 5.62+
+}
+
+sub user_agent_keepalive {
+ $ENV{APACHE_TEST_HTTP11} = shift;
+}
+
+sub do_request {
+ my($ua, $method, $url, $callback) = @_;
+ my $r = HTTP::Request->new($method, resolve_url($url));
+ my $response = $ua->request($r, $callback);
+ lwp_trace($response);
+}
+
+sub hostport {
+ my $config = shift || Apache::Test::config();
+ my $vars = $config->{vars};
+ local $vars->{scheme} =
+ $Apache::TestRequest::Scheme || $vars->{scheme};
+ my $hostport = $config->hostport;
+
+ my $default_hostport = join ':', $vars->{servername}, $vars->{port};
+ if (my $module = $Apache::TestRequest::Module) {
+ $hostport = $module eq 'default'
+ ? $default_hostport
+ : $config->{vhosts}->{$module}->{hostport};
+ }
+
+ $hostport || $default_hostport;
+}
+
+sub resolve_url {
+ my $url = shift;
+ Carp::croak("no url passed") unless defined $url;
+
+ return $url if $url =~ m,^(\w+):/,;
+ $url = "/$url" unless $url =~ m,^/,;
+
+ my $vars = Apache::Test::vars();
+
+ local $vars->{scheme} =
+ $Apache::TestRequest::Scheme || $vars->{scheme} || 'http';
+
+ scheme_fixup($vars->{scheme});
+
+ my $hostport = hostport();
+
+ return "$vars->{scheme}://$hostport$url";
+}
+
+my %wanted_args = map {$_, 1} qw(username password realm content filename
+ redirect_ok cert);
+
+sub wanted_args {
+ \%wanted_args;
+}
+
+sub redirect_ok {
+ my $self = shift;
+ if ($have_lwp) {
+ # Return user setting or let LWP handle it.
+ return $RedirectOK if defined $RedirectOK;
+ return $self->SUPER::redirect_ok(@_);
+ }
+
+ # No LWP. We don't support redirect on POST.
+ return 0 if $self->method eq 'POST';
+ # Return user setting or our internal calculation.
+ return $RedirectOK if defined $RedirectOK;
+ return $REDIR;
+}
+
+my %credentials;
+
+#subclass LWP::UserAgent
+sub new {
+ my $self = shift->SUPER::new(@_);
+
+ lwp_debug(); #init from %ENV (set by Apache::TestRun)
+
+ my $config = Apache::Test::config();
+ if (my $proxy = $config->configure_proxy) {
+ #t/TEST -proxy
+ $self->proxy(http => "http://$proxy");
+ }
+
+ $self->timeout(UA_TIMEOUT);
+
+ $self;
+}
+
+sub credentials {
+ my $self = shift;
+ return $self->get_basic_credentials(@_);
+}
+
+sub get_basic_credentials {
+ my($self, $realm, $uri, $proxy) = @_;
+
+ for ($realm, '__ALL__') {
+ next unless $_ && $credentials{$_};
+ return @{ $credentials{$_} };
+ }
+
+ return (undef,undef);
+}
+
+sub vhost_socket {
+ my $module = shift;
+ local $Apache::TestRequest::Module = $module if $module;
+
+ my $hostport = hostport(Apache::Test::config());
+
+ my($host, $port) = split ':', $hostport;
+ my(%args) = (PeerAddr => $host, PeerPort => $port);
+
+ if ($module and ($module =~ /ssl/ || $module eq 'h2')) {
+ require IO::Socket::SSL;
+ # Add all conn_opts to args
+ map {$args{$_} = $conn_opts->{$_}} keys %{$conn_opts};
+ return IO::Socket::SSL->new(%args, Timeout => UA_TIMEOUT);
+ }
+ else {
+ require IO::Socket;
+ return IO::Socket::INET->new(%args);
+ }
+}
+
+#IO::Socket::SSL::getline does not correctly handle OpenSSL *_WANT_*.
+#Could care less about performance here, just need a getline()
+#that returns the same results with or without ssl.
+#Inspired from Net::SSLeay::ssl_read_all().
+my %getline = (
+ 'IO::Socket::SSL' => sub {
+ my $self = shift;
+ # _get_ssl_object in IO::Socket::SSL only meant for internal use!
+ # But we need to compensate for unsufficient getline impl there.
+ my $ssl = $self->_get_ssl_object;
+ my ($got, $rv, $errs);
+ my $reply = '';
+
+ while (1) {
+ ($got, $rv) = Net::SSLeay::read($ssl, 1);
+ if (! defined $got) {
+ my $err = Net::SSLeay::get_error($ssl, $rv);
+ if ($err != Net::SSLeay::ERROR_WANT_READ() and
+ $err != Net::SSLeay::ERROR_WANT_WRITE()) {
+ $errs = Net::SSLeay::print_errs('SSL_read');
+ last;
+ }
+ next;
+ }
+ last if $got eq ''; # EOF
+ $reply .= $got;
+ last if $got eq "\n";
+ }
+
+ wantarray ? ($reply, $errs) : $reply;
+ },
+);
+
+sub getline {
+ my $sock = shift;
+ my $class = ref $sock;
+ my $method = $getline{$class} || 'getline';
+ $sock->$method();
+}
+
+sub socket_trace {
+ my $sock = shift;
+ return unless $sock->can('get_peer_certificate');
+
+ #like having some -v info
+ my $cert = $sock->get_peer_certificate;
+ print "#Cipher: ", $sock->get_cipher, "\n";
+ print "#Peer DN: ", $cert->subject_name, "\n";
+}
+
+sub prepare {
+ my $url = shift;
+
+ if ($have_lwp) {
+ user_agent();
+ $url = resolve_url($url);
+ }
+ else {
+ lwp_debug() if $ENV{APACHE_TEST_DEBUG_LWP};
+ }
+
+ my($pass, $keep) = Apache::TestConfig::filter_args(\@_, \%wanted_args);
+
+ %credentials = ();
+ if (defined $keep->{username}) {
+ $credentials{$keep->{realm} || '__ALL__'} =
+ [$keep->{username}, $keep->{password}];
+ }
+ if (defined(my $content = $keep->{content})) {
+ if ($content eq '-') {
+ $content = join '', <STDIN>;
+ }
+ elsif ($content =~ /^x(\d+)$/) {
+ $content = 'a' x $1;
+ }
+ push @$pass, content => $content;
+ }
+ if (exists $keep->{cert}) {
+ set_client_cert($keep->{cert});
+ }
+
+ return ($url, $pass, $keep);
+}
+
+sub UPLOAD {
+ my($url, $pass, $keep) = prepare(@_);
+
+ local $RedirectOK = exists $keep->{redirect_ok}
+ ? $keep->{redirect_ok}
+ : $RedirectOK;
+
+ if ($keep->{filename}) {
+ return upload_file($url, $keep->{filename}, $pass);
+ }
+ else {
+ return upload_string($url, $keep->{content});
+ }
+}
+
+sub UPLOAD_BODY {
+ UPLOAD(@_)->content;
+}
+
+sub UPLOAD_BODY_ASSERT {
+ content_assert(UPLOAD(@_));
+}
+
+#lwp only supports files
+sub upload_string {
+ my($url, $data) = @_;
+
+ my $CRLF = "\015\012";
+ my $bound = 742617000027;
+ my $req = HTTP::Request->new(POST => $url);
+
+ my $content = join $CRLF,
+ "--$bound",
+ "Content-Disposition: form-data; name=\"HTTPUPLOAD\"; filename=\"b\"",
+ "Content-Type: text/plain", "",
+ $data, "--$bound--", "";
+
+ $req->header("Content-Length", length($content));
+ $req->content_type("multipart/form-data; boundary=$bound");
+ $req->content($content);
+
+ $UA->request($req);
+}
+
+sub upload_file {
+ my($url, $file, $args) = @_;
+
+ my $content = [@$args, filename => [$file]];
+
+ $UA->request(HTTP::Request::Common::POST($url,
+ Content_Type => 'form-data',
+ Content => $content,
+ ));
+}
+
+#useful for POST_HEAD and $DebugLWP (see below)
+sub lwp_as_string {
+ my($r, $want_body) = @_;
+ my $content = $r->content;
+
+ unless ($r->isa('HTTP::Request') or
+ $r->header('Content-Length') or
+ $r->header('Transfer-Encoding'))
+ {
+ $r->header('Content-Length' => length $content);
+ $r->header('X-Content-length-note' => 'added by Apache::TestRequest');
+ }
+
+ $r->content('') unless $want_body;
+
+ (my $string = $r->as_string) =~ s/^/\#/mg;
+ $r->content($content); #reset
+ $string;
+}
+
+$DebugLWP = 0; #1 == print METHOD URL and header response for all requests
+ #2 == #1 + response body
+ #other == passed to LWP::Debug->import
+
+sub lwp_debug {
+ package main; #wtf: else package in perldb changes
+ my $val = $_[0] || $ENV{APACHE_TEST_DEBUG_LWP};
+
+ return unless $val;
+
+ if ($val =~ /^\d+$/) {
+ $Apache::TestRequest::DebugLWP = $val;
+ return "\$Apache::TestRequest::DebugLWP = $val\n";
+ }
+ else {
+ my(@args) = @_ ? @_ : split /\s+/, $val;
+ require LWP::Debug;
+ LWP::Debug->import(@args);
+ return "LWP::Debug->import(@args)\n";
+ }
+}
+
+sub lwp_trace {
+ my $r = shift;
+
+ unless ($r->request->protocol) {
+ #lwp always sends a request, but never sets
+ #$r->request->protocol, happens deeper in the
+ #LWP::Protocol::http* modules
+ my $proto = user_agent_request_num($r) ? "1.1" : "1.0";
+ $r->request->protocol("HTTP/$proto");
+ }
+
+ my $want_body = $DebugLWP > 1;
+ print "#lwp request:\n",
+ lwp_as_string($r->request, $want_body);
+
+ print "#server response:\n",
+ lwp_as_string($r, $want_body);
+}
+
+sub lwp_call {
+ my($name, $shortcut) = (shift, shift);
+
+ my $r = (\&{$name})->(@_);
+
+ Carp::croak("$name(@_) didn't return a response object") unless $r;
+
+ my $error = "";
+ unless ($shortcut) {
+ #GET, HEAD, POST
+ if ($r->method eq "POST" && !defined($r->header("Content-Length"))) {
+ $r->header('Content-Length' => length($r->content));
+ }
+ $r = $UA ? $UA->request($r) : $r;
+ my $proto = $r->protocol;
+ if (defined($proto)) {
+ if ($proto !~ /^HTTP\/(\d\.\d)$/) {
+ $error = "response had no protocol (is LWP broken or something?)";
+ }
+ if ($1 ne "1.0" && $1 ne "1.1") {
+ $error = "response had protocol HTTP/$1 (headers not sent?)"
+ unless ($1 eq "0.9" && $ENV{APACHE_TEST_HTTP_09_OK});
+ }
+ }
+ }
+
+ if ($DebugLWP and not $shortcut) {
+ lwp_trace($r);
+ }
+
+ Carp::croak($error) if $error;
+
+ return $shortcut ? $r->$shortcut() : $r;
+}
+
+my %shortcuts = (RC => sub { shift->code },
+ OK => sub { shift->is_success },
+ STR => sub { shift->as_string },
+ HEAD => sub { lwp_as_string(shift, 0) },
+ BODY => sub { shift->content },
+ BODY_ASSERT => sub { content_assert(shift) },
+);
+
+for my $name (@EXPORT) {
+ my $package = $have_lwp ?
+ 'HTTP::Request::Common': 'Apache::TestClient';
+
+ my $method = join '::', $package, $name;
+ no strict 'refs';
+
+ next unless defined &$method;
+
+ *$name = sub {
+ my($url, $pass, $keep) = prepare(@_);
+ local $RedirectOK = exists $keep->{redirect_ok}
+ ? $keep->{redirect_ok}
+ : $RedirectOK;
+ return lwp_call($method, undef, $url, @$pass);
+ };
+
+ while (my($shortcut, $cv) = each %shortcuts) {
+ my $alias = join '_', $name, $shortcut;
+ *$alias = sub { lwp_call($name, $cv, @_) };
+ }
+}
+
+my @export_std = @EXPORT;
+for my $method (@export_std) {
+ push @EXPORT, map { join '_', $method, $_ } keys %shortcuts;
+}
+
+push @EXPORT, qw(UPLOAD UPLOAD_BODY UPLOAD_BODY_ASSERT);
+
+sub to_string {
+ my $obj = shift;
+ ref($obj) ? $obj->as_string : $obj;
+}
+
+# request an interpreter instance and use this interpreter id to
+# select the same interpreter in requests below
+sub same_interp_tie {
+ my($url) = @_;
+
+ my $res = GET($url, INTERP_KEY, 'tie');
+ unless ($res->code == 200) {
+ die sprintf "failed to init the same_handler data (url=%s). " .
+ "Failed with code=%s, response:\n%s",
+ $url, $res->code, $res->content;
+ }
+ my $same_interp = $res->header(INTERP_KEY);
+
+ return $same_interp;
+}
+
+# run the request though the selected perl interpreter, by polling
+# until we found it
+# currently supports only GET, HEAD, PUT, POST subs
+sub same_interp_do {
+ my($same_interp, $sub, $url, @args) = @_;
+
+ die "must pass an interpreter id, obtained via same_interp_tie()"
+ unless defined $same_interp and $same_interp;
+
+ push @args, (INTERP_KEY, $same_interp);
+
+ my $res = '';
+ my $times = 0;
+ my $found_same_interp = '';
+ do {
+ #loop until we get a response from our interpreter instance
+ $res = $sub->($url, @args);
+ die "no result" unless $res;
+ my $code = $res->code;
+ if ($code == 200) {
+ $found_same_interp = $res->header(INTERP_KEY) || '';
+ }
+ elsif ($code == 404) {
+ # try again
+ }
+ else {
+ die sprintf "failed to run the request (url=%s):\n" .
+ "code=%s, response:\n%s", $url, $code, $res->content;
+ }
+
+ unless ($found_same_interp eq $same_interp) {
+ $found_same_interp = '';
+ }
+
+ if ($times++ > TRY_TIMES) { #prevent endless loop
+ die "unable to find interp $same_interp\n";
+ }
+ } until ($found_same_interp);
+
+ return $found_same_interp ? $res : undef;
+}
+
+
+sub set_client_cert {
+ my $name = shift;
+ my $vars = Apache::Test::vars();
+ my $dir = join '/', $vars->{sslca}, $vars->{sslcaorg};
+
+ if ($name) {
+ my ($cert, $key) = ("$dir/certs/$name.crt", "$dir/keys/$name.pem");
+ # IO::Socket:SSL raw socket compatibility
+ $conn_opts->{SSL_cert_file} = $cert;
+ $conn_opts->{SSL_key_file} = $key;
+ if ($LWP::VERSION >= 6.0) {
+ # IO::Socket:SSL doesn't look at environment variables
+ if ($UA) {
+ $UA->ssl_opts(SSL_cert_file => $cert);
+ $UA->ssl_opts(SSL_key_file => $key);
+ } else {
+ user_agent(ssl_opts => { SSL_cert_file => $cert,
+ SSL_key_file => $key });
+ }
+ }
+ }
+ else {
+ # IO::Socket:SSL raw socket compatibility
+ $conn_opts->{SSL_cert_file} = undef;
+ $conn_opts->{SSL_key_file} = undef;
+ if ($LWP::VERSION >= 6.0 and $UA) {
+ $UA->ssl_opts(SSL_cert_file => undef);
+ $UA->ssl_opts(SSL_key_file => undef);
+ }
+ }
+}
+
+# Only for IO::Socket:SSL raw socket compatibility,
+# when using user_agent() already done in its
+# constructor.
+sub set_ca_cert {
+ my $vars = Apache::Test::vars();
+ my $cafile = "$vars->{sslca}/$vars->{sslcaorg}/certs/ca.crt";
+ $conn_opts->{SSL_ca_file} = $cafile;
+}
+
+#want news: urls to work with the LWP shortcuts
+#but cant find a clean way to override the default nntp port
+#by brute force we trick Net::NTTP into calling FixupNNTP::new
+#instead of IO::Socket::INET::new, we fixup the args then forward
+#to IO::Socket::INET::new
+
+#also want KeepAlive on for Net::HTTP
+#XXX libwww-perl 5.53_xx has: LWP::UserAgent->new(keep_alive => 1);
+
+sub install_net_socket_new {
+ my($module, $code) = @_;
+
+ return unless Apache::Test::have_module($module);
+
+ no strict 'refs';
+
+ my $new;
+ my $isa = \@{"$module\::ISA"};
+
+ for (@$isa) {
+ last if $new = $_->can('new');
+ }
+
+ my $fixup_class = "Apache::TestRequest::$module";
+ unshift @$isa, $fixup_class;
+
+ *{"$fixup_class\::new"} = sub {
+ my $class = shift;
+ my $args = {@_};
+ $code->($args);
+ return $new->($class, %$args);
+ };
+}
+
+my %scheme_fixups = (
+ 'news' => sub {
+ return if $INC{'Net/NNTP.pm'};
+ eval {
+ install_net_socket_new('Net::NNTP' => sub {
+ my $args = shift;
+ my($host, $port) = split ':',
+ Apache::TestRequest::hostport();
+ $args->{PeerPort} = $port;
+ $args->{PeerAddr} = $host;
+ });
+ };
+ },
+);
+
+sub scheme_fixup {
+ my $scheme = shift;
+ my $fixup = $scheme_fixups{$scheme};
+ return unless $fixup;
+ $fixup->();
+}
+
+# when the client side simply prints the response body which should
+# include the test's output, we need to make sure that the request
+# hasn't failed, or the test will be skipped instead of indicating the
+# error.
+sub content_assert {
+ my $res = shift;
+
+ return $res->content if $res->is_success;
+
+ die join "\n",
+ "request has failed (the response code was: " . $res->code . ")",
+ "see t/logs/error_log for more details\n";
+}
+
+1;
+
+=head1 NAME
+
+Apache::TestRequest - Send requests to your Apache test server
+
+=head1 SYNOPSIS
+
+ use Apache::Test qw(ok have_lwp);
+ use Apache::TestRequest qw(GET POST);
+ use Apache::Constants qw(HTTP_OK);
+
+ plan tests => 1, have_lwp;
+
+ my $res = GET '/test.html';
+ ok $res->code == HTTP_OK, "Request is ok";
+
+=head1 DESCRIPTION
+
+B<Apache::TestRequest> provides convenience functions to allow you to
+make requests to your Apache test server in your test scripts. It
+subclasses C<LWP::UserAgent>, so that you have access to all if its
+methods, but also exports a number of useful functions likely useful
+for majority of your test requests. Users of the old C<Apache::test>
+(or C<Apache::testold>) module, take note! Herein lie most of the
+functions you'll need to use to replace C<Apache::test> in your test
+suites.
+
+Each of the functions exported by C<Apache::TestRequest> uses an
+C<LWP::UserAgent> object to submit the request and retrieve its
+results. The return value for many of these functions is an
+HTTP::Response object. See L<HTTP::Response|HTTP::Response> for
+documentation of its methods, which you can use in your tests. For
+example, use the C<code()> and C<content()> methods to test the
+response code and content of your request. Using C<GET>, you can
+perform a couple of tests using these methods like this:
+
+ use Apache::Test qw(ok have_lwp);
+ use Apache::TestRequest qw(GET POST);
+ use Apache::Constants qw(HTTP_OK);
+
+ plan tests => 2, have_lwp;
+
+ my $uri = "/test.html?foo=1&bar=2";
+ my $res = GET $uri;
+ ok $res->code == HTTP_OK, "Check that the request was OK";
+ ok $res->content eq "foo => 1, bar => 2", "Check its content";
+
+Note that you can also use C<Apache::TestRequest> with
+C<Test::Builder> and its derivatives, including C<Test::More>:
+
+ use Test::More;
+ # ...
+ is $res->code, HTTP_OK, "Check that the request was OK";
+ is $res->content, "foo => 1, bar => 2", "Check its content";
+
+=head1 CONFIGURATION FUNCTION
+
+You can tell C<Apache::TestRequest> what kind of C<LWP::UserAgent>
+object to use for its convenience functions with C<user_agent()>. This
+function uses its arguments to construct an internal global
+C<LWP::UserAgent> object that will be used for all subsequent requests
+made by the convenience functions. The arguments it takes are the same
+as for the C<LWP::UserAgent> constructor. See the
+C<L<LWP::UserAgent|LWP::UserAgent>> documentation for a complete list.
+
+The C<user_agent()> function only creates the internal
+C<LWP::UserAgent> object the first time it is called. Since this
+function is called internally by C<Apache::TestRequest>, you should
+always use the C<reset> parameter to force it to create a new global
+C<LWP::UserAgent> Object:
+
+ Apache::TestRequest::user_agent(reset => 1, %params);
+
+C<user_agent()> differs from C<< LWP::UserAgent->new >> in two
+additional ways. First, it supports an additional parameter,
+C<keep_alive>, which enables connection persistence, where the same
+connection is used to process multiple requests (and, according to the
+C<L<LWP::UserAgent|LWP::UserAgent>> documentation, has the effect of
+loading and enabling the new experimental HTTP/1.1 protocol module).
+
+And finally, the semantics of the C<requests_redirectable> parameter is
+different than for C<LWP::UserAgent> in that you can pass it a boolean
+value as well as an array for C<LWP::UserAgent>. To force
+C<Apache::TestRequest> not to follow redirects in any of its convenience
+functions, pass a false value to C<requests_redirectable>:
+
+ Apache::TestRequest::user_agent(reset => 1,
+ requests_redirectable => 0);
+
+If LWP is not installed, then you can still pass in an array reference
+as C<LWP::UserAgent> expects. C<Apache::TestRequest> will examine the
+array and allow redirects if the array contains more than one value or
+if there is only one value and that value is not "POST":
+
+ # Always allow redirection.
+ my $redir = have_lwp() ? [qw(GET HEAD POST)] : 1;
+ Apache::TestRequest::user_agent(reset => 1,
+ requests_redirectable => $redir);
+
+But note that redirection will B<not> work with C<POST> unless LWP is
+installed. It's best, therefore, to check C<have_lwp> before running
+tests that rely on a redirection from C<POST>.
+
+Sometimes it is desireable to have C<Apache::TestRequest> remember
+cookies sent by the pages you are testing and send them back to the
+server on subsequent requests. This is especially necessary when
+testing pages whose functionality relies on sessions or the presence
+of preferences stored in cookies.
+
+By default, C<LWP::UserAgent> does B<not> remember cookies between
+requests. You can tell it to remember cookies between request by
+adding:
+
+ Apache::TestRequest::user_agent(cookie_jar => {});
+
+before issuing the requests.
+
+
+=head1 FUNCTIONS
+
+C<Apache::TestRequest> exports a number of functions that will likely
+prove convenient for use in the majority of your request tests.
+
+
+
+
+=head2 Optional Parameters
+
+Each function also takes a number of optional arguments.
+
+=over 4
+
+=item redirect_ok
+
+By default a request will follow redirects retrieved from the server. To
+prevent this behavior, pass a false value to a C<redirect_ok>
+parameter:
+
+ my $res = GET $uri, redirect_ok => 0;
+
+Alternately, if all of your tests need to disable redirects, tell
+C<Apache::TestRequest> to use an C<LWP::UserAgent> object that
+disables redirects:
+
+ Apache::TestRequest::user_agent( reset => 1,
+ requests_redirectable => 0 );
+
+=item cert
+
+If you need to force an SSL request to use a particular SSL
+certificate, pass the name of the certificate via the C<cert>
+parameter:
+
+ my $res = GET $uri, cert => 'my_cert';
+
+=item content
+
+If you need to add content to your request, use the C<content>
+parameter:
+
+ my $res = GET $uri, content => 'hello world!';
+
+=item filename
+
+The name of a local file on the file system to be sent to the Apache
+test server via C<UPLOAD()> and its friends.
+
+=back
+
+=head2 The Functions
+
+=head3 GET
+
+ my $res = GET $uri;
+
+Sends a simple GET request to the Apache test server. Returns an
+C<HTTP::Response> object.
+
+You can also supply additional headers to be sent with the request by
+adding their name/value pairs after the C<url> parameter, for example:
+
+ my $res = GET $url, 'Accept-Language' => 'de,en-us,en;q=0.5';
+
+=head3 GET_STR
+
+A shortcut function for C<GET($uri)-E<gt>as_string>.
+
+=head3 GET_BODY
+
+A shortcut function for C<GET($uri)-E<gt>content>.
+
+=head3 GET_BODY_ASSERT
+
+Use this function when your test is outputting content that you need
+to check, and you want to make sure that the request was successful
+before comparing the contents of the request. If the request was
+unsuccessful, C<GET_BODY_ASSERT> will return an error
+message. Otherwise it will simply return the content of the request
+just as C<GET_BODY> would.
+
+=head3 GET_OK
+
+A shortcut function for C<GET($uri)-E<gt>is_success>.
+
+=head3 GET_RC
+
+A shortcut function for C<GET($uri)-E<gt>code>.
+
+=head3 GET_HEAD
+
+Throws out the content of the request, and returns the string
+representation of the request. Since the body has been thrown out, the
+representation will consist solely of the headers. Furthermore,
+C<GET_HEAD> inserts a "#" at the beginning of each line of the return
+string, so that the contents are suitable for printing to STDERR
+during your tests without interfering with the workings of
+C<Test::Harness>.
+
+=head3 HEAD
+
+ my $res = HEAD $uri;
+
+Sends a HEAD request to the Apache test server. Returns an
+C<HTTP::Response> object.
+
+=head3 HEAD_STR
+
+A shortcut function for C<HEAD($uri)-E<gt>as_string>.
+
+=head3 HEAD_BODY
+
+A shortcut function for C<HEAD($uri)-E<gt>content>. Of course, this
+means that it will likely return nothing.
+
+=head3 HEAD_BODY_ASSERT
+
+Use this function when your test is outputting content that you need
+to check, and you want to make sure that the request was successful
+before comparing the contents of the request. If the request was
+unsuccessful, C<HEAD_BODY_ASSERT> will return an error
+message. Otherwise it will simply return the content of the request
+just as C<HEAD_BODY> would.
+
+=head3 HEAD_OK
+
+A shortcut function for C<GET($uri)-E<gt>is_success>.
+
+=head3 HEAD_RC
+
+A shortcut function for C<GET($uri)-E<gt>code>.
+
+=head3 HEAD_HEAD
+
+Throws out the content of the request, and returns the string
+representation of the request. Since the body has been thrown out, the
+representation will consist solely of the headers. Furthermore,
+C<GET_HEAD> inserts a "#" at the beginning of each line of the return
+string, so that the contents are suitable for printing to STDERR
+during your tests without interfering with the workings of
+C<Test::Harness>.
+
+=head3 PUT
+
+ my $res = PUT $uri;
+
+Sends a simple PUT request to the Apache test server. Returns an
+C<HTTP::Response> object.
+
+=head3 PUT_STR
+
+A shortcut function for C<PUT($uri)-E<gt>as_string>.
+
+=head3 PUT_BODY
+
+A shortcut function for C<PUT($uri)-E<gt>content>.
+
+=head3 PUT_BODY_ASSERT
+
+Use this function when your test is outputting content that you need
+to check, and you want to make sure that the request was successful
+before comparing the contents of the request. If the request was
+unsuccessful, C<PUT_BODY_ASSERT> will return an error
+message. Otherwise it will simply return the content of the request
+just as C<PUT_BODY> would.
+
+=head3 PUT_OK
+
+A shortcut function for C<PUT($uri)-E<gt>is_success>.
+
+=head3 PUT_RC
+
+A shortcut function for C<PUT($uri)-E<gt>code>.
+
+=head3 PUT_HEAD
+
+Throws out the content of the request, and returns the string
+representation of the request. Since the body has been thrown out, the
+representation will consist solely of the headers. Furthermore,
+C<PUT_HEAD> inserts a "#" at the beginning of each line of the return
+string, so that the contents are suitable for printing to STDERR
+during your tests without interfering with the workings of
+C<Test::Harness>.
+
+=head3 POST
+
+ my $res = POST $uri, [ arg => $val, arg2 => $val ];
+
+Sends a POST request to the Apache test server and returns an
+C<HTTP::Response> object. An array reference of parameters passed as
+the second argument will be submitted to the Apache test server as the
+POST content. Parameters corresponding to those documented in
+L<Optional Parameters|/Optional
+Parameters> can follow the optional array reference of parameters, or after
+C<$uri>.
+
+To upload a chunk of data, simply use:
+
+ my $res = POST $uri, content => $data;
+
+=head3 POST_STR
+
+A shortcut function for C<POST($uri, @args)-E<gt>content>.
+
+=head3 POST_BODY
+
+A shortcut function for C<POST($uri, @args)-E<gt>content>.
+
+=head3 POST_BODY_ASSERT
+
+Use this function when your test is outputting content that you need
+to check, and you want to make sure that the request was successful
+before comparing the contents of the request. If the request was
+unsuccessful, C<POST_BODY_ASSERT> will return an error
+message. Otherwise it will simply return the content of the request
+just as C<POST_BODY> would.
+
+=head3 POST_OK
+
+A shortcut function for C<POST($uri, @args)-E<gt>is_success>.
+
+=head3 POST_RC
+
+A shortcut function for C<POST($uri, @args)-E<gt>code>.
+
+=head3 POST_HEAD
+
+Throws out the content of the request, and returns the string
+representation of the request. Since the body has been thrown out, the
+representation will consist solely of the headers. Furthermore,
+C<POST_HEAD> inserts a "#" at the beginning of each line of the return
+string, so that the contents are suitable for printing to STDERR
+during your tests without interfering with the workings of
+C<Test::Harness>.
+
+=head3 UPLOAD
+
+ my $res = UPLOAD $uri, \@args, filename => $filename;
+
+Sends a request to the Apache test server that includes an uploaded
+file. Other POST parameters can be passed as a second argument as an
+array reference.
+
+C<Apache::TestRequest> will read in the contents of the file named via
+the C<filename> parameter for submission to the server. If you'd
+rather, you can submit use the C<content> parameter instead of
+C<filename>, and its value will be submitted to the Apache server as
+file contents:
+
+ my $res = UPLOAD $uri, undef, content => "This is file content";
+
+The name of the file sent to the server will simply be "b". Note that
+in this case, you cannot pass other POST arguments to C<UPLOAD()> --
+they would be ignored.
+
+=head3 UPLOAD_BODY
+
+A shortcut function for C<UPLOAD($uri, @params)-E<gt>content>.
+
+=head3 UPLOAD_BODY_ASSERT
+
+Use this function when your test is outputting content that you need
+to check, and you want to make sure that the request was successful
+before comparing the contents of the request. If the request was
+unsuccessful, C<UPLOAD_BODY_ASSERT> will return an error
+message. Otherwise it will simply return the content of the request
+just as C<UPLOAD_BODY> would.
+
+=head3 OPTIONS
+
+ my $res = OPTIONS $uri;
+
+Sends an C<OPTIONS> request to the Apache test server. Returns an
+C<HTTP::Response> object with the I<Allow> header, indicating which
+methods the server supports. Possible methods include C<OPTIONS>,
+C<GET>, C<HEAD> and C<POST>. This function thus can be useful for
+testing what options the Apache server supports. Consult the HTTPD 1.1
+specification, section 9.2, at
+I<http://www.faqs.org/rfcs/rfc2616.html> for more information.
+
+
+
+
+
+=head2 URL Manipulation Functions
+
+C<Apache::TestRequest> also includes a few helper functions to aid in
+the creation of urls used in the functions above.
+
+
+
+=head3 C<module2path>
+
+ $path = Apache::TestRequest::module2path($module_name);
+
+Convert a module name to a path, safe for use in the various request
+methods above. e.g. C<::> can't be used in URLs on win32. For example:
+
+ $path = Apache::TestRequest::module2path('Foo::Bar');
+
+returns:
+
+ /Foo__Bar
+
+
+
+
+=head3 C<module2url>
+
+ $url = Apache::TestRequest::module2url($module);
+ $url = Apache::TestRequest::module2url($module, \%options);
+
+Convert a module name to a full URL including the current
+configurations C<hostname:port> and sets C<module> accordingly.
+
+ $url = Apache::TestRequest::module2url('Foo::Bar');
+
+returns:
+
+ http://$hostname:$port/Foo__Bar
+
+The default scheme used is C<http>. You can override this by passing
+your preferred scheme into an optional second param. For example:
+
+ $module = 'MyTestModule::TestHandler';
+ $url = Apache::TestRequest::module2url($module, {scheme => 'https'});
+
+returns:
+
+ https://$hostname:$port/MyTestModule__TestHandler
+
+You may also override the default path with a path of your own:
+
+ $module = 'MyTestModule::TestHandler';
+ $url = Apache::TestRequest::module2url($module, {path => '/foo'});
+
+returns:
+
+ http://$hostname:$port/foo
+
+
+
+
+
+=head1 ENVIRONMENT VARIABLES
+
+The following environment variables can affect the behavior of
+C<Apache::TestRequest>:
+
+=over
+
+=item APACHE_TEST_PRETEND_NO_LWP
+
+If the environment variable C<APACHE_TEST_PRETEND_NO_LWP> is set to a
+true value, C<Apache::TestRequest> will pretend that LWP is not
+available so one can test whether the test suite will survive on a
+system which doesn't have libwww-perl installed.
+
+=item APACHE_TEST_HTTP_09_OK
+
+If the environment variable C<APACHE_TEST_HTTP_09_OK> is set to a
+true value, C<Apache::TestRequest> will allow HTTP/0.9 responses
+from the server to proceed. The default behavior is to die if
+the response protocol is not either HTTP/1.0 or HTTP/1.1.
+
+=back
+
+=head1 SEE ALSO
+
+L<Apache::Test|Apache::Test> is the main Apache testing module. Use it
+to set up your tests, create a plan, and to ensure that you have the
+Apache version and modules you need.
+
+Use L<Apache::TestMM|Apache::TestMM> in your I<Makefile.PL> to set up
+your distribution for testing.
+
+=head1 AUTHOR
+
+Doug MacEachern with contributions from Geoffrey Young, Philippe
+M. Chiasson, Stas Bekman and others. Documentation by David Wheeler.
+
+Questions can be asked at the test-dev <at> httpd.apache.org list. For
+more information see: I<http://httpd.apache.org/test/> and
+I<http://perl.apache.org/docs/general/testing/testing.html>.
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestRun.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestRun.pm
new file mode 100644
index 0000000..f398eb5
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestRun.pm
@@ -0,0 +1,1220 @@
+# 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::TestRun;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test ();
+use Apache::TestMM ();
+use Apache::TestConfig ();
+use Apache::TestConfigC ();
+use Apache::TestRequest ();
+use Apache::TestHarness ();
+use Apache::TestTrace;
+
+use Cwd;
+use ExtUtils::MakeMaker;
+use File::Find qw(finddepth);
+use File::Path;
+use File::Spec::Functions qw(catfile catdir canonpath);
+use File::Basename qw(basename dirname);
+use Getopt::Long qw(GetOptions);
+use Config;
+
+use constant IS_APACHE_TEST_BUILD => Apache::TestConfig::IS_APACHE_TEST_BUILD;
+
+use constant STARTUP_TIMEOUT => 300; # secs (good for extreme debug cases)
+
+use subs qw(exit_shell exit_perl);
+
+my $orig_command;
+my $orig_cwd;
+my $orig_conf_opts;
+
+my %core_files = ();
+
+my @std_run = qw(start-httpd run-tests stop-httpd);
+my @others = qw(verbose configure clean help ssl http11 bugreport
+ save no-httpd one-process);
+my @flag_opts = (@std_run, @others);
+my @string_opts = qw(order trace);
+my @ostring_opts = qw(proxy ping);
+my @debug_opts = qw(debug);
+my @list_opts = qw(preamble postamble breakpoint);
+my @hash_opts = qw(header);
+my @help_opts = qw(clean help);
+my @request_opts = qw(get post head);
+
+my @exit_opts_no_need_httpd = (@help_opts);
+my @exit_opts_need_httpd = (@debug_opts, qw(ping));
+
+my %usage = (
+ 'start-httpd' => 'start the test server',
+ 'run-tests' => 'run the tests',
+ 'order=mode' => 'run the tests in one of the modes: ' .
+ '(repeat|random|SEED)',
+ 'stop-httpd' => 'stop the test server',
+ 'no-httpd' => 'run the tests without configuring or starting httpd',
+ 'verbose[=1]' => 'verbose output',
+ 'configure' => 'force regeneration of httpd.conf ' .
+ ' (tests will not be run)',
+ 'clean' => 'remove all generated test files',
+ 'help' => 'display this message',
+ 'bugreport' => 'print the hint how to report problems',
+ 'preamble' => 'config to add at the beginning of httpd.conf',
+ 'postamble' => 'config to add at the end of httpd.conf',
+ 'ping[=block]' => 'test if server is running or port in use',
+ 'debug[=name]' => 'start server under debugger name (gdb, ddd, etc.)',
+ 'breakpoint=bp' => 'set breakpoints (multiply bp can be set)',
+ 'header' => "add headers to (" .
+ join('|', @request_opts) . ") request",
+ 'http11' => 'run all tests with HTTP/1.1 (keep alive) requests',
+ 'ssl' => 'run tests through ssl',
+ 'proxy' => 'proxy requests (default proxy is localhost)',
+ 'trace=T' => 'change tracing default to: warning, notice, ' .
+ 'info, debug, ...',
+ 'one-process' => 'run the server in single process mode',
+ (map { $_, "\U$_\E url" } @request_opts),
+);
+
+sub fixup {
+ #make sure we use an absolute path to perl
+ #else Test::Harness uses the perl in our PATH
+ #which might not be the one we want
+ $^X = $Config{perlpath} unless -e $^X;
+}
+
+# if the test suite was aborted because of a user-error we don't want
+# to call the bugreport and invite users to submit a bug report -
+# after all it's a user error. but we still want the program to fail,
+# so raise this flag in such a case.
+my $user_error = 0;
+sub user_error {
+ my $self = shift;
+ $user_error = shift if @_;
+ $user_error;
+}
+
+sub new {
+ my $class = shift;
+
+ my $self = bless {
+ tests => [],
+ @_,
+ }, $class;
+
+ $self->fixup;
+
+ $self;
+}
+
+#split arguments into test files/dirs and options
+#take extra care if -e, the file matches /\.t$/
+# if -d, the dir contains .t files
+#so we dont slurp arguments that are not tests, example:
+# httpd $HOME/apache-2.0/bin/httpd
+
+sub split_test_args {
+ my($self) = @_;
+
+ my(@tests);
+ my $top_dir = $self->{test_config}->{vars}->{top_dir};
+ my $t_dir = $self->{test_config}->{vars}->{t_dir};
+
+ my $argv = $self->{argv};
+ my @leftovers = ();
+ for (@$argv) {
+ my $arg = $_;
+ # need the t/ (or t\) for stat-ing, but don't want to include
+ # it in test output
+ $arg =~ s@^(?:\.[\\/])?t[\\/]@@;
+ my $file = catfile $t_dir, $arg;
+ if (-d $file and $_ ne '/') {
+ my @files = <$file/*.t>;
+ my $remove = catfile $top_dir, "";
+ if (@files) {
+ push @tests, map { s,^\Q$remove,,; $_ } @files;
+ next;
+ }
+ }
+ else {
+ if ($file =~ /\.t$/ and -e $file) {
+ push @tests, "t/$arg";
+ next;
+ }
+ elsif (-e "$file.t") {
+ push @tests, "t/$arg.t";
+ next;
+ }
+ elsif (/^[\d.]+$/) {
+ my @t = $_;
+ #support range of subtests: t/TEST t/foo/bar 60..65
+ if (/^(\d+)\.\.(\d+)$/) {
+ @t = $1..$2;
+ }
+
+ push @{ $self->{subtests} }, @t;
+ next;
+ }
+ }
+ push @leftovers, $_;
+ }
+
+ $self->{tests} = [ map { canonpath($_) } @tests ];
+ $self->{argv} = \@leftovers;
+}
+
+sub die_on_invalid_args {
+ my($self) = @_;
+
+ # at this stage $self->{argv} should be empty
+ my @invalid_argv = @{ $self->{argv} };
+ if (@invalid_argv) {
+ error "unknown opts or test names: @invalid_argv\n" .
+ "-help will list options\n";
+ exit_perl 0;
+ }
+
+}
+
+sub passenv {
+ my $passenv = Apache::TestConfig->passenv;
+ for (keys %$passenv) {
+ return 1 if $ENV{$_};
+ }
+ 0;
+}
+
+sub getopts {
+ my($self, $argv) = @_;
+
+ local *ARGV = $argv;
+ my(%opts, %vopts, %conf_opts);
+
+ # a workaround to support -verbose and -verbose=0|1
+ # $Getopt::Long::VERSION > 2.26 can use the "verbose:1" rule
+ # but we have to support older versions as well
+ @ARGV = grep defined,
+ map {/-verbose=(\d)/ ? ($1 ? '-verbose' : undef) : $_ } @ARGV;
+
+ # permute : optional values can come before the options
+ # pass_through : all unknown things are to be left in @ARGV
+ Getopt::Long::Configure(qw(pass_through permute));
+
+ # grab from @ARGV only the options that we expect
+ GetOptions(\%opts, @flag_opts, @help_opts,
+ (map "$_:s", @debug_opts, @request_opts, @ostring_opts),
+ (map "$_=s", @string_opts),
+ (map { ("$_=s", $vopts{$_} ||= []) } @list_opts),
+ (map { ("$_=s", $vopts{$_} ||= {}) } @hash_opts));
+
+ $opts{$_} = $vopts{$_} for keys %vopts;
+
+ # separate configuration options and test files/dirs
+ my $req_wanted_args = Apache::TestRequest::wanted_args();
+ my @argv = ();
+ my %req_args = ();
+
+ while (@ARGV) {
+ my $val = shift @ARGV;
+ if ($val =~ /^--?(.+)/) { # must have a leading - or --
+ my $key = lc $1;
+ # a known config option?
+ if (exists $Apache::TestConfig::Usage{$key}) {
+ $conf_opts{$key} = shift @ARGV;
+ next;
+ } # a TestRequest config option?
+ elsif (exists $req_wanted_args->{$key}) {
+ $req_args{$key} = shift @ARGV;
+ next;
+ }
+ }
+ # to be processed later
+ push @argv, $val;
+ }
+
+ # save the orig args (make a deep copy)
+ $orig_conf_opts = { %conf_opts };
+
+ # fixup the filepath options on win32 (spaces, short names, etc.)
+ if (Apache::TestConfig::WIN32) {
+ for my $key (keys %conf_opts) {
+ next unless Apache::TestConfig::conf_opt_is_a_filepath($key);
+ next unless -e $conf_opts{$key};
+ $conf_opts{$key} = Win32::GetShortPathName($conf_opts{$key});
+ }
+ }
+
+ $opts{req_args} = \%req_args;
+
+ # only test files/dirs if any at all are left in argv
+ $self->{argv} = \@argv;
+
+ # force regeneration of httpd.conf if commandline args want to
+ # modify it. configure_opts() has more checks to decide whether to
+ # reconfigure or not.
+ # XXX: $self->passenv() is already tested in need_reconfiguration()
+ $self->{reconfigure} = $opts{configure} ||
+ (grep { $opts{$_}->[0] } qw(preamble postamble)) ||
+ (grep { $Apache::TestConfig::Usage{$_} } keys %conf_opts ) ||
+ $self->passenv() || (! -e 't/conf/httpd.conf');
+
+ if (exists $opts{debug}) {
+ $opts{debugger} = $opts{debug};
+ $opts{debug} = 1;
+ }
+
+ if ($opts{trace}) {
+ my %levels = map {$_ => 1} @Apache::TestTrace::Levels;
+ if (exists $levels{ $opts{trace} }) {
+ $Apache::TestTrace::Level = $opts{trace};
+ # propogate the override for the server-side.
+ # -trace overrides any previous APACHE_TEST_TRACE_LEVEL settings
+ $ENV{APACHE_TEST_TRACE_LEVEL} = $opts{trace};
+ }
+ else {
+ error "unknown trace level: $opts{trace}",
+ "valid levels are: @Apache::TestTrace::Levels";
+ exit_perl 0;
+ }
+ }
+
+ # breakpoint automatically turns the debug mode on
+ if (@{ $opts{breakpoint} }) {
+ $opts{debug} ||= 1;
+ }
+
+ if ($self->{reconfigure}) {
+ $conf_opts{save} = 1;
+ delete $self->{reconfigure};
+ }
+ else {
+ $conf_opts{thaw} = 1;
+ }
+
+ #propagate some values
+ for (qw(verbose)) {
+ $conf_opts{$_} = $opts{$_};
+ }
+
+ $self->{opts} = \%opts;
+ $self->{conf_opts} = \%conf_opts;
+}
+
+sub default_run_opts {
+ my $self = shift;
+ my($opts, $tests) = ($self->{opts}, $self->{tests});
+
+ unless (grep { exists $opts->{$_} } @std_run, @request_opts) {
+ if (@$tests && $self->{server}->ping) {
+ # if certain tests are specified and server is running,
+ # dont restart
+ $opts->{'run-tests'} = 1;
+ }
+ else {
+ #default is start-server run-tests stop-server
+ $opts->{$_} = 1 for @std_run;
+ }
+ }
+
+ $opts->{'run-tests'} ||= @$tests;
+}
+
+my $parent_pid = $$;
+sub is_parent { $$ == $parent_pid }
+
+my $caught_sig_int = 0;
+
+sub install_sighandlers {
+ my $self = shift;
+
+ my($server, $opts) = ($self->{server}, $self->{opts});
+
+ $SIG{__DIE__} = sub {
+ return unless $_[0] =~ /^Failed/i; #dont catch Test::ok failures
+
+ # _show_results() calls die() under a few conditions, such as
+ # when no tests are run or when tests fail. make sure the message
+ # is propagated back to the user.
+ print $_[0] if (caller(1))[3]||'' eq 'Test::Harness::_show_results';
+
+ $server->stop(1) if $opts->{'start-httpd'};
+ $server->failed_msg("error running tests");
+ exit_perl 0;
+ };
+
+ $SIG{INT} = sub {
+ if ($caught_sig_int++) {
+ warning "\ncaught SIGINT";
+ exit_perl 0;
+ }
+ warning "\nhalting tests";
+ $server->stop if $opts->{'start-httpd'};
+ exit_perl 0;
+ };
+
+ #try to make sure we scan for core no matter what happens
+ #must eval "" to "install" this END block, otherwise it will
+ #always run, a subclass might not want that
+ eval 'END {
+ return unless is_parent(); # because of fork
+ $self ||=
+ Apache::TestRun->new(test_config => Apache::TestConfig->thaw);
+ {
+ local $?; # preserve the exit status
+ eval {
+ $self->scan_core;
+ };
+ }
+ $self->try_bug_report();
+ }';
+ die "failed: $@" if $@;
+
+}
+
+sub try_bug_report {
+ my $self = shift;
+ if ($? && !$self->user_error &&
+ $self->{opts}->{bugreport} && $self->can('bug_report')) {
+ $self->bug_report;
+ }
+}
+
+#throw away cached config and start fresh
+sub refresh {
+ my $self = shift;
+ $self->opt_clean(1);
+ $self->{conf_opts}->{save} = delete $self->{conf_opts}->{thaw} || 1;
+ $self->{test_config} = $self->new_test_config()->httpd_config;
+ $self->{test_config}->{server}->{run} = $self;
+ $self->{server} = $self->{test_config}->server;
+}
+
+sub configure_opts {
+ my $self = shift;
+ my $save = shift;
+ my $refreshed = 0;
+
+ my($test_config, $opts) = ($self->{test_config}, $self->{opts});
+
+ $test_config->{vars}->{scheme} =
+ $opts->{ssl} ? 'https' :
+ $self->{conf_opts}->{scheme} || 'http';
+
+ if ($opts->{http11}) {
+ $ENV{APACHE_TEST_HTTP11} = 1;
+ }
+
+ # unless we are already reconfiguring, check for .conf.in files changes
+ if (!$$save &&
+ (my @reasons =
+ $self->{test_config}->need_reconfiguration($self->{conf_opts}))) {
+ warning "forcing re-configuration:";
+ warning "\t- $_." for @reasons;
+ unless ($refreshed) {
+ $self->refresh;
+ $refreshed = 1;
+ $test_config = $self->{test_config};
+ }
+ }
+
+ # unless we are already reconfiguring, check for -proxy
+ if (!$$save && exists $opts->{proxy}) {
+ my $max = $test_config->{vars}->{maxclients};
+ $opts->{proxy} ||= 'on';
+
+ #if config is cached and MaxClients == 1, must reconfigure
+ if (!$$save and $opts->{proxy} eq 'on' and $max == 1) {
+ $$save = 1;
+ warning "server is reconfigured for proxy";
+ unless ($refreshed) {
+ $self->refresh;
+ $refreshed = 1;
+ $test_config = $self->{test_config};
+ }
+ }
+
+ $test_config->{vars}->{proxy} = $opts->{proxy};
+ }
+ else {
+ $test_config->{vars}->{proxy} = 'off';
+ }
+
+ return unless $$save;
+
+ my $preamble = sub { shift->preamble($opts->{preamble}) };
+ my $postamble = sub { shift->postamble($opts->{postamble}) };
+
+ $test_config->preamble_register($preamble);
+ $test_config->postamble_register($postamble);
+}
+
+sub pre_configure { }
+
+sub configure {
+ my $self = shift;
+
+ if ($self->{opts}->{'no-httpd'}) {
+ warning "skipping httpd configuration";
+ return;
+ }
+
+ # create the conf dir as early as possible
+ $self->{test_config}->prepare_t_conf();
+
+ my $save = \$self->{conf_opts}->{save};
+ $self->configure_opts($save);
+
+ my $config = $self->{test_config};
+ unless ($$save) {
+ my $addr = \$config->{vars}->{remote_addr};
+ my $remote_addr = $config->our_remote_addr;
+ unless ($$addr eq $remote_addr) {
+ warning "local ip address has changed, updating config cache";
+ $$addr = $remote_addr;
+ }
+ #update minor changes to cached config
+ #without complete regeneration
+ #for example this allows switching between
+ #'t/TEST' and 't/TEST -ssl'
+ $config->sync_vars(qw(scheme proxy remote_addr));
+ return;
+ }
+
+ my $test_config = $self->{test_config};
+ $test_config->sslca_generate;
+ $test_config->generate_ssl_conf if $self->{opts}->{ssl};
+ $test_config->cmodules_configure;
+ $test_config->generate_httpd_conf;
+ $test_config->save;
+
+}
+
+sub try_exit_opts {
+ my $self = shift;
+ my @opts = @_;
+
+ for (@opts) {
+ next unless exists $self->{opts}->{$_};
+ my $method = "opt_$_";
+ my $rc = $self->$method();
+ exit_perl $rc if $rc;
+ }
+
+ if ($self->{opts}->{'stop-httpd'}) {
+ my $ok = 1;
+ if ($self->{server}->ping) {
+ $ok = $self->{server}->stop;
+ $ok = $ok < 0 ? 0 : 1; # adjust to 0/1 logic
+ }
+ else {
+ warning "server $self->{server}->{name} is not running";
+ # cleanup a stale pid file if found
+ my $pid_file = $self->{test_config}->{vars}->{t_pid_file};
+ unlink $pid_file if -e $pid_file;
+ }
+ exit_perl $ok;
+ }
+}
+
+sub start {
+ my $self = shift;
+
+ my $opts = $self->{opts};
+ my $server = $self->{server};
+
+ #if t/TEST -d is running make sure we don't try to stop/start the server
+ my $file = $server->debugger_file;
+ if (-e $file and $opts->{'start-httpd'}) {
+ if ($server->ping) {
+ warning "server is running under the debugger, " .
+ "defaulting to -run";
+ $opts->{'start-httpd'} = $opts->{'stop-httpd'} = 0;
+ }
+ else {
+ warning "removing stale debugger note: $file";
+ unlink $file;
+ }
+ }
+
+ $self->check_runtime_user();
+
+ if ($opts->{'start-httpd'}) {
+ exit_perl 0 unless $server->start;
+ }
+ elsif ($opts->{'run-tests'}) {
+ my $is_up = $server->ping
+ || (exists $self->{opts}->{ping}
+ && $self->{opts}->{ping} eq 'block'
+ && $server->wait_till_is_up(STARTUP_TIMEOUT));
+ unless ($is_up) {
+ error "server is not ready yet, try again.";
+ exit_perl 0;
+ }
+ }
+}
+
+sub run_tests {
+ my $self = shift;
+
+ my $test_opts = {
+ verbose => $self->{opts}->{verbose},
+ tests => $self->{tests},
+ order => $self->{opts}->{order},
+ subtests => $self->{subtests} || [],
+ };
+
+ if (grep { exists $self->{opts}->{$_} } @request_opts) {
+ run_request($self->{test_config}, $self->{opts});
+ }
+ else {
+ Apache::TestHarness->run($test_opts)
+ if $self->{opts}->{'run-tests'};
+ }
+}
+
+sub stop {
+ my $self = shift;
+
+ return $self->{server}->stop if $self->{opts}->{'stop-httpd'};
+}
+
+sub new_test_config {
+ my $self = shift;
+
+ Apache::TestConfig->new($self->{conf_opts});
+}
+
+sub set_ulimit_via_sh {
+ return if Apache::TestConfig::WINFU;
+ return if $ENV{APACHE_TEST_ULIMIT_SET};
+
+ # only root can allow unlimited core dumps on Solaris (8 && 9?)
+ if (Apache::TestConfig::SOLARIS) {
+ my $user = getpwuid($>) || '';
+ if ($user ne 'root') {
+ warning "Skipping 'set unlimited ulimit for coredumps', " .
+ "since we are running as a non-root user on Solaris";
+ return;
+ }
+ }
+
+ my $binsh = '/bin/sh';
+ return unless -e $binsh;
+ $ENV{APACHE_TEST_ULIMIT_SET} = 1;
+
+ my $sh = Symbol::gensym();
+ open $sh, "echo ulimit -a | $binsh|" or die;
+ local $_;
+ while (<$sh>) {
+ if (/^core.*unlimited$/) {
+ #already set to unlimited
+ $ENV{APACHE_TEST_ULIMIT_SET} = 1;
+ return;
+ }
+ }
+ close $sh;
+
+ $orig_command = "ulimit -c unlimited; $orig_command";
+ warning "setting ulimit to allow core files\n$orig_command";
+ # use 'or die' to avoid warnings due to possible overrides of die
+ exec $orig_command or die "exec $orig_command has failed";
+}
+
+sub set_ulimit {
+ my $self = shift;
+ #return if $self->set_ulimit_via_bsd_resource;
+ eval { $self->set_ulimit_via_sh };
+}
+
+sub set_env {
+ #export some environment variables for t/modules/env.t
+ #(the values are unimportant)
+ $ENV{APACHE_TEST_HOSTNAME} = 'test.host.name';
+ $ENV{APACHE_TEST_HOSTTYPE} = 'z80';
+}
+
+sub run {
+ my $self = shift;
+
+ # assuming that test files are always in the same directory as the
+ # driving script, make it possible to run the test suite from any place
+ # use a full path, which will work after chdir (e.g. ./TEST)
+ $0 = File::Spec->rel2abs($0);
+ if (-e $0) {
+ my $top = dirname dirname $0;
+ chdir $top if $top and -d $top;
+ }
+
+ # reconstruct argv, preserve multiwords args, eg 'PerlTrace all'
+ my $argv = join " ", map { /^-/ ? $_ : qq['$_'] } @ARGV;
+ $orig_command = "$^X $0 $argv";
+ $orig_cwd = Cwd::cwd();
+ $self->set_ulimit;
+ $self->set_env; #make sure these are always set
+
+ $self->detect_relocation($orig_cwd);
+
+ my(@argv) = @_;
+
+ $self->getopts(\@argv);
+
+ $self->pre_configure();
+
+ # can't setup the httpd-specific parts of the config object yet
+ $self->{test_config} = $self->new_test_config();
+
+ $self->warn_core();
+
+ # give TestServer access to our runtime configuration directives
+ # so we can tell the server stuff if we need to
+ $self->{test_config}->{server}->{run} = $self;
+
+ $self->{server} = $self->{test_config}->server;
+
+ local($SIG{__DIE__}, $SIG{INT});
+ $self->install_sighandlers;
+
+ $self->try_exit_opts(@exit_opts_no_need_httpd);
+
+ # httpd is found here (unless it was already configured before)
+ $self->{test_config}->httpd_config();
+
+ $self->try_exit_opts(@exit_opts_need_httpd);
+
+ if ($self->{opts}->{configure}) {
+ warning "cleaning out current configuration";
+ $self->opt_clean(1);
+ }
+
+ $self->split_test_args;
+
+ $self->die_on_invalid_args;
+
+ $self->default_run_opts;
+
+ # if configure() fails for some reason before it has flushed the
+ # config to a file, save it so -clean will be able to clean
+ if ($self->{opts}->{'start-httpd'} || $self->{opts}->{'configure'}) {
+ eval { $self->configure };
+ if ($@) {
+ error "configure() has failed:\n$@";
+ warning "forcing Apache::TestConfig object save";
+ $self->{test_config}->save;
+ warning "run 't/TEST -clean' to clean up before continuing";
+ exit_perl 0;
+ }
+ }
+
+ if ($self->{opts}->{configure}) {
+ warning "reconfiguration done";
+ exit_perl 1;
+ }
+
+ $self->start unless $self->{opts}->{'no-httpd'};
+
+ $self->run_tests;
+
+ $self->stop unless $self->{opts}->{'no-httpd'};
+}
+
+sub rerun {
+ my $vars = shift;
+
+ # in %$vars
+ # - httpd will be always set
+ # - apxs is optional
+
+ $orig_cwd ||= Cwd::cwd();
+ chdir $orig_cwd;
+ my $new_opts = " -httpd $vars->{httpd}";
+ $new_opts .= " -apxs $vars->{apxs}" if $vars->{apxs};
+
+ my $new_command = $orig_command;
+
+ # strip any old bogus -httpd/-apxs
+ $new_command =~ s/--?httpd\s+$orig_conf_opts->{httpd}//
+ if $orig_conf_opts->{httpd};
+ $new_command =~ s/--?httpd\s+$orig_conf_opts->{httpd}//
+ if $orig_conf_opts->{httpd} and $vars->{apxs};
+
+ # add new opts
+ $new_command .= $new_opts;
+
+ warning "running with new config opts: $new_command";
+
+ # use 'or die' to avoid warnings due to possible overrides of die
+ exec $new_command or die "exec $new_command has failed";
+}
+
+
+# make it easy to move the whole distro w/o running
+# 't/TEST -clean' before moving. when moving the whole package,
+# the old cached config will stay, so we want to nuke it only if
+# we realize that it's no longer valid. we can't just check the
+# existance of the saved top_dir value, since the project may have
+# been copied and the old dir could be still there, but that's not
+# the one that we work in
+sub detect_relocation {
+ my($self, $cur_top_dir) = @_;
+
+ my $config_file = catfile qw(t conf apache_test_config.pm);
+ return unless -e $config_file;
+
+ my %inc = %INC;
+ eval { require "$config_file" };
+ %INC = %inc; # be stealth
+ warn($@), return if $@;
+
+ my $cfg = 'apache_test_config'->new;
+
+ # if the top_dir from saved config doesn't match the current
+ # top_dir, that means that the whole project was relocated to a
+ # different directory, w/o running t/TEST -clean first (in each
+ # directory with a test suite)
+ my $cfg_top_dir = $cfg->{vars}->{top_dir};
+ return unless $cfg_top_dir;
+ return if $cfg_top_dir eq $cur_top_dir;
+
+ # if that's the case silently fixup the saved config to use the
+ # new paths, and force a complete cleanup. if we don't fixup the
+ # config files, the cleanup process won't be able to locate files
+ # to delete and re-configuration will fail
+ {
+ # in place editing
+ local @ARGV = $config_file;
+ local $^I = ".bak"; # Win32 needs a backup
+ while (<>) {
+ s{$cfg_top_dir}{$cur_top_dir}g;
+ print;
+ }
+ unlink $config_file . $^I;
+ }
+
+ my $cleanup_cmd = "$^X $0 -clean";
+ warning "cleaning up the old config";
+ # XXX: do we care to check success?
+ system $cleanup_cmd;
+
+ # XXX: I tried hard to accomplish that w/o starting a new process,
+ # but too many things get on the way, so for now just keep it as an
+ # external process, as it's absolutely transparent to the normal
+ # app-run
+}
+
+my @oh = qw(jeez golly gosh darn shucks dangit rats nuts dangnabit crap);
+sub oh {
+ $oh[ rand scalar @oh ];
+}
+
+#e.g. t/core or t/core.12499
+my $core_pat = '^core(\.\d+)?' . "\$";
+
+# $self->scan_core_incremental([$only_top_dir])
+# normally would be called after each test
+# and since it updates the list of seen core files
+# scan_core() won't report these again
+# currently used in Apache::TestSmoke
+#
+# if $only_t_dir arg is true only the t_dir dir (t/) will be scanned
+sub scan_core_incremental {
+ my($self, $only_t_dir) = @_;
+ my $vars = $self->{test_config}->{vars};
+
+ # no core files dropped on win32
+ return () if Apache::TestConfig::WIN32;
+
+ if ($only_t_dir) {
+ require IO::Dir;
+ my @cores = ();
+ for (IO::Dir->new($vars->{t_dir})->read) {
+ my $file = catfile $vars->{t_dir}, $_;
+ next unless -f $file;
+ next unless /$core_pat/o;
+ next if exists $core_files{$file} &&
+ $core_files{$file} == -M $file;
+ $core_files{$file} = -M $file;
+ push @cores, $file;
+ }
+ return @cores
+ ? join "\n", "server dumped core, for stacktrace, run:",
+ map { "gdb $vars->{httpd} -core $_" } @cores
+ : ();
+ }
+
+ my @msg = ();
+ finddepth({ no_chdir => 1,
+ wanted => sub {
+ return unless -f $_;
+ my $file = basename $File::Find::name;
+ return unless $file =~ /$core_pat/o;
+ my $core = $File::Find::name;
+ unless (exists $core_files{$core} && $core_files{$core} == -M $core) {
+ # new core file!
+
+ # XXX: could rename the file if it doesn't include the pid
+ # in its name (i.e., just called 'core', instead of 'core.365')
+
+ # XXX: could pass the test name and rename the core file
+ # to use that name as a suffix, plus pid, time or some
+ # other unique identifier, in case the same test is run
+ # more than once and each time it caused a segfault
+ $core_files{$core} = -M $core;
+ push @msg, "server dumped core, for stacktrace, run:\n" .
+ "gdb $vars->{httpd} -core $core";
+ }
+ }}, $vars->{top_dir});
+
+ return @msg;
+
+}
+
+sub scan_core {
+ my $self = shift;
+ my $vars = $self->{test_config}->{vars};
+ my $times = 0;
+
+ # no core files dropped on win32
+ return if Apache::TestConfig::WIN32;
+
+ finddepth({ no_chdir => 1,
+ wanted => sub {
+ return unless -f $_;
+ my $file = basename $File::Find::name;
+ return unless $file =~ /$core_pat/o;
+ my $core = $File::Find::name;
+ if (exists $core_files{$core} && $core_files{$core} == -M $core) {
+ # we have seen this core file before the start of the test
+ info "an old core file has been found: $core";
+ }
+ else {
+ my $oh = oh();
+ my $again = $times++ ? "again" : "";
+ error "oh $oh, server dumped core $again";
+ error "for stacktrace, run: gdb $vars->{httpd} -core $core";
+ }
+ }}, $vars->{top_dir});
+}
+
+# warn the user that there is a core file before the tests
+# start. suggest to delete it before proceeding or a false alarm can
+# be generated at the end of the test routine run.
+sub warn_core {
+ my $self = shift;
+ my $vars = $self->{test_config}->{vars};
+ %core_files = (); # reset global
+
+ # no core files dropped on win32
+ return if Apache::TestConfig::WIN32;
+
+ finddepth(sub {
+ return unless -f $_;
+ return unless /$core_pat/o;
+ my $core = "$File::Find::dir/$_";
+ info "consider removing an old $core file before running tests";
+ # remember the timestamp of $core so we can check if it's the
+ # old core file at the end of the run and not complain then
+ $core_files{$core} = -M $core;
+ }, $vars->{top_dir});
+}
+
+# catch any attempts to ./t/TEST the tests as root user
+
+sub check_runtime_user {
+ my $self = shift;
+
+ return if Apache::TestConfig::WINFU;
+
+ my $user = getpwuid($>) || '';
+
+ if ($user eq 'root') {
+ error "Apache cannot spawn child processes as root, therefore the test suite must be run as a non-privileged user.";
+ exit_perl(1);
+ }
+
+ return 1;
+}
+
+sub run_request {
+ my($test_config, $opts) = @_;
+
+ my @args = (%{ $opts->{header} }, %{ $opts->{req_args} });
+
+ my($request, $url) = ("", "");
+
+ for (@request_opts) {
+ next unless exists $opts->{$_};
+ $url = $opts->{$_} if $opts->{$_};
+ $request = join $request ? '_' : '', $request, $_;
+ }
+
+ if ($request) {
+ my $method = \&{"Apache::TestRequest::\U$request"};
+ my $res = $method->($url, @args);
+ print Apache::TestRequest::to_string($res);
+ }
+}
+
+sub opt_clean {
+ my($self, $level) = @_;
+ my $test_config = $self->{test_config};
+ $test_config->server->stop;
+ $test_config->clean($level);
+ 1;
+}
+
+sub opt_ping {
+ my($self) = @_;
+
+ my $test_config = $self->{test_config};
+ my $server = $test_config->server;
+ my $pid = $server->ping;
+ my $name = $server->{name};
+ # support t/TEST -ping=block -run ...
+ my $exit = not $self->{opts}->{'run-tests'};
+
+ if ($pid) {
+ if ($pid == -1) {
+ error "port $test_config->{vars}->{port} is in use, ".
+ "but cannot determine server pid";
+ }
+ else {
+ my $version = $server->{version};
+ warning "server $name running (pid=$pid, version=$version)";
+ }
+ return $exit;
+ }
+
+ if (exists $self->{opts}->{ping} && $self->{opts}->{ping} eq 'block') {
+ $server->wait_till_is_up(STARTUP_TIMEOUT);
+ }
+ else {
+ warning "no server is running on $name";
+ exit_perl(0);
+ }
+
+ return $exit; #means call exit() if true
+}
+
+sub test_inc {
+ map { "$_/Apache-Test/lib" } qw(. ..);
+}
+
+sub set_perl5lib {
+ $ENV{PERL5LIB} = join $Config{path_sep}, shift->test_inc();
+}
+
+sub set_perldb_opts {
+ my $config = shift->{test_config};
+ my $file = catfile $config->{vars}->{t_logs}, 'perldb.out';
+ $config->genfile($file); #mark for -clean
+ $ENV{PERLDB_OPTS} = "NonStop frame=4 AutoTrace LineInfo=$file";
+ warning "perldb log is t/logs/perldb.out";
+}
+
+sub opt_debug {
+ my $self = shift;
+ my $server = $self->{server};
+
+ my $opts = $self->{opts};
+ my $debug_opts = {};
+
+ for (qw(debugger breakpoint)) {
+ $debug_opts->{$_} = $opts->{$_};
+ }
+
+ if (my $db = $opts->{debugger}) {
+ if ($db =~ s/^perl=?//) {
+ $opts->{'run-tests'} = 1;
+ $self->start; #if not already running
+ $self->set_perl5lib;
+ $self->set_perldb_opts if $db eq 'nostop';
+ system $^X, '-MApache::TestPerlDB', '-d', @{ $self->{tests} };
+ $self->stop;
+ return 1;
+ }
+ elsif ($db =~ s/^lwp[=:]?//) {
+ $ENV{APACHE_TEST_DEBUG_LWP} = $db || 1;
+ $opts->{verbose} = 1;
+ return 0;
+ }
+ }
+
+ $server->stop;
+ $server->start_debugger($debug_opts);
+ 1;
+}
+
+sub opt_help {
+ my $self = shift;
+
+ print <<EOM;
+usage: TEST [options ...]
+ where options include:
+EOM
+
+ for (sort keys %usage){
+ printf " -%-13s %s\n", $_, $usage{$_};
+ }
+
+ print "\n configuration options:\n";
+
+ Apache::TestConfig->usage;
+ 1;
+}
+
+# generate t/TEST script (or a different filename) which will drive
+# Apache::TestRun
+sub generate_script {
+ my ($class, @opts) = @_;
+
+ my %opts = ();
+
+ # back-compat
+ if (@opts == 1) {
+ $opts{file} = $opts[0];
+ }
+ else {
+ %opts = @opts;
+ $opts{file} ||= catfile 't', 'TEST';
+ }
+
+ my $body = "BEGIN { eval { require blib && blib->import; } }\n";
+
+ my %args = @Apache::TestMM::Argv;
+ while (my($k, $v) = each %args) {
+ $v =~ s/\|/\\|/g;
+ $body .= "\n\$Apache::TestConfig::Argv{'$k'} = q|$v|;\n";
+ }
+
+ my $header = Apache::TestConfig->perlscript_header;
+
+ $body .= join "\n",
+ $header, "use $class ();";
+
+ if (my $report = $opts{bugreport}) {
+ $body .= "\n\npackage $class;\n" .
+ "sub bug_report { print '$report' }\n\n";
+ }
+
+ $body .= "$class->new->run(\@ARGV);";
+
+ Apache::Test::basic_config()->write_perlscript($opts{file},
+ $body);
+}
+
+# in idiomatic perl functions return 1 on success and 0 on
+# failure. Shell expects the opposite behavior. So this function
+# reverses the status.
+sub exit_perl {
+ exit_shell $_[0] ? 0 : 1;
+}
+
+# expects shell's exit status values (0==success)
+sub exit_shell {
+# require Carp;
+# Carp::cluck('exiting');
+ CORE::exit $_[0];
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Apache::TestRun - Run the test suite
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+The C<Apache::TestRun> package controls the configuration and running
+of the test suite.
+
+=head1 METHODS
+
+Several methods are sub-classable, if the default behavior should be
+changed.
+
+=head2 C<bug_report>
+
+The C<bug_report()> method is executed when C<t/TEST> was executed
+with the C<-bugreport> option, and C<make test> (or C<t/TEST>)
+fail. Normally this is callback which you can use to tell the user how
+to deal with the problem, e.g. suggesting to read some document or
+email some details to someone who can take care of it. By default
+nothing is executed.
+
+The C<-bugreport> option is needed so this feature won't become
+annoying to developers themselves. It's automatically added to the
+C<run_tests> target in F<Makefile>. So if you repeateadly have to test
+your code, just don't use C<make test> but run C<t/TEST>
+directly. Here is an example of a custom C<t/TEST>
+
+ My::TestRun->new->run(@ARGV);
+
+ package My::TestRun;
+ use base 'Apache::TestRun';
+
+ sub bug_report {
+ my $self = shift;
+
+ print <<EOI;
+ +--------------------------------------------------------+
+ | Please file a bug report: http://perl.apache.org/bugs/ |
+ +--------------------------------------------------------+
+ EOI
+ }
+
+=head2 C<pre_configure>
+
+The C<pre_configure()> method is executed before the configuration for
+C<Apache::Test> is generated. So if you need to adjust the setup
+before I<httpd.conf> and other files are autogenerated, this is the
+right place to do so.
+
+For example if you don't want to inherit a LoadModule directive for
+I<mod_apreq.so> but to make sure that the local version is used, you
+can sub-class C<Apache::TestRun> and override this method in
+I<t/TEST.PL>:
+
+ package My::TestRun;
+ use base 'Apache::TestRun';
+ use Apache::TestConfig;
+ __PACKAGE__->new->run(@ARGV);
+
+ sub pre_configure {
+ my $self = shift;
+ # Don't load an installed mod_apreq
+ Apache::TestConfig::autoconfig_skip_module_add('mod_apreq.c');
+
+ $self->SUPER::pre_configure();
+ }
+
+Notice that the extension is I<.c>, and not I<.so>.
+
+Don't forget to run the super class' c<pre_configure()> method.
+
+
+
+=head2 C<new_test_config>
+
+META: to be completed
+
+=cut
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestRunPHP.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestRunPHP.pm
new file mode 100644
index 0000000..df01bc4
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestRunPHP.pm
@@ -0,0 +1,332 @@
+# 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::TestRunPHP;
+
+use strict;
+use warnings FATAL => 'all';
+
+use File::Spec::Functions qw(catfile canonpath);
+
+use Apache::TestRun ();
+use Apache::TestConfigParse ();
+use Apache::TestTrace;
+use Apache::TestConfigPHP ();
+use Apache::TestHarnessPHP ();
+
+use vars qw($VERSION);
+$VERSION = '1.00'; # make CPAN.pm's r() version scanner happy
+
+use File::Spec::Functions qw(catfile);
+
+# subclass of Apache::TestRun that configures php things
+use vars qw(@ISA);
+@ISA = qw(Apache::TestRun);
+
+sub start {
+ my $self = shift;
+
+ # point php to our own php.ini file
+ $ENV{PHPRC} = catfile $self->{test_config}->{vars}->{serverroot},
+ 'conf';
+
+ $self->SUPER::start(@_);
+}
+
+sub new_test_config {
+ my $self = shift;
+
+ Apache::TestConfigPHP->new($self->{conf_opts});
+}
+
+sub configure_php {
+ my $self = shift;
+
+ my $test_config = $self->{test_config};
+
+ $test_config->postamble_register(qw(configure_php_inc
+ configure_php_ini
+ configure_php_functions
+ configure_php_tests));
+}
+
+sub configure {
+ my $self = shift;
+
+ $self->configure_php;
+
+ $self->SUPER::configure;
+}
+
+#if Apache::TestRun refreshes config in the middle of configure
+#we need to re-add php configure hooks
+sub refresh {
+ my $self = shift;
+ $self->SUPER::refresh;
+ $self->configure_php;
+}
+
+my @request_opts = qw(get post head);
+
+sub run_tests {
+ my $self = shift;
+
+ my $test_opts = {
+ verbose => $self->{opts}->{verbose},
+ tests => $self->{tests},
+ order => $self->{opts}->{order},
+ subtests => $self->{subtests} || [],
+ };
+
+ if (grep { exists $self->{opts}->{$_} } @request_opts) {
+ run_request($self->{test_config}, $self->{opts});
+ }
+ else {
+ Apache::TestHarnessPHP->run($test_opts)
+ if $self->{opts}->{'run-tests'};
+ }
+}
+
+sub split_test_args {
+ my($self) = @_;
+
+ my(@tests);
+ my $top_dir = $self->{test_config}->{vars}->{top_dir};
+ my $t_dir = $self->{test_config}->{vars}->{t_dir};
+
+ my $argv = $self->{argv};
+ my @leftovers = ();
+ for (@$argv) {
+ my $arg = $_;
+ # need the t/ (or t\) for stat-ing, but don't want to include
+ # it in test output
+ $arg =~ s@^(?:\.[\\/])?t[\\/]@@;
+ my $file = catfile $t_dir, $arg;
+ if (-d $file and $_ ne '/') {
+ my @files = <$file/*.t>;
+ push @files, <$file/*.php>;
+ my $remove = catfile $top_dir, "";
+ if (@files) {
+ push @tests, map { s,^\Q$remove,,; $_ } @files;
+ next;
+ }
+ }
+ else {
+ if (($file =~ /\.t$/ || $file =~ /\.php$/) and -e $file) {
+ push @tests, "t/$arg";
+ next;
+ }
+ elsif (-e "$file.t") {
+ push @tests, "t/$arg.t";
+ next;
+ }
+ elsif (/^[\d.]+$/) {
+ my @t = $_;
+ #support range of subtests: t/TEST t/foo/bar 60..65
+ if (/^(\d+)\.\.(\d+)$/) {
+ @t = $1..$2;
+ }
+
+ push @{ $self->{subtests} }, @t;
+ next;
+ }
+ }
+ push @leftovers, $_;
+ }
+
+ $self->{tests} = [ map { canonpath($_) } @tests ];
+ $self->{argv} = \@leftovers;
+}
+1;
+__END__
+
+=head1 NAME
+
+Apache::TestRunPHP - configure and run a PHP-based test suite
+
+=head1 SYNOPSIS
+
+ use Apache::TestRunPHP;
+ Apache::TestRunPHP->new->run(@ARGV);
+
+=head1 DESCRIPTION
+
+The C<Apache::TestRunPHP> package controls the configuration and
+running of the test suite for PHP-based tests. It's a subclass
+of C<Apache::TestRun> and similar in function to C<Apache::TestRunPerl>.
+
+Refer to the C<Apache::TestRun> manpage for information on the
+available API.
+
+=head1 EXAMPLE
+
+C<TestRunPHP> works almost identially to C<TestRunPerl>, but in
+case you are new to C<Apache-Test> here is a quick getting started
+guide. be sure to see the links at the end of this document for
+places to find additional details.
+
+because C<Apache-Test> is a Perl-based testing framework we start
+from a C<Makefile.PL>, which should have the following lines (in
+addition to the standard C<Makefile.PL> parts):
+
+ use Apache::TestMM qw(test clean);
+ use Apache::TestRunPHP ();
+
+ Apache::TestMM::filter_args();
+
+ Apache::TestRunPHP->generate_script();
+
+C<generate_script()> will create a script named C<t/TEST>, the gateway
+to the Perl testing harness and what is invoked when you call
+C<make test>. C<filter_args()> accepts some C<Apache::Test>-specific
+arguments and passes them along. for example, to point to a specific
+C<httpd> installation you would invoke C<Makefile.PL> as follows
+
+ $ perl Makefile.PL -httpd /my/local/apache/bin/httpd
+
+and C</my/local/apache/bin/httpd> will be propagated throughout the
+rest of the process. note that PHP needs to be active within Apache
+prior to configuring the test framework as shown above, either by
+virtue of PHP being compiled into the C<httpd> binary statically or
+through an active C<LoadModule> statement within the configuration
+located in C</my/local/apache/conf/httpd.conf>. Other required modules
+are the (very common) mod_alias and mod_env.
+
+now, like with C<Apache::TestRun> and C<Apache::TestRunPerl>, you can
+place client-side Perl test scripts under C<t/>, such as C<t/01basic.t>,
+and C<Apache-Test> will run these scripts when you call C<make test>.
+however, what makes C<Apache::TestRunPHP> unique is some added magic
+specifically tailored to a PHP environment. here are the mechanics.
+
+C<Apache::TestRunPHP> will look for PHP test scripts in that match
+the following pattern
+
+ t/response/TestFoo/bar.php
+
+where C<Foo> and C<bar> can be anything you like, and C<t/response/Test*>
+is case sensitive. when this format is adhered to, C<Apache::TestRunPHP>
+will create an associated Perl test script called C<t/foo/bar.t>, which
+will be executed when you call C<make test>. all C<bar.t> does is issue
+a simple GET to C<bar.php>, leaving the actual testing to C<bar.php>. in
+essence, you can forget that C<bar.t> even exists.
+
+what does C<bar.php> look like? here is an example:
+
+ <?php
+ print "1..1\n";
+ print "ok 1\n"
+ ?>
+
+if it looks odd, that's ok because it is. I could explain to you exactly
+what this means, but it isn't important to understand the gory details.
+instead, it is sufficient to understand that when C<Apache::Test> calls
+C<bar.php> it feeds the results directly to C<Test::Harness>, a module
+that comes with every Perl installation, and C<Test::Harness> expects
+what it receives to be formatted in a very specific way. by itself, all
+of this is pretty useless, so C<Apache::Test> provides PHP testers with
+something much better. here is a much better example:
+
+ <?php
+ # import the Test::More emulation layer
+ # see
+ # http://search.cpan.org/dist/Test-Simple/lib/Test/More.pm
+ # for Perl's documentation - these functions should behave
+ # in the same way
+ require 'test-more.php';
+
+ # plan() the number of tests
+ plan(6);
+
+ # call ok() for each test you plan
+ ok ('foo' == 'foo', 'foo is equal to foo');
+ ok ('foo' != 'foo', 'foo is not equal to foo');
+
+ # ok() can be other things as well
+ is ('bar', 'bar', 'bar is bar');
+ is ('baz', 'bar', 'baz is baz');
+ isnt ('bar', 'beer', 'bar is not beer');
+ like ('bar', '/ar$/', 'bar matches ar$');
+
+ diag("printing some debugging information");
+
+ # whoops! one too many tests. I wonder what will happen...
+ is ('biff', 'biff', 'baz is a baz');
+ ?>
+
+the include library C<test-more.php> is automatically generated by
+C<Apache::TestConfigPHP> and configurations tweaked in such a
+a way that your PHP scripts can find it without issue. the
+functions provided by C<test-more.php> are equivalent in name and
+function to those in C<Test::More>, a standard Perl testing
+library, so you can see that manpage for details on the syntax
+and functionality of each.
+
+at this point, we have enough in place to run some tests from
+PHP-land - a C<Makefile.PL> to configure Apache for us, and
+a PHP script in C<t/response/TestFoo/bar.php> to send some
+results out to the testing engine. issuing C<make test>
+would start Apache, issue the request to C<bar.php>, generate
+a report, and shut down Apache. the report would look like
+something like this after running the tests in verbose mode
+(eg C<make test TEST_VERBOSE=1>):
+
+ t/php/bar....1..6
+ ok 1 - foo is equal to foo
+ not ok 2 - foo is not equal to foo
+ # Failed test (/src/devel/perl-php-test/t/response/TestFoo/bar.php at line 13)
+ ok 3 - bar is bar
+ not ok 4 - baz is baz
+ # Failed test (/src/devel/perl-php-test/t/response/TestFoo/bar.php at line 17)
+ # got: 'baz'
+ # expected: 'bar'
+ ok 5 - bar is not beer
+ ok 6 - bar matches ar$
+ # printing some debugging information
+ ok 7 - baz is a baz
+ FAILED tests 2, 4, 7
+ Failed 3/6 tests, 50.00% okay
+ Failed Test Stat Wstat Total Fail Failed List of Failed
+ -------------------------------------------------------------------------------
+ t/php/bar.t 6 3 50.00% 2 4 7
+ Failed 1/1 test scripts, 0.00% okay. 1/6 subtests failed, 83.33% okay.
+
+note that the actual test file that was run was C<t/php/bar.t>. this
+file is autogenerated based on the C<t/response/TestFoo/bar.php>
+pattern of your PHP script. C<t/php/bar.t> happens to be written in
+Perl, but you really don't need to worry about it too much.
+
+as an interesting aside, if you are using perl-5.8.3 or later you can
+actually create your own C<t/foo.php> client-side scripts and they
+will be run via php (using our C<php.ini>). but more on that later...
+
+=head1 SEE ALSO
+
+the best source of information about using Apache-Test with
+PHP (at this time) is probably the talk given at ApacheCon 2004
+(L<http://xrl.us/phpperl>), as well as the code from the talk
+(L<http://xrl.us/phpperlcode>). there is also the online tutorial
+L<http://perl.apache.org/docs/general/testing/testing.html>
+which has all of the mod_perl-specific syntax and features have been
+ported to PHP with this class.
+
+=head1 AUTHOR
+
+C<Apache-Test> is a community effort, maintained by a group of
+dedicated volunteers.
+
+Questions can be asked at the test-dev <at> httpd.apache.org list
+For more information see: http://httpd.apache.org/test/.
+
+=cut
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestRunParrot.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestRunParrot.pm
new file mode 100644
index 0000000..21bd3a9
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestRunParrot.pm
@@ -0,0 +1,68 @@
+# 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::TestRunParrot;
+
+use strict;
+use warnings FATAL => 'all';
+
+use File::Spec::Functions qw(catfile canonpath);
+
+use Apache::TestRun ();
+use Apache::TestConfigParse ();
+use Apache::TestTrace;
+use Apache::TestConfigParrot ();
+
+use vars qw($VERSION);
+$VERSION = '1.00'; # make CPAN.pm's r() version scanner happy
+
+use File::Spec::Functions qw(catfile);
+
+# subclass of Apache::TestRun that configures parrot things
+use vars qw(@ISA);
+@ISA = qw(Apache::TestRun);
+
+sub new_test_config {
+ my $self = shift;
+
+ Apache::TestConfigParrot->new($self->{conf_opts});
+}
+
+sub configure_parrot {
+ my $self = shift;
+
+ my $test_config = $self->{test_config};
+
+ $test_config->postamble_register(qw(configure_parrot_tests));
+}
+
+sub configure {
+ my $self = shift;
+
+ $self->configure_parrot;
+
+ $self->SUPER::configure;
+}
+
+#if Apache::TestRun refreshes config in the middle of configure
+#we need to re-add parrotconfigure hooks
+sub refresh {
+ my $self = shift;
+ $self->SUPER::refresh;
+ $self->configure_parrot;
+}
+
+1;
+__END__
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestRunPerl.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestRunPerl.pm
new file mode 100644
index 0000000..2226575
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestRunPerl.pm
@@ -0,0 +1,139 @@
+# 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::TestRunPerl;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestRun ();
+use Apache::TestConfigParse ();
+use Apache::TestTrace;
+
+use vars qw($VERSION);
+$VERSION = '1.00'; # make CPAN.pm's r() version scanner happy
+
+use File::Spec::Functions qw(catfile);
+
+#subclass of Apache::TestRun that configures mod_perlish things
+use vars qw(@ISA);
+@ISA = qw(Apache::TestRun);
+
+sub pre_configure {
+ my $self = shift;
+
+ # Apache::TestConfigPerl already configures mod_perl.so
+ Apache::TestConfig::autoconfig_skip_module_add('mod_perl.c');
+
+ # skip over Embperl.so - it's funky
+ Apache::TestConfig::autoconfig_skip_module_add('Embperl.c');
+}
+
+sub configure_modperl {
+ my $self = shift;
+
+ my $test_config = $self->{test_config};
+
+ my $rev = $test_config->server->{rev};
+ my $ver = $test_config->server->{version};
+
+ # sanity checking and loading the right mod_perl version
+
+ # remove mod_perl.pm from %INC so that the below require()
+ # calls accurately populate $mp_ver
+ delete $INC{'mod_perl.pm'};
+
+ if ($rev == 2) {
+ eval { require mod_perl2 };
+ } else {
+ eval { require mod_perl };
+ }
+
+ my $mp_ver = $mod_perl::VERSION;
+ if ($@) {
+ error "You are using mod_perl response handlers ",
+ "but do not have a mod_perl capable Apache.";
+ Apache::TestRun::exit_perl(0);
+ }
+ if (($rev == 1 && $mp_ver >= 1.99) ||
+ ($rev == 2 && $mp_ver < 1.99)) {
+ error "Found mod_perl/$mp_ver, but it can't be used with $ver";
+ Apache::TestRun::exit_perl(0);
+ }
+
+ if ($rev == 2) {
+ # load apreq2 if it is present
+ # do things a bit differently that find_and_load_module()
+ # because apreq2 can't be loaded that way (the 2 causes a problem)
+ my $name = 'mod_apreq2.so';
+ if (my $mod_path = $test_config->find_apache_module($name)) {
+
+ # don't match the 2 here
+ my ($sym) = $name =~ m/mod_(\w+)2\./;
+
+ if ($mod_path && -e $mod_path) {
+ $test_config->preamble(IfModule => "!mod_$sym.c",
+ qq{LoadModule ${sym}_module "$mod_path"\n});
+ }
+ }
+ }
+
+ $test_config->preamble_register(qw(configure_libmodperl
+ configure_env));
+
+ $test_config->postamble_register(qw(configure_inc
+ configure_pm_tests_inc
+ configure_startup_pl
+ configure_pm_tests));
+}
+
+sub configure {
+ my $self = shift;
+
+ $self->configure_modperl;
+
+ $self->SUPER::configure;
+}
+
+#if Apache::TestRun refreshes config in the middle of configure
+#we need to re-add modperl configure hooks
+sub refresh {
+ my $self = shift;
+ $self->SUPER::refresh;
+ $self->configure_modperl;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Apache::TestRunPerl - Run mod_perl-requiring Test Suite
+
+=head1 SYNOPSIS
+
+ use Apache::TestRunPerl;
+ Apache::TestRunPerl->new->run(@ARGV);
+
+=head1 DESCRIPTION
+
+The C<Apache::TestRunPerl> package controls the configuration and
+running of the test suite. It's a subclass of C<Apache::TestRun>, and
+should be used only when you need to run mod_perl tests.
+
+Refer to the C<Apache::TestRun> manpage for information on the
+available API.
+
+=cut
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestSSLCA.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestSSLCA.pm
new file mode 100644
index 0000000..3f1a24a
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestSSLCA.pm
@@ -0,0 +1,593 @@
+# 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::TestSSLCA;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Cwd ();
+use DirHandle ();
+use File::Path ();
+use File::Copy 'cp';
+use File::Basename;
+use Net::SSLeay;
+use Apache::TestConfig ();
+use Apache::TestTrace;
+
+use constant SSLCA_DB => 'index.txt';
+
+use vars qw(@EXPORT_OK &import);
+
+use subs qw(symlink);
+
+@EXPORT_OK = qw(dn dn_vars dn_oneline);
+*import = \&Exporter::import;
+
+my $openssl = $ENV{APACHE_TEST_OPENSSL_CMD} || 'openssl';
+my $version = version();
+
+my $CA = 'asf';
+my $Config; #global Apache::TestConfig object
+
+my $days = '-days 365';
+my $cakey = 'keys/ca.pem';
+my $cacert = 'certs/ca.crt';
+my $capolicy = '-policy policy_anything';
+my $cacrl = 'crl/ca-bundle.crl';
+my $dgst = 'sha256';
+
+#we use the same password for everything
+my $pass = 'httpd';
+my $passin = "-passin pass:$pass";
+my $passout = "-passout pass:$pass";
+
+# (limited) subjectAltName otherName testing
+my $san_msupn = ', otherName:msUPN;UTF8:$mail';
+my $san_dnssrv = ', otherName:1.3.6.1.5.5.7.8.7;IA5:_https.$CN';
+
+# in 0.9.7 s/Email/emailAddress/ in DN
+my $email_field = Apache::Test::normalize_vstring($version) <
+ Apache::Test::normalize_vstring("0.9.7") ?
+ "Email" : "emailAddress";
+
+# downgrade to SHA-1 for OpenSSL before 0.9.8
+if (Apache::Test::normalize_vstring($version) <
+ Apache::Test::normalize_vstring("0.9.8")) {
+ $dgst = 'sha1';
+ # otherNames in x509v3_config are not supported either
+ $san_msupn = $san_dnssrv = "";
+}
+
+my $sslproto = "all";
+
+if (Apache::Test::normalize_vstring($version) >=
+ Apache::Test::normalize_vstring("1.1.1")
+ && !defined(&Net::SSLeay::CTX_set_post_handshake_auth)) {
+ # OpenSSL 1.1.1 disables PHA by default client-side in TLSv1.3 but
+ # most clients are not updated to enable it (at time of writing).
+ # Many mod_ssl tests require working PHA, so disable v1.3 unless
+ # using an updated Net::SSLeay. This is strictly insufficient
+ # since an updated IO::Socket::SSL is also needed; to be
+ # continued. Ref: https://github.com/openssl/openssl/issues/6933
+ $sslproto = "all -TLSv1.3";
+}
+
+my $ca_dn = {
+ asf => {
+ C => 'US',
+ ST => 'California',
+ L => 'San Francisco',
+ O => 'ASF',
+ OU => 'httpd-test',
+ CN => '',
+ $email_field => 'test-dev@httpd.apache.org',
+ },
+};
+
+my $cert_dn = {
+ client_snakeoil => {
+ C => 'AU',
+ ST => 'Queensland',
+ L => 'Mackay',
+ O => 'Snake Oil, Ltd.',
+ OU => 'Staff',
+ },
+ client_ok => {
+ },
+ client_colon => {
+ CN => "user:colon",
+ },
+ client_revoked => {
+ },
+ server => {
+ CN => 'localhost',
+ OU => 'httpd-test/rsa-test',
+ },
+ server2 => {
+ CN => 'localhost',
+ OU => 'httpd-test/rsa-test-2',
+ },
+ server_des3 => {
+ CN => 'localhost',
+ OU => 'httpd-test/rsa-des3-test',
+ },
+ server2_des3 => {
+ CN => 'localhost',
+ OU => 'httpd-test/rsa-des3-test-2',
+ },
+};
+
+#generate DSA versions of the server certs/keys
+for my $key (keys %$cert_dn) {
+ next unless $key =~ /^server/;
+ my $val = $$cert_dn{$key};
+ my $name = join '_', $key, 'dsa';
+ $cert_dn->{$name} = { %$val }; #copy
+ $cert_dn->{$name}->{OU} =~ s/rsa/dsa/;
+}
+
+sub ca_dn {
+ $ca_dn = shift if @_;
+ $ca_dn;
+}
+
+sub cert_dn {
+ $cert_dn = shift if @_;
+ $cert_dn;
+}
+
+sub dn {
+ my $name = shift;
+
+ my %dn = %{ $ca_dn->{$CA} }; #default values
+ $dn{CN} ||= $name; #try make sure each Common Name is different
+
+ my $default_dn = $cert_dn->{$name};
+
+ if ($default_dn) {
+ while (my($key, $value) = each %$default_dn) {
+ #override values
+ $dn{$key} = $value;
+ }
+ }
+
+ return wantarray ? %dn : \%dn;
+}
+
+sub dn_vars {
+ my($name, $type) = @_;
+
+ my $dn = dn($name);
+ my $prefix = join '_', 'SSL', $type, 'DN';
+
+ return { map { $prefix ."_$_", $dn->{$_} } keys %$dn };
+}
+
+sub dn_oneline {
+ my($dn, $rfc2253) = @_;
+
+ unless (ref $dn) {
+ $dn = dn($dn);
+ }
+
+ my $string = "";
+ my @parts = (qw(C ST L O OU CN), $email_field);
+ @parts = reverse @parts if $rfc2253;
+
+ for my $k (@parts) {
+ next unless $dn->{$k};
+ if ($rfc2253) {
+ my $tmp = $dn->{$k};
+ $tmp =~ s{([,+"\\<>;])}{\\$1}g;
+ $tmp =~ s{^([ #])}{\\$1};
+ $tmp =~ s{ $}{\\ };
+ $string .= "," if $string;
+ $string .= "$k=$tmp";
+ }
+ else {
+ $string .= "/$k=$dn->{$k}";
+ }
+ }
+
+ $string;
+}
+
+sub openssl {
+ return $openssl unless @_;
+
+ my $cmd = "$openssl @_";
+
+ info $cmd;
+
+ unless (system($cmd) == 0) {
+ my $status = $? >> 8;
+ die "system @_ failed (exit status=$status)";
+ }
+}
+
+my @dirs = qw(keys newcerts certs crl export csr conf proxy);
+
+sub init {
+ for my $dir (@dirs) {
+ gendir($dir);
+ }
+}
+
+sub config_file {
+ my $name = shift;
+
+ my $file = "conf/$name.cnf";
+ return $file if -e $file;
+
+ my $dn = dn($name);
+ my $db = SSLCA_DB;
+
+ writefile($db, '', 1) unless -e $db;
+
+ writefile($file, <<EOF);
+mail = $dn->{$email_field}
+CN = $dn->{CN}
+
+[ req ]
+distinguished_name = req_distinguished_name
+attributes = req_attributes
+prompt = no
+default_bits = 2048
+output_password = $pass
+
+[ req_distinguished_name ]
+C = $dn->{C}
+ST = $dn->{ST}
+L = $dn->{L}
+O = $dn->{O}
+OU = $dn->{OU}
+CN = \$CN
+$email_field = \$mail
+
+[ req_attributes ]
+challengePassword = $pass
+
+[ ca ]
+default_ca = CA_default
+
+[ CA_default ]
+certs = certs # Where the issued certs are kept
+new_certs_dir = newcerts # default place for new certs.
+crl_dir = crl # Where the issued crl are kept
+database = $db # database index file.
+serial = serial # The current serial number
+
+certificate = $cacert # The CA certificate
+crl = $cacrl # The current CRL
+private_key = $cakey # The private key
+
+default_days = 365 # how long to certify for
+default_crl_days = 365 # how long before next CRL
+default_md = $dgst # which md to use.
+preserve = no # keep passed DN ordering
+
+[ policy_anything ]
+countryName = optional
+stateOrProvinceName = optional
+localityName = optional
+organizationName = optional
+organizationalUnitName = optional
+commonName = supplied
+$email_field = optional
+
+[ client_ok_ext ]
+nsComment = This Is A Comment
+1.3.6.1.4.1.18060.12.0 = DER:0c064c656d6f6e73
+subjectAltName = email:\$mail$san_msupn
+
+[ server_ext ]
+subjectAltName = DNS:\$CN$san_dnssrv
+EOF
+
+ return $file;
+}
+
+sub config {
+ my $name = shift;
+
+ my $file = config_file($name);
+
+ my $config = "-config $file";
+
+ $config;
+}
+
+use constant PASSWORD_CLEARTEXT =>
+ Apache::TestConfig::WIN32 || Apache::TestConfig::NETWARE;
+
+#http://www.modssl.org/docs/2.8/ssl_reference.html#ToC21
+my $basic_auth_password =
+ PASSWORD_CLEARTEXT ? 'password': 'xxj31ZMTZzkVA';
+my $digest_auth_hash = '$1$OXLyS...$Owx8s2/m9/gfkcRVXzgoE/';
+
+sub new_ca {
+ writefile('serial', "01\n", 1);
+
+ writefile('ssl.htpasswd',
+ join ':', dn_oneline('client_snakeoil'),
+ $basic_auth_password);
+
+ openssl req => "-new -x509 -keyout $cakey -out $cacert $days",
+ config('ca');
+
+ export_cert('ca'); #useful for importing into IE
+}
+
+sub new_key {
+ my $name = shift;
+
+ my $encrypt = @_ ? "@_ $passout" : "";
+
+ my $out = "-out keys/$name.pem $encrypt";
+
+ if ($name =~ /dsa/) {
+ #this takes a long time so just do it once
+ #don't do this in real life
+ unless (-e 'dsa-param') {
+ openssl dsaparam => '-inform PEM -out dsa-param 2048';
+ }
+ openssl gendsa => "$out dsa-param";
+ }
+ else {
+ openssl genrsa => "$out 2048";
+ }
+}
+
+sub new_cert {
+ my $name = shift;
+
+ openssl req => "-new -key keys/$name.pem -out csr/$name.csr",
+ $passin, $passout, config($name);
+
+ sign_cert($name);
+
+ export_cert($name);
+}
+
+sub sign_cert {
+ my $name = shift;
+ my $exts = '';
+
+ $exts = ' -extensions client_ok_ext' if $name =~ /client_ok/;
+
+ $exts = ' -extensions server_ext' if $name =~ /server/;
+
+ openssl ca => "$capolicy -in csr/$name.csr -out certs/$name.crt",
+ $passin, config($name), '-batch', $exts;
+}
+
+#handy for importing into a browser such as netscape
+sub export_cert {
+ my $name = shift;
+
+ return if $name =~ /^server/; #no point in exporting server certs
+
+ openssl pkcs12 => "-export -in certs/$name.crt -inkey keys/$name.pem",
+ "-out export/$name.p12", $passin, $passout;
+}
+
+sub revoke_cert {
+ my $name = shift;
+
+ my @args = (config('cacrl'), $passin);
+
+ #revokes in the SSLCA_DB database
+ openssl ca => "-revoke certs/$name.crt", @args;
+
+ #generates crl from the index.txt database
+ openssl ca => "-gencrl -out $cacrl", @args;
+}
+
+sub symlink {
+ my($file, $symlink) = @_;
+
+ my $what = 'linked';
+
+ if (Apache::TestConfig::WINFU) {
+ cp $file, $symlink;
+ $what = 'copied';
+ }
+ else {
+ CORE::symlink($file, $symlink);
+ }
+
+ info "$what $file to $symlink";
+}
+
+sub hash_certs {
+ my($type, $dir) = @_;
+
+ chdir $dir;
+
+ my $dh = DirHandle->new('.') or die "opendir $dir: $!";
+ my $n = 0;
+
+ for my $file ($dh->read) {
+ next unless $file =~ /\.cr[tl]$/;
+ chomp(my $hash = `openssl $type -noout -hash < $file`);
+ next unless $hash;
+ my $symlink = "$hash.r$n";
+ $n++;
+ symlink $file, $symlink;
+ }
+
+ close $dh;
+
+ chdir $CA;
+}
+
+sub make_proxy_cert {
+ my $name = shift;
+
+ my $from = "certs/$name.crt";
+ my $to = "proxy/$name.pem";
+
+ info "generating proxy cert: $to";
+
+ my $fh_to = Symbol::gensym();
+ my $fh_from = Symbol::gensym();
+
+ open $fh_to, ">$to" or die "open $to: $!";
+ open $fh_from, $from or die "open $from: $!";
+
+ cp $fh_from, $fh_to;
+
+ $from = "keys/$name.pem";
+
+ open $fh_from, $from or die "open $from: $!";
+
+ cp $fh_from, $fh_to;
+
+ close $fh_from;
+ close $fh_to;
+}
+
+sub setup {
+ $CA = shift;
+
+ unless ($ca_dn->{$CA}) {
+ die "unknown CA $CA";
+ }
+
+ gendir($CA);
+
+ chdir $CA;
+
+ init();
+ new_ca();
+
+ my @names = keys %$cert_dn;
+
+ for my $name (@names) {
+ my @key_args = ();
+ if ($name =~ /_des3/) {
+ push @key_args, '-des3';
+ }
+
+ new_key($name, @key_args);
+ new_cert($name);
+
+ if ($name =~ /_revoked$/) {
+ revoke_cert($name);
+ }
+
+ if ($name =~ /^client_/) {
+ make_proxy_cert($name);
+ }
+ }
+
+ hash_certs(crl => 'crl');
+}
+
+sub generate {
+ $Config = shift;
+
+ $CA = shift || $Config->{vars}->{sslcaorg};
+
+ my $root = $Config->{vars}->{sslca};
+
+ return if -d $root;
+
+ my $pwd = Cwd::cwd();
+ my $base = dirname $root;
+ my $dir = basename $root;
+
+ chdir $base;
+
+ # Ensure the CNs used in the server certs match up with the
+ # hostname being used for testing.
+ while (my($key, $val) = each %$cert_dn) {
+ next unless $key =~ /^server/;
+ $val->{CN} = $Config->{vars}->{servername};
+ }
+
+ #make a note that we created the tree
+ $Config->clean_add_path($root);
+
+ gendir($dir);
+
+ chdir $dir;
+
+ warning "generating SSL CA for $CA";
+
+ setup($CA);
+
+ chdir $pwd;
+}
+
+sub clean {
+ my $config = shift;
+
+ #rel2abs adds same drive letter for win32 that clean_add_path added
+ my $dir = File::Spec->rel2abs($config->{vars}->{sslca});
+
+ unless ($config->{clean}->{dirs}->{$dir}) {
+ return; #we did not generate this ca
+ }
+
+ unless ($config->{clean_level} > 1) {
+ #skip t/TEST -conf
+ warning "skipping regeneration of SSL CA; run t/TEST -clean to force";
+ return;
+ }
+
+ File::Path::rmtree([$dir], 1, 1);
+}
+
+#not using Apache::TestConfig methods because the openssl commands
+#will generate heaps of files we cannot keep track of
+
+sub writefile {
+ my($file, $content) = @_;
+
+ my $fh = Symbol::gensym();
+ open $fh, ">$file" or die "open $file: $!";
+ print $fh $content;
+ close $fh;
+}
+
+sub gendir {
+ my($dir) = @_;
+
+ return if -d $dir;
+ mkdir $dir, 0755;
+}
+
+sub version {
+ my $version = qx($openssl version);
+ return $1 if $version =~ /^OpenSSL (\S+) /;
+ return 0;
+}
+
+sub dgst {
+ return $dgst;
+}
+
+sub email_field {
+ return $email_field;
+}
+
+sub sslproto {
+ return $sslproto;
+}
+
+1;
+__END__
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestServer.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestServer.pm
new file mode 100644
index 0000000..3a30a63
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestServer.pm
@@ -0,0 +1,724 @@
+# 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::TestServer;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Config;
+use Socket ();
+use File::Spec::Functions qw(catfile);
+
+use Apache::TestTrace;
+use Apache::TestRun;
+use Apache::TestConfig ();
+use Apache::TestRequest ();
+
+use constant COLOR => Apache::TestConfig::COLOR;
+use constant WIN32 => Apache::TestConfig::WIN32;
+
+my $CTRL_M = COLOR ? "\r" : "\n";
+
+# some debuggers use the same syntax as others, so we reuse the same
+# code by using the following mapping
+my %debuggers = (
+ gdb => 'gdb',
+ ddd => 'gdb',
+ valgrind => 'valgrind',
+ strace => 'strace',
+);
+
+sub new {
+ my $class = shift;
+ my $config = shift;
+
+ my $self = bless {
+ config => $config || Apache::TestConfig->thaw,
+ }, $class;
+
+ $self->{name} = join ':',
+ map { $self->{config}->{vars}->{$_} } qw(servername port);
+
+ $self->{port_counter} = $self->{config}->{vars}->{port};
+
+ $self;
+}
+
+# call this when you already know where httpd is
+sub post_config {
+ my($self) = @_;
+
+ $self->{version} = $self->{config}->httpd_version || '';
+ $self->{mpm} = $self->{config}->httpd_mpm || '';
+
+ # try to get the revision number from the standard Apache version
+ # string and various variations made by distributions which mangle
+ # that string
+
+ # Foo-Apache-Bar/x.y.z
+ ($self->{rev}) = $self->{version} =~ m|/(\d)\.|;
+
+ if ($self->{rev}) {
+ debug "Matched Apache revision $self->{version} $self->{rev}";
+ }
+ else {
+ # guessing is not good as it'll only mislead users
+ # and we can't die since a config object is required
+ # during Makefile.PL's write_perlscript when path to httpd may
+ # be unknown yet. so default to non-existing version 0 for now.
+ # and let TestRun.pm figure out the required pieces
+ debug "can't figure out Apache revision, from string: " .
+ "'$self->{version}', using a non-existing revision 0";
+ $self->{rev} = 0; # unknown
+ }
+
+ ($self->{revminor}) = $self->{version} =~ m|/\d\.(\d)|;
+
+ if ($self->{revminor}) {
+ debug "Matched Apache revminor $self->{version} $self->{revminor}";
+ }
+ else {
+ $self->{revminor} = 0;
+ }
+
+ $self;
+}
+
+sub version_of {
+ my($self, $thing) = @_;
+ die "Can't figure out what Apache server generation we are running"
+ unless $self->{rev};
+
+ $thing->{$self->{rev}};
+}
+
+my @apache_logs = qw(
+error_log access_log httpd.pid
+apache_runtime_status rewrite_log
+ssl_engine_log ssl_request_log
+cgisock
+);
+
+sub clean {
+ my $self = shift;
+
+ my $dir = $self->{config}->{vars}->{t_logs};
+
+ for (@apache_logs) {
+ my $file = catfile $dir, $_;
+ if (unlink $file) {
+ debug "unlink $file";
+ }
+ }
+}
+
+sub pid_file {
+ my $self = shift;
+
+ my $vars = $self->{config}->{vars};
+
+ return $vars->{t_pid_file} || catfile $vars->{t_logs}, 'httpd.pid';
+}
+
+sub dversion {
+ my $self = shift;
+
+ my $dv = "-D APACHE$self->{rev}";
+
+ if ($self->{rev} == 2 and $self->{revminor} == 4) {
+ $dv .= " -D APACHE2_4";
+ }
+
+ return $dv;
+}
+
+sub config_defines {
+ my $self = shift;
+
+ my @defines = ();
+
+ for my $item (qw(useithreads)) {
+ next unless $Config{$item} and $Config{$item} eq 'define';
+ push @defines, "-D PERL_\U$item";
+ }
+
+ if (my $defines = $self->{config}->{vars}->{defines}) {
+ push @defines, map { "-D $_" } split " ", $defines;
+ }
+
+ "@defines";
+}
+
+sub args {
+ my $self = shift;
+ my $vars = $self->{config}->{vars};
+ my $dversion = $self->dversion; #for .conf version conditionals
+ my $defines = $self->config_defines;
+
+ "-d $vars->{serverroot} -f $vars->{t_conf_file} $dversion $defines";
+}
+
+my %one_process = (1 => '-X', 2 => '-D ONE_PROCESS');
+
+sub start_cmd {
+ my $self = shift;
+
+ my $args = $self->args;
+ my $config = $self->{config};
+ my $vars = $config->{vars};
+ my $httpd = $vars->{httpd};
+
+ my $one_process = $self->{run}->{opts}->{'one-process'}
+ ? $self->version_of(\%one_process)
+ : '';
+
+ #XXX: threaded mpm does not respond to SIGTERM with -D ONE_PROCESS
+
+ return "$httpd $one_process $args";
+}
+
+sub default_gdbinit {
+ my $gdbinit = "";
+ my @sigs = qw(PIPE);
+
+ for my $sig (@sigs) {
+ for my $flag (qw(pass nostop)) {
+ $gdbinit .= "handle SIG$sig $flag\n";
+ }
+ }
+
+ $gdbinit;
+}
+
+sub strace_cmd {
+ my($self, $strace, $file) = @_;
+ #XXX truss, ktrace, etc.
+ "$strace -f -o $file -s1024";
+}
+
+sub valgrind_cmd {
+ my($self, $valgrind) = @_;
+ "$valgrind -v --leak-check=yes --show-reachable=yes --error-limit=no";
+}
+
+sub start_valgrind {
+ my $self = shift;
+ my $opts = shift;
+
+ my $config = $self->{config};
+ my $args = $self->args;
+ my $one_process = $self->version_of(\%one_process);
+ my $valgrind_cmd = $self->valgrind_cmd($opts->{debugger});
+ my $httpd = $config->{vars}->{httpd};
+
+ my $command = "$valgrind_cmd $httpd $one_process $args";
+
+ debug $command;
+ system $command;
+}
+
+sub start_strace {
+ my $self = shift;
+ my $opts = shift;
+
+ my $config = $self->{config};
+ my $args = $self->args;
+ my $one_process = $self->version_of(\%one_process);
+ my $file = catfile $config->{vars}->{t_logs}, 'strace.log';
+ my $strace_cmd = $self->strace_cmd($opts->{debugger}, $file);
+ my $httpd = $config->{vars}->{httpd};
+
+ $config->genfile($file); #just mark for cleanup
+
+ my $command = "$strace_cmd $httpd $one_process $args";
+
+ debug $command;
+ system $command;
+}
+
+sub start_gdb {
+ my $self = shift;
+ my $opts = shift;
+
+ my $debugger = $opts->{debugger};
+ my @breakpoints = @{ $opts->{breakpoint} || [] };
+ my $config = $self->{config};
+ my $args = $self->args;
+ my $one_process = $self->version_of(\%one_process);
+
+ my $file = catfile $config->{vars}->{serverroot}, '.gdb-test-start';
+ my $fh = $config->genfile($file);
+
+ print $fh default_gdbinit();
+
+ if (@breakpoints) {
+ print $fh "b ap_run_pre_config\n";
+ print $fh "run $one_process $args\n";
+ print $fh "finish\n";
+ for (@breakpoints) {
+ print $fh "b $_\n"
+ }
+ print $fh "continue\n";
+ }
+ else {
+ print $fh "run $one_process $args\n";
+ }
+ close $fh;
+
+ my $command;
+ my $httpd = $config->{vars}->{httpd};
+
+ if ($debugger eq 'ddd') {
+ $command = qq{ddd --gdb --debugger "gdb -command $file" $httpd};
+ }
+ else {
+ ## defaults to gdb if not set in %ENV or via -debug
+ $command = "$debugger $httpd -command $file";
+ }
+
+ $self->note_debugging;
+ debug $command;
+ system $command;
+
+ unlink $file;
+}
+
+sub debugger_file {
+ my $self = shift;
+ catfile $self->{config}->{vars}->{serverroot}, '.debugging';
+}
+
+#make a note that the server is running under the debugger
+#remove note when this process exits via END
+
+sub note_debugging {
+ my $self = shift;
+ my $file = $self->debugger_file;
+ my $fh = $self->{config}->genfile($file);
+ eval qq(END { unlink "$file" });
+}
+
+sub start_debugger {
+ my $self = shift;
+ my $opts = shift;
+
+ $opts->{debugger} ||= $ENV{MP_DEBUGGER} || 'gdb';
+
+ # XXX: FreeBSD 5.2+
+ # gdb 6.1 and before segfaults when trying to
+ # debug httpd startup code. 6.5 has been proven
+ # to work. FreeBSD typically installs this as
+ # gdb65.
+ # Is it worth it to check the debugger and os version
+ # and die ?
+
+ unless (grep { /^$opts->{debugger}/ } keys %debuggers) {
+ error "$opts->{debugger} is not a supported debugger",
+ "These are the supported debuggers: ".
+ join ", ", sort keys %debuggers;
+ die("\n");
+ }
+
+ my $debugger = $opts->{debugger};
+ $debugger =~ s/\d+$//;
+
+ my $method = "start_" . $debuggers{$debugger};
+
+ ## $opts->{debugger} is passed through unchanged
+ ## so when we try to run it next, its found.
+ $self->$method($opts);
+}
+
+sub pid {
+ my $self = shift;
+ my $file = $self->pid_file;
+ my $fh = Symbol::gensym();
+ open $fh, $file or do {
+ return 0;
+ };
+
+ # try to avoid the race condition when the pid file was created
+ # but not yet written to
+ for (1..8) {
+ last if -s $file > 0;
+ select undef, undef, undef, 0.25;
+ }
+
+ chomp(my $pid = <$fh> || '');
+ $pid;
+}
+
+sub select_next_port {
+ my $self = shift;
+
+ my $max_tries = 100; #XXX
+ while ($max_tries-- > 0) {
+ return $self->{port_counter}
+ if $self->port_available(++$self->{port_counter});
+ }
+
+ return 0;
+}
+
+sub port_available {
+ my $self = shift;
+ my $port = shift || $self->{config}->{vars}->{port};
+ local *S;
+
+ my $proto = getprotobyname('tcp');
+
+ socket(S, Socket::PF_INET(),
+ Socket::SOCK_STREAM(), $proto) || die "socket: $!";
+ setsockopt(S, Socket::SOL_SOCKET(),
+ Socket::SO_REUSEADDR(),
+ pack("l", 1)) || die "setsockopt: $!";
+
+ if (bind(S, Socket::sockaddr_in($port, Socket::INADDR_ANY()))) {
+ close S;
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
+
+=head2 stop()
+
+attempt to stop the server.
+
+returns:
+
+ on success: $pid of the server
+ on failure: -1
+
+=cut
+
+sub stop {
+ my $self = shift;
+ my $aborted = shift;
+
+ if (WIN32) {
+ require Win32::Process;
+ my $obj = $self->{config}->{win32obj};
+ my $pid = -1;
+ if ($pid = $obj ? $obj->GetProcessID : $self->pid) {
+ if (kill(0, $pid)) {
+ Win32::Process::KillProcess($pid, 0);
+ warning "server $self->{name} shutdown";
+ }
+ }
+ unlink $self->pid_file if -e $self->pid_file;
+ return $pid;
+ }
+
+ my $pid = 0;
+ my $tries = 3;
+ my $tried_kill = 0;
+
+ my $port = $self->{config}->{vars}->{port};
+
+ while ($self->ping) {
+ #my $state = $tried_kill ? "still" : "already";
+ #print "Port $port $state in use\n";
+
+ if ($pid = $self->pid and !$tried_kill++) {
+ if (kill TERM => $pid) {
+ warning "server $self->{name} shutdown";
+ sleep 1;
+
+ for (1..6) {
+ if (! $self->ping) {
+ if ($_ == 1) {
+ unlink $self->pid_file if -e $self->pid_file;
+ return $pid;
+ }
+ last;
+ }
+ if ($_ == 1) {
+ warning "port $port still in use...";
+ }
+ else {
+ print "...";
+ }
+ sleep $_;
+ }
+
+ if ($self->ping) {
+ error "\nserver was shutdown but port $port ".
+ "is still in use, please shutdown the service ".
+ "using this port or select another port ".
+ "for the tests";
+ }
+ else {
+ print "done\n";
+ }
+ }
+ else {
+ error "kill $pid failed: $!";
+ }
+ }
+ else {
+ error "port $port is in use, ".
+ "cannot determine server pid to shutdown";
+ return -1;
+ }
+
+ if (--$tries <= 0) {
+ error "cannot shutdown server on Port $port, ".
+ "please shutdown manually";
+ unlink $self->pid_file if -e $self->pid_file;
+ return -1;
+ }
+ }
+
+ unlink $self->pid_file if -e $self->pid_file;
+ return $pid;
+}
+
+sub ping {
+ my $self = shift;
+ my $pid = $self->pid;
+
+ if ($pid and kill 0, $pid) {
+ return $pid;
+ }
+ elsif (! $self->port_available) {
+ return -1;
+ }
+
+ return 0;
+}
+
+sub failed_msg {
+ my $self = shift;
+ my($log, $rlog) = $self->{config}->error_log;
+ my $log_file_info = -e $log ?
+ "please examine $rlog" :
+ "$rlog wasn't created, start the server in the debug mode";
+ error "@_ ($log_file_info)";
+}
+
+#this doesn't work well on solaris or hpux at the moment
+use constant USE_SIGCHLD => $^O eq 'linux';
+
+sub start {
+ my $self = shift;
+
+ my $old_pid = -1;
+ if (WIN32) {
+ # Stale PID files (e.g. left behind from a previous test run
+ # that crashed) cannot be trusted on Windows because PID's are
+ # re-used too frequently, so just remove it. If there is an old
+ # server still running then the attempt to start a new one below
+ # will simply fail because the port will be unavailable.
+ if (-f $self->pid_file) {
+ error "Removing old PID file -- " .
+ "Unclean shutdown of previous test run?\n";
+ unlink $self->pid_file;
+ }
+ $old_pid = 0;
+ }
+ else {
+ $old_pid = $self->stop;
+ }
+ my $cmd = $self->start_cmd;
+ my $config = $self->{config};
+ my $vars = $config->{vars};
+ my $httpd = $vars->{httpd} || 'unknown';
+
+ if ($old_pid == -1) {
+ return 0;
+ }
+
+ local $| = 1;
+
+ unless (-x $httpd) {
+ my $why = -e $httpd ? "is not executable" : "does not exist";
+ error "cannot start server: httpd ($httpd) $why";
+ return 0;
+ }
+
+ print "$cmd\n";
+ my $old_sig;
+
+ if (WIN32) {
+ #make sure only 1 process is started for win32
+ #else Kill will only shutdown the parent
+ my $one_process = $self->version_of(\%one_process);
+ require Win32::Process;
+ my $obj;
+ # We need the "1" below to inherit the calling processes
+ # handles when running Apache::TestSmoke so as to properly
+ # dup STDOUT/STDERR
+ Win32::Process::Create($obj,
+ $httpd,
+ "$cmd $one_process",
+ 1,
+ Win32::Process::NORMAL_PRIORITY_CLASS(),
+ '.');
+ unless ($obj) {
+ die "Could not start the server: " .
+ Win32::FormatMessage(Win32::GetLastError());
+ }
+ $config->{win32obj} = $obj;
+ }
+ else {
+ $old_sig = $SIG{CHLD};
+
+ if (USE_SIGCHLD) {
+ # XXX: try not to be POSIX dependent
+ require POSIX;
+
+ #XXX: this is not working well on solaris or hpux
+ $SIG{CHLD} = sub {
+ while ((my $child = waitpid(-1, POSIX::WNOHANG())) > 0) {
+ my $status = $? >> 8;
+ #error "got child exit $status";
+ if ($status) {
+ my $msg = "server has died with status $status";
+ $self->failed_msg("\n$msg");
+ Apache::TestRun->new(test_config => $config)->scan_core;
+ kill SIGTERM => $$;
+ }
+ }
+ };
+ }
+
+ defined(my $pid = fork) or die "Can't fork: $!";
+ unless ($pid) { # child
+ my $status = system "$cmd";
+ if ($status) {
+ $status = $? >> 8;
+ #error "httpd didn't start! $status";
+ }
+ CORE::exit $status;
+ }
+ }
+
+ while ($old_pid and $old_pid == $self->pid) {
+ warning "old pid file ($old_pid) still exists";
+ sleep 1;
+ }
+
+ my $version = $self->{version};
+ my $mpm = $config->{mpm} || "";
+ $mpm = "($mpm MPM)" if $mpm;
+ print "using $version $mpm\n";
+
+ my $timeout = $vars->{startup_timeout} ||
+ $ENV{APACHE_TEST_STARTUP_TIMEOUT} ||
+ 60;
+
+ my $start_time = time;
+ my $preamble = "${CTRL_M}waiting $timeout seconds for server to start: ";
+ print $preamble unless COLOR;
+ while (1) {
+ my $delta = time - $start_time;
+ print COLOR
+ ? ($preamble, sprintf "%02d:%02d", (gmtime $delta)[1,0])
+ : '.';
+ sleep 1;
+ if ($self->pid) {
+ print $preamble, "ok (waited $delta secs)\n";
+ last;
+ }
+ elsif ($delta > $timeout) {
+ my $suggestion = $timeout + 300;
+ print $preamble, "not ok\n";
+ error <<EOI;
+giving up after $delta secs. If you think that your system
+is slow or overloaded try again with a longer timeout value.
+by setting the environment variable APACHE_TEST_STARTUP_TIMEOUT
+to a high value (e.g. $suggestion) and repeat the last command.
+EOI
+ last;
+ }
+ }
+
+ # now that the server has started don't abort the test run if it
+ # dies
+ $SIG{CHLD} = $old_sig || 'DEFAULT';
+
+ if (my $pid = $self->pid) {
+ print "server $self->{name} started\n";
+
+ my $vh = $config->{vhosts};
+ my $by_port = sub { $vh->{$a}->{port} <=> $vh->{$b}->{port} };
+
+ for my $module (sort $by_port keys %$vh) {
+ print "server $vh->{$module}->{name} listening ($module)\n",
+ }
+
+ if ($config->configure_proxy) {
+ print "tests will be proxied through $vars->{proxy}\n";
+ }
+ }
+ else {
+ $self->failed_msg("server failed to start!");
+ return 0;
+ }
+
+ return 1 if $self->wait_till_is_up($timeout);
+
+ $self->failed_msg("failed to start server!");
+ return 0;
+}
+
+
+# wait till the server is up and return 1
+# if the waiting times out returns 0
+sub wait_till_is_up {
+ my($self, $timeout) = @_;
+ my $config = $self->{config};
+ my $sleep_interval = 1; # secs
+
+ my $server_up = sub {
+ local $SIG{__WARN__} = sub {}; #avoid "cannot connect ..." warnings
+ # avoid fatal errors when LWP is not available
+ return eval {
+ my $r=Apache::TestRequest::GET('/index.html');
+ $r->code!=500 or $r->header('client-warning')!~/internal/i;
+ } || 0;
+ };
+
+ if ($server_up->()) {
+ return 1;
+ }
+
+ my $start_time = time;
+ my $preamble = "${CTRL_M}still waiting for server to warm up: ";
+ print $preamble unless COLOR;
+ while (1) {
+ my $delta = time - $start_time;
+ print COLOR
+ ? ($preamble, sprintf "%02d:%02d", (gmtime $delta)[1,0])
+ : '.';
+ sleep $sleep_interval;
+ if ($server_up->()) {
+ print "${CTRL_M}the server is up (waited $delta secs) \n";
+ return 1;
+ }
+ elsif ($delta > $timeout) {
+ print "${CTRL_M}the server is down, giving up after $delta secs\n";
+ return 0;
+ }
+ else {
+ # continue
+ }
+ }
+}
+
+1;
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestSmoke.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestSmoke.pm
new file mode 100644
index 0000000..decc11b
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestSmoke.pm
@@ -0,0 +1,949 @@
+# 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::TestSmoke;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test ();
+use Apache::TestConfig ();
+use Apache::TestTrace;
+
+use Apache::TestHarness ();
+use Apache::TestRun (); # for core scan functions
+use Apache::TestSort;
+
+use Getopt::Long qw(GetOptions);
+use File::Spec::Functions qw(catfile);
+use FindBin;
+use POSIX ();
+use Symbol ();
+
+#use constant DEBUG => 1;
+
+# how many times to run all tests at the first iteration
+use constant DEFAULT_TIMES => 10;
+
+# if after this number of tries to reduce the number of tests fails we
+# give up on more tries
+use constant MAX_REDUCTION_TRIES => 50;
+
+my @num_opts = qw(times);
+my @string_opts = qw(order report);
+my @flag_opts = qw(help verbose bug_mode);
+
+my %order = map {$_ => 1} qw(random repeat);
+
+my %usage = (
+ 'times=N' => 'how many times to run the entire test suite' .
+ ' (default: ' . DEFAULT_TIMES . ')',
+ 'order=MODE' => 'modes: random, repeat' .
+ ' (default: random)',
+ 'report=FILENAME' => 'save report in a filename' .
+ ' (default: smoke-report-<date>.txt)',
+ 'verbose[=1]' => 'verbose output' .
+ ' (default: 0)',
+ 'bug_mode' => 'bug report mode' .
+ ' (default: 0)',
+);
+
+sub new {
+ my($class, @argv) = @_;
+
+ my $self = bless {
+ seen => {}, # seen sequences and tried them md5 hash
+ results => {}, # final reduced sequences md5 hash
+ smoking_completed => 0,
+ tests => [],
+ total_iterations => 0,
+ total_reduction_attempts => 0,
+ total_reduction_successes => 0,
+ total_tests_run => 0,
+ }, ref($class)||$class;
+
+ $self->{test_config} = Apache::TestConfig->thaw;
+
+ $self->getopts(\@argv);
+ my $opts = $self->{opts};
+
+ chdir "$FindBin::Bin/..";
+ $self->{times} = $opts->{times} || DEFAULT_TIMES;
+ $self->{order} = $opts->{order} || 'random';
+ $self->{verbose} = $opts->{verbose} || 0;
+
+ $self->{run_iter} = $self->{times};
+
+ # this is like 'make test' but produces an output to be used in
+ # the bug report
+ if ($opts->{bug_mode}) {
+ $self->{bug_mode} = 1;
+ $self->{run_iter} = 1;
+ $self->{times} = 1;
+ $self->{verbose} = 1;
+ $self->{order} = 'random';
+ $self->{trace} = 'debug';
+ }
+
+ # specific tests end up in $self->{tests} and $self->{subtests};
+ # and get removed from $self->{argv}
+ $self->Apache::TestRun::split_test_args();
+
+ my $test_opts = {
+ verbose => $self->{verbose},
+ tests => $self->{tests},
+ order => $self->{order},
+ subtests => $self->{subtests} || [],
+ };
+
+ @{ $self->{tests} } = $self->get_tests($test_opts);
+
+ $self->{base_command} = "$^X $FindBin::Bin/TEST";
+
+ # options common to all
+ $self->{base_command} .= " -verbose" if $self->{verbose};
+
+ # options specific to the startup
+ $self->{start_command} = "$self->{base_command} -start";
+ $self->{start_command} .= " -trace=" . $self->{trace} if $self->{trace};
+
+ # options specific to the run
+ $self->{run_command} = "$self->{base_command} -run";
+
+ # options specific to the stop
+ $self->{stop_command} = "$self->{base_command} -stop";
+
+ $self;
+}
+
+sub getopts {
+ my($self, $argv) = @_;
+ my %opts;
+ local *ARGV = $argv;
+
+ # permute : optional values can come before the options
+ # pass_through : all unknown things are to be left in @ARGV
+ Getopt::Long::Configure(qw(pass_through permute));
+
+ # grab from @ARGV only the options that we expect
+ GetOptions(\%opts, @flag_opts,
+ (map "$_=s", @string_opts),
+ (map "$_=i", @num_opts));
+
+ if (exists $opts{order} && !exists $order{$opts{order}}) {
+ error "unknown -order mode: $opts{order}";
+ $self->opt_help();
+ exit;
+ }
+
+ if ($opts{help}) {
+ $self->opt_help;
+ exit;
+ }
+
+ # min
+ $self->{opts} = \%opts;
+
+ $self->{argv} = [@ARGV];
+}
+
+# XXX: need proper sub-classing
+# from Apache::TestHarness
+sub skip { Apache::TestHarness::skip(@_); }
+sub prune { Apache::TestHarness::prune(@_); }
+sub get_tests { Apache::TestHarness::get_tests(@_);}
+
+sub install_sighandlers {
+ my $self = shift;
+
+ $SIG{INT} = sub {
+ # make sure that there the server is down
+ $self->kill_proc();
+
+ $self->report_finish;
+ exit;
+ };
+}
+
+END {
+ local $?; # preserve the exit status
+ eval {
+ Apache::TestRun->new(test_config =>
+ Apache::TestConfig->thaw)->scan_core;
+ };
+}
+
+sub run {
+ my($self) = shift;
+
+ $self->Apache::TestRun::warn_core();
+ local $SIG{INT};
+ $self->install_sighandlers;
+
+ $self->report_start();
+
+ if ($self->{bug_mode}) {
+ # 'make test', but useful for bug reports
+ $self->run_bug_mode();
+ }
+ else {
+ # normal smoke
+ my $iter = 0;
+ while ($iter++ < $self->{run_iter}) {
+ my $last = $self->run_iter($iter);
+ last if $last;
+ }
+ }
+ $self->{smoking_completed} = 1;
+ $self->report_finish();
+ exit;
+}
+
+sub sep {
+ my($char, $title) = @_;
+ my $width = 60;
+ if ($title) {
+ my $side = int( ($width - length($title) - 2) / 2);
+ my $pad = ($side+1) * 2 + length($title) < $width ? 1 : 0;
+ return $char x $side . " $title " . $char x ($side+$pad);
+ }
+ else {
+ return $char x $width;
+ }
+}
+
+my %log_files = ();
+use constant FH => 0;
+use constant POS => 1;
+sub logs_init {
+ my($self, @log_files) = @_;
+
+ for my $path (@log_files) {
+ my $fh = Symbol::gensym();
+ open $fh, "<$path" or die "Can't open $path: $!";
+ seek $fh, 0, POSIX::SEEK_END();
+ $log_files{$path}[FH] = $fh;
+ $log_files{$path}[POS] = tell $fh;
+ }
+}
+
+sub logs_end {
+ for my $path (keys %log_files) {
+ close $log_files{$path}[FH];
+ }
+}
+
+sub log_diff {
+ my($self, $path) = @_;
+
+ my $log = $log_files{$path};
+ die "no such log file: $path" unless $log;
+
+ my $fh = $log->[FH];
+ # no checkpoints were made yet?
+ unless (defined $log->[POS]) {
+ seek $fh, 0, POSIX::SEEK_END();
+ $log->[POS] = tell $fh;
+ return '';
+ }
+
+ seek $fh, $log->[POS], POSIX::SEEK_SET(); # not really needed
+ local $/; # slurp mode
+ my $diff = <$fh>;
+ seek $fh, 0, POSIX::SEEK_END(); # not really needed
+ $log->[POS] = tell $fh;
+
+ return $diff || '';
+}
+
+# this is a special mode, which really just runs 't/TEST -start;
+# t/TEST -run; t/TEST -stop;' but it runs '-run' separately for each
+# test, and checks whether anything bad has happened after the run
+# of each test (i.e. either a test has failed, or a test may be successful,
+# but server may have dumped a core file, we detect that).
+sub run_bug_mode {
+ my($self) = @_;
+
+ my $iter = 0;
+
+ warning "running t/TEST in the bug report mode";
+
+ my $reduce_iter = 0;
+ my @good = ();
+
+ # first time run all tests, or all specified tests
+ my @tests = @{ $self->{tests} }; # copy
+ my $bad = $self->run_test($iter, $reduce_iter, \@tests, \@good);
+ $self->{total_iterations}++;
+
+}
+
+
+# returns true if for some reason no more iterations should be made
+sub run_iter {
+ my($self, $iter) = @_;
+ my $stop_now = 0;
+ my $reduce_iter = 0;
+ my @good = ();
+ warning "\n" . sep("-");
+ warning sprintf "[%03d-%02d-%02d] running all tests",
+ $iter, $reduce_iter, $self->{times};
+
+
+ # first time run all tests, or all specified tests
+ my @tests = @{ $self->{tests} }; # copy
+
+ # hack to ensure a new random seed is generated
+ Apache::TestSort->run(\@tests, $self);
+
+ my $bad = $self->run_test($iter, $reduce_iter, \@tests, \@good);
+ unless ($bad) {
+ $self->{total_iterations}++;
+ return $stop_now;
+ }
+ error "recorded a positive failure ('$bad'), " .
+ "will try to minimize the input now";
+
+ my $command = $self->{base_command};
+
+ # does the test fail on its own
+ {
+ $reduce_iter++;
+ warning sprintf "[%03d-%02d-%02d] trying '$bad' on its own",
+ $iter, $reduce_iter, 1;
+ my @good = ();
+ my @tests = ($bad);
+ my $bad = $self->run_test($iter, $reduce_iter, \@tests, \@good);
+ # if a test is failing on its own there is no point to
+ # continue looking for other sequences
+ if ($bad) {
+ $stop_now = 1;
+ $self->{total_iterations}++;
+ unless ($self->sequence_seen($self->{results}, [@good, $bad])) {
+ $self->report_success($iter, $reduce_iter, "$command $bad", 1);
+ }
+ return $stop_now;
+ }
+ }
+
+ # positive failure
+ my $ok_tests = @good;
+ my $reduction_success = 0;
+ my $done = 0;
+ while (@good > 1) {
+ my $tries = 0;
+ my $reduce_sub = $self->reduce_stream(\@good);
+ $reduce_iter++;
+ while ($tries++ < MAX_REDUCTION_TRIES) {
+ $self->{total_reduction_attempts}++;
+ my @try = @{ $reduce_sub->() };
+
+ # reduction stream is empty (tried all?)
+ unless (@try) {
+ $done = 1;
+ last;
+ }
+
+ warning sprintf "\n[%03d-%02d-%02d] trying %d tests",
+ $iter, $reduce_iter, $tries, scalar(@try);
+ my @ok = ();
+ my @tests = (@try, $bad);
+ my $new_bad = $self->run_test($iter, $reduce_iter, \@tests, \@ok);
+ if ($new_bad) {
+ # successful reduction
+ $reduction_success++;
+ @good = @ok;
+ $tries = 0;
+ my $num = @ok;
+ error "*** reduction $reduce_iter succeeded ($num tests) ***";
+ $self->{total_reduction_successes}++;
+ $self->log_successful_reduction($iter, \@ok);
+ last;
+ }
+ }
+
+ # last round of reducing has failed, so we give up
+ if ($done || $tries >= MAX_REDUCTION_TRIES){
+ error "no further reductions were made";
+ $done = 1;
+ last;
+ }
+
+ }
+
+ # we have a minimal failure sequence at this point (to the extend
+ # of success of our attempts to reduce)
+
+ # report the sequence if we didn't see such one yet in the
+ # previous iterations
+ unless ($self->sequence_seen($self->{results}, [@good, $bad])) {
+ # if no reduction succeeded, it's 0
+ $reduce_iter = 0 unless $reduction_success;
+ $self->report_success($iter, $reduce_iter,
+ "$command @good $bad", @good + 1);
+ }
+
+ $self->{total_iterations}++;
+
+ return $stop_now;
+}
+
+# my $sub = $self->reduce_stream(\@items);
+sub reduce_stream {
+ my($self) = shift;
+ my @items = @{+shift};
+
+ my $items = @items;
+ my $odd = $items % 2 ? 1 : 0;
+ my $middle = int($items/2) - 1;
+ my $c = 0;
+
+ return sub {
+ $c++; # remember stream's state
+
+ # a single item is not reduce-able
+ return \@items if $items == 1;
+
+ my @try = ();
+ my $max_repeat_tries = 50; # avoid seen sequences
+ my $repeat = 0;
+ while ($repeat++ <= $max_repeat_tries) {
+
+ # try to use a binary search
+ if ($c == 1) {
+ # right half
+ @try = @items[($middle+1)..($items-1)];
+ }
+ elsif ($c == 2) {
+ # left half
+ @try = @items[0..$middle];
+ }
+
+ # try to use a random window size alg
+ else {
+ my $left = int rand($items);
+ $left = $items - 1 if $left == $items - 1;
+ my $right = $left + int rand($items - $left);
+ $right = $items - 1 if $right >= $items;
+ @try = @items[$left..$right];
+ }
+
+ if ($self->sequence_seen($self->{seen}, \@try)) {
+ @try = ();
+ }
+ else {
+ last; # found an unseen sequence
+ }
+ }
+ return \@try;
+ }
+}
+
+sub sequence_seen {
+ my ($self, $rh_store, $ra_tests) = @_;
+
+ require Digest::MD5;
+ my $digest = Digest::MD5::md5_hex(join '', @$ra_tests);
+ #error $self->{seen};
+ return $rh_store->{$digest}++ ? 1 : 0
+
+}
+
+sub run_test {
+ require IPC::Run3;
+ my($self, $iter, $count, $tests, $ra_ok) = @_;
+ my $bad = '';
+ my $ra_nok = [];
+
+ #warning "$self->{base_command} @$tests";
+
+ #$SIG{PIPE} = 'IGNORE';
+ $SIG{PIPE} = sub { die "pipe broke" };
+
+ # start server
+ {
+ my $command = $self->{start_command};
+ my $log = '';
+ IPC::Run3::run3($command, undef, \$log, \$log);
+ my $started_ok = ($log =~ /started/) ? 1 : 0;
+ unless ($started_ok) {
+ error "failed to start server\n $log";
+ exit 1;
+ }
+ }
+
+ my $t_logs = $self->{test_config}->{vars}->{t_logs};
+ my @log_files = map { catfile $t_logs, $_ } qw(error_log access_log);
+ $self->logs_init(@log_files);
+
+ # run tests
+ {
+ my $command = $self->{run_command};
+
+ my $max_len = 1;
+ for my $test (@$tests) {
+ $max_len = length $test if length $test > $max_len;
+ }
+
+ for my $test (@$tests) {
+ (my $test_name = $test) =~ s/\.t$//;
+ my $fill = "." x ($max_len - length $test_name);
+ $self->{total_tests_run}++;
+
+ my $test_command = "$command $test";
+ my $log = '';
+ IPC::Run3::run3($test_command, undef, \$log, \$log);
+ my $ok = ($log =~ /All tests successful|NOTESTS/) ? 1 : 0;
+
+ my @core_files_msg = $self->Apache::TestRun::scan_core_incremental(1);
+
+ # if the test has caused core file(s) it's not ok
+ $ok = 0 if @core_files_msg;
+
+ if ($ok == 1) {
+ push @$ra_ok, $test;
+ if ($self->{verbose}) {
+
+ if ($log =~ m/NOTESTS/) {
+ print STDERR "$test_name${fill}skipped\n";
+ } else {
+ print STDERR "$test_name${fill}ok\n";
+ }
+ }
+ # need to run log_diff to reset the position of the fh
+ my %log_diffs = map { $_ => $self->log_diff($_) } @log_files;
+
+ }
+ elsif ($ok == 0) {
+ push @$ra_nok, $test;
+ $bad = $test;
+
+ if ($self->{verbose}) {
+ print STDERR "$test_name${fill}FAILED\n";
+ error sep("-");
+
+ # give server some time to finish the
+ # logging. it's ok to wait long time since we have
+ # to deal with an error
+ sleep 5;
+ my %log_diffs = map { $_ => $self->log_diff($_) } @log_files;
+
+ # client log
+ error "\t\t*** run log ***";
+ $log =~ s/^/ /mg;
+ print STDERR "$log\n";
+
+ # server logs
+ for my $path (@log_files) {
+ next unless length $log_diffs{$path};
+ error "\t\t*** $path ***";
+ $log_diffs{$path} =~ s/^/ /mg;
+ print STDERR "$log_diffs{$path}\n";
+ }
+ }
+ if (@core_files_msg) {
+ unless ($self->{verbose}) {
+ # currently the output of 'run log' already
+ # includes the information about core files once
+ # Test::Harness::Straps allows us to run callbacks
+ # after each test, and we move back to run all
+ # tests at once, we will log the message here
+ error "$test_name caused core";
+ print STDERR join "\n", @core_files_msg, "\n";
+ }
+ }
+
+ if ($self->{verbose}) {
+ error sep("-");
+ }
+
+ unless ($self->{bug_mode}) {
+ # normal smoke stop the run, but in the bug_mode
+ # we want to complete all the tests
+ last;
+ }
+ }
+
+
+ }
+ }
+
+ $self->logs_end();
+
+ # stop server
+ $self->kill_proc();
+
+ if ($self->{bug_mode}) {
+ warning sep("-");
+ if (@$ra_nok == 0) {
+ printf STDERR "All tests successful (%d)\n", scalar @$ra_ok;
+ }
+ else {
+ error sprintf "error running %d tests out of %d\n",
+ scalar(@$ra_nok), scalar @$ra_ok + @$ra_nok;
+ }
+ }
+ else {
+ return $bad;
+ }
+
+
+}
+
+sub report_start {
+ my($self) = shift;
+
+ my $time = scalar localtime;
+ $self->{start_time} = $time;
+ $time =~ s/\s/_/g;
+ $time =~ s/:/-/g; # winFU
+ my $file = $self->{opts}->{report} ||
+ catfile Apache::Test::vars('top_dir'), "smoke-report-$time.txt";
+ $self->{runtime}->{report} = $file;
+ info "Report file: $file";
+
+ open my $fh, ">$file" or die "cannot open $file for writing: $!";
+ $self->{fh} = $fh;
+ my $sep = sep("-");
+ my $title = sep('=', "Special Tests Sequence Failure Finder Report");
+
+ print $fh <<EOM;
+$title
+$sep
+First iteration used:
+$self->{base_command} @{$self->{tests}}
+$sep
+EOM
+
+}
+
+sub report_success {
+ my($self, $iter, $reduce_iter, $sequence, $tests) = @_;
+
+ my @report = ("iteration $iter ($tests tests):\n",
+ "\t$sequence\n",
+ "(made $reduce_iter successful reductions)\n\n");
+
+ print @report;
+ if (my $fh = $self->{fh}) {
+ print $fh @report;
+ }
+}
+
+sub report_finish {
+ my($self) = @_;
+
+ my $start_time = $self->{start_time};
+ my $end_time = scalar localtime;
+ if (my $fh = delete $self->{fh}) {
+ my $failures = scalar keys %{ $self->{results} };
+
+ my $sep = sep("-");
+ my $cfg_as_string = $self->build_config_as_string;
+ my $unique_seqs = scalar keys %{ $self->{results} };
+ my $attempts = $self->{total_reduction_attempts};
+ my $successes = $self->{total_reduction_successes};
+ my $completion = $self->{smoking_completed}
+ ? "Completed"
+ : "Not Completed (aborted by user)";
+
+ my $status = "Unknown";
+ if ($self->{total_iterations} > 0) {
+ if ($failures) {
+ $status = "*** NOT OK ***";
+ }
+ else {
+ $status = "+++ OK +++";
+ }
+ }
+
+ my $title = sep('=', "Summary");
+
+ my $iter_made = sprintf "Iterations (%s) made : %d",
+ $self->{order}, $self->{total_iterations};
+
+ print $fh <<EOM;
+
+$title
+Completion : $completion
+Status : $status
+Tests run : $self->{total_tests_run}
+$iter_made
+EOM
+
+ if ($attempts > 0 && $failures) {
+ my $reduction_stats = sprintf "%d/%d (%d%% success)",
+ $attempts, $successes, $successes / $attempts * 100;
+
+ print $fh <<EOM;
+Unique sequences found : $unique_seqs
+Reduction tries/success : $reduction_stats
+EOM
+ }
+
+ print $fh <<EOM;
+$sep
+--- Started at: $start_time ---
+--- Ended at: $end_time ---
+$sep
+The smoke testing was run on the system with the following
+parameters:
+
+$cfg_as_string
+
+-- this report was generated by $0
+EOM
+ close $fh;
+ }
+}
+
+# in case the smoke gets killed before it had a chance to finish and
+# write the report, at least we won't lose the last successful reduction
+# XXX: this wasn't needed before we switched to IPC::Run3, since
+# Ctrl-C would log the collected data, but it doesn't work with
+# IPC::Run3. So if that gets fixed, we can remove that function
+sub log_successful_reduction {
+ my($self, $iter, $tests) = @_;
+
+ my $file = $self->{runtime}->{report} . ".$iter.temp";
+ debug "saving in $file";
+ open my $fh, ">$file" or die "cannot open $file for writing: $!";
+ print $fh join " ", @$tests;
+ close $fh;
+}
+
+sub build_config_as_string {
+ Apache::TestConfig::as_string();
+}
+
+sub kill_proc {
+ my($self) = @_;
+
+ my $command = $self->{stop_command};
+ my $log = '';
+ require IPC::Run3;
+ IPC::Run3::run3($command, undef, \$log, \$log);
+
+ my $stopped_ok = ($log =~ /shutdown/) ? 1 : 0;
+ unless ($stopped_ok) {
+ error "failed to stop server\n $log";
+ }
+}
+
+sub opt_help {
+ my $self = shift;
+
+ print <<EOM;
+usage: t/SMOKE [options ...] [tests]
+ where the options are:
+EOM
+
+ for (sort keys %usage){
+ printf " -%-16s %s\n", $_, $usage{$_};
+ }
+ print <<EOM;
+
+ if 'tests' argument is not provided all available tests will be run
+EOM
+}
+
+# generate t/SMOKE script (or a different filename) which will drive
+# Apache::TestSmoke
+sub generate_script {
+ my ($class, $file) = @_;
+
+ $file ||= catfile 't', 'SMOKE';
+
+ my $content = join "\n",
+ "BEGIN { eval { require blib && blib->import; } }",
+ Apache::TestConfig->perlscript_header,
+ "use $class;",
+ "$class->new(\@ARGV)->run;";
+
+ Apache::Test::basic_config()->write_perlscript($file, $content);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Apache::TestSmoke - Special Tests Sequence Failure Finder
+
+=head1 SYNOPSIS
+
+ # get the usage and the default values
+ % t/SMOKE -help
+
+ # repeat all tests 5 times and save the report into
+ # the file 'myreport'
+ % t/SMOKE -times=5 -report=myreport
+
+ # run all tests default number of iterations, and repeat tests
+ # default number of times
+ % t/SMOKE
+
+ # same as above but work only the specified tests
+ % t/SMOKE foo/bar foo/tar
+
+ # run once a sequence of tests in a non-random mode
+ # e.g. when trying to reduce a known long sequence that fails
+ % t/SMOKE -order=rotate -times=1 foo/bar foo/tar
+
+ # show me each currently running test
+ # it's not the same as running the tests in the verbose mode
+ % t/SMOKE -verbose
+
+ # run t/TEST, but show any problems after *each* tests is run
+ # useful for bug reports (it actually runs t/TEST -start, then
+ # t/TEST -run for each test separately and finally t/TEST -stop
+ % t/SMOKE -bug_mode
+
+ # now read the created report file
+
+=head1 DESCRIPTION
+
+=head2 The Problem
+
+When we try to test a stateless machine (i.e. all tests are
+independent), running all tests once ensures that all tested things
+properly work. However when a state machine is tested (i.e. where a
+run of one test may influence another test) it's not enough to run all
+the tests once to know that the tested features actually work. It's
+quite possible that if the same tests are run in a different order
+and/or repeated a few times, some tests may fail. This usually
+happens when some tests don't restore the system under test to its
+pristine state at the end of the run, which may influence other tests
+which rely on the fact that they start on pristine state, when in fact
+it's not true anymore. In fact it's possible that a single test may
+fail when run twice or three times in a sequence.
+
+=head2 The Solution
+
+To reduce the possibility of such dependency errors, it's helpful to
+run random testing repeated many times with many different srand
+seeds. Of course if no failures get spotted that doesn't mean that
+there are no tests inter-dependencies, which may cause a failure in
+production. But random testing definitely helps to spot many problems
+and can give better test coverage.
+
+=head2 Resolving Sequence Problems
+
+When this kind of testing is used and a failure is detected there are
+two problems:
+
+=over
+
+=item 1
+
+First is to be able to reproduce the problem so if we think we fixed
+it, we could verify the fix. This one is easy, just remember the
+sequence of tests run till the failed test and rerun the same sequence
+once again after the problem has been fixed.
+
+=item 2
+
+Second is to be able to understand the cause of the problem. If during
+the random test the failure has happened after running 400 tests, how
+can we possibly know which previously running tests has caused to the
+failure of the test 401. Chances are that most of the tests were clean
+and don't have inter-dependency problem. Therefore it'd be very
+helpful if we could reduce the long sequence to a minimum. Preferably
+1 or 2 tests. That's when we can try to understand the cause of the
+detected problem.
+
+=back
+
+This utility attempts to solve both problems, and at the end of each
+iteration print a minimal sequence of tests causing to a failure. This
+doesn't always succeed, but works in many cases.
+
+This utility:
+
+=over
+
+=item 1
+
+Runs the tests randomly until the first failure is detected. Or
+non-randomly if the option I<-order> is set to I<repeat> or I<rotate>.
+
+=item 2
+
+Then it tries to reduce that sequence of tests to a minimum, and this
+sequence still causes to the same failure.
+
+=item 3
+
+(XXX: todo): then it reruns the minimal sequence in the verbose mode
+and saves the output.
+
+=item 4
+
+It reports all the successful reductions as it goes to STDOUT and
+report file of the format: smoke-report-<date>.txt.
+
+In addition the systems build parameters are logged into the report
+file, so the detected problems could be reproduced.
+
+=item 5
+
+Goto 1 and run again using a new random seed, which potentially should
+detect different failures.
+
+=back
+
+=head1 Reduction Algorithm
+
+Currently for each reduction path, the following reduction algorithms
+get applied:
+
+=over
+
+=item 1
+
+Binary search: first try the upper half then the lower.
+
+=item 2
+
+Random window: randomize the left item, then the right item and return
+the items between these two points.
+
+=back
+
+=head1 t/SMOKE.PL
+
+I<t/SMOKE.PL> is driving this module, if you don't have it, create it:
+
+ #!perl
+
+ use strict;
+ use warnings FATAL => 'all';
+
+ use FindBin;
+ use lib "$FindBin::Bin/../Apache-Test/lib";
+ use lib "$FindBin::Bin/../lib";
+
+ use Apache::TestSmoke ();
+
+ Apache::TestSmoke->new(@ARGV)->run;
+
+usually I<Makefile.PL> converts it into I<t/SMOKE> while adjusting the
+perl path, but you create I<t/SMOKE> in first place as well.
+
+=head1 AUTHOR
+
+Stas Bekman
+
+=cut
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestSmokePerl.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestSmokePerl.pm
new file mode 100644
index 0000000..265a4f7
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestSmokePerl.pm
@@ -0,0 +1,34 @@
+# 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::TestSmokePerl;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::TestSmoke ();
+use ModPerl::Config ();
+
+# a subclass of Apache::TestSmoke that configures mod_perlish things
+use vars qw(@ISA);
+@ISA = qw(Apache::TestSmoke);
+
+sub build_config_as_string {
+ ModPerl::Config::as_string();
+}
+
+1;
+__END__
+
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm
new file mode 100644
index 0000000..33eabc2
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm
@@ -0,0 +1,76 @@
+# 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::TestSort;
+
+use strict;
+use warnings FATAL => 'all';
+use Apache::TestTrace;
+
+sub repeat {
+ my($list) = @_;
+ return @{$list};
+}
+
+sub random {
+ my($list) = @_;
+
+ my $seed = $ENV{APACHE_TEST_SEED} || '';
+ my $info = "";
+
+ if ($seed) {
+ $info = " (user defined)";
+ # so we could reproduce the order
+ }
+ else {
+ $info = " (autogenerated)";
+ $seed = time ^ ($$ + ($$ << 15));
+ }
+
+ warning "Using random number seed: $seed" . $info;
+
+ srand($seed);
+
+ #from perlfaq4.pod
+ for (my $i = @$list; --$i; ) {
+ my $j = int rand($i+1);
+ next if $i == $j;
+ @$list[$i,$j] = @$list[$j,$i];
+ }
+}
+
+sub run {
+ my($self, $list, $args) = @_;
+
+ my $order = $args->{order} || 'repeat';
+ if ($order =~ /^\d+$/) {
+ #dont want an explicit -seed option but env var can be a pain
+ #so if -order is number assume it is the random seed
+ $ENV{APACHE_TEST_SEED} = $order;
+ $order = 'random';
+ }
+ my $sort = \&{$order};
+
+ # re-shuffle the list according to the requested order
+ if (defined &$sort) {
+ $sort->($list);
+ }
+ else {
+ error "unknown order '$order'";
+ }
+
+}
+
+1;
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestTrace.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestTrace.pm
new file mode 100644
index 0000000..19c5b29
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestTrace.pm
@@ -0,0 +1,256 @@
+# 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::TestTrace;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Exporter ();
+use vars qw(@Levels @Utils @Level_subs @Util_subs
+ @ISA @EXPORT $VERSION $Level $LogFH);
+
+BEGIN {
+ @Levels = qw(emerg alert crit error warning notice info debug);
+ @Utils = qw(todo);
+ @Level_subs = map {($_, "${_}_mark", "${_}_sub")} (@Levels);
+ @Util_subs = map {($_, "${_}_mark", "${_}_sub")} (@Utils);
+}
+
+@ISA = qw(Exporter);
+@EXPORT = (@Level_subs);
+$VERSION = '0.01';
+use subs (@Level_subs, @Util_subs);
+
+# default settings overrideable by users
+$Level = undef;
+$LogFH = \*STDERR;
+
+# private data
+use constant COLOR => ($ENV{APACHE_TEST_COLOR} && -t STDOUT) ? 1 : 0;
+use constant HAS_COLOR => eval {
+ #XXX: another way to color WINFU terms?
+ !(grep { $^O eq $_ } qw(MSWin32 cygwin NetWare)) and
+ COLOR and require Term::ANSIColor;
+};
+use constant HAS_DUMPER => eval { require Data::Dumper; };
+
+# emerg => 1, alert => 2, crit => 3, ...
+my %levels; @levels{@Levels} = 1..@Levels;
+$levels{todo} = $levels{debug};
+my $default_level = 'info'; # to prevent user typos
+
+my %colors = ();
+
+if (HAS_COLOR) {
+ %colors = (
+ emerg => 'bold white on_blue',
+ alert => 'bold blue on_yellow',
+ crit => 'reverse',
+ error => 'bold red',
+ warning => 'yellow',
+ notice => 'green',
+ info => 'cyan',
+ debug => 'magenta',
+ reset => 'reset',
+ todo => 'underline',
+ );
+
+ $Term::ANSIColor::AUTORESET = 1;
+
+ for (keys %colors) {
+ $colors{$_} = Term::ANSIColor::color($colors{$_});
+ }
+}
+
+*expand = HAS_DUMPER ?
+ sub { map { ref $_ ? Data::Dumper::Dumper($_) : $_ } @_ } :
+ sub { @_ };
+
+sub prefix {
+ my $prefix = shift;
+
+ if ($prefix eq 'mark') {
+ return join(":", (caller(3))[1..2]) . " : ";
+ }
+ elsif ($prefix eq 'sub') {
+ return (caller(3))[3] . " : ";
+ }
+ else {
+ return '';
+ }
+}
+
+sub c_trace {
+ my ($level, $prefix_type) = (shift, shift);
+ my $prefix = prefix($prefix_type);
+ print $LogFH
+ map { "$colors{$level}$prefix$_$colors{reset}\n"}
+ grep defined($_), expand(@_);
+}
+
+sub nc_trace {
+ my ($level, $prefix_type) = (shift, shift);
+ my $prefix = prefix($prefix_type);
+ print $LogFH
+ map { sprintf "[%7s] %s%s\n", $level, $prefix, $_ }
+ grep defined($_), expand(@_);
+}
+
+{
+ my $trace = HAS_COLOR ? \&c_trace : \&nc_trace;
+ my @prefices = ('', 'mark', 'sub');
+ # if the level is sufficiently high, enable the tracing for a
+ # given level otherwise assign NOP
+ for my $level (@Levels, @Utils) {
+ no strict 'refs';
+ for my $prefix (@prefices) {
+ my $func = $prefix ? "${level}_$prefix" : $level;
+ *$func = sub { $trace->($level, $prefix, @_)
+ if trace_level() >= $levels{$level};
+ };
+ }
+ }
+}
+
+sub trace_level {
+ # overridden by user/-trace
+ (defined $Level && $levels{$Level}) ||
+ # or overridden by env var
+ (exists $ENV{APACHE_TEST_TRACE_LEVEL} &&
+ $levels{$ENV{APACHE_TEST_TRACE_LEVEL}}) ||
+ # or default
+ $levels{$default_level};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Apache::TestTrace - Helper output generation functions
+
+=head1 SYNOPSIS
+
+ use Apache::TestTrace;
+
+ debug "foo bar";
+
+ info_sub "missed it";
+
+ error_mark "something is wrong";
+
+ # test sub that exercises all the tracing functions
+ sub test {
+ print $Apache::TestTrace::LogFH
+ "TraceLevel: $Apache::TestTrace::Level\n";
+ $_->($_,[1..3],$_) for qw(emerg alert crit error
+ warning notice info debug todo);
+ print $Apache::TestTrace::LogFH "\n\n"
+ };
+
+ # demo the trace subs using default setting
+ test();
+
+ {
+ # override the default trace level with 'crit'
+ local $Apache::TestTrace::Level = 'crit';
+ # now only 'crit' and higher levels will do tracing lower level
+ test();
+ }
+
+ {
+ # set the trace level to 'debug'
+ local $Apache::TestTrace::Level = 'debug';
+ # now only 'debug' and higher levels will do tracing lower level
+ test();
+ }
+
+ {
+ open OUT, ">/tmp/foo" or die $!;
+ # override the default Log filehandle
+ local $Apache::TestTrace::LogFH = \*OUT;
+ # now the traces will go into a new filehandle
+ test();
+ close OUT;
+ }
+
+ # override tracing level via -trace opt
+ % t/TEST -trace=debug
+
+ # override tracing level via env var
+ % env APACHE_TEST_TRACE_LEVEL=debug t/TEST
+
+=head1 DESCRIPTION
+
+This module exports a number of functions that make it easier
+generating various diagnostics messages in your programs in a
+consistent way and saves some keystrokes as it handles the new lines
+and sends the messages to STDERR for you.
+
+This module provides the same trace methods as syslog(3)'s log
+levels. Listed from low level to high level: emerg(), alert(), crit(),
+error(), warning(), notice(), info(), debug(). The only different
+function is warning(), since warn is already taken by Perl.
+
+The module provides another trace function called todo() which is
+useful for todo items. It has the same level as I<debug> (the
+highest).
+
+There are two more variants of each of these functions. If the
+I<_mark> suffix is appended (e.g., I<error_mark>) the trace will start
+with the filename and the line number the function was called from. If
+the I<_sub> suffix is appended (e.g., I<error_info>) the trace will
+start with the name of the subroutine the function was called from.
+
+If you have C<Term::ANSIColor> installed the diagnostic messages will
+be colorized, otherwise a special for each function prefix will be
+used.
+
+If C<Data::Dumper> is installed and you pass a reference to a variable
+to any of these functions, the variable will be dumped with
+C<Data::Dumper::Dumper()>.
+
+Functions whose level is above the level set in
+C<$Apache::TestTrace::Level> become NOPs. For example if the level is
+set to I<alert>, only alert() and emerg() functions will generate the
+output. The default setting of this variable is I<warning>. Other
+valid values are: I<emerg>, I<alert>, I<crit>, I<error>, I<warning>,
+I<notice>, I<info>, I<debug>.
+
+Another way to affect the trace level is to set
+C<$ENV{APACHE_TEST_TRACE_LEVEL}>, which takes effect if
+C<$Apache::TestTrace::Level> is not set. So an explicit setting of
+C<$Apache::TestTrace::Level> always takes precedence.
+
+By default all the output generated by these functions goes to
+STDERR. You can override the default filehandler by overriding
+C<$Apache::TestTrace::LogFH> with a new filehandler.
+
+When you override this package's global variables, think about
+localizing your local settings, so it won't affect other modules using
+this module in the same run.
+
+=head1 TODO
+
+ o provide an option to disable the coloring altogether via some flag
+ or import()
+
+=head1 AUTHOR
+
+Stas Bekman with contributions from Doug MacEachern
+
+=cut
+
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestUtil.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestUtil.pm
new file mode 100644
index 0000000..3e3c9cd
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestUtil.pm
@@ -0,0 +1,989 @@
+# 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::TestUtil;
+
+use strict;
+use warnings FATAL => 'all';
+
+use File::Find ();
+use File::Path ();
+use Exporter ();
+use Carp ();
+use Config;
+use File::Basename qw(dirname);
+use File::Spec::Functions qw(catfile catdir file_name_is_absolute tmpdir);
+use Symbol ();
+use Fcntl qw(SEEK_END);
+
+use Apache::Test ();
+use Apache::TestConfig ();
+
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %CLEAN);
+
+$VERSION = '0.02';
+@ISA = qw(Exporter);
+
+@EXPORT = qw(t_cmp t_debug t_append_file t_write_file t_open_file
+ t_mkdir t_rmtree t_is_equal t_filepath_cmp t_write_test_lib
+ t_server_log_error_is_expected t_server_log_warn_is_expected
+ t_client_log_error_is_expected t_client_log_warn_is_expected
+);
+
+@EXPORT_OK = qw(t_write_perl_script t_write_shell_script t_chown
+ t_catfile_apache t_catfile t_file_watch_for
+ t_start_error_log_watch t_finish_error_log_watch
+ t_start_file_watch t_read_file_watch t_finish_file_watch);
+
+%CLEAN = ();
+
+$Apache::TestUtil::DEBUG_OUTPUT = \*STDOUT;
+
+# 5.005's Data::Dumper has problems to dump certain datastructures
+use constant HAS_DUMPER => eval { $] >= 5.006 && require Data::Dumper; };
+use constant INDENT => 4;
+
+{
+ my %files;
+ sub t_start_file_watch (;$) {
+ my $name = defined $_[0] ? $_[0] : 'error_log';
+ $name = File::Spec->catfile(Apache::Test::vars->{t_logs}, $name)
+ unless (File::Spec->file_name_is_absolute($name));
+
+ if (open my $fh, '<', $name) {
+ seek $fh, 0, SEEK_END;
+ $files{$name} = $fh;
+ }
+ else {
+ delete $files{$name};
+ }
+
+ return;
+ }
+
+ sub t_finish_file_watch (;$) {
+ my $name = defined $_[0] ? $_[0] : 'error_log';
+ $name = File::Spec->catfile(Apache::Test::vars->{t_logs}, $name)
+ unless (File::Spec->file_name_is_absolute($name));
+
+ my $fh = delete $files{$name};
+ unless (defined $fh) {
+ open $fh, '<', $name or return;
+ return readline $fh;
+ }
+
+ return readline $fh;
+ }
+
+ sub t_read_file_watch (;$) {
+ my $name = defined $_[0] ? $_[0] : 'error_log';
+ $name = File::Spec->catfile(Apache::Test::vars->{t_logs}, $name)
+ unless (File::Spec->file_name_is_absolute($name));
+
+ my $fh = $files{$name};
+ unless (defined $fh) {
+ open $fh, '<', $name or return;
+ $files{$name} = $fh;
+ }
+
+ return readline $fh;
+ }
+
+ sub t_file_watch_for ($$$) {
+ my ($name, $re, $timeout) = @_;
+ local $/ = "\n";
+ $re = qr/$re/ unless ref $re;
+ $timeout *= 10;
+ my $buf = '';
+ my @acc;
+ while ($timeout >= 0) {
+ my $line = t_read_file_watch $name;
+ unless (defined $line) { # EOF
+ select undef, undef, undef, 0.1;
+ $timeout--;
+ next;
+ }
+ $buf .= $line;
+ next unless $buf =~ /\n$/; # incomplete line
+
+ # found a complete line
+ $line = $buf;
+ $buf = '';
+
+ push @acc, $line;
+ return wantarray ? @acc : $line if $line =~ $re;
+ }
+ return;
+ }
+
+ sub t_start_error_log_watch {
+ t_start_file_watch;
+ }
+
+ sub t_finish_error_log_watch {
+ local $/ = "\n";
+ return my @lines = t_finish_file_watch;
+ }
+}
+
+# because of the prototype and recursive call to itself a forward
+# declaration is needed
+sub t_is_equal ($$);
+
+# compare any two datastructures (must pass references for non-scalars)
+# undef()'s are valid args
+sub t_is_equal ($$) {
+ my ($a, $b) = @_;
+ return 0 unless @_ == 2;
+
+ # this was added in Apache::Test::VERSION 1.12 - remove deprecated
+ # logic sometime around 1.15 or mid September, 2004.
+ if (UNIVERSAL::isa($a, 'Regexp')) {
+ my @warning = ("WARNING!!! t_is_equal() argument order has changed.",
+ "use of a regular expression as the first argument",
+ "is deprecated. support will be removed soon.");
+ t_debug(@warning);
+ ($a, $b) = ($b, $a);
+ }
+
+ if (defined $a && defined $b) {
+ my $ref_a = ref $a;
+ my $ref_b = ref $b;
+ if (!$ref_a && !$ref_b) {
+ return $a eq $b;
+ }
+ elsif ($ref_a eq 'ARRAY' && $ref_b eq 'ARRAY') {
+ return 0 unless @$a == @$b;
+ for my $i (0..$#$a) {
+ t_is_equal($a->[$i], $b->[$i]) || return 0;
+ }
+ }
+ elsif ($ref_a eq 'HASH' && $ref_b eq 'HASH') {
+ return 0 unless (keys %$a) == (keys %$b);
+ for my $key (sort keys %$a) {
+ return 0 unless exists $b->{$key};
+ t_is_equal($a->{$key}, $b->{$key}) || return 0;
+ }
+ }
+ elsif ($ref_b eq 'Regexp') {
+ return $a =~ $b;
+ }
+ else {
+ # try to compare the references
+ return $a eq $b;
+ }
+ }
+ else {
+ # undef == undef! a valid test
+ return (defined $a || defined $b) ? 0 : 1;
+ }
+ return 1;
+}
+
+
+
+sub t_cmp ($$;$) {
+ Carp::carp(join(":", (caller)[1..2]) .
+ ' usage: $res = t_cmp($received, $expected, [$comment])')
+ if @_ < 2 || @_ > 3;
+
+ my ($received, $expected) = @_;
+
+ # this was added in Apache::Test::VERSION 1.12 - remove deprecated
+ # logic sometime around 1.15 or mid September, 2004.
+ if (UNIVERSAL::isa($_[0], 'Regexp')) {
+ my @warning = ("WARNING!!! t_cmp() argument order has changed.",
+ "use of a regular expression as the first argument",
+ "is deprecated. support will be removed soon.");
+ t_debug(@warning);
+ ($received, $expected) = ($expected, $received);
+ }
+
+ t_debug("testing : " . pop) if @_ == 3;
+ t_debug("expected: " . struct_as_string(0, $expected));
+ t_debug("received: " . struct_as_string(0, $received));
+ return t_is_equal($received, $expected);
+}
+
+# Essentially t_cmp, but on Win32, first converts pathnames
+# to their DOS long name.
+sub t_filepath_cmp ($$;$) {
+ my @a = (shift, shift);
+ if (Apache::TestConfig::WIN32) {
+ $a[0] = Win32::GetLongPathName($a[0]) if defined $a[0] && -e $a[0];
+ $a[1] = Win32::GetLongPathName($a[1]) if defined $a[1] && -e $a[1];
+ }
+ return @_ == 1 ? t_cmp($a[0], $a[1], $_[0]) : t_cmp($a[0], $a[1]);
+}
+
+
+*expand = HAS_DUMPER ?
+ sub { map { ref $_ ? Data::Dumper::Dumper($_) : $_ } @_ } :
+ sub { @_ };
+
+sub t_debug {
+ my $out = $Apache::TestUtil::DEBUG_OUTPUT;
+ print $out map {"# $_\n"} map {split /\n/} grep {defined} expand(@_);
+}
+
+sub t_open_file {
+ my $file = shift;
+
+ die "must pass a filename" unless defined $file;
+
+ # create the parent dir if it doesn't exist yet
+ makepath(dirname $file);
+
+ my $fh = Symbol::gensym();
+ open $fh, ">$file" or die "can't open $file: $!";
+ t_debug("writing file: $file");
+ $CLEAN{files}{$file}++;
+
+ return $fh;
+}
+
+sub _temp_package_dir {
+ return catdir(tmpdir(), 'apache_test');
+}
+
+sub t_write_test_lib {
+ my $file = shift;
+
+ die "must pass a filename" unless defined $file;
+
+ t_write_file(catdir(_temp_package_dir(), $file), @_);
+}
+
+sub t_write_file {
+ my $file = shift;
+
+ die "must pass a filename" unless defined $file;
+
+ # create the parent dir if it doesn't exist yet
+ makepath(dirname $file);
+
+ my $fh = Symbol::gensym();
+ open $fh, ">$file" or die "can't open $file: $!";
+ t_debug("writing file: $file");
+ print $fh join '', @_ if @_;
+ close $fh;
+ $CLEAN{files}{$file}++;
+}
+
+sub t_append_file {
+ my $file = shift;
+
+ die "must pass a filename" unless defined $file;
+
+ # create the parent dir if it doesn't exist yet
+ makepath(dirname $file);
+
+ # add to the cleanup list only if we created it now
+ $CLEAN{files}{$file}++ unless -e $file;
+
+ my $fh = Symbol::gensym();
+ open $fh, ">>$file" or die "can't open $file: $!";
+ print $fh join '', @_ if @_;
+ close $fh;
+}
+
+sub t_write_shell_script {
+ my $file = shift;
+
+ my $code = join '', @_;
+ my($ext, $shebang);
+
+ if (Apache::TestConfig::WIN32()) {
+ $code =~ s/echo$/echo./mg; #required to echo newline
+ $ext = 'bat';
+ $shebang = "\@echo off\nREM this is a bat";
+ }
+ else {
+ $ext = 'sh';
+ $shebang = '#!/bin/sh';
+ }
+
+ $file .= ".$ext";
+ t_write_file($file, "$shebang\n", $code);
+ $ext;
+}
+
+sub t_write_perl_script {
+ my $file = shift;
+
+ my $shebang = "#!$Config{perlpath}\n";
+ my $warning = Apache::TestConfig->thaw->genwarning($file);
+ t_write_file($file, $shebang, $warning, @_);
+ chmod 0755, $file;
+}
+
+
+sub t_mkdir {
+ my $dir = shift;
+ makepath($dir);
+}
+
+# returns a list of dirs successfully created
+sub makepath {
+ my($path) = @_;
+
+ return if !defined($path) || -e $path;
+ my $full_path = $path;
+
+ # remember which dirs were created and should be cleaned up
+ while (1) {
+ $CLEAN{dirs}{$path} = 1;
+ $path = dirname $path;
+ last if -e $path;
+ }
+
+ return File::Path::mkpath($full_path, 0, 0755);
+}
+
+sub t_rmtree {
+ die "must pass a dirname" unless defined $_[0];
+ File::Path::rmtree((@_ > 1 ? \@_ : $_[0]), 0, 1);
+}
+
+#chown a file or directory to the test User/Group
+#noop if chown is unsupported
+
+sub t_chown {
+ my $file = shift;
+ my $config = Apache::Test::config();
+ my($uid, $gid);
+
+ eval {
+ #XXX cache this lookup
+ ($uid, $gid) = (getpwnam($config->{vars}->{user}))[2,3];
+ };
+
+ if ($@) {
+ if ($@ =~ /^The getpwnam function is unimplemented/) {
+ #ok if unsupported, e.g. win32
+ return 1;
+ }
+ else {
+ die $@;
+ }
+ }
+
+ CORE::chown($uid, $gid, $file) || die "chown $file: $!";
+}
+
+# $string = struct_as_string($indent_level, $var);
+#
+# return any nested datastructure via Data::Dumper or ala Data::Dumper
+# as a string. undef() is a valid arg.
+#
+# $indent_level should be 0 (used for nice indentation during
+# recursive datastructure traversal)
+sub struct_as_string{
+ return "???" unless @_ == 2;
+ my $level = shift;
+
+ return "undef" unless defined $_[0];
+ my $pad = ' ' x (($level + 1) * INDENT);
+ my $spad = ' ' x ($level * INDENT);
+
+ if (HAS_DUMPER) {
+ local $Data::Dumper::Terse = 1;
+ $Data::Dumper::Terse = $Data::Dumper::Terse; # warn
+ my $data = Data::Dumper::Dumper(@_);
+ $data =~ s/\n$//; # \n is handled by the caller
+ return $data;
+ }
+ else {
+ if (ref($_[0]) eq 'ARRAY') {
+ my @data = ();
+ for my $i (0..$#{ $_[0] }) {
+ push @data,
+ struct_as_string($level+1, $_[0]->[$i]);
+ }
+ return join "\n", "[", map({"$pad$_,"} @data), "$spad\]";
+ } elsif ( ref($_[0])eq 'HASH') {
+ my @data = ();
+ for my $key (keys %{ $_[0] }) {
+ push @data,
+ "$key => " .
+ struct_as_string($level+1, $_[0]->{$key});
+ }
+ return join "\n", "{", map({"$pad$_,"} @data), "$spad\}";
+ } else {
+ return $_[0];
+ }
+ }
+}
+
+my $banner_format =
+ "\n*** The following %s expected and harmless ***\n";
+
+sub is_expected_banner {
+ my $type = shift;
+ my $count = @_ ? shift : 1;
+ sprintf $banner_format, $count == 1
+ ? "$type entry is"
+ : "$count $type entries are";
+}
+
+sub t_server_log_is_expected {
+ print STDERR is_expected_banner(@_);
+}
+
+sub t_client_log_is_expected {
+ my $vars = Apache::Test::config()->{vars};
+ my $log_file = catfile $vars->{serverroot}, "logs", "error_log";
+
+ my $fh = Symbol::gensym();
+ open $fh, ">>$log_file" or die "Can't open $log_file: $!";
+ my $oldfh = select($fh); $| = 1; select($oldfh);
+ print $fh is_expected_banner(@_);
+ close $fh;
+}
+
+sub t_server_log_error_is_expected { t_server_log_is_expected("error", @_);}
+sub t_server_log_warn_is_expected { t_server_log_is_expected("warn", @_); }
+sub t_client_log_error_is_expected { t_client_log_is_expected("error", @_);}
+sub t_client_log_warn_is_expected { t_client_log_is_expected("warn", @_); }
+
+END {
+ # remove files that were created via this package
+ for (grep {-e $_ && -f _ } keys %{ $CLEAN{files} } ) {
+ t_debug("removing file: $_");
+ unlink $_;
+ }
+
+ # remove dirs that were created via this package
+ for (grep {-e $_ && -d _ } keys %{ $CLEAN{dirs} } ) {
+ t_debug("removing dir tree: $_");
+ t_rmtree($_);
+ }
+}
+
+# essentially File::Spec->catfile, but on Win32
+# returns the long path name, if the file is absolute
+sub t_catfile {
+ my $f = catfile(@_);
+ return $f unless file_name_is_absolute($f);
+ return Apache::TestConfig::WIN32 && -e $f ?
+ Win32::GetLongPathName($f) : $f;
+}
+
+# Apache uses a Unix-style specification for files, with
+# forward slashes for directory separators. This is
+# essentially File::Spec::Unix->catfile, but on Win32
+# returns the long path name, if the file is absolute
+sub t_catfile_apache {
+ my $f = File::Spec::Unix->catfile(@_);
+ return $f unless file_name_is_absolute($f);
+ return Apache::TestConfig::WIN32 && -e $f ?
+ Win32::GetLongPathName($f) : $f;
+}
+
+1;
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+Apache::TestUtil - Utility functions for writing tests
+
+=head1 SYNOPSIS
+
+ use Apache::Test;
+ use Apache::TestUtil;
+
+ ok t_cmp("foo", "foo", "sanity check");
+ t_write_file("filename", @content);
+ my $fh = t_open_file($filename);
+ t_mkdir("/foo/bar");
+ t_rmtree("/foo/bar");
+ t_is_equal($a, $b);
+
+=head1 DESCRIPTION
+
+C<Apache::TestUtil> automatically exports a number of functions useful
+in writing tests.
+
+All the files and directories created using the functions from this
+package will be automatically destroyed at the end of the program
+execution (via END block). You should not use these functions other
+than from within tests which should cleanup all the created
+directories and files at the end of the test.
+
+=head1 FUNCTIONS
+
+=over
+
+=item t_cmp()
+
+ t_cmp($received, $expected, $comment);
+
+t_cmp() prints the values of I<$comment>, I<$expected> and
+I<$received>. e.g.:
+
+ t_cmp(1, 1, "1 == 1?");
+
+prints:
+
+ # testing : 1 == 1?
+ # expected: 1
+ # received: 1
+
+then it returns the result of comparison of the I<$expected> and the
+I<$received> variables. Usually, the return value of this function is
+fed directly to the ok() function, like this:
+
+ ok t_cmp(1, 1, "1 == 1?");
+
+the third argument (I<$comment>) is optional, mostly useful for
+telling what the comparison is trying to do.
+
+It is valid to use C<undef> as an expected value. Therefore:
+
+ my $foo;
+ t_cmp(undef, $foo, "undef == undef?");
+
+will return a I<true> value.
+
+You can compare any two data-structures with t_cmp(). Just make sure
+that if you pass non-scalars, you have to pass their references. The
+datastructures can be deeply nested. For example you can compare:
+
+ t_cmp({1 => [2..3,{5..8}], 4 => [5..6]},
+ {1 => [2..3,{5..8}], 4 => [5..6]},
+ "hash of array of hashes");
+
+You can also compare the second argument against the first as a
+regex. Use the C<qr//> function in the second argument. For example:
+
+ t_cmp("abcd", qr/^abc/, "regex compare");
+
+will do:
+
+ "abcd" =~ /^abc/;
+
+This function is exported by default.
+
+=item t_filepath_cmp()
+
+This function is used to compare two filepaths via t_cmp().
+For non-Win32, it simply uses t_cmp() for the comparison,
+but for Win32, Win32::GetLongPathName() is invoked to convert
+the first two arguments to their DOS long pathname. This is useful
+when there is a possibility the two paths being compared
+are not both represented by their long or short pathname.
+
+This function is exported by default.
+
+=item t_debug()
+
+ t_debug("testing feature foo");
+ t_debug("test", [1..3], 5, {a=>[1..5]});
+
+t_debug() prints out any datastructure while prepending C<#> at the
+beginning of each line, to make the debug printouts comply with
+C<Test::Harness>'s requirements. This function should be always used
+for debug prints, since if in the future the debug printing will
+change (e.g. redirected into a file) your tests won't need to be
+changed.
+
+the special global variable $Apache::TestUtil::DEBUG_OUTPUT can
+be used to redirect the output from t_debug() and related calls
+such as t_write_file(). for example, from a server-side test
+you would probably need to redirect it to STDERR:
+
+ sub handler {
+ plan $r, tests => 1;
+
+ local $Apache::TestUtil::DEBUG_OUTPUT = \*STDERR;
+
+ t_write_file('/tmp/foo', 'bar');
+ ...
+ }
+
+left to its own devices, t_debug() will collide with the standard
+HTTP protocol during server-side tests, resulting in a situation
+both confusing difficult to debug. but STDOUT is left as the
+default, since you probably don't want debug output under normal
+circumstances unless running under verbose mode.
+
+This function is exported by default.
+
+=item t_write_test_lib()
+
+ t_write_test_lib($filename, @lines)
+
+t_write_test_lib() creates a new file at I<$filename> or overwrites
+the existing file with the content passed in I<@lines>. The file
+is created in a temporary directory which is added to @INC at
+test configuration time. It is intended to be used for creating
+temporary packages for testing which can be modified at run time,
+see the Apache::Reload unit tests for an example.
+
+=item t_write_file()
+
+ t_write_file($filename, @lines);
+
+t_write_file() creates a new file at I<$filename> or overwrites the
+existing file with the content passed in I<@lines>. If only the
+I<$filename> is passed, an empty file will be created.
+
+If parent directories of C<$filename> don't exist they will be
+automagically created.
+
+The generated file will be automatically deleted at the end of the
+program's execution.
+
+This function is exported by default.
+
+=item t_append_file()
+
+ t_append_file($filename, @lines);
+
+t_append_file() is similar to t_write_file(), but it doesn't clobber
+existing files and appends C<@lines> to the end of the file. If the
+file doesn't exist it will create it.
+
+If parent directories of C<$filename> don't exist they will be
+automagically created.
+
+The generated file will be registered to be automatically deleted at
+the end of the program's execution, only if the file was created by
+t_append_file().
+
+This function is exported by default.
+
+=item t_write_shell_script()
+
+ Apache::TestUtil::t_write_shell_script($filename, @lines);
+
+Similar to t_write_file() but creates a portable shell/batch
+script. The created filename is constructed from C<$filename> and an
+appropriate extension automatically selected according to the platform
+the code is running under.
+
+It returns the extension of the created file.
+
+=item t_write_perl_script()
+
+ Apache::TestUtil::t_write_perl_script($filename, @lines);
+
+Similar to t_write_file() but creates a executable Perl script with
+correctly set shebang line.
+
+=item t_open_file()
+
+ my $fh = t_open_file($filename);
+
+t_open_file() opens a file I<$filename> for writing and returns the
+file handle to the opened file.
+
+If parent directories of C<$filename> don't exist they will be
+automagically created.
+
+The generated file will be automatically deleted at the end of the
+program's execution.
+
+This function is exported by default.
+
+=item t_mkdir()
+
+ t_mkdir($dirname);
+
+t_mkdir() creates a directory I<$dirname>. The operation will fail if
+the parent directory doesn't exist.
+
+If parent directories of C<$dirname> don't exist they will be
+automagically created.
+
+The generated directory will be automatically deleted at the end of
+the program's execution.
+
+This function is exported by default.
+
+=item t_rmtree()
+
+ t_rmtree(@dirs);
+
+t_rmtree() deletes the whole directories trees passed in I<@dirs>.
+
+This function is exported by default.
+
+=item t_chown()
+
+ Apache::TestUtil::t_chown($file);
+
+Change ownership of $file to the test's I<User>/I<Group>. This
+function is noop on platforms where chown(2) is unsupported
+(e.g. Win32).
+
+=item t_is_equal()
+
+ t_is_equal($a, $b);
+
+t_is_equal() compares any two datastructures and returns 1 if they are
+exactly the same, otherwise 0. The datastructures can be nested
+hashes, arrays, scalars, undefs or a combination of any of these. See
+t_cmp() for an example.
+
+If C<$b> is a regex reference, the regex comparison C<$a =~ $b> is
+performed. For example:
+
+ t_is_equal($server_version, qr{^Apache});
+
+If comparing non-scalars make sure to pass the references to the
+datastructures.
+
+This function is exported by default.
+
+=item t_server_log_error_is_expected()
+
+If the handler's execution results in an error or a warning logged to
+the I<error_log> file which is expected, it's a good idea to have a
+disclaimer printed before the error itself, so one can tell real
+problems with tests from expected errors. For example when testing how
+the package behaves under error conditions the I<error_log> file might
+be loaded with errors, most of which are expected.
+
+For example if a handler is about to generate a run-time error, this
+function can be used as:
+
+ use Apache::TestUtil;
+ ...
+ sub handler {
+ my $r = shift;
+ ...
+ t_server_log_error_is_expected();
+ die "failed because ...";
+ }
+
+After running this handler the I<error_log> file will include:
+
+ *** The following error entry is expected and harmless ***
+ [Tue Apr 01 14:00:21 2003] [error] failed because ...
+
+When more than one entry is expected, an optional numerical argument,
+indicating how many entries to expect, can be passed. For example:
+
+ t_server_log_error_is_expected(2);
+
+will generate:
+
+ *** The following 2 error entries are expected and harmless ***
+
+If the error is generated at compile time, the logging must be done in
+the BEGIN block at the very beginning of the file:
+
+ BEGIN {
+ use Apache::TestUtil;
+ t_server_log_error_is_expected();
+ }
+ use DOES_NOT_exist;
+
+After attempting to run this handler the I<error_log> file will
+include:
+
+ *** The following error entry is expected and harmless ***
+ [Tue Apr 01 14:04:49 2003] [error] Can't locate "DOES_NOT_exist.pm"
+ in @INC (@INC contains: ...
+
+Also see C<t_server_log_warn_is_expected()> which is similar but used
+for warnings.
+
+This function is exported by default.
+
+=item t_server_log_warn_is_expected()
+
+C<t_server_log_warn_is_expected()> generates a disclaimer for expected
+warnings.
+
+See the explanation for C<t_server_log_error_is_expected()> for more
+details.
+
+This function is exported by default.
+
+=item t_client_log_error_is_expected()
+
+C<t_client_log_error_is_expected()> generates a disclaimer for
+expected errors. But in contrast to
+C<t_server_log_error_is_expected()> called by the client side of the
+script.
+
+See the explanation for C<t_server_log_error_is_expected()> for more
+details.
+
+For example the following client script fails to find the handler:
+
+ use Apache::Test;
+ use Apache::TestUtil;
+ use Apache::TestRequest qw(GET);
+
+ plan tests => 1;
+
+ t_client_log_error_is_expected();
+ my $url = "/error_document/cannot_be_found";
+ my $res = GET($url);
+ ok t_cmp(404, $res->code, "test 404");
+
+After running this test the I<error_log> file will include an entry
+similar to the following snippet:
+
+ *** The following error entry is expected and harmless ***
+ [Tue Apr 01 14:02:55 2003] [error] [client 127.0.0.1]
+ File does not exist: /tmp/test/t/htdocs/error
+
+When more than one entry is expected, an optional numerical argument,
+indicating how many entries to expect, can be passed. For example:
+
+ t_client_log_error_is_expected(2);
+
+will generate:
+
+ *** The following 2 error entries are expected and harmless ***
+
+This function is exported by default.
+
+=item t_client_log_warn_is_expected()
+
+C<t_client_log_warn_is_expected()> generates a disclaimer for expected
+warnings on the client side.
+
+See the explanation for C<t_client_log_error_is_expected()> for more
+details.
+
+This function is exported by default.
+
+=item t_catfile('a', 'b', 'c')
+
+This function is essentially C<File::Spec-E<gt>catfile>, but
+on Win32 will use C<Win32::GetLongpathName()> to convert the
+result to a long path name (if the result is an absolute file).
+The function is not exported by default.
+
+=item t_catfile_apache('a', 'b', 'c')
+
+This function is essentially C<File::Spec::Unix-E<gt>catfile>, but
+on Win32 will use C<Win32::GetLongpathName()> to convert the
+result to a long path name (if the result is an absolute file).
+It is useful when comparing something to that returned by Apache,
+which uses a Unix-style specification with forward slashes for
+directory separators. The function is not exported by default.
+
+=item t_start_error_log_watch(), t_finish_error_log_watch()
+
+This pair of functions provides an easy interface for checking
+the presence or absense of any particular message or messages
+in the httpd error_log that were generated by the httpd daemon
+as part of a test suite. It is likely, that you should proceed
+this with a call to one of the t_*_is_expected() functions.
+
+ t_start_error_log_watch();
+ do_it;
+ ok grep {...} t_finish_error_log_watch();
+
+Another usage case could be a handler that emits some debugging messages
+to the error_log. Now, if this handler is called in a series of other
+test cases it can be hard to find the relevant messages manually. In such
+cases the following sequence in the test file may help:
+
+ t_start_error_log_watch();
+ GET '/this/or/that';
+ t_debug t_finish_error_log_watch();
+
+=item t_start_file_watch()
+
+ Apache::TestUtil::t_start_file_watch('access_log');
+
+This function is similar to C<t_start_error_log_watch()> but allows for
+other files than C<error_log> to be watched. It opens the given file
+and positions the file pointer at its end. Subsequent calls to
+C<t_read_file_watch()> or C<t_finish_file_watch()> will read lines that
+have been appended after this call.
+
+A file name can be passed as parameter. If omitted
+or undefined the C<error_log> is opened. Relative file name are
+evaluated relative to the directory containing C<error_log>.
+
+If the specified file does not exist (yet) no error is returned. It is
+assumed that it will appear soon. In this case C<t_{read,finish}_file_watch()>
+will open the file silently and read from the beginning.
+
+=item t_read_file_watch(), t_finish_file_watch()
+
+ local $/ = "\n";
+ $line1=Apache::TestUtil::t_read_file_watch('access_log');
+ $line2=Apache::TestUtil::t_read_file_watch('access_log');
+
+ @lines=Apache::TestUtil::t_finish_file_watch('access_log');
+
+This pair of functions reads the file opened by C<t_start_error_log_watch()>.
+
+As does the core C<readline> function, they return one line if called in
+scalar context, otherwise all lines until end of file.
+
+Before calling C<readline> these functions do not set C<$/> as does
+C<t_finish_error_log_watch>. So, if the file has for example a fixed
+record length use this:
+
+ {
+ local $/=\$record_length;
+ @lines=t_finish_file_watch($name);
+ }
+
+=item t_file_watch_for()
+
+ @lines=Apache::TestUtil::t_file_watch_for('access_log',
+ qr/condition/,
+ $timeout);
+
+This function reads the file from the current position and looks for the
+first line that matches C<qr/condition/>. If no such line could be found
+until end of file the function pauses and retries until either such a line
+is found or the timeout (in seconds) is reached.
+
+In scalar or void context only the matching line is returned. In list
+context all read lines are returned with the matching one in last position.
+
+The function uses C<\n> and end-of-line marker and waits for complete lines.
+
+The timeout although it can be specified with sub-second precision is not very
+accurate. It is simply multiplied by 10. The result is used as a maximum loop
+count. For the intented purpose this should be good enough.
+
+Use this function to check for logfile entries when you cannot be sure that
+they are already written when the test program reaches the point, for example
+to check for messages that are written in a PerlCleanupHandler or a
+PerlLogHandler.
+
+ ok t_file_watch_for 'access_log', qr/expected log entry/, 2;
+
+This call reads the C<access_log> and waits for maximum 2 seconds for the
+expected entry to appear.
+
+=back
+
+=head1 AUTHOR
+
+Stas Bekman <stas@stason.org>,
+Torsten Förtsch <torsten.foertsch@gmx.net>
+
+=head1 SEE ALSO
+
+perl(1)
+
+=cut
+