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