1# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
2package TestHooks::startup;
3
4# test PerlPostConfigHandler and PerlOpenLogsHandler phases
5# also test that we can run things on vhost entries from these phases
6
7use strict;
8use warnings FATAL => 'all';
9
10use Apache::TestUtil;
11use Apache::Test;
12use Apache::TestTrace;
13
14use APR::Table;
15use Apache2::ServerRec ();
16use Apache2::ServerUtil ();
17use Apache2::RequestRec ();
18use Apache2::RequestIO ();
19
20use File::Spec::Functions qw(catfile catdir);
21use File::Path qw(mkpath);
22
23use Apache2::Const -compile => 'OK';
24
25my $dir = catdir Apache::Test::vars("documentroot"), 'hooks', 'startup';
26
27sub open_logs {
28    my ($conf_pool, $log_pool, $temp_pool, $s) = @_;
29
30    # main server
31    run("open_logs", $s);
32
33    for (my $vhost_s = $s->next; $vhost_s; $vhost_s = $vhost_s->next) {
34        my $port = $vhost_s->port;
35        my $val = $vhost_s->dir_config->{PostConfig};
36        # we have one vhost that we want to run open_logs for
37        next unless $val && $val eq 'VHost';
38        run("open_logs", $vhost_s);
39    }
40
41    Apache2::Const::OK;
42}
43
44sub post_config {
45    my ($conf_pool, $log_pool, $temp_pool, $s) = @_;
46
47    # main server
48    run("post_config", $s);
49
50    for (my $vhost_s = $s->next; $vhost_s; $vhost_s = $vhost_s->next) {
51        my $port = $vhost_s->port;
52        my $val = $vhost_s->dir_config->{PostConfig};
53        # we have one vhost that we want to run post_config for
54        next unless $val && $val eq 'VHost';
55        run("post_config", $vhost_s);
56    }
57
58    Apache2::Const::OK;
59}
60
61sub run {
62    my ($phase, $s) = @_;
63
64    my $val = $s->dir_config->{PostConfig} or die "Can't read PostConfig var";
65
66    # make sure that these are set at the earliest possible time
67    die '$ENV{MOD_PERL} not set!' unless $ENV{MOD_PERL};
68    die '$ENV{MOD_PERL_API_VERSION} not set!'
69        unless $ENV{MOD_PERL_API_VERSION} == 2;
70
71    my $port = $s->port;
72    my $file = catfile $dir, "$phase-$port";
73
74    mkpath $dir, 0, 0755;
75    open my $fh, ">$file" or die "can't open $file: $!";
76    print $fh $val;
77    close $fh;
78
79    debug "Phase $phase is completed for server at port $port";
80}
81
82sub handler {
83    my $r = shift;
84
85    $r->content_type('text/plain');
86
87    my $s = $r->server;
88    my $expected = $s->dir_config->{PostConfig}
89        or die "Can't read PostConfig var";
90    my $port = $s->port;
91
92    for my $phase (qw(open_logs post_config)) {
93        my $file = catfile $dir, "$phase-$port";
94        open my $fh, "$file" or die "can't open $file: $!";
95        my $received = <$fh> || '';
96        close $fh;
97
98        # can't cleanup the file here, because t/SMOKE may run this
99        # test more than once, so we cleanup on startup in modperl_extra.pl
100        # unlink $file;
101
102        if ($expected eq $received) {
103            $r->print("$phase ok\n");
104        } else {
105            warn "phase: $phase\n";
106            warn "port: $port\n";
107            warn "expected: $expected\n";
108            warn "received: $received\n";
109        }
110    }
111    Apache2::Const::OK;
112}
113
1141;
115__DATA__
116<NoAutoConfig>
117<VirtualHost TestHooks::startup>
118    PerlSetVar PostConfig VHost
119    PerlModule TestHooks::startup
120    PerlPostConfigHandler TestHooks::startup::post_config
121    PerlOpenLogsHandler   TestHooks::startup::open_logs
122    <Location /TestHooks__startup>
123        SetHandler modperl
124        PerlResponseHandler TestHooks::startup
125    </Location>
126</VirtualHost>
127PerlSetVar PostConfig Main
128PerlModule TestHooks::startup
129PerlPostConfigHandler TestHooks::startup::post_config
130PerlOpenLogsHandler   TestHooks::startup::open_logs
131<Location /TestHooks__startup>
132    SetHandler modperl
133    PerlResponseHandler TestHooks::startup
134</Location>
135</NoAutoConfig>
136