From dc548f01cf1d39a05892a50dfc6bd8d13d50c227 Mon Sep 17 00:00:00 2001 From: b1v1r Date: Fri, 18 Sep 2009 08:34:12 +0000 Subject: [PATCH] Cleanup test scripts. --- apache2/t/run-regression-tests.pl.in | 1080 +++++++++++++------------- apache2/t/run-unit-tests.pl.in | 202 ++--- 2 files changed, 642 insertions(+), 640 deletions(-) diff --git a/apache2/t/run-regression-tests.pl.in b/apache2/t/run-regression-tests.pl.in index f41d2b62..15614e94 100755 --- a/apache2/t/run-regression-tests.pl.in +++ b/apache2/t/run-regression-tests.pl.in @@ -5,8 +5,8 @@ # Syntax: run-regression-tests.pl [options] [file [N]] # # All: run-regression-tests.pl -# All in file: run-regression-tests.pl file -# Nth in file: run-regression-tests.pl file N +# All in file: run-regression-tests.pl file +# Nth in file: run-regression-tests.pl file N # use strict; use Time::HiRes qw(gettimeofday sleep); @@ -45,8 +45,8 @@ $UA->agent($UA_NAME); # Hack for testing the script w/o configure if ($HTTPD eq "\@APXS_HTTPD\@") { - $HTTPD = "/usr/local/apache2/bin/httpd"; - $MODULES_DIR = "/usr/local/apache2/modules"; + $HTTPD = "/usr/local/apache2/bin/httpd"; + $MODULES_DIR = "/usr/local/apache2/modules"; } $SIG{TERM} = $SIG{INT} = \&handle_interrupt; @@ -55,14 +55,14 @@ my %opt; getopts('A:E:D:C:T:H:a:p:dvh', \%opt); if ($opt{d}) { - $Data::Dumper::Indent = 1; - $Data::Dumper::Terse = 1; - $Data::Dumper::Pad = ""; - $Data::Dumper::Quotekeys = 0; + $Data::Dumper::Indent = 1; + $Data::Dumper::Terse = 1; + $Data::Dumper::Pad = ""; + $Data::Dumper::Quotekeys = 0; } sub usage { - print stderr <<"EOT"; + print stderr <<"EOT"; @_ Usage: $SCRIPT [options] [file [N]] @@ -81,17 +81,17 @@ Usage: $SCRIPT [options] [file [N]] EOT - exit(1); + exit(1); } usage() if ($opt{h}); ### Check httpd binary if (defined $opt{a}) { - $HTTPD = $opt{a}; + $HTTPD = $opt{a}; } else { - $opt{a} = $HTTPD; + $opt{a} = $HTTPD; } usage("Invalid Apache startup script: $HTTPD\n") unless (-e $HTTPD); @@ -105,673 +105,675 @@ $opt{p} = 8088 unless (defined $opt{p}); $opt{v} = 1 if ($opt{d}); unless (defined $opt{S}) { - my $httpd_root = `$HTTPD -V`; - ($opt{S} = $httpd_root) =~ s/.*-D HTTPD_ROOT="([^"]*)".*/$1/sm; + my $httpd_root = `$HTTPD -V`; + ($opt{S} = $httpd_root) =~ s/.*-D HTTPD_ROOT="([^"]*)".*/$1/sm; } %ENV = ( - %ENV, - SERVER_ROOT => $opt{S}, - SERVER_PORT => $opt{p}, - SERVER_NAME => "localhost", - TEST_SERVER_ROOT => $SROOT_DIR, - DATA_DIR => $DATA_DIR, - TEMP_DIR => $TEMP_DIR, - UPLOAD_DIR => $UPLOAD_DIR, - CONF_DIR => $CONF_DIR, - MODULES_DIR => $MODULES_DIR, - LOGS_DIR => $FILES_DIR, - SCRIPT_DIR => $SCRIPT_DIR, - REGRESSION_DIR => $REG_DIR, - DIST_ROOT => File::Spec->rel2abs(dirname("$SCRIPT_DIR/../../..")), - AUDIT_LOG => $opt{A}, - DEBUG_LOG => $opt{D}, - ERROR_LOG => $opt{E}, - HTTPD_CONF => $opt{C}, - HTDOCS => $opt{H}, - USER_AGENT => $UA_NAME, + %ENV, + SERVER_ROOT => $opt{S}, + SERVER_PORT => $opt{p}, + SERVER_NAME => "localhost", + TEST_SERVER_ROOT => $SROOT_DIR, + DATA_DIR => $DATA_DIR, + TEMP_DIR => $TEMP_DIR, + UPLOAD_DIR => $UPLOAD_DIR, + CONF_DIR => $CONF_DIR, + MODULES_DIR => $MODULES_DIR, + LOGS_DIR => $FILES_DIR, + SCRIPT_DIR => $SCRIPT_DIR, + REGRESSION_DIR => $REG_DIR, + DIST_ROOT => File::Spec->rel2abs(dirname("$SCRIPT_DIR/../../..")), + AUDIT_LOG => $opt{A}, + DEBUG_LOG => $opt{D}, + ERROR_LOG => $opt{E}, + HTTPD_CONF => $opt{C}, + HTDOCS => $opt{H}, + USER_AGENT => $UA_NAME, ); #dbg("OPTIONS: ", \%opt); if (-e "$PID_FILE") { - msg("Shutting down previous instance: $PID_FILE"); - httpd_stop(); + msg("Shutting down previous instance: $PID_FILE"); + httpd_stop(); } if (defined $ARGV[0]) { - runfile(dirname($ARGV[0]), basename($ARGV[0]), $ARGV[1]); - done(); + runfile(dirname($ARGV[0]), basename($ARGV[0]), $ARGV[1]); + done(); } for my $type (@TYPES) { - my $dir = "$SCRIPT_DIR/regression/$type"; - my @cfg = (); + my $dir = "$SCRIPT_DIR/regression/$type"; + my @cfg = (); - # Get test names - opendir(DIR, "$dir") or quit(1, "Failed to open \"$dir\": $!"); - @cfg = grep { /\.t$/ && -f "$dir/$_" } readdir(DIR); - closedir(DIR); - - for my $cfg (sort @cfg) { - runfile($dir, $cfg); - } + # Get test names + opendir(DIR, "$dir") or quit(1, "Failed to open \"$dir\": $!"); + @cfg = grep { /\.t$/ && -f "$dir/$_" } readdir(DIR); + closedir(DIR); + for my $cfg (sort @cfg) { + runfile($dir, $cfg); + } } done(); sub runfile { - my($dir, $cfg, $testnum) = @_; - my $fn = "$dir/$cfg"; - my @data = (); - my $edata; - my @C = (); - my @test = (); - my $teststr; - my $n = 0; - my $pass = 0; + my($dir, $cfg, $testnum) = @_; + my $fn = "$dir/$cfg"; + my @data = (); + my $edata; + my @C = (); + my @test = (); + my $teststr; + my $n = 0; + my $pass = 0; - open(CFG, "<$fn") or quit(1, "Failed to open \"$fn\": $!"); - @data = ; - - $edata = q/@C = (/ . join("", @data) . q/)/; - eval $edata; - quit(1, "Failed to read test data \"$cfg\": $@") if ($@); + open(CFG, "<$fn") or quit(1, "Failed to open \"$fn\": $!"); + @data = ; + + $edata = q/@C = (/ . join("", @data) . q/)/; + eval $edata; + quit(1, "Failed to read test data \"$cfg\": $@") if ($@); - unless (@C) { - msg("\nNo tests defined for $fn"); - return; - } + unless (@C) { + msg("\nNo tests defined for $fn"); + return; + } - msg("\nLoaded ".@C." tests from $fn"); - for my $t (@C) { - $n++; - next if (defined $testnum and $n != $testnum); + msg("\nLoaded ".@C." tests from $fn"); + for my $t (@C) { + $n++; + next if (defined $testnum and $n != $testnum); - my $httpd_up = 0; - my %t = %{$t || {}}; - my $id = sprintf("%3d", $n); - my $out = ""; - my $rc = 0; - my $conf_fn; + my $httpd_up = 0; + my %t = %{$t || {}}; + my $id = sprintf("%3d", $n); + my $out = ""; + my $rc = 0; + my $conf_fn; - # Startup httpd with optionally included conf. - if (exists $t{conf} and defined $t{conf}) { - $conf_fn = sprintf "%s/%s_%s_%06d.conf", - $CONF_DIR, $t{type}, $cfg, $n; - #dbg("Writing test config to: $conf_fn"); - open(CONF, ">$conf_fn") or die "Failed to open conf \"$conf_fn\": $!\n"; - print CONF (ref $t{conf} eq "CODE" ? eval { &{$t{conf}} } : $t{conf}); - msg("$@") if ($@); - close CONF; - $httpd_up = httpd_start(\%t, "Include $conf_fn") ? 0 : 1; - } - else { - $httpd_up = httpd_start(\%t) ? 0 : 1; - } + # Startup httpd with optionally included conf. + if (exists $t{conf} and defined $t{conf}) { + $conf_fn = sprintf "%s/%s_%s_%06d.conf", + $CONF_DIR, $t{type}, $cfg, $n; + #dbg("Writing test config to: $conf_fn"); + open(CONF, ">$conf_fn") or die "Failed to open conf \"$conf_fn\": $!\n"; + print CONF (ref $t{conf} eq "CODE" ? eval { &{$t{conf}} } : $t{conf}); + msg("$@") if ($@); + close CONF; + $httpd_up = httpd_start(\%t, "Include $conf_fn") ? 0 : 1; + } + else { + $httpd_up = httpd_start(\%t) ? 0 : 1; + } - # Run any prerun setup - if ($rc == 0 and exists $t{prerun} and defined $t{prerun}) { - vrb("Executing perl prerun..."); - $rc = &{$t{prerun}}; - vrb("Perl prerun returned: $rc"); - } + # Run any prerun setup + if ($rc == 0 and exists $t{prerun} and defined $t{prerun}) { + vrb("Executing perl prerun..."); + $rc = &{$t{prerun}}; + vrb("Perl prerun returned: $rc"); + } - if ($httpd_up) { - # Perform the request and check response - if (exists $t{request}) { - my $resp = do_request($t{request}); - if (!$resp) { - msg("invalid response"); - vrb("RESPONSE: ", $resp); - $rc = 1; - } - else { - for my $key (keys %{ $t{match_response} || {}}) { - my($neg,$mtype) = ($key =~ m/^(-?)(.*)$/); - my $m = $t{match_response}{$key}; - my $match = match_response($mtype, $resp, $m); - if ($neg and defined $match) { - $rc = 1; - msg("response $mtype matched: $m"); - vrb($resp); - last; - } - elsif (!$neg and !defined $match) { - $rc = 1; - msg("response $mtype failed to match: $m"); - vrb($resp); - last; - } - } - } - } + if ($httpd_up) { + # Perform the request and check response + if (exists $t{request}) { + my $resp = do_request($t{request}); + if (!$resp) { + msg("invalid response"); + vrb("RESPONSE: ", $resp); + $rc = 1; + } + else { + for my $key (keys %{ $t{match_response} || {}}) { + my($neg,$mtype) = ($key =~ m/^(-?)(.*)$/); + my $m = $t{match_response}{$key}; + my $match = match_response($mtype, $resp, $m); + if ($neg and defined $match) { + $rc = 1; + msg("response $mtype matched: $m"); + vrb($resp); + last; + } + elsif (!$neg and !defined $match) { + $rc = 1; + msg("response $mtype failed to match: $m"); + vrb($resp); + last; + } + } + } + } - # Run any arbitrary perl tests - if ($rc == 0 and exists $t{test} and defined $t{test}) { - dbg("Executing perl test(s)..."); - $rc = eval { &{$t{test}} }; - if (! defined $rc) { - msg("Error running test: $@"); - $rc = -1; - } - dbg("Perl tests returned: $rc"); - } + # Run any arbitrary perl tests + if ($rc == 0 and exists $t{test} and defined $t{test}) { + dbg("Executing perl test(s)..."); + $rc = eval { &{$t{test}} }; + if (! defined $rc) { + msg("Error running test: $@"); + $rc = -1; + } + dbg("Perl tests returned: $rc"); + } - # Search for all log matches - if ($rc == 0 and exists $t{match_log} and defined $t{match_log}) { - for my $key (keys %{ $t{match_log} || {}}) { - my($neg,$mtype) = ($key =~ m/^(-?)(.*)$/); - my $m = $t{match_log}{$key}; - my $match = match_log($mtype, @{$m || []}); - if ($neg and defined $match) { - $rc = 1; - msg("$mtype log matched: $m->[0]"); - last; - } - elsif (!$neg and !defined $match) { - $rc = 1; - msg("$mtype log failed to match: $m->[0]"); - last; - } - } - } + # Search for all log matches + if ($rc == 0 and exists $t{match_log} and defined $t{match_log}) { + for my $key (keys %{ $t{match_log} || {}}) { + my($neg,$mtype) = ($key =~ m/^(-?)(.*)$/); + my $m = $t{match_log}{$key}; + my $match = match_log($mtype, @{$m || []}); + if ($neg and defined $match) { + $rc = 1; + msg("$mtype log matched: $m->[0]"); + last; + } + elsif (!$neg and !defined $match) { + $rc = 1; + msg("$mtype log failed to match: $m->[0]"); + last; + } + } + } - # Search for all file matches - if ($rc == 0 and exists $t{match_file} and defined $t{match_file}) { - sleep 1; # Make sure the file exists - for my $key (keys %{ $t{match_file} || {}}) { - my($neg,$fn) = ($key =~ m/^(-?)(.*)$/); - my $m = $t{match_file}{$key}; - my $match = match_file($fn, $m); - if ($neg and defined $match) { - $rc = 1; - msg("$fn file matched: $m"); - last; - } - elsif (!$neg and !defined $match) { - $rc = 1; - msg("$fn file failed match: $m"); - last; - } - } - } - } - else { - msg("Failed to start httpd."); - $rc = 1; - } + # Search for all file matches + if ($rc == 0 and exists $t{match_file} and defined $t{match_file}) { + sleep 1; # Make sure the file exists + for my $key (keys %{ $t{match_file} || {}}) { + my($neg,$fn) = ($key =~ m/^(-?)(.*)$/); + my $m = $t{match_file}{$key}; + my $match = match_file($fn, $m); + if ($neg and defined $match) { + $rc = 1; + msg("$fn file matched: $m"); + last; + } + elsif (!$neg and !defined $match) { + $rc = 1; + msg("$fn file failed match: $m"); + last; + } + } + } + } + else { + msg("Failed to start httpd."); + $rc = 1; + } - if ($rc == 0) { - $pass++; - } - else { - vrb("Test Config: $conf_fn"); - vrb("Debug Log: $FILE{debug}{fn}"); - dbg(escape("$FILE{debug}{buf}")); - vrb("Error Log: $FILE{error}{fn}"); - dbg(escape("$FILE{error}{buf}")); - } + if ($rc == 0) { + $pass++; + } + else { + vrb("Test Config: $conf_fn"); + vrb("Debug Log: $FILE{debug}{fn}"); + dbg(escape("$FILE{debug}{buf}")); + vrb("Error Log: $FILE{error}{fn}"); + dbg(escape("$FILE{error}{buf}")); + } - msg(sprintf("%s) %s%s: %s%s", $id, $t{type}, (exists($t{comment}) ? " - $t{comment}" : ""), ($rc ? "failed" : "passed"), ((defined($out) && $out ne "")? " ($out)" : ""))); - - if ($httpd_up) { - $httpd_up = httpd_stop(\%t) ? 0 : 1; - } + msg(sprintf("%s) %s%s: %s%s", $id, $t{type}, (exists($t{comment}) ? " - $t{comment}" : ""), ($rc ? "failed" : "passed"), ((defined($out) && $out ne "")? " ($out)" : ""))); + + if ($httpd_up) { + $httpd_up = httpd_stop(\%t) ? 0 : 1; + } - } + } - $TOTAL += $testnum ? 1 : $n; - $PASSED += $pass; + $TOTAL += $testnum ? 1 : $n; + $PASSED += $pass; - msg(sprintf("Passed: %2d; Failed: %2d", $pass, $testnum ? (1 - $pass) : ($n - $pass))); + msg(sprintf("Passed: %2d; Failed: %2d", $pass, $testnum ? (1 - $pass) : ($n - $pass))); } # Take out any indenting and translate LF -> CRLF sub normalize_raw_request_data { - my $r = $_[0]; + my $r = $_[0]; - # Allow for indenting in test file - $r =~ s/^[ \t]*\x0d?\x0a//s; - my($indention) = ($r =~ m/^([ \t]*)/s); # indention taken from first line - $r =~ s/^$indention//mg; - $r =~ s/(\x0d?\x0a)[ \t]+$/$1/s; + # Allow for indenting in test file + $r =~ s/^[ \t]*\x0d?\x0a//s; + my($indention) = ($r =~ m/^([ \t]*)/s); # indention taken from first line + $r =~ s/^$indention//mg; + $r =~ s/(\x0d?\x0a)[ \t]+$/$1/s; - # Translate LF to CRLF - $r =~ s/^\x0a/\x0d\x0a/mg; - $r =~ s/([^\x0d])\x0a/$1\x0d\x0a/mg; + # Translate LF to CRLF + $r =~ s/^\x0a/\x0d\x0a/mg; + $r =~ s/([^\x0d])\x0a/$1\x0d\x0a/mg; - return $r; + return $r; } sub do_raw_request { - my $sock = new IO::Socket::INET( - Proto => "tcp", - PeerAddr => "localhost", - PeerPort => $opt{p}, - ) or msg("Failed to connect to localhost:$opt{p}: $@"); - return unless ($sock); + my $sock = new IO::Socket::INET( + Proto => "tcp", + PeerAddr => "localhost", + PeerPort => $opt{p}, + ) or msg("Failed to connect to localhost:$opt{p}: $@"); + return unless ($sock); - # Join togeather the request - my $r = join("", @_); - dbg($r); + # Join togeather the request + my $r = join("", @_); + dbg($r); - # Write to socket - print $sock "$r"; - $sock->shutdown(1); + # Write to socket + print $sock "$r"; + $sock->shutdown(1); - # Read from socket - my @resp = <$sock>; - $sock->close(); + # Read from socket + my @resp = <$sock>; + $sock->close(); - return HTTP::Response->parse(join("", @resp)); + return HTTP::Response->parse(join("", @resp)); } sub do_request { - my $r = $_[0]; - - # Allow test to execute code - if (ref $r eq "CODE") { - $r = eval { &$r }; - msg("$@") unless (defined $r); - } + my $r = $_[0]; + + # Allow test to execute code + if (ref $r eq "CODE") { + $r = eval { &$r }; + msg("$@") unless (defined $r); + } - if (ref $r eq "HTTP::Request") { - my $resp = $UA->request($r); - dbg($resp->request()->as_string()) if ($opt{d}); - return $resp - } - else { - return do_raw_request($r); - } + if (ref $r eq "HTTP::Request") { + my $resp = $UA->request($r); + dbg($resp->request()->as_string()) if ($opt{d}); + return $resp + } + else { + return do_raw_request($r); + } - return; + return; } sub match_response { - my($name, $resp, $re) = @_; + my($name, $resp, $re) = @_; - msg("Warning: Empty regular expression.") if (!defined $re or $re eq ""); + msg("Warning: Empty regular expression.") if (!defined $re or $re eq ""); - if ($name eq "status") { - return $& if ($resp->code =~ m/$re/); - } - elsif ($name eq "content") { - return $& if ($resp->content =~ m/$re/m); - } - elsif ($name eq "raw") { - return $& if ($resp->as_string =~ m/$re/m); - } + if ($name eq "status") { + return $& if ($resp->code =~ m/$re/); + } + elsif ($name eq "content") { + return $& if ($resp->content =~ m/$re/m); + } + elsif ($name eq "raw") { + return $& if ($resp->as_string =~ m/$re/m); + } - return; + return; } sub read_log { - my($name, $timeout, $graph) = @_; - return match_log($name, undef, $timeout, $graph); + my($name, $timeout, $graph) = @_; + return match_log($name, undef, $timeout, $graph); } sub match_log { - my($name, $re, $timeout, $graph) = @_; - my $t0 = gettimeofday; - my($fh,$rbuf) = ($FILE{$name}{fd}, \$FILE{$name}{buf}); - my $n = length($$rbuf); - my $rc = undef; + my($name, $re, $timeout, $graph) = @_; + my $t0 = gettimeofday; + my($fh,$rbuf) = ($FILE{$name}{fd}, \$FILE{$name}{buf}); + my $n = length($$rbuf); + my $rc = undef; - unless (defined $fh) { - msg("Error: File \"$name\" is not opened for matching."); - return; - } + unless (defined $fh) { + msg("Error: File \"$name\" is not opened for matching."); + return; + } - $timeout = 0 unless (defined $timeout); + $timeout = 0 unless (defined $timeout); - my $i = 0; - my $graphed = 0; - READ: { - do { - my $nbytes = $fh->sysread($$rbuf, $BUFSIZ, $n); - if (!defined($nbytes)) { - msg("Error: Could not read \"$name\" log: $!"); - last; - } - elsif (!defined($re) and $nbytes == 0) { - last; - } + my $i = 0; + my $graphed = 0; + READ: { + do { + my $nbytes = $fh->sysread($$rbuf, $BUFSIZ, $n); + if (!defined($nbytes)) { + msg("Error: Could not read \"$name\" log: $!"); + last; + } + elsif (!defined($re) and $nbytes == 0) { + last; + } - # Remove APR pool debugging - $$rbuf =~ s/POOL DEBUG:[^\n]+PALLOC[^\n]+\n//sg; + # Remove APR pool debugging + $$rbuf =~ s/POOL DEBUG:[^\n]+PALLOC[^\n]+\n//sg; - $n = length($$rbuf); + $n = length($$rbuf); - #dbg("Match \"$re\" in $name \"$$rbuf\" ($n)"); - if ($$rbuf =~ m/$re/m) { - $rc = $&; - last; - } - # TODO: Use select()/poll() - sleep 0.1 unless ($nbytes == $BUFSIZ); - if ($graph and $opt{d}) { - $i++; - if ($i == 10) { - $graphed++; - $i=0; - print STDERR $graph if ($graphed == 1); - print STDERR "." - } - } - } while (gettimeofday - $t0 < $timeout); - } - print STDERR "\n" if ($graphed); + #dbg("Match \"$re\" in $name \"$$rbuf\" ($n)"); + if ($$rbuf =~ m/$re/m) { + $rc = $&; + last; + } + # TODO: Use select()/poll() + sleep 0.1 unless ($nbytes == $BUFSIZ); + if ($graph and $opt{d}) { + $i++; + if ($i == 10) { + $graphed++; + $i=0; + print STDERR $graph if ($graphed == 1); + print STDERR "." + } + } + } while (gettimeofday - $t0 < $timeout); + } + print STDERR "\n" if ($graphed); - return $rc; + return $rc; } sub match_file { - my($neg,$fn) = ($_[0] =~ m/^(-?)(.*)$/); - unless (exists $FILE{$fn}) { - eval { - $FILE{$fn}{fn} = $fn; - $FILE{$fn}{fd} = new FileHandle($fn, O_RDONLY) or die "$!\n"; - $FILE{$fn}{fd}->blocking(0); - $FILE{$fn}{buf} = ""; - }; - if ($@) { - msg("Warning: Failed to open file \"$fn\": $@"); - return; - } - } - return match_log($_[0], $_[1]); # timeout makes no sense + my($neg,$fn) = ($_[0] =~ m/^(-?)(.*)$/); + unless (exists $FILE{$fn}) { + eval { + $FILE{$fn}{fn} = $fn; + $FILE{$fn}{fd} = new FileHandle($fn, O_RDONLY) or die "$!\n"; + $FILE{$fn}{fd}->blocking(0); + $FILE{$fn}{buf} = ""; + }; + if ($@) { + msg("Warning: Failed to open file \"$fn\": $@"); + return; + } + } + return match_log($_[0], $_[1]); # timeout makes no sense } sub quote_shell { - my($s) = @_; - return $s unless ($s =~ m|[^\w!%+,\-./:@^]|); - $s =~ s/(['\\])/\\$1/g; - return "'$s'"; + my($s) = @_; + return $s unless ($s =~ m|[^\w!%+,\-./:@^]|); + $s =~ s/(['\\])/\\$1/g; + return "'$s'"; } sub escape { - my @new = (); - for my $c (split(//, $_[0])) { - my $oc = ord($c); - push @new, ((($oc >= 0x20 and $oc <= 0x7e) or $oc == 0x0a or $oc == 0x0d) ? $c : sprintf("\\x%02x", ord($c))); - } - join('', @new); + my @new = (); + for my $c (split(//, $_[0])) { + my $oc = ord($c); + push @new, ((($oc >= 0x20 and $oc <= 0x7e) or $oc == 0x0a or $oc == 0x0d) ? $c : sprintf("\\x%02x", ord($c))); + } + join('', @new); } sub dbg { - return unless(@_ and $opt{d}); - my $out = join "", map { - (ref $_ ne "" ? Dumper($_) : $_) - } @_; - $out =~ s/^/DBG: /mg; - print STDOUT "$out\n"; + return unless(@_ and $opt{d}); + my $out = join "", map { + (ref $_ ne "" ? Dumper($_) : $_) + } @_; + $out =~ s/^/DBG: /mg; + print STDOUT "$out\n"; } sub vrb { - return unless(@_ and $opt{v}); - msg(@_); + return unless(@_ and $opt{v}); + msg(@_); } sub msg { - return unless(@_); - my $out = join "", map { - (ref $_ ne "" ? Dumper($_) : $_) - } @_; - print STDOUT "$out\n"; + return unless(@_); + my $out = join "", map { + (ref $_ ne "" ? Dumper($_) : $_) + } @_; + print STDOUT "$out\n"; } sub handle_interrupt { - $SIG{TERM} = $SIG{INT} = \&handle_interrupt; + $SIG{TERM} = $SIG{INT} = \&handle_interrupt; - msg("Interrupted via SIG$_[0]. Shutting down tests..."); - httpd_stop(); + msg("Interrupted via SIG$_[0]. Shutting down tests..."); + httpd_stop(); - quit(1); + quit(1); } sub quit { - my($ec,$msg) = @_; - $ec = 0 unless (defined $_[0]); + my($ec,$msg) = @_; + $ec = 0 unless (defined $_[0]); - msg("$msg") if (defined $msg); + msg("$msg") if (defined $msg); - exit $ec; + exit $ec; } sub done { - if ($PASSED != $TOTAL) { - quit(1, "\n$PASSED/$TOTAL tests passed."); - } + if ($PASSED != $TOTAL) { + quit(1, "\n$PASSED/$TOTAL tests passed."); + } - quit(0, "\nAll tests passed ($TOTAL)."); + quit(0, "\nAll tests passed ($TOTAL)."); } sub httpd_start { - my $t = shift; - httpd_reset_fd($t); - my @p = ( - $HTTPD, - -d => $opt{S}, - -f => $opt{C}, - (map { (-c => $_) } ("Listen localhost:$opt{p}", @_)), - -k => "start", - ); + my $t = shift; + httpd_reset_fd($t); + my @p = ( + $HTTPD, + -d => $opt{S}, + -f => $opt{C}, + (map { (-c => $_) } ("Listen localhost:$opt{p}", @_)), + -k => "start", + ); - my $httpd_out; - my $httpd_pid = open3(undef, $httpd_out, undef, @p) or quit(1); - my $out = join("\\n", grep(!/POOL DEBUG/, (<$httpd_out>))); - close $httpd_out; - waitpid($httpd_pid, 0); + my $httpd_out; + my $httpd_pid = open3(undef, $httpd_out, undef, @p) or quit(1); + my $out = join("\\n", grep(!/POOL DEBUG/, (<$httpd_out>))); + close $httpd_out; + waitpid($httpd_pid, 0); - my $rc = $?; - if ( WIFEXITED($rc) ) { - $rc = WEXITSTATUS($rc); - vrb("Httpd start returned with $rc.") if ($rc); - } - elsif( WIFSIGNALED($rc) ) { - msg("Httpd start failed with signal " . WTERMSIG($rc) . "."); - $rc = -1; - } - else { - msg("Httpd start failed with unknown error."); - $rc = -1; - } + my $rc = $?; + if ( WIFEXITED($rc) ) { + $rc = WEXITSTATUS($rc); + vrb("Httpd start returned with $rc.") if ($rc); + } + elsif( WIFSIGNALED($rc) ) { + msg("Httpd start failed with signal " . WTERMSIG($rc) . "."); + $rc = -1; + } + else { + msg("Httpd start failed with unknown error."); + $rc = -1; + } - if (defined $out and $out ne "") { - vrb(join(" ", map { quote_shell($_) } @p)); - msg("Httpd start failed with error messages:\n$out"); - return -1 - } + if (defined $out and $out ne "") { + vrb(join(" ", map { quote_shell($_) } @p)); + msg("Httpd start failed with error messages:\n$out"); + return -1 + } - # Look for startup msg - unless (defined match_log("error", qr/resuming normal operations/, 60, "Waiting on httpd to start: ")) { - vrb(join(" ", map { quote_shell($_) } @p)); - vrb(match_log("error", qr/(^.*ModSecurity: .*)/sm, 10)); - msg("Httpd server failed to start."); - return -1; - } + # Look for startup msg + unless (defined match_log("error", qr/resuming normal operations/, 60, "Waiting on httpd to start: ")) { + vrb(join(" ", map { quote_shell($_) } @p)); + vrb(match_log("error", qr/(^.*ModSecurity: .*)/sm, 10)); + msg("Httpd server failed to start."); + return -1; + } - return $rc; + return $rc; } sub httpd_stop { - my $t = shift; - my @p = ( - $HTTPD, - -d => $opt{S}, - -f => $opt{C}, - (map { (-c => $_) } ("Listen localhost:$opt{p}", @_)), - -k => "stop", - ); + my $t = shift; + my @p = ( + $HTTPD, + -d => $opt{S}, + -f => $opt{C}, + (map { (-c => $_) } ("Listen localhost:$opt{p}", @_)), + -k => "stop", + ); - my $httpd_out; - my $httpd_pid = open3(undef, $httpd_out, undef, @p) or quit(1); - my $out = join("\\n", grep(!/POOL DEBUG/, (<$httpd_out>))); - close $httpd_out; - waitpid($httpd_pid, 0); + my $httpd_out; + my $httpd_pid = open3(undef, $httpd_out, undef, @p) or quit(1); + my $out = join("\\n", grep(!/POOL DEBUG/, (<$httpd_out>))); + close $httpd_out; + waitpid($httpd_pid, 0); - if (defined $out and $out ne "") { - msg("Httpd stop failed with error messages:\n$out"); - return -1 - } + if (defined $out and $out ne "") { + msg("Httpd stop failed with error messages:\n$out"); + return -1 + } - my $rc = $?; - if ( WIFEXITED($rc) ) { - $rc = WEXITSTATUS($rc); - vrb("Httpd stop returned with $rc.") if ($rc); - } - elsif( WIFSIGNALED($rc) ) { - msg("Httpd stop failed with signal " . WTERMSIG($rc) . "."); - $rc = -1; - } - else { - msg("Httpd stop failed with unknown error."); - $rc = -1; - } + my $rc = $?; + if ( WIFEXITED($rc) ) { + $rc = WEXITSTATUS($rc); + vrb("Httpd stop returned with $rc.") if ($rc); + } + elsif( WIFSIGNALED($rc) ) { + msg("Httpd stop failed with signal " . WTERMSIG($rc) . "."); + $rc = -1; + } + else { + msg("Httpd stop failed with unknown error."); + $rc = -1; + } - # Look for startup msg - unless (defined match_log("error", qr/caught SIG[A-Z]+, shutting down/, 60, "Waiting on httpd to stop: ")) { - vrb(join(" ", map { quote_shell($_) } @p)); - msg("Httpd server failed to shutdown."); - return -1; - } + # Look for startup msg + unless (defined match_log("error", qr/caught SIG[A-Z]+, shutting down/, 60, "Waiting on httpd to stop: ")) { + vrb(join(" ", map { quote_shell($_) } @p)); + msg("Httpd server failed to shutdown."); + sleep 0.5; + return -1; + } - return $rc; + sleep 0.5; + + return $rc; } sub httpd_reload { - my $t = shift; - httpd_reset_fd($t); - my @p = ( - $HTTPD, - -d => $opt{S}, - -f => $opt{C}, - (map { (-c => $_) } ("Listen localhost:$opt{p}", @_)), - -k => "graceful", - ); + my $t = shift; + httpd_reset_fd($t); + my @p = ( + $HTTPD, + -d => $opt{S}, + -f => $opt{C}, + (map { (-c => $_) } ("Listen localhost:$opt{p}", @_)), + -k => "graceful", + ); - my $httpd_out; - my $httpd_pid = open3(undef, $httpd_out, undef, @p) or quit(1); - my $out = join("\\n", grep(!/POOL DEBUG/, (<$httpd_out>))); - close $httpd_out; - waitpid($httpd_pid, 0); + my $httpd_out; + my $httpd_pid = open3(undef, $httpd_out, undef, @p) or quit(1); + my $out = join("\\n", grep(!/POOL DEBUG/, (<$httpd_out>))); + close $httpd_out; + waitpid($httpd_pid, 0); - if (defined $out and $out ne "") { - msg("Httpd reload failed with error messages:\n$out"); - return -1 - } + if (defined $out and $out ne "") { + msg("Httpd reload failed with error messages:\n$out"); + return -1 + } - my $rc = $?; - if ( WIFEXITED($rc) ) { - $rc = WEXITSTATUS($rc); - vrb("Httpd reload returned with $rc.") if ($rc); - } - elsif( WIFSIGNALED($rc) ) { - msg("Httpd reload failed with signal " . WTERMSIG($rc) . "."); - $rc = -1; - } - else { - msg("Httpd reload failed with unknown error."); - $rc = -1; - } + my $rc = $?; + if ( WIFEXITED($rc) ) { + $rc = WEXITSTATUS($rc); + vrb("Httpd reload returned with $rc.") if ($rc); + } + elsif( WIFSIGNALED($rc) ) { + msg("Httpd reload failed with signal " . WTERMSIG($rc) . "."); + $rc = -1; + } + else { + msg("Httpd reload failed with unknown error."); + $rc = -1; + } - # Look for startup msg - unless (defined match_log("error", qr/resuming normal operations/, 60, "Waiting on httpd to restart: ")) { - vrb(join(" ", map { quote_shell($_) } @p)); - msg("Httpd server failed to reload."); - return -1; - } + # Look for startup msg + unless (defined match_log("error", qr/resuming normal operations/, 60, "Waiting on httpd to restart: ")) { + vrb(join(" ", map { quote_shell($_) } @p)); + msg("Httpd server failed to reload."); + return -1; + } - return $rc; + return $rc; } sub httpd_reset_fd { - my($t) = @_; + my($t) = @_; - # Cleanup - for my $key (keys %FILE) { - if (exists $FILE{$key}{fd} and defined $FILE{$key}{fd}) { - $FILE{$key}{fd}->close(); - } - delete $FILE{$key}; - } + # Cleanup + for my $key (keys %FILE) { + if (exists $FILE{$key}{fd} and defined $FILE{$key}{fd}) { + $FILE{$key}{fd}->close(); + } + delete $FILE{$key}; + } - # Error - eval { - $FILE{error}{fn} = $opt{E}; - $FILE{error}{fd} = new FileHandle($opt{E}, O_RDWR|O_CREAT) or die "$!\n"; - $FILE{error}{fd}->blocking(0); - $FILE{error}{fd}->sysseek(0, 2); - $FILE{error}{buf} = ""; - }; - if ($@) { - msg("Warning: Failed to open file \"$opt{E}\": $@"); - return undef; - } + # Error + eval { + $FILE{error}{fn} = $opt{E}; + $FILE{error}{fd} = new FileHandle($opt{E}, O_RDWR|O_CREAT) or die "$!\n"; + $FILE{error}{fd}->blocking(0); + $FILE{error}{fd}->sysseek(0, 2); + $FILE{error}{buf} = ""; + }; + if ($@) { + msg("Warning: Failed to open file \"$opt{E}\": $@"); + return undef; + } - # Audit - eval { - $FILE{audit}{fn} = $opt{A}; - $FILE{audit}{fd} = new FileHandle($opt{A}, O_RDWR|O_CREAT) or die "$!\n"; - $FILE{audit}{fd}->blocking(0); - $FILE{audit}{fd}->sysseek(0, 2); - $FILE{audit}{buf} = ""; - }; - if ($@) { - msg("Warning: Failed to open file \"$opt{A}\": $@"); - return undef; - } + # Audit + eval { + $FILE{audit}{fn} = $opt{A}; + $FILE{audit}{fd} = new FileHandle($opt{A}, O_RDWR|O_CREAT) or die "$!\n"; + $FILE{audit}{fd}->blocking(0); + $FILE{audit}{fd}->sysseek(0, 2); + $FILE{audit}{buf} = ""; + }; + if ($@) { + msg("Warning: Failed to open file \"$opt{A}\": $@"); + return undef; + } - # Debug - eval { - $FILE{debug}{fn} = $opt{D}; - $FILE{debug}{fd} = new FileHandle($opt{D}, O_RDWR|O_CREAT) or die "$!\n"; - $FILE{debug}{fd}->blocking(0); - $FILE{debug}{fd}->sysseek(0, 2); - $FILE{debug}{buf} = ""; - }; - if ($@) { - msg("Warning: Failed to open file \"$opt{D}\": $@"); - return undef; - } + # Debug + eval { + $FILE{debug}{fn} = $opt{D}; + $FILE{debug}{fd} = new FileHandle($opt{D}, O_RDWR|O_CREAT) or die "$!\n"; + $FILE{debug}{fd}->blocking(0); + $FILE{debug}{fd}->sysseek(0, 2); + $FILE{debug}{buf} = ""; + }; + if ($@) { + msg("Warning: Failed to open file \"$opt{D}\": $@"); + return undef; + } - # Any extras listed in "match_log" - if ($t and exists $t->{match_log}) { - for my $k (keys %{ $t->{match_log} || {} }) { - my($neg,$fn) = ($k =~ m/^(-?)(.*)$/); - next if (!$fn or exists $FILE{$fn}); - eval { - $FILE{$fn}{fn} = $fn; - $FILE{$fn}{fd} = new FileHandle($fn, O_RDWR|O_CREAT) or die "$!\n"; - $FILE{$fn}{fd}->blocking(0); - $FILE{$fn}{fd}->sysseek(0, 2); - $FILE{$fn}{buf} = ""; - }; - if ($@) { - msg("Warning: Failed to open file \"$fn\": $@"); - return undef; - } - } - } + # Any extras listed in "match_log" + if ($t and exists $t->{match_log}) { + for my $k (keys %{ $t->{match_log} || {} }) { + my($neg,$fn) = ($k =~ m/^(-?)(.*)$/); + next if (!$fn or exists $FILE{$fn}); + eval { + $FILE{$fn}{fn} = $fn; + $FILE{$fn}{fd} = new FileHandle($fn, O_RDWR|O_CREAT) or die "$!\n"; + $FILE{$fn}{fd}->blocking(0); + $FILE{$fn}{fd}->sysseek(0, 2); + $FILE{$fn}{buf} = ""; + }; + if ($@) { + msg("Warning: Failed to open file \"$fn\": $@"); + return undef; + } + } + } } sub encode_chunked { - my($data, $size) = @_; - $size = 128 unless ($size); - my $chunked = ""; - - my $n = 0; - my $bytes = length($data); - while ($bytes >= $size) { - $chunked .= sprintf "%x\x0d\x0a%s\x0d\x0a", $size, substr($data, $n, $size); - $n += $size; - $bytes -= $size; - } - if ($bytes) { - $chunked .= sprintf "%x\x0d\x0a%s\x0d\x0a", $bytes, substr($data, $n, $bytes); - } - $chunked .= "0\x0d\x0a\x0d\x0a" + my($data, $size) = @_; + $size = 128 unless ($size); + my $chunked = ""; + + my $n = 0; + my $bytes = length($data); + while ($bytes >= $size) { + $chunked .= sprintf "%x\x0d\x0a%s\x0d\x0a", $size, substr($data, $n, $size); + $n += $size; + $bytes -= $size; + } + if ($bytes) { + $chunked .= sprintf "%x\x0d\x0a%s\x0d\x0a", $bytes, substr($data, $n, $bytes); + } + $chunked .= "0\x0d\x0a\x0d\x0a" } diff --git a/apache2/t/run-unit-tests.pl.in b/apache2/t/run-unit-tests.pl.in index 845061fc..66212c1c 100755 --- a/apache2/t/run-unit-tests.pl.in +++ b/apache2/t/run-unit-tests.pl.in @@ -4,8 +4,8 @@ # # Syntax: # All: run-tests.pl -# All in file: run-tests.pl file -# Nth in file: run-tests.pl file N +# All in file: run-tests.pl file +# Nth in file: run-tests.pl file N # use strict; use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG); @@ -22,140 +22,140 @@ my $TOTAL = 0; my $DEBUG = $ENV{MSC_TEST_DEBUG} || 0; if (defined $ARGV[0]) { - runfile(dirname($ARGV[0]), basename($ARGV[0]), $ARGV[1]); - done(); + runfile(dirname($ARGV[0]), basename($ARGV[0]), $ARGV[1]); + done(); } for my $type (sort @TYPES) { - my $dir = "$SCRIPTDIR/$type"; - my @cfg = (); + my $dir = "$SCRIPTDIR/$type"; + my @cfg = (); - # Get test names - opendir(DIR, "$dir") or quit(1, "Failed to open \"$dir\": $!"); - @cfg = grep { /\.t$/ && -f "$dir/$_" } readdir(DIR); - closedir(DIR); + # Get test names + opendir(DIR, "$dir") or quit(1, "Failed to open \"$dir\": $!"); + @cfg = grep { /\.t$/ && -f "$dir/$_" } readdir(DIR); + closedir(DIR); - for my $cfg (sort @cfg) { - runfile($dir, $cfg); - } + for my $cfg (sort @cfg) { + runfile($dir, $cfg); + } } done(); sub runfile { - my($dir, $cfg, $testnum) = @_; - my $fn = "$dir/$cfg"; - my @data = (); - my $edata; - my @C = (); - my @test = (); - my $teststr; - my $n = 0; - my $pass = 0; + my($dir, $cfg, $testnum) = @_; + my $fn = "$dir/$cfg"; + my @data = (); + my $edata; + my @C = (); + my @test = (); + my $teststr; + my $n = 0; + my $pass = 0; - open(CFG, "<$fn") or quit(1, "Failed to open \"$fn\": $!"); - @data = ; - - $edata = q/@C = (/ . join("", @data) . q/)/; - eval $edata; - quit(1, "Failed to read test data \"$cfg\": $@") if ($@); + open(CFG, "<$fn") or quit(1, "Failed to open \"$fn\": $!"); + @data = ; + + $edata = q/@C = (/ . join("", @data) . q/)/; + eval $edata; + quit(1, "Failed to read test data \"$cfg\": $@") if ($@); - unless (@C) { - msg("\nNo tests defined for $fn"); - return; - } + unless (@C) { + msg("\nNo tests defined for $fn"); + return; + } - msg("\nLoaded ".@C." tests from $fn"); - for my $t (@C) { - $n++; - next if (defined $testnum and $n != $testnum); + msg("\nLoaded ".@C." tests from $fn"); + for my $t (@C) { + $n++; + next if (defined $testnum and $n != $testnum); - my %t = %{$t || {}}; - my $id = sprintf("%6d", $n); - my $in = (exists($t{input}) and defined($t{input})) ? $t{input} : ""; - my $out; - my $test_in = new FileHandle(); - my $test_out = new FileHandle(); - my $test_pid; - my $rc = 0; - my $param; + my %t = %{$t || {}}; + my $id = sprintf("%6d", $n); + my $in = (exists($t{input}) and defined($t{input})) ? $t{input} : ""; + my $out; + my $test_in = new FileHandle(); + my $test_out = new FileHandle(); + my $test_pid; + my $rc = 0; + my $param; - if ($t{type} eq "tfn") { - $param = escape($t{output}); - } - elsif ($t{type} eq "op") { - $param = escape($t{param}); - } - elsif ($t{type} eq "action") { - $param = escape($t{param}); - } - else { - quit(1, "Unknown type \"$t{type}\" - should be one of: " . join(",",@TYPES)); - } + if ($t{type} eq "tfn") { + $param = escape($t{output}); + } + elsif ($t{type} eq "op") { + $param = escape($t{param}); + } + elsif ($t{type} eq "action") { + $param = escape($t{param}); + } + else { + quit(1, "Unknown type \"$t{type}\" - should be one of: " . join(",",@TYPES)); + } - @test = ("-t", $t{type}, "-n", $t{name}, "-p", $param, "-D", "$DEBUG", (exists($t{ret}) ? ("-r", $t{ret}) : ()), (exists($t{iterations}) ? ("-I", $t{iterations}) : ()), (exists($t{prerun}) ? ("-P", $t{prerun}) : ())); - $teststr = "$TEST " . join(" ", map { "\"$_\"" } @test); - $test_pid = open2($test_out, $test_in, $TEST, @test) or quit(1, "Failed to execute test: $teststr\": $!"); - print $test_in "$in"; - close $test_in; - $out = join("\\n", split(/\n/, <$test_out>)); - close $test_out; - waitpid($test_pid, 0); + @test = ("-t", $t{type}, "-n", $t{name}, "-p", $param, "-D", "$DEBUG", (exists($t{ret}) ? ("-r", $t{ret}) : ()), (exists($t{iterations}) ? ("-I", $t{iterations}) : ()), (exists($t{prerun}) ? ("-P", $t{prerun}) : ())); + $teststr = "$TEST " . join(" ", map { "\"$_\"" } @test); + $test_pid = open2($test_out, $test_in, $TEST, @test) or quit(1, "Failed to execute test: $teststr\": $!"); + print $test_in "$in"; + close $test_in; + $out = join("\\n", split(/\n/, <$test_out>)); + close $test_out; + waitpid($test_pid, 0); - $rc = $?; - if ( WIFEXITED($rc) ) { - $rc = WEXITSTATUS($rc); - } - elsif( WIFSIGNALED($rc) ) { - msg("Test exited with signal " . WTERMSIG($rc) . "."); - msg("Executed: $teststr"); - $rc = -1; - } - else { - msg("Test exited with unknown error."); - $rc = -1; - } + $rc = $?; + if ( WIFEXITED($rc) ) { + $rc = WEXITSTATUS($rc); + } + elsif( WIFSIGNALED($rc) ) { + msg("Test exited with signal " . WTERMSIG($rc) . "."); + msg("Executed: $teststr"); + $rc = -1; + } + else { + msg("Test exited with unknown error."); + $rc = -1; + } - if ($rc == 0) { - $pass++; - } + if ($rc == 0) { + $pass++; + } - msg(sprintf("%s) %s \"%s\"%s: %s%s", $id, $t{type}, $t{name}, (exists($t{comment}) ? " $t{comment}" : ""), ($rc ? "failed" : "passed"), ((defined($out) && $out ne "")? " ($out)" : ""))); - - } + msg(sprintf("%s) %s \"%s\"%s: %s%s", $id, $t{type}, $t{name}, (exists($t{comment}) ? " $t{comment}" : ""), ($rc ? "failed" : "passed"), ((defined($out) && $out ne "")? " ($out)" : ""))); + + } - $TOTAL += $testnum ? 1 : $n; - $PASSED += $pass; + $TOTAL += $testnum ? 1 : $n; + $PASSED += $pass; - msg(sprintf("Passed: %2d; Failed: %2d", $pass, $testnum ? (1 - $pass) : ($n - $pass))); + msg(sprintf("Passed: %2d; Failed: %2d", $pass, $testnum ? (1 - $pass) : ($n - $pass))); } sub escape { - my @new = (); - for my $c (split(//, $_[0])) { - push @new, ((ord($c) >= 0x20 and ord($c) <= 0x7e) ? $c : sprintf("\\x%02x", ord($c))); - } - join('', @new); + my @new = (); + for my $c (split(//, $_[0])) { + push @new, ((ord($c) >= 0x20 and ord($c) <= 0x7e) ? $c : sprintf("\\x%02x", ord($c))); + } + join('', @new); } sub msg { - print STDOUT "@_\n" if (@_); + print STDOUT "@_\n" if (@_); } sub quit { - my($ec,$msg) = @_; - $ec = 0 unless (defined $_[0]); + my($ec,$msg) = @_; + $ec = 0 unless (defined $_[0]); - msg("$msg") if (defined $msg); + msg("$msg") if (defined $msg); - exit $ec; + exit $ec; } sub done { - if ($PASSED != $TOTAL) { - quit(1, "\n$PASSED/$TOTAL tests passed."); - } + if ($PASSED != $TOTAL) { + quit(1, "\n$PASSED/$TOTAL tests passed."); + } - quit(0, "\nAll tests passed ($TOTAL)."); + quit(0, "\nAll tests passed ($TOTAL)."); }