1# Licensed to the Apache Software Foundation (ASF) under one or more 2# contributor license agreements. See the NOTICE file distributed with 3# this work for additional information regarding copyright ownership. 4# The ASF licenses this file to You under the Apache License, Version 2.0 5# (the "License"); you may not use this file except in compliance with 6# the License. You may obtain a copy of the License at 7# 8# http://www.apache.org/licenses/LICENSE-2.0 9# 10# Unless required by applicable law or agreed to in writing, software 11# distributed under the License is distributed on an "AS IS" BASIS, 12# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13# See the License for the specific language governing permissions and 14# limitations under the License. 15# 16package Apache::TestConfig; #not TestConfigParse on purpose 17 18#dont really want/need a full-blown parser 19#but do want something somewhat generic 20 21use strict; 22use warnings FATAL => 'all'; 23 24use Apache::TestTrace; 25 26use File::Spec::Functions qw(rel2abs splitdir file_name_is_absolute); 27use File::Basename qw(dirname basename); 28 29sub strip_quotes { 30 local $_ = shift || $_; 31 s/^\"//; s/\"$//; $_; 32} 33 34my %wanted_config = ( 35 TAKE1 => {map { $_, 1 } qw(ServerRoot ServerAdmin TypesConfig DocumentRoot)}, 36 TAKE2 => {map { $_, 1 } qw(LoadModule LoadFile)}, 37); 38 39my %spec_init = ( 40 TAKE1 => sub { shift->{+shift} = "" }, 41 TAKE2 => sub { shift->{+shift} = [] }, 42); 43 44my %spec_apply = ( 45 TypesConfig => \&inherit_server_file, 46 ServerRoot => sub {}, #dont override $self->{vars}->{serverroot} 47 DocumentRoot => \&inherit_directive_var, 48 LoadModule => \&inherit_load_module, 49 LoadFile => \&inherit_load_file, 50); 51 52#where to add config, default is preamble 53my %spec_postamble = map { $_, 'postamble' } qw(TypesConfig); 54 55# need to enclose the following directives into <IfModule 56# mod_foo.c>..</IfModule>, since mod_foo might be unavailable 57my %ifmodule = ( 58 TypesConfig => 'mod_mime.c', 59); 60 61sub spec_add_config { 62 my($self, $directive, $val) = @_; 63 64 my $where = $spec_postamble{$directive} || 'preamble'; 65 66 if (my $ifmodule = $ifmodule{TypesConfig}) { 67 $self->postamble(<<EOI); 68<IfModule $ifmodule> 69 $directive $val 70</IfModule> 71EOI 72 } 73 else { 74 $self->$where($directive => $val); 75 } 76} 77 78# resolve relative files like Apache->server_root_relative 79# this function doesn't test whether the resolved file exists 80sub server_file_rel2abs { 81 my($self, $file, $base) = @_; 82 83 my ($serverroot, $result) = (); 84 85 # order search sequence 86 my @tries = ([ $base, 87 'user-supplied $base' ], 88 [ $self->{inherit_config}->{ServerRoot}, 89 'httpd.conf inherited ServerRoot' ], 90 [ $self->apxs('PREFIX', 1), 91 'apxs-derived ServerRoot' ]); 92 93 # remove surrounding quotes if any 94 # e.g. Include "/tmp/foo.html" 95 $file =~ s/^\s*["']?//; 96 $file =~ s/["']?\s*$//; 97 98 if (file_name_is_absolute($file)) { 99 debug "$file is already absolute"; 100 $result = $file; 101 } 102 else { 103 foreach my $try (@tries) { 104 next unless defined $try->[0]; 105 106 if (-d $try->[0]) { 107 $serverroot = $try->[0]; 108 debug "using $try->[1] to resolve $file"; 109 last; 110 } 111 } 112 113 if ($serverroot) { 114 $result = rel2abs $file, $serverroot; 115 } 116 else { 117 warning "unable to resolve $file - cannot find a suitable ServerRoot"; 118 warning "please specify a ServerRoot in your httpd.conf or use apxs"; 119 120 # return early, skipping file test below 121 return $file; 122 } 123 } 124 125 my $dir = dirname $result; 126 # $file might not exist (e.g. if it's a glob pattern like 127 # "conf/*.conf" but what we care about here is to check whether 128 # the base dir was successfully resolved. we don't check whether 129 # the file exists at all. it's the responsibility of the caller to 130 # do this check 131 if (defined $dir && -e $dir && -d _) { 132 if (-e $result) { 133 debug "$file successfully resolved to existing file $result"; 134 } 135 else { 136 debug "base dir of '$file' successfully resolved to $dir"; 137 } 138 139 } 140 else { 141 $dir ||= ''; 142 warning "dir '$dir' does not exist (while resolving '$file')"; 143 144 # old behavior was to return the resolved but non-existent 145 # file. preserve that behavior and return $result anyway. 146 } 147 148 return $result; 149} 150 151sub server_file { 152 my $f = shift->server_file_rel2abs(@_); 153 return qq("$f"); 154} 155 156sub inherit_directive_var { 157 my($self, $c, $directive) = @_; 158 159 $self->{vars}->{"inherit_\L$directive"} = $c->{$directive}; 160} 161 162sub inherit_server_file { 163 my($self, $c, $directive) = @_; 164 165 $self->spec_add_config($directive, 166 $self->server_file($c->{$directive})); 167} 168 169#so we have the same names if these modules are linked static or shared 170my %modname_alias = ( 171 'mod_pop.c' => 'pop_core.c', 172 'mod_proxy_ajp.c' => 'proxy_ajp.c', 173 'mod_proxy_http.c' => 'proxy_http.c', 174 'mod_proxy_ftp.c' => 'proxy_ftp.c', 175 'mod_proxy_balancer.c' => 'proxy_balancer.c', 176 'mod_proxy_connect.c' => 'proxy_connect.c', 177 'mod_modperl.c' => 'mod_perl.c', 178); 179 180# Block modules which inhibit testing: 181# - mod_jk requires JkWorkerFile or JkWorker to be configured 182# skip it for now, tomcat has its own test suite anyhow. 183# - mod_casp2 requires other settings in addition to LoadModule 184# - mod_bwshare and mod_evasive20 block fast requests that tests are doing 185# - mod_fcgid causes https://rt.cpan.org/Public/Bug/Display.html?id=54476 186# - mod_modnss.c and mod_rev.c require further configuration 187my @autoconfig_skip_module = qw(mod_jk.c mod_casp2.c mod_bwshare.c 188 mod_fcgid.c mod_evasive20.c mod_modnss.c mod_rev.c); 189 190# add modules to be not inherited from the existing config. 191# e.g. prevent from LoadModule perl_module to be included twice, when 192# mod_perl already configures LoadModule and it's certainly found in 193# the existing httpd.conf installed system-wide. 194sub autoconfig_skip_module_add { 195 push @autoconfig_skip_module, @_; 196} 197 198sub should_skip_module { 199 my($self, $name) = @_; 200 201 for (@autoconfig_skip_module) { 202 if (UNIVERSAL::isa($_, 'Regexp')) { 203 return 1 if $name =~ /$_/; 204 } 205 else { 206 return 1 if $name eq $_; 207 } 208 } 209 return 0; 210} 211 212#inherit LoadModule 213sub inherit_load_module { 214 my($self, $c, $directive) = @_; 215 216 for my $args (@{ $c->{$directive} }) { 217 my $modname = $args->[0]; 218 my $file = $self->server_file_rel2abs($args->[1]); 219 220 unless (-e $file) { 221 debug "$file does not exist, skipping LoadModule"; 222 next; 223 } 224 225 my $name = basename $args->[1]; 226 $name =~ s/\.(s[ol]|dll)$/.c/; #mod_info.so => mod_info.c 227 $name =~ s/^lib/mod_/; #libphp4.so => mod_php4.c 228 229 $name = $modname_alias{$name} if $modname_alias{$name}; 230 231 # remember all found modules 232 $self->{modules}->{$name} = $file; 233 debug "Found: $modname => $name"; 234 235 if ($self->should_skip_module($name)) { 236 debug "Skipping LoadModule of $name"; 237 next; 238 } 239 240 debug "LoadModule $modname $name"; 241 242 # sometimes people have broken system-wide httpd.conf files, 243 # which include LoadModule of modules, which are built-in, but 244 # won't be skipped above if they are found in the modules/ 245 # directory. this usually happens when httpd is built once 246 # with its modules built as shared objects and then again with 247 # static ones: the old httpd.conf still has the LoadModule 248 # directives, even though the modules are now built-in 249 # so we try to workaround this problem using <IfModule> 250 $self->preamble(IfModule => "!$name", 251 qq{LoadModule $modname "$file"\n}); 252 } 253} 254 255#inherit LoadFile 256sub inherit_load_file { 257 my($self, $c, $directive) = @_; 258 259 for my $args (@{ $c->{$directive} }) { 260 my $file = $self->server_file_rel2abs($args->[0]); 261 262 unless (-e $file) { 263 debug "$file does not exist, skipping LoadFile"; 264 next; 265 } 266 267 if ($self->should_skip_module($args->[0])) { 268 debug "Skipping LoadFile of $args->[0]"; 269 next; 270 } 271 272 # remember all found modules 273 push @{$self->{load_file}}, $file; 274 275 debug "LoadFile $file"; 276 277 $self->preamble_first(qq{LoadFile "$file"\n}); 278 } 279} 280 281sub parse_take1 { 282 my($self, $c, $directive) = @_; 283 $c->{$directive} = strip_quotes; 284} 285 286sub parse_take2 { 287 my($self, $c, $directive) = @_; 288 push @{ $c->{$directive} }, [map { strip_quotes } split]; 289} 290 291sub apply_take1 { 292 my($self, $c, $directive) = @_; 293 294 if (exists $self->{vars}->{lc $directive}) { 295 #override replacement @Variables@ 296 $self->{vars}->{lc $directive} = $c->{$directive}; 297 } 298 else { 299 $self->spec_add_config($directive, qq("$c->{$directive}")); 300 } 301} 302 303sub apply_take2 { 304 my($self, $c, $directive) = @_; 305 306 for my $args (@{ $c->{$directive} }) { 307 $self->spec_add_config($directive => [map { qq("$_") } @$args]); 308 } 309} 310 311sub inherit_config_file_or_directory { 312 my ($self, $item) = @_; 313 314 if (-d $item) { 315 my $dir = $item; 316 debug "descending config directory: $dir"; 317 318 for my $entry (glob "$dir/*") { 319 $self->inherit_config_file_or_directory($entry); 320 } 321 return; 322 } 323 324 my $file = $item; 325 debug "inheriting config file: $file"; 326 327 my $fh = Symbol::gensym(); 328 open($fh, $file) or return; 329 330 my $c = $self->{inherit_config}; 331 while (<$fh>) { 332 s/^\s*//; s/\s*$//; s/^\#.*//; 333 next if /^$/; 334 335 # support continuous config lines (which use \ to break the line) 336 while (s/\\$//) { 337 my $cont = <$fh>; 338 $cont =~ s/^\s*//; 339 $cont =~ s/\s*$//; 340 $_ .= $cont; 341 } 342 343 (my $directive, $_) = split /\s+/, $_, 2; 344 345 if ($directive eq "Include" or $directive eq "IncludeOptional") { 346 foreach my $include (glob($self->server_file_rel2abs($_))) { 347 $self->inherit_config_file_or_directory($include); 348 } 349 } 350 351 #parse what we want 352 while (my($spec, $wanted) = each %wanted_config) { 353 next unless $wanted->{$directive}; 354 my $method = "parse_\L$spec"; 355 $self->$method($c, $directive); 356 } 357 } 358 359 close $fh; 360} 361 362sub inherit_config { 363 my $self = shift; 364 365 $self->get_httpd_static_modules; 366 $self->get_httpd_defines; 367 368 #may change after parsing httpd.conf 369 $self->{vars}->{inherit_documentroot} = 370 catfile $self->{httpd_basedir}, 'htdocs'; 371 372 my $file = $self->{vars}->{httpd_conf}; 373 my $extra_file = $self->{vars}->{httpd_conf_extra}; 374 375 unless ($file and -e $file) { 376 if (my $base = $self->{httpd_basedir}) { 377 my $default_conf = $self->{httpd_defines}->{SERVER_CONFIG_FILE}; 378 $default_conf ||= catfile qw(conf httpd.conf); 379 $file = catfile $base, $default_conf; 380 381 # SERVER_CONFIG_FILE might be an absolute path 382 unless (-e $file) { 383 if (-e $default_conf) { 384 $file = $default_conf; 385 } 386 else { 387 # try a little harder 388 if (my $root = $self->{httpd_defines}->{HTTPD_ROOT}) { 389 debug "using HTTPD_ROOT to resolve $default_conf"; 390 $file = catfile $root, $default_conf; 391 } 392 } 393 } 394 } 395 } 396 397 unless ($extra_file and -e $extra_file) { 398 if ($extra_file and my $base = $self->{httpd_basedir}) { 399 my $default_conf = catfile qw(conf $extra_file); 400 $extra_file = catfile $base, $default_conf; 401 # SERVER_CONFIG_FILE might be an absolute path 402 $extra_file = $default_conf if !-e $extra_file and -e $default_conf; 403 } 404 } 405 406 return unless $file or $extra_file; 407 408 my $c = $self->{inherit_config}; 409 410 #initialize array refs and such 411 while (my($spec, $wanted) = each %wanted_config) { 412 for my $directive (keys %$wanted) { 413 $spec_init{$spec}->($c, $directive); 414 } 415 } 416 417 $self->inherit_config_file_or_directory($file) if $file; 418 $self->inherit_config_file_or_directory($extra_file) if $extra_file; 419 420 #apply what we parsed 421 while (my($spec, $wanted) = each %wanted_config) { 422 for my $directive (keys %$wanted) { 423 next unless $c->{$directive}; 424 my $cv = $spec_apply{$directive} || 425 $self->can("apply_\L$directive") || 426 $self->can("apply_\L$spec"); 427 $cv->($self, $c, $directive); 428 } 429 } 430} 431 432sub get_httpd_static_modules { 433 my $self = shift; 434 435 my $httpd = $self->{vars}->{httpd}; 436 return unless $httpd; 437 438 $httpd = shell_ready($httpd); 439 my $cmd = "$httpd -l"; 440 my $list = $self->open_cmd($cmd); 441 442 while (<$list>) { 443 s/\s+$//; 444 next unless /\.c$/; 445 chomp; 446 s/^\s+//; 447 $self->{modules}->{$_} = 1; 448 } 449 450 close $list; 451} 452 453sub get_httpd_defines { 454 my $self = shift; 455 456 my $httpd = $self->{vars}->{httpd}; 457 return unless $httpd; 458 459 $httpd = shell_ready($httpd); 460 my $cmd = "$httpd -V"; 461 462 my $httpdconf = $self->{vars}->{httpd_conf}; 463 $cmd .= " -f $httpdconf" if $httpdconf; 464 465 my $serverroot = $self->{vars}->{serverroot}; 466 $cmd .= " -d $serverroot" if $serverroot; 467 468 my $proc = $self->open_cmd($cmd); 469 470 while (<$proc>) { 471 chomp; 472 if( s/^\s*-D\s*//) { 473 s/\s+$//; 474 my($key, $val) = split '=', $_, 2; 475 $self->{httpd_defines}->{$key} = $val ? strip_quotes($val) : 1; 476 debug "isolated httpd_defines $key = " . $self->{httpd_defines}->{$key}; 477 } 478 elsif (/(version|built|module magic number|server mpm):\s+(.*)/i) { 479 my $val = $2; 480 (my $key = uc $1) =~ s/\s/_/g; 481 $self->{httpd_info}->{$key} = $val; 482 debug "isolated httpd_info $key = " . $val; 483 } 484 } 485 486 close $proc; 487 488 if (my $mmn = $self->{httpd_info}->{MODULE_MAGIC_NUMBER}) { 489 @{ $self->{httpd_info} } 490 {qw(MODULE_MAGIC_NUMBER_MAJOR 491 MODULE_MAGIC_NUMBER_MINOR)} = split ':', $mmn; 492 } 493 494 # get the mpm information where available 495 # lowercase for consistency across the two extraction methods 496 # XXX or maybe consider making have_apache_mpm() case-insensitive? 497 if (my $mpm = $self->{httpd_info}->{SERVER_MPM}) { 498 # 2.1 499 $self->{mpm} = lc $mpm; 500 } 501 elsif (my $mpm_dir = $self->{httpd_defines}->{APACHE_MPM_DIR}) { 502 # 2.0 503 $self->{mpm} = lc basename $mpm_dir; 504 } 505 else { 506 # Apache 1.3 - no mpm to speak of 507 $self->{mpm} = ''; 508 } 509 510 my $version = $self->{httpd_info}->{VERSION} || ''; 511 512 if ($version =~ qr,Apache/2,) { 513 # PHP 4.x on httpd-2.x needs a special modname alias: 514 $modname_alias{'mod_php4.c'} = 'sapi_apache2.c'; 515 } 516 517 unless ($version =~ qr,Apache/(2.0|1.3),) { 518 # for 2.1 and later, mod_proxy_* are really called mod_proxy_* 519 delete @modname_alias{grep {/^mod_proxy_/} keys %modname_alias}; 520 } 521} 522 523sub httpd_version { 524 my $self = shift; 525 526 my $httpd = $self->{vars}->{httpd}; 527 return unless $httpd; 528 529 my $version; 530 $httpd = shell_ready($httpd); 531 my $cmd = "$httpd -v"; 532 533 my $v = $self->open_cmd($cmd); 534 535 local $_; 536 while (<$v>) { 537 next unless s/^Server\s+version:\s*//i; 538 chomp; 539 my @parts = split; 540 foreach (@parts) { 541 next unless /^Apache\//; 542 $version = $_; 543 last; 544 } 545 $version ||= $parts[0]; 546 last; 547 } 548 549 close $v; 550 551 return $version; 552} 553 554sub httpd_mpm { 555 return shift->{mpm}; 556} 557 5581; 559