|
Packit Service |
384592 |
#!@PERL@
|
|
Packit Service |
384592 |
#
|
|
Packit Service |
384592 |
# Run regression tests.
|
|
Packit Service |
384592 |
#
|
|
Packit Service |
384592 |
# Syntax: run-regression-tests.pl [options] [file [N]]
|
|
Packit Service |
384592 |
#
|
|
Packit Service |
384592 |
# All: run-regression-tests.pl
|
|
Packit Service |
384592 |
# All in file: run-regression-tests.pl file
|
|
Packit Service |
384592 |
# Nth in file: run-regression-tests.pl file N
|
|
Packit Service |
384592 |
#
|
|
Packit Service |
384592 |
use strict;
|
|
Packit Service |
384592 |
use Time::HiRes qw(gettimeofday sleep);
|
|
Packit Service |
384592 |
use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);
|
|
Packit Service |
384592 |
use File::Spec qw(rel2abs);
|
|
Packit Service |
384592 |
use File::Basename qw(basename dirname);
|
|
Packit Service |
384592 |
use FileHandle;
|
|
Packit Service |
384592 |
use IPC::Open2 qw(open2);
|
|
Packit Service |
384592 |
use IPC::Open3 qw(open3);
|
|
Packit Service |
384592 |
use Getopt::Std;
|
|
Packit Service |
384592 |
use Data::Dumper;
|
|
Packit Service |
384592 |
use IO::Socket;
|
|
Packit Service |
384592 |
use LWP::UserAgent;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my @TYPES = qw(config misc action target rule);
|
|
Packit Service |
384592 |
my $SCRIPT = basename($0);
|
|
Packit Service |
384592 |
my $SCRIPT_DIR = File::Spec->rel2abs(dirname($0));
|
|
Packit Service |
384592 |
my $REG_DIR = "$SCRIPT_DIR/regression";
|
|
Packit Service |
384592 |
my $SROOT_DIR = "$REG_DIR/server_root";
|
|
Packit Service |
384592 |
my $DATA_DIR = "$SROOT_DIR/data";
|
|
Packit Service |
384592 |
my $TEMP_DIR = "$SROOT_DIR/tmp";
|
|
Packit Service |
384592 |
my $UPLOAD_DIR = "$SROOT_DIR/upload";
|
|
Packit Service |
384592 |
my $CONF_DIR = "$SROOT_DIR/conf";
|
|
Packit Service |
384592 |
my $MODULES_DIR = q(@APXS_LIBEXECDIR@);
|
|
Packit Service |
384592 |
my $FILES_DIR = "$SROOT_DIR/logs";
|
|
Packit Service |
384592 |
my $PID_FILE = "$FILES_DIR/httpd.pid";
|
|
Packit Service |
384592 |
my $HTTPD = q(@APXS_HTTPD@);
|
|
Packit Service |
384592 |
my $PASSED = 0;
|
|
Packit Service |
384592 |
my $TOTAL = 0;
|
|
Packit Service |
384592 |
my $BUFSIZ = 32768;
|
|
Packit Service |
384592 |
my %C = ();
|
|
Packit Service |
384592 |
my %FILE = ();
|
|
Packit Service |
384592 |
my $UA_NAME = "ModSecurity Regression Tests/1.2.3";
|
|
Packit Service |
384592 |
my $UA = LWP::UserAgent->new;
|
|
Packit Service |
384592 |
$UA->agent($UA_NAME);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Hack for testing the script w/o configure
|
|
Packit Service |
384592 |
if ($HTTPD eq "\@APXS_HTTPD\@") {
|
|
Packit Service |
384592 |
$HTTPD = "/usr/local/apache2/bin/httpd";
|
|
Packit Service |
384592 |
$MODULES_DIR = "/usr/local/apache2/modules";
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
$SIG{TERM} = $SIG{INT} = \&handle_interrupt;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my $platform = "apache";
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my %opt;
|
|
Packit Service |
384592 |
getopts('A:E:D:C:T:H:a:p:dvh', \%opt);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if ($opt{d}) {
|
|
Packit Service |
384592 |
$Data::Dumper::Indent = 1;
|
|
Packit Service |
384592 |
$Data::Dumper::Terse = 1;
|
|
Packit Service |
384592 |
$Data::Dumper::Pad = "";
|
|
Packit Service |
384592 |
$Data::Dumper::Quotekeys = 0;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub usage {
|
|
Packit Service |
384592 |
print stderr <<"EOT";
|
|
Packit Service |
384592 |
@_
|
|
Packit Service |
384592 |
Usage: $SCRIPT [options] [file [N]]
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
Options:
|
|
Packit Service |
384592 |
-A file Specify ModSecurity audit log to read.
|
|
Packit Service |
384592 |
-D file Specify ModSecurity debug log to read.
|
|
Packit Service |
384592 |
-E file Specify Apache httpd error log to read.
|
|
Packit Service |
384592 |
-C file Specify Apache httpd base conf file to generate/reload.
|
|
Packit Service |
384592 |
-H path Specify Apache httpd htdocs path.
|
|
Packit Service |
384592 |
-S path Specify Apache httpd server root path.
|
|
Packit Service |
384592 |
-a file Specify Apache httpd binary (default: httpd)
|
|
Packit Service |
384592 |
-p port Specify Apache httpd port (default: 8088)
|
|
Packit Service |
384592 |
-v Enable verbose output (details on failure).
|
|
Packit Service |
384592 |
-d Enable debugging output.
|
|
Packit Service |
384592 |
-h This help.
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
EOT
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
exit(1);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
usage() if ($opt{h});
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
### Check httpd binary
|
|
Packit Service |
384592 |
if (defined $opt{a}) {
|
|
Packit Service |
384592 |
$HTTPD = $opt{a};
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
$opt{a} = $HTTPD;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
usage("Invalid Apache startup script: $HTTPD\n") unless (-e $HTTPD);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
### Defaults
|
|
Packit Service |
384592 |
$opt{A} = "$FILES_DIR/modsec_audit.log" unless (defined $opt{A});
|
|
Packit Service |
384592 |
$opt{D} = "$FILES_DIR/modsec_debug.log" unless (defined $opt{D});
|
|
Packit Service |
384592 |
$opt{E} = "$FILES_DIR/error.log" unless (defined $opt{E});
|
|
Packit Service |
384592 |
$opt{C} = "$CONF_DIR/httpd.conf" unless (defined $opt{C});
|
|
Packit Service |
384592 |
$opt{H} = "$SROOT_DIR/htdocs" unless (defined $opt{H});
|
|
Packit Service |
384592 |
$opt{p} = 8088 unless (defined $opt{p});
|
|
Packit Service |
384592 |
$opt{v} = 1 if ($opt{d});
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
unless (defined $opt{S}) {
|
|
Packit Service |
384592 |
my $httpd_root = `$HTTPD -V`;
|
|
Packit Service |
384592 |
($opt{S} = $httpd_root) =~ s/.*-D HTTPD_ROOT="([^"]*)".*/$1/sm;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
%ENV = (
|
|
Packit Service |
384592 |
%ENV,
|
|
Packit Service |
384592 |
SERVER_ROOT => $opt{S},
|
|
Packit Service |
384592 |
SERVER_PORT => $opt{p},
|
|
Packit Service |
384592 |
SERVER_NAME => "localhost",
|
|
Packit Service |
384592 |
TEST_SERVER_ROOT => $SROOT_DIR,
|
|
Packit Service |
384592 |
DATA_DIR => $DATA_DIR,
|
|
Packit Service |
384592 |
TEMP_DIR => $TEMP_DIR,
|
|
Packit Service |
384592 |
UPLOAD_DIR => $UPLOAD_DIR,
|
|
Packit Service |
384592 |
CONF_DIR => $CONF_DIR,
|
|
Packit Service |
384592 |
MODULES_DIR => $MODULES_DIR,
|
|
Packit Service |
384592 |
LOGS_DIR => $FILES_DIR,
|
|
Packit Service |
384592 |
SCRIPT_DIR => $SCRIPT_DIR,
|
|
Packit Service |
384592 |
REGRESSION_DIR => $REG_DIR,
|
|
Packit Service |
384592 |
DIST_ROOT => File::Spec->rel2abs(dirname("$SCRIPT_DIR/../../..")),
|
|
Packit Service |
384592 |
AUDIT_LOG => $opt{A},
|
|
Packit Service |
384592 |
DEBUG_LOG => $opt{D},
|
|
Packit Service |
384592 |
ERROR_LOG => $opt{E},
|
|
Packit Service |
384592 |
HTTPD_CONF => $opt{C},
|
|
Packit Service |
384592 |
HTDOCS => $opt{H},
|
|
Packit Service |
384592 |
USER_AGENT => $UA_NAME,
|
|
Packit Service |
384592 |
);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
#dbg("OPTIONS: ", \%opt);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if (-e "$PID_FILE") {
|
|
Packit Service |
384592 |
msg("Shutting down previous instance: $PID_FILE");
|
|
Packit Service |
384592 |
httpd_stop();
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if (defined $ARGV[0]) {
|
|
Packit Service |
384592 |
runfile(dirname($ARGV[0]), basename($ARGV[0]), $ARGV[1]);
|
|
Packit Service |
384592 |
done();
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
for my $type (@TYPES) {
|
|
Packit Service |
384592 |
my $dir = "$SCRIPT_DIR/regression/$type";
|
|
Packit Service |
384592 |
my @cfg = ();
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Get test names
|
|
Packit Service |
384592 |
opendir(DIR, "$dir") or quit(1, "Failed to open \"$dir\": $!");
|
|
Packit Service |
384592 |
@cfg = grep { /\.t$/ && -f "$dir/$_" } readdir(DIR);
|
|
Packit Service |
384592 |
closedir(DIR);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
for my $cfg (sort @cfg) {
|
|
Packit Service |
384592 |
runfile($dir, $cfg);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
done();
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub runfile {
|
|
Packit Service |
384592 |
my($dir, $cfg, $testnum) = @_;
|
|
Packit Service |
384592 |
my $fn = "$dir/$cfg";
|
|
Packit Service |
384592 |
my @data = ();
|
|
Packit Service |
384592 |
my $edata;
|
|
Packit Service |
384592 |
my @C = ();
|
|
Packit Service |
384592 |
my @test = ();
|
|
Packit Service |
384592 |
my $teststr;
|
|
Packit Service |
384592 |
my $n = 0;
|
|
Packit Service |
384592 |
my $pass = 0;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
open(CFG, "<$fn") or quit(1, "Failed to open \"$fn\": $!");
|
|
Packit Service |
384592 |
@data = <CFG>;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
$edata = q/@C = (/ . join("", @data) . q/)/;
|
|
Packit Service |
384592 |
eval $edata;
|
|
Packit Service |
384592 |
quit(1, "Failed to read test data \"$cfg\": $@") if ($@);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
unless (@C) {
|
|
Packit Service |
384592 |
msg("\nNo tests defined for $fn");
|
|
Packit Service |
384592 |
return;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
msg("\nLoaded ".@C." tests from $fn");
|
|
Packit Service |
384592 |
for my $t (@C) {
|
|
Packit Service |
384592 |
$n++;
|
|
Packit Service |
384592 |
next if (defined $testnum and $n != $testnum);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my $httpd_up = 0;
|
|
Packit Service |
384592 |
my %t = %{$t || {}};
|
|
Packit Service |
384592 |
my $id = sprintf("%3d", $n);
|
|
Packit Service |
384592 |
my $out = "";
|
|
Packit Service |
384592 |
my $rc = 0;
|
|
Packit Service |
384592 |
my $conf_fn;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Startup httpd with optionally included conf.
|
|
Packit Service |
384592 |
if (exists $t{conf} and defined $t{conf}) {
|
|
Packit Service |
384592 |
$conf_fn = sprintf "%s/%s_%s_%06d.conf",
|
|
Packit Service |
384592 |
$CONF_DIR, $t{type}, $cfg, $n;
|
|
Packit Service |
384592 |
#dbg("Writing test config to: $conf_fn");
|
|
Packit Service |
384592 |
open(CONF, ">$conf_fn") or die "Failed to open conf \"$conf_fn\": $!\n";
|
|
Packit Service |
384592 |
print CONF (ref $t{conf} eq "CODE" ? eval { &{$t{conf}} } : $t{conf});
|
|
Packit Service |
384592 |
msg("$@") if ($@);
|
|
Packit Service |
384592 |
close CONF;
|
|
Packit Service |
384592 |
$httpd_up = httpd_start(\%t, "Include $conf_fn") ? 0 : 1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
$httpd_up = httpd_start(\%t) ? 0 : 1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Run any prerun setup
|
|
Packit Service |
384592 |
if ($rc == 0 and exists $t{prerun} and defined $t{prerun}) {
|
|
Packit Service |
384592 |
vrb("Executing perl prerun...");
|
|
Packit Service |
384592 |
$rc = &{$t{prerun}};
|
|
Packit Service |
384592 |
vrb("Perl prerun returned: $rc");
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if ($httpd_up) {
|
|
Packit Service |
384592 |
# Perform the request and check response
|
|
Packit Service |
384592 |
if (exists $t{request}) {
|
|
Packit Service |
384592 |
my $resp = do_request($t{request});
|
|
Packit Service |
384592 |
if (!$resp) {
|
|
Packit Service |
384592 |
msg("invalid response");
|
|
Packit Service |
384592 |
vrb("RESPONSE: ", $resp);
|
|
Packit Service |
384592 |
$rc = 1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
for my $key (keys %{ $t{match_response} || {}}) {
|
|
Packit Service |
384592 |
my($neg,$mtype) = ($key =~ m/^(-?)(.*)$/);
|
|
Packit Service |
384592 |
my $m = $t{match_response}{$key};
|
|
Packit Service |
384592 |
if (ref($m) eq "HASH") {
|
|
Packit Service |
384592 |
if ($m->{$platform}) {
|
|
Packit Service |
384592 |
$m = $m->{$platform};
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
my $ap = join(", ", keys %{$m});
|
|
Packit Service |
384592 |
msg("Warning: trying to match: $mtype. Nothing " .
|
|
Packit Service |
384592 |
"to match in current platform: $platform. " .
|
|
Packit Service |
384592 |
"This test only contains cotent for: $ap.");
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
my $match = match_response($mtype, $resp, $m);
|
|
Packit Service |
384592 |
if ($neg and defined $match) {
|
|
Packit Service |
384592 |
$rc = 1;
|
|
Packit Service |
384592 |
msg("response $mtype matched: $m");
|
|
Packit Service |
384592 |
vrb($resp);
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
elsif (!$neg and !defined $match) {
|
|
Packit Service |
384592 |
$rc = 1;
|
|
Packit Service |
384592 |
msg("response $mtype failed to match: $m");
|
|
Packit Service |
384592 |
vrb($resp);
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Run any arbitrary perl tests
|
|
Packit Service |
384592 |
if ($rc == 0 and exists $t{test} and defined $t{test}) {
|
|
Packit Service |
384592 |
dbg("Executing perl test(s)...");
|
|
Packit Service |
384592 |
$rc = eval { &{$t{test}} };
|
|
Packit Service |
384592 |
if (! defined $rc) {
|
|
Packit Service |
384592 |
msg("Error running test: $@");
|
|
Packit Service |
384592 |
$rc = -1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
dbg("Perl tests returned: $rc");
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Search for all log matches
|
|
Packit Service |
384592 |
if ($rc == 0 and exists $t{match_log} and defined $t{match_log}) {
|
|
Packit Service |
384592 |
for my $key (keys %{ $t{match_log} || {}}) {
|
|
Packit Service |
384592 |
my($neg,$mtype) = ($key =~ m/^(-?)(.*)$/);
|
|
Packit Service |
384592 |
my $m = $t{match_log}{$key};
|
|
Packit Service |
384592 |
if (ref($m) eq "HASH") {
|
|
Packit Service |
384592 |
if ($m->{$platform}) {
|
|
Packit Service |
384592 |
$m = $m->{$platform};
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
my $ap = join(", ", keys %{$m});
|
|
Packit Service |
384592 |
msg("Warning: trying to match: $mtype. Nothing " .
|
|
Packit Service |
384592 |
"to match in current platform: $platform. " .
|
|
Packit Service |
384592 |
"This test only contains cotent for: $ap.");
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
my $match = match_log($mtype, @{$m || []});
|
|
Packit Service |
384592 |
if ($neg and defined $match) {
|
|
Packit Service |
384592 |
$rc = 1;
|
|
Packit Service |
384592 |
msg("$mtype log matched: $m->[0]");
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
elsif (!$neg and !defined $match) {
|
|
Packit Service |
384592 |
$rc = 1;
|
|
Packit Service |
384592 |
msg("$mtype log failed to match: $m->[0]");
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Search for all file matches
|
|
Packit Service |
384592 |
if ($rc == 0 and exists $t{match_file} and defined $t{match_file}) {
|
|
Packit Service |
384592 |
sleep 1; # Make sure the file exists
|
|
Packit Service |
384592 |
for my $key (keys %{ $t{match_file} || {}}) {
|
|
Packit Service |
384592 |
my($neg,$fn) = ($key =~ m/^(-?)(.*)$/);
|
|
Packit Service |
384592 |
my $m = $t{match_file}{$key};
|
|
Packit Service |
384592 |
my $match = match_file($fn, $m);
|
|
Packit Service |
384592 |
if ($neg and defined $match) {
|
|
Packit Service |
384592 |
$rc = 1;
|
|
Packit Service |
384592 |
msg("$fn file matched: $m");
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
elsif (!$neg and !defined $match) {
|
|
Packit Service |
384592 |
$rc = 1;
|
|
Packit Service |
384592 |
msg("$fn file failed match: $m");
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
msg("Failed to start httpd.");
|
|
Packit Service |
384592 |
$rc = 1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if ($rc == 0) {
|
|
Packit Service |
384592 |
$pass++;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
vrb("Test Config: $conf_fn");
|
|
Packit Service |
384592 |
vrb("Debug Log: $FILE{debug}{fn}");
|
|
Packit Service |
384592 |
dbg(escape("$FILE{debug}{buf}"));
|
|
Packit Service |
384592 |
vrb("Error Log: $FILE{error}{fn}");
|
|
Packit Service |
384592 |
dbg(escape("$FILE{error}{buf}"));
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
msg(sprintf("%s) %s%s: %s%s", $id, $t{type}, (exists($t{comment}) ? " - $t{comment}" : ""), ($rc ? "failed" : "passed"), ((defined($out) && $out ne "")? " ($out)" : "")));
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if ($httpd_up) {
|
|
Packit Service |
384592 |
$httpd_up = httpd_stop(\%t) ? 0 : 1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
$TOTAL += $testnum ? 1 : $n;
|
|
Packit Service |
384592 |
$PASSED += $pass;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
msg(sprintf("Passed: %2d; Failed: %2d", $pass, $testnum ? (1 - $pass) : ($n - $pass)));
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Take out any indenting and translate LF -> CRLF
|
|
Packit Service |
384592 |
sub normalize_raw_request_data {
|
|
Packit Service |
384592 |
my $r = $_[0];
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Allow for indenting in test file
|
|
Packit Service |
384592 |
$r =~ s/^[ \t]*\x0d?\x0a//s;
|
|
Packit Service |
384592 |
my($indention) = ($r =~ m/^([ \t]*)/s); # indention taken from first line
|
|
Packit Service |
384592 |
$r =~ s/^$indention//mg;
|
|
Packit Service |
384592 |
$r =~ s/(\x0d?\x0a)[ \t]+$/$1/s;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Translate LF to CRLF
|
|
Packit Service |
384592 |
$r =~ s/^\x0a/\x0d\x0a/mg;
|
|
Packit Service |
384592 |
$r =~ s/([^\x0d])\x0a/$1\x0d\x0a/mg;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
return $r;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub do_raw_request {
|
|
Packit Service |
384592 |
my $sock = new IO::Socket::INET(
|
|
Packit Service |
384592 |
Proto => "tcp",
|
|
Packit Service |
384592 |
PeerAddr => "localhost",
|
|
Packit Service |
384592 |
PeerPort => $opt{p},
|
|
Packit Service |
384592 |
) or msg("Failed to connect to localhost:$opt{p}: $@");
|
|
Packit Service |
384592 |
return unless ($sock);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Join togeather the request
|
|
Packit Service |
384592 |
my $r = join("", @_);
|
|
Packit Service |
384592 |
dbg($r);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Write to socket
|
|
Packit Service |
384592 |
print $sock "$r";
|
|
Packit Service |
384592 |
$sock->shutdown(1);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Read from socket
|
|
Packit Service |
384592 |
my @resp = <$sock>;
|
|
Packit Service |
384592 |
$sock->close();
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
return HTTP::Response->parse(join("", @resp));
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub do_request {
|
|
Packit Service |
384592 |
my $r = $_[0];
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Allow test to execute code
|
|
Packit Service |
384592 |
if (ref $r eq "CODE") {
|
|
Packit Service |
384592 |
$r = eval { &$r };
|
|
Packit Service |
384592 |
msg("$@") unless (defined $r);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if (ref $r eq "HTTP::Request") {
|
|
Packit Service |
384592 |
my $resp = $UA->request($r);
|
|
Packit Service |
384592 |
dbg($resp->request()->as_string()) if ($opt{d});
|
|
Packit Service |
384592 |
return $resp
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
return do_raw_request($r);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
return;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub match_response {
|
|
Packit Service |
384592 |
my($name, $resp, $re) = @_;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
msg("Warning: Empty regular expression.") if (!defined $re or $re eq "");
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if ($name eq "status") {
|
|
Packit Service |
384592 |
return $& if ($resp->code =~ m/$re/);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
elsif ($name eq "content") {
|
|
Packit Service |
384592 |
return $& if ($resp->content =~ m/$re/m);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
elsif ($name eq "raw") {
|
|
Packit Service |
384592 |
return $& if ($resp->as_string =~ m/$re/m);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
return;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub read_log {
|
|
Packit Service |
384592 |
my($name, $timeout, $graph) = @_;
|
|
Packit Service |
384592 |
return match_log($name, undef, $timeout, $graph);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub match_log {
|
|
Packit Service |
384592 |
my($name, $re, $timeout, $graph) = @_;
|
|
Packit Service |
384592 |
my $t0 = gettimeofday;
|
|
Packit Service |
384592 |
my($fh,$rbuf) = ($FILE{$name}{fd}, \$FILE{$name}{buf});
|
|
Packit Service |
384592 |
my $n = length($$rbuf);
|
|
Packit Service |
384592 |
my $rc = undef;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
unless (defined $fh) {
|
|
Packit Service |
384592 |
msg("Error: File \"$name\" is not opened for matching.");
|
|
Packit Service |
384592 |
return;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
$timeout = 0 unless (defined $timeout);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my $i = 0;
|
|
Packit Service |
384592 |
my $graphed = 0;
|
|
Packit Service |
384592 |
READ: {
|
|
Packit Service |
384592 |
do {
|
|
Packit Service |
384592 |
my $nbytes = $fh->sysread($$rbuf, $BUFSIZ, $n);
|
|
Packit Service |
384592 |
if (!defined($nbytes)) {
|
|
Packit Service |
384592 |
msg("Error: Could not read \"$name\" log: $!");
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
elsif (!defined($re) and $nbytes == 0) {
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Remove APR pool debugging
|
|
Packit Service |
384592 |
$$rbuf =~ s/POOL DEBUG:[^\n]+PALLOC[^\n]+\n//sg;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
$n = length($$rbuf);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
#dbg("Match \"$re\" in $name \"$$rbuf\" ($n)");
|
|
Packit Service |
384592 |
if ($$rbuf =~ m/$re/m) {
|
|
Packit Service |
384592 |
$rc = $&;
|
|
Packit Service |
384592 |
last;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
# TODO: Use select()/poll()
|
|
Packit Service |
384592 |
sleep 0.1 unless ($nbytes == $BUFSIZ);
|
|
Packit Service |
384592 |
if ($graph and $opt{d}) {
|
|
Packit Service |
384592 |
$i++;
|
|
Packit Service |
384592 |
if ($i == 10) {
|
|
Packit Service |
384592 |
$graphed++;
|
|
Packit Service |
384592 |
$i=0;
|
|
Packit Service |
384592 |
print STDERR $graph if ($graphed == 1);
|
|
Packit Service |
384592 |
print STDERR "."
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
} while (gettimeofday - $t0 < $timeout);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
print STDERR "\n" if ($graphed);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
return $rc;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub match_file {
|
|
Packit Service |
384592 |
my($neg,$fn) = ($_[0] =~ m/^(-?)(.*)$/);
|
|
Packit Service |
384592 |
unless (exists $FILE{$fn}) {
|
|
Packit Service |
384592 |
eval {
|
|
Packit Service |
384592 |
$FILE{$fn}{fn} = $fn;
|
|
Packit Service |
384592 |
$FILE{$fn}{fd} = new FileHandle($fn, O_RDONLY) or die "$!\n";
|
|
Packit Service |
384592 |
$FILE{$fn}{fd}->blocking(0);
|
|
Packit Service |
384592 |
$FILE{$fn}{buf} = "";
|
|
Packit Service |
384592 |
};
|
|
Packit Service |
384592 |
if ($@) {
|
|
Packit Service |
384592 |
msg("Warning: Failed to open file \"$fn\": $@");
|
|
Packit Service |
384592 |
return;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
return match_log($_[0], $_[1]); # timeout makes no sense
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub quote_shell {
|
|
Packit Service |
384592 |
my($s) = @_;
|
|
Packit Service |
384592 |
return $s unless ($s =~ m|[^\w!%+,\-./:@^]|);
|
|
Packit Service |
384592 |
$s =~ s/(['\\])/\\$1/g;
|
|
Packit Service |
384592 |
return "'$s'";
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub escape {
|
|
Packit Service |
384592 |
my @new = ();
|
|
Packit Service |
384592 |
for my $c (split(//, $_[0])) {
|
|
Packit Service |
384592 |
my $oc = ord($c);
|
|
Packit Service |
384592 |
push @new, ((($oc >= 0x20 and $oc <= 0x7e) or $oc == 0x0a or $oc == 0x0d) ? $c : sprintf("\\x%02x", ord($c)));
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
join('', @new);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub dbg {
|
|
Packit Service |
384592 |
return unless(@_ and $opt{d});
|
|
Packit Service |
384592 |
my $out = join "", map {
|
|
Packit Service |
384592 |
(ref $_ ne "" ? Dumper($_) : $_)
|
|
Packit Service |
384592 |
} @_;
|
|
Packit Service |
384592 |
$out =~ s/^/DBG: /mg;
|
|
Packit Service |
384592 |
print STDOUT "$out\n";
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub vrb {
|
|
Packit Service |
384592 |
return unless(@_ and $opt{v});
|
|
Packit Service |
384592 |
msg(@_);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub msg {
|
|
Packit Service |
384592 |
return unless(@_);
|
|
Packit Service |
384592 |
my $out = join "", map {
|
|
Packit Service |
384592 |
(ref $_ ne "" ? Dumper($_) : $_)
|
|
Packit Service |
384592 |
} @_;
|
|
Packit Service |
384592 |
print STDOUT "$out\n";
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub handle_interrupt {
|
|
Packit Service |
384592 |
$SIG{TERM} = $SIG{INT} = \&handle_interrupt;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
msg("Interrupted via SIG$_[0]. Shutting down tests...");
|
|
Packit Service |
384592 |
httpd_stop();
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
quit(1);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub quit {
|
|
Packit Service |
384592 |
my($ec,$msg) = @_;
|
|
Packit Service |
384592 |
$ec = 0 unless (defined $_[0]);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
msg("$msg") if (defined $msg);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
exit $ec;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub done {
|
|
Packit Service |
384592 |
if ($PASSED != $TOTAL) {
|
|
Packit Service |
384592 |
quit(1, "\n$PASSED/$TOTAL tests passed.");
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
quit(0, "\nAll tests passed ($TOTAL).");
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub httpd_start {
|
|
Packit Service |
384592 |
my $t = shift;
|
|
Packit Service |
384592 |
httpd_reset_fd($t);
|
|
Packit Service |
384592 |
my @p = (
|
|
Packit Service |
384592 |
$HTTPD,
|
|
Packit Service |
384592 |
-d => $opt{S},
|
|
Packit Service |
384592 |
-f => $opt{C},
|
|
Packit Service |
384592 |
(map { (-c => $_) } ("Listen localhost:$opt{p}", @_)),
|
|
Packit Service |
384592 |
-k => "start",
|
|
Packit Service |
384592 |
);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my $httpd_out;
|
|
Packit Service |
384592 |
my $httpd_pid = open3(undef, $httpd_out, undef, @p) or quit(1);
|
|
Packit Service |
384592 |
my $out = join("\\n", grep(!/POOL DEBUG/, (<$httpd_out>)));
|
|
Packit Service |
384592 |
close $httpd_out;
|
|
Packit Service |
384592 |
waitpid($httpd_pid, 0);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my $rc = $?;
|
|
Packit Service |
384592 |
if ( WIFEXITED($rc) ) {
|
|
Packit Service |
384592 |
$rc = WEXITSTATUS($rc);
|
|
Packit Service |
384592 |
vrb("Httpd start returned with $rc.") if ($rc);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
elsif( WIFSIGNALED($rc) ) {
|
|
Packit Service |
384592 |
msg("Httpd start failed with signal " . WTERMSIG($rc) . ".");
|
|
Packit Service |
384592 |
$rc = -1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
msg("Httpd start failed with unknown error.");
|
|
Packit Service |
384592 |
$rc = -1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if (defined $out and $out ne "") {
|
|
Packit Service |
384592 |
vrb(join(" ", map { quote_shell($_) } @p));
|
|
Packit Service |
384592 |
msg("Httpd start failed with error messages:\n$out");
|
|
Packit Service |
384592 |
httpd_stop();
|
|
Packit Service |
384592 |
return -1
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Look for startup msg
|
|
Packit Service |
384592 |
unless (defined match_log("error", qr/resuming normal operations/, 60, "Waiting on httpd to start: ")) {
|
|
Packit Service |
384592 |
vrb(join(" ", map { quote_shell($_) } @p));
|
|
Packit Service |
384592 |
vrb(match_log("error", qr/(^.*ModSecurity: .*)/sm, 10));
|
|
Packit Service |
384592 |
msg("Httpd server failed to start.");
|
|
Packit Service |
384592 |
httpd_stop();
|
|
Packit Service |
384592 |
return -1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
return $rc;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub httpd_stop {
|
|
Packit Service |
384592 |
my $t = shift;
|
|
Packit Service |
384592 |
my @p = (
|
|
Packit Service |
384592 |
$HTTPD,
|
|
Packit Service |
384592 |
-d => $opt{S},
|
|
Packit Service |
384592 |
-f => $opt{C},
|
|
Packit Service |
384592 |
(map { (-c => $_) } ("Listen localhost:$opt{p}", @_)),
|
|
Packit Service |
384592 |
-k => "stop",
|
|
Packit Service |
384592 |
);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my $httpd_out;
|
|
Packit Service |
384592 |
my $httpd_pid = open3(undef, $httpd_out, undef, @p) or quit(1);
|
|
Packit Service |
384592 |
my $out = join("\\n", grep(!/POOL DEBUG/, (<$httpd_out>)));
|
|
Packit Service |
384592 |
close $httpd_out;
|
|
Packit Service |
384592 |
waitpid($httpd_pid, 0);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if (defined $out and $out ne "") {
|
|
Packit Service |
384592 |
msg("Httpd stop failed with error messages:\n$out");
|
|
Packit Service |
384592 |
return -1
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my $rc = $?;
|
|
Packit Service |
384592 |
if ( WIFEXITED($rc) ) {
|
|
Packit Service |
384592 |
$rc = WEXITSTATUS($rc);
|
|
Packit Service |
384592 |
vrb("Httpd stop returned with $rc.") if ($rc);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
elsif( WIFSIGNALED($rc) ) {
|
|
Packit Service |
384592 |
msg("Httpd stop failed with signal " . WTERMSIG($rc) . ".");
|
|
Packit Service |
384592 |
$rc = -1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
msg("Httpd stop failed with unknown error.");
|
|
Packit Service |
384592 |
$rc = -1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Look for startup msg
|
|
Packit Service |
384592 |
unless (defined match_log("error", qr/caught SIG[A-Z]+, shutting down/, 60, "Waiting on httpd to stop: ")) {
|
|
Packit Service |
384592 |
vrb(join(" ", map { quote_shell($_) } @p));
|
|
Packit Service |
384592 |
msg("Httpd server failed to shutdown.");
|
|
Packit Service |
384592 |
sleep 0.5;
|
|
Packit Service |
384592 |
return -1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sleep 0.5;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
return $rc;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub httpd_reload {
|
|
Packit Service |
384592 |
my $t = shift;
|
|
Packit Service |
384592 |
httpd_reset_fd($t);
|
|
Packit Service |
384592 |
my @p = (
|
|
Packit Service |
384592 |
$HTTPD,
|
|
Packit Service |
384592 |
-d => $opt{S},
|
|
Packit Service |
384592 |
-f => $opt{C},
|
|
Packit Service |
384592 |
(map { (-c => $_) } ("Listen localhost:$opt{p}", @_)),
|
|
Packit Service |
384592 |
-k => "graceful",
|
|
Packit Service |
384592 |
);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my $httpd_out;
|
|
Packit Service |
384592 |
my $httpd_pid = open3(undef, $httpd_out, undef, @p) or quit(1);
|
|
Packit Service |
384592 |
my $out = join("\\n", grep(!/POOL DEBUG/, (<$httpd_out>)));
|
|
Packit Service |
384592 |
close $httpd_out;
|
|
Packit Service |
384592 |
waitpid($httpd_pid, 0);
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
if (defined $out and $out ne "") {
|
|
Packit Service |
384592 |
msg("Httpd reload failed with error messages:\n$out");
|
|
Packit Service |
384592 |
return -1
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my $rc = $?;
|
|
Packit Service |
384592 |
if ( WIFEXITED($rc) ) {
|
|
Packit Service |
384592 |
$rc = WEXITSTATUS($rc);
|
|
Packit Service |
384592 |
vrb("Httpd reload returned with $rc.") if ($rc);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
elsif( WIFSIGNALED($rc) ) {
|
|
Packit Service |
384592 |
msg("Httpd reload failed with signal " . WTERMSIG($rc) . ".");
|
|
Packit Service |
384592 |
$rc = -1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
else {
|
|
Packit Service |
384592 |
msg("Httpd reload failed with unknown error.");
|
|
Packit Service |
384592 |
$rc = -1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Look for startup msg
|
|
Packit Service |
384592 |
unless (defined match_log("error", qr/resuming normal operations/, 60, "Waiting on httpd to restart: ")) {
|
|
Packit Service |
384592 |
vrb(join(" ", map { quote_shell($_) } @p));
|
|
Packit Service |
384592 |
msg("Httpd server failed to reload.");
|
|
Packit Service |
384592 |
return -1;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
return $rc;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub httpd_reset_fd {
|
|
Packit Service |
384592 |
my($t) = @_;
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Cleanup
|
|
Packit Service |
384592 |
for my $key (keys %FILE) {
|
|
Packit Service |
384592 |
if (exists $FILE{$key}{fd} and defined $FILE{$key}{fd}) {
|
|
Packit Service |
384592 |
$FILE{$key}{fd}->close();
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
delete $FILE{$key};
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Error
|
|
Packit Service |
384592 |
eval {
|
|
Packit Service |
384592 |
$FILE{error}{fn} = $opt{E};
|
|
Packit Service |
384592 |
$FILE{error}{fd} = new FileHandle($opt{E}, O_RDWR|O_CREAT) or die "$!\n";
|
|
Packit Service |
384592 |
$FILE{error}{fd}->blocking(0);
|
|
Packit Service |
384592 |
$FILE{error}{fd}->sysseek(0, 2);
|
|
Packit Service |
384592 |
$FILE{error}{buf} = "";
|
|
Packit Service |
384592 |
};
|
|
Packit Service |
384592 |
if ($@) {
|
|
Packit Service |
384592 |
msg("Warning: Failed to open file \"$opt{E}\": $@");
|
|
Packit Service |
384592 |
return undef;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Audit
|
|
Packit Service |
384592 |
eval {
|
|
Packit Service |
384592 |
$FILE{audit}{fn} = $opt{A};
|
|
Packit Service |
384592 |
$FILE{audit}{fd} = new FileHandle($opt{A}, O_RDWR|O_CREAT) or die "$!\n";
|
|
Packit Service |
384592 |
$FILE{audit}{fd}->blocking(0);
|
|
Packit Service |
384592 |
$FILE{audit}{fd}->sysseek(0, 2);
|
|
Packit Service |
384592 |
$FILE{audit}{buf} = "";
|
|
Packit Service |
384592 |
};
|
|
Packit Service |
384592 |
if ($@) {
|
|
Packit Service |
384592 |
msg("Warning: Failed to open file \"$opt{A}\": $@");
|
|
Packit Service |
384592 |
return undef;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Debug
|
|
Packit Service |
384592 |
eval {
|
|
Packit Service |
384592 |
$FILE{debug}{fn} = $opt{D};
|
|
Packit Service |
384592 |
$FILE{debug}{fd} = new FileHandle($opt{D}, O_RDWR|O_CREAT) or die "$!\n";
|
|
Packit Service |
384592 |
$FILE{debug}{fd}->blocking(0);
|
|
Packit Service |
384592 |
$FILE{debug}{fd}->sysseek(0, 2);
|
|
Packit Service |
384592 |
$FILE{debug}{buf} = "";
|
|
Packit Service |
384592 |
};
|
|
Packit Service |
384592 |
if ($@) {
|
|
Packit Service |
384592 |
msg("Warning: Failed to open file \"$opt{D}\": $@");
|
|
Packit Service |
384592 |
return undef;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
# Any extras listed in "match_log"
|
|
Packit Service |
384592 |
if ($t and exists $t->{match_log}) {
|
|
Packit Service |
384592 |
for my $k (keys %{ $t->{match_log} || {} }) {
|
|
Packit Service |
384592 |
my($neg,$fn) = ($k =~ m/^(-?)(.*)$/);
|
|
Packit Service |
384592 |
next if (!$fn or exists $FILE{$fn});
|
|
Packit Service |
384592 |
eval {
|
|
Packit Service |
384592 |
$FILE{$fn}{fn} = $fn;
|
|
Packit Service |
384592 |
$FILE{$fn}{fd} = new FileHandle($fn, O_RDWR|O_CREAT) or die "$!\n";
|
|
Packit Service |
384592 |
$FILE{$fn}{fd}->blocking(0);
|
|
Packit Service |
384592 |
$FILE{$fn}{fd}->sysseek(0, 2);
|
|
Packit Service |
384592 |
$FILE{$fn}{buf} = "";
|
|
Packit Service |
384592 |
};
|
|
Packit Service |
384592 |
if ($@) {
|
|
Packit Service |
384592 |
msg("Warning: Failed to open file \"$fn\": $@");
|
|
Packit Service |
384592 |
return undef;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
sub encode_chunked {
|
|
Packit Service |
384592 |
my($data, $size) = @_;
|
|
Packit Service |
384592 |
$size = 128 unless ($size);
|
|
Packit Service |
384592 |
my $chunked = "";
|
|
Packit Service |
384592 |
|
|
Packit Service |
384592 |
my $n = 0;
|
|
Packit Service |
384592 |
my $bytes = length($data);
|
|
Packit Service |
384592 |
while ($bytes >= $size) {
|
|
Packit Service |
384592 |
$chunked .= sprintf "%x\x0d\x0a%s\x0d\x0a", $size, substr($data, $n, $size);
|
|
Packit Service |
384592 |
$n += $size;
|
|
Packit Service |
384592 |
$bytes -= $size;
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
if ($bytes) {
|
|
Packit Service |
384592 |
$chunked .= sprintf "%x\x0d\x0a%s\x0d\x0a", $bytes, substr($data, $n, $bytes);
|
|
Packit Service |
384592 |
}
|
|
Packit Service |
384592 |
$chunked .= "0\x0d\x0a\x0d\x0a"
|
|
Packit Service |
384592 |
}
|