From eadc2832fec8fd725b7fef6df80dfefd1c4ce366 Mon Sep 17 00:00:00 2001 From: brectanus Date: Thu, 31 Jul 2008 16:59:37 +0000 Subject: [PATCH] Cleanup regression suite to make it a bit more user-friendly. --- apache2/t/regression/misc/10-tfn-cache.t | 14 +-- apache2/t/run-regression-tests.pl.in | 133 ++++++++++++----------- 2 files changed, 79 insertions(+), 68 deletions(-) diff --git a/apache2/t/regression/misc/10-tfn-cache.t b/apache2/t/regression/misc/10-tfn-cache.t index 80e3e269..271834db 100644 --- a/apache2/t/regression/misc/10-tfn-cache.t +++ b/apache2/t/regression/misc/10-tfn-cache.t @@ -2,7 +2,7 @@ { type => "misc", - comment => "tfncache - simple fully cached", + comment => "tfncache (simple fully cached)", conf => qq( SecRuleEngine On SecDebugLog $ENV{DEBUG_LOG} @@ -30,7 +30,7 @@ }, { type => "misc", - comment => "tfncache - simple partially cached", + comment => "tfncache (simple partially cached)", conf => qq( SecRuleEngine On SecDebugLog $ENV{DEBUG_LOG} @@ -57,7 +57,7 @@ }, { type => "misc", - comment => "tfncache - separate phases", + comment => "tfncache (separate phases)", conf => qq( SecRuleEngine On SecDebugLog $ENV{DEBUG_LOG} @@ -84,7 +84,7 @@ }, { type => "misc", - comment => "tfncache - non-modifying tfns cached", + comment => "tfncache (non-modifying tfns cached)", conf => qq( SecRuleEngine On SecDebugLog $ENV{DEBUG_LOG} @@ -111,7 +111,7 @@ }, { type => "misc", - comment => "tfncache - unique keys", + comment => "tfncache (unique keys)", conf => qq( SecRuleEngine On SecDebugLog $ENV{DEBUG_LOG} @@ -146,7 +146,7 @@ }, { type => "misc", - comment => "tfncache - large cache", + comment => "tfncache (large cache)", conf => qq( SecRuleEngine On SecDebugLog $ENV{DEBUG_LOG} @@ -172,7 +172,7 @@ SecRule ARGS "foobar" "phase:4,t:none,t:removeWhiteSpace,t:lowercase,deny" ), match_log => { - debug => [ qr/Adding request argument \(BODY\): name "test", value "Foo Bar"/, 60 ], + debug => [ qr/Adding request argument \(BODY\): name "test", value "Foo Bar"/, 60, "Waiting for httpd to process request: "], -error => [ qr/segmentation fault/i, 60 ], }, match_response => { diff --git a/apache2/t/run-regression-tests.pl.in b/apache2/t/run-regression-tests.pl.in index a3daf6b3..69243227 100755 --- a/apache2/t/run-regression-tests.pl.in +++ b/apache2/t/run-regression-tests.pl.in @@ -52,7 +52,7 @@ $SIG{TERM} = $SIG{INT} = \&handle_interrupt; my %opt; getopts('A:E:D:C:T:H:a:p:dvh', \%opt); -if ($opt{D}) { +if ($opt{d}) { $Data::Dumper::Indent = 1; $Data::Dumper::Terse = 1; $Data::Dumper::Pad = ""; @@ -73,8 +73,8 @@ Usage: $SCRIPT [options] [file [N]] -S path Specify Apache httpd server root path. -a file Specify Apache httpd binary (default: httpd) -p port Specify Apache httpd port (default: 8088) - -d Enable debugging. - -v Enable verbose debugging. + -v Enable verbose output (details on failure). + -d Enable debugging output. -h This help. EOT @@ -100,6 +100,7 @@ $opt{E} = "$FILES_DIR/error.log" unless (defined $opt{E}); $opt{C} = "$CONF_DIR/httpd.conf" unless (defined $opt{C}); $opt{H} = "$SROOT_DIR/htdocs" unless (defined $opt{H}); $opt{p} = 8088 unless (defined $opt{p}); +$opt{v} = 1 if ($opt{d}); unless (defined $opt{S}) { my $httpd_root = `$HTTPD -V`; @@ -196,7 +197,7 @@ sub runfile { 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"); + #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 ($@); @@ -209,9 +210,9 @@ sub runfile { # Run any prerun setup if ($rc == 0 and exists $t{prerun} and defined $t{prerun}) { - dbg("Executing perl prerun..."); + vrb("Executing perl prerun..."); $rc = &{$t{prerun}}; - dbg("Perl prerun returned: $rc"); + vrb("Perl prerun returned: $rc"); } if ($httpd_up) { @@ -220,7 +221,7 @@ sub runfile { my $resp = do_request($t{request}); if (!$resp) { msg("invalid response"); - dbg("RESPONSE: ", $resp); + vrb("RESPONSE: ", $resp); $rc = 1; } else { @@ -231,13 +232,13 @@ sub runfile { if ($neg and defined $match) { $rc = 1; msg("response $mtype matched: $m"); - dbg($resp); + vrb($resp); last; } elsif (!$neg and !defined $match) { $rc = 1; msg("response $mtype failed to match: $m"); - dbg($resp); + vrb($resp); last; } } @@ -246,13 +247,13 @@ sub runfile { # Run any arbitrary perl tests if ($rc == 0 and exists $t{test} and defined $t{test}) { - dbg("Executing perl test(s)...") if ($opt{v}); + dbg("Executing perl test(s)..."); $rc = eval { &{$t{test}} }; if (! defined $rc) { msg("Error running test: $@"); $rc = -1; } - dbg("Perl tests returned: $rc") if ($opt{v}); + dbg("Perl tests returned: $rc"); } # Search for all log matches @@ -303,13 +304,11 @@ sub runfile { $pass++; } else { - if ($opt{d}) { - dbg("Test Config: $conf_fn"); - dbg("Debug Log: $FILE{debug}{fn}"); - dbg(escape("$FILE{debug}{buf}")) if ($opt{v}); - dbg("Error Log: $FILE{error}{fn}"); - dbg(escape("$FILE{error}{buf}")) if ($opt{v}); - } + 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)" : ""))); @@ -353,7 +352,7 @@ sub do_raw_request { # Join togeather the request my $r = join("", @_); - dbg($r) if ($opt{v}); + dbg($r); # Write to socket print $sock "$r"; @@ -377,9 +376,7 @@ sub do_request { if (ref $r eq "HTTP::Request") { my $resp = $UA->request($r); - if ($opt{d} and $opt{v}) { - dbg($resp->request()->as_string()); - } + dbg($resp->request()->as_string()) if ($opt{d}); return $resp } else { @@ -418,6 +415,7 @@ sub match_log { 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."); @@ -427,36 +425,44 @@ sub match_log { $timeout = 0 unless (defined $timeout); my $i = 0; - 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; - - $n = length($$rbuf); - - #dbg("Match \"$re\" in $name \"$$rbuf\" ($n)"); - return $& if ($$rbuf =~ m/$re/m); - # TODO: Use select()/poll() - sleep 0.1 unless ($nbytes == $BUFSIZ); - if ($graph and $opt{v}) { - $i++; - if ($i == 10) { - $i=0; - print STDERR "." + 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; } - } - } while (gettimeofday - $t0 < $timeout); - print STDERR "\n" if ($graph and $opt{v}); - return; + # Remove APR pool debugging + $$rbuf =~ s/POOL DEBUG:[^\n]+PALLOC[^\n]+\n//sg; + + $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); + + return $rc; } sub match_file { @@ -501,6 +507,11 @@ sub dbg { print STDOUT "$out\n"; } +sub vrb { + return unless(@_ and $opt{v}); + msg(@_); +} + sub msg { return unless(@_); my $out = join "", map { @@ -555,7 +566,7 @@ sub httpd_start { my $rc = $?; if ( WIFEXITED($rc) ) { $rc = WEXITSTATUS($rc); - dbg("Httpd start returned with $rc.") if ($rc); + vrb("Httpd start returned with $rc.") if ($rc); } elsif( WIFSIGNALED($rc) ) { msg("Httpd start failed with signal " . WTERMSIG($rc) . "."); @@ -567,15 +578,15 @@ sub httpd_start { } if (defined $out and $out ne "") { - dbg(join(" ", map { quote_shell($_) } @p)); + 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, $opt{d})) { - dbg(join(" ", map { quote_shell($_) } @p)); - dbg(match_log("error", qr/(^.*ModSecurity: .*)/sm, 10)); + 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; } @@ -607,7 +618,7 @@ sub httpd_stop { my $rc = $?; if ( WIFEXITED($rc) ) { $rc = WEXITSTATUS($rc); - dbg("Httpd stop returned with $rc.") if ($rc); + vrb("Httpd stop returned with $rc.") if ($rc); } elsif( WIFSIGNALED($rc) ) { msg("Httpd stop failed with signal " . WTERMSIG($rc) . "."); @@ -619,8 +630,8 @@ sub httpd_stop { } # Look for startup msg - unless (defined match_log("error", qr/caught SIG[A-Z]+, shutting down/, 60, $opt{d})) { - dbg(join(" ", map { quote_shell($_) } @p)); + 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; } @@ -653,7 +664,7 @@ sub httpd_reload { my $rc = $?; if ( WIFEXITED($rc) ) { $rc = WEXITSTATUS($rc); - dbg("Httpd reload returned with $rc.") if ($rc); + vrb("Httpd reload returned with $rc.") if ($rc); } elsif( WIFSIGNALED($rc) ) { msg("Httpd reload failed with signal " . WTERMSIG($rc) . "."); @@ -665,8 +676,8 @@ sub httpd_reload { } # Look for startup msg - unless (defined match_log("error", qr/resuming normal operations/, 60, $opt{d})) { - dbg(join(" ", map { quote_shell($_) } @p)); + 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; }