#!@PERL@ # # Run regression tests. # # 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 # use strict; use Time::HiRes qw(gettimeofday sleep); use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG); use File::Spec qw(rel2abs); use File::Basename qw(basename dirname); use FileHandle; use IPC::Open2 qw(open2); use IPC::Open3 qw(open3); use Getopt::Std; use Data::Dumper; use IO::Socket; use LWP::UserAgent; my @TYPES = qw(config misc action target rule); my $SCRIPT = basename($0); my $SCRIPT_DIR = File::Spec->rel2abs(dirname($0)); my $REG_DIR = "$SCRIPT_DIR/regression"; my $SROOT_DIR = "$REG_DIR/server_root"; my $DATA_DIR = "$SROOT_DIR/data"; my $TEMP_DIR = "$SROOT_DIR/tmp"; my $UPLOAD_DIR = "$SROOT_DIR/upload"; my $CONF_DIR = "$SROOT_DIR/conf"; my $MODULES_DIR = q(@APXS_LIBEXECDIR@); my $FILES_DIR = "$SROOT_DIR/logs"; my $PID_FILE = "$FILES_DIR/httpd.pid"; my $HTTPD = q(@APXS_HTTPD@); my $PASSED = 0; my $TOTAL = 0; my $BUFSIZ = 32768; my %C = (); my %FILE = (); my $UA_NAME = "ModSecurity Regression Tests/1.2.3"; my $UA = LWP::UserAgent->new; $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"; } $SIG{TERM} = $SIG{INT} = \&handle_interrupt; my $platform = "apache"; 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; } sub usage { print stderr <<"EOT"; @_ Usage: $SCRIPT [options] [file [N]] Options: -A file Specify ModSecurity audit log to read. -D file Specify ModSecurity debug log to read. -E file Specify Apache httpd error log to read. -C file Specify Apache httpd base conf file to generate/reload. -H path Specify Apache httpd htdocs path. -S path Specify Apache httpd server root path. -a file Specify Apache httpd binary (default: httpd) -p port Specify Apache httpd port (default: 8088) -v Enable verbose output (details on failure). -d Enable debugging output. -h This help. EOT exit(1); } usage() if ($opt{h}); ### Check httpd binary if (defined $opt{a}) { $HTTPD = $opt{a}; } else { $opt{a} = $HTTPD; } usage("Invalid Apache startup script: $HTTPD\n") unless (-e $HTTPD); ### Defaults $opt{A} = "$FILES_DIR/modsec_audit.log" unless (defined $opt{A}); $opt{D} = "$FILES_DIR/modsec_debug.log" unless (defined $opt{D}); $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`; ($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, ); #dbg("OPTIONS: ", \%opt); if (-e "$PID_FILE") { msg("Shutting down previous instance: $PID_FILE"); httpd_stop(); } if (defined $ARGV[0]) { runfile(dirname($ARGV[0]), basename($ARGV[0]), $ARGV[1]); done(); } for my $type (@TYPES) { 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); } } 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; 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; } 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; # 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"); } 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}; if (ref($m) eq "HASH") { if ($m->{$platform}) { $m = $m->{$platform}; } else { my $ap = join(", ", keys %{$m}); msg("Warning: trying to match: $mtype. Nothing " . "to match in current platform: $platform. " . "This test only contains cotent for: $ap."); last; } } 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"); } # 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}; if (ref($m) eq "HASH") { if ($m->{$platform}) { $m = $m->{$platform}; } else { my $ap = join(", ", keys %{$m}); msg("Warning: trying to match: $mtype. Nothing " . "to match in current platform: $platform. " . "This test only contains cotent for: $ap."); last; } } 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; } 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; } } $TOTAL += $testnum ? 1 : $n; $PASSED += $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]; # 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; 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); # Join togeather the request my $r = join("", @_); dbg($r); # Write to socket print $sock "$r"; $sock->shutdown(1); # Read from socket my @resp = <$sock>; $sock->close(); 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); } 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; } sub match_response { my($name, $resp, $re) = @_; 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); } return; } sub read_log { 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; unless (defined $fh) { msg("Error: File \"$name\" is not opened for matching."); return; } $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; } # 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 { 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'"; } 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); } sub dbg { 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(@_); } sub msg { return unless(@_); my $out = join "", map { (ref $_ ne "" ? Dumper($_) : $_) } @_; print STDOUT "$out\n"; } sub handle_interrupt { $SIG{TERM} = $SIG{INT} = \&handle_interrupt; msg("Interrupted via SIG$_[0]. Shutting down tests..."); httpd_stop(); quit(1); } sub quit { my($ec,$msg) = @_; $ec = 0 unless (defined $_[0]); msg("$msg") if (defined $msg); exit $ec; } sub done { if ($PASSED != $TOTAL) { quit(1, "\n$PASSED/$TOTAL tests passed."); } 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 $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; } if (defined $out and $out ne "") { vrb(join(" ", map { quote_shell($_) } @p)); msg("Httpd start failed with error messages:\n$out"); httpd_stop(); 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."); httpd_stop(); return -1; } 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 $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 } 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."); sleep 0.5; return -1; } 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 $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 } 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; } return $rc; } sub httpd_reset_fd { 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}; } # 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; } # 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; } } } } 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" }