# A regression test "framework" for Privoxy. For documentation see:
# perldoc privoxy-regression-test.pl
#
-# $Id: privoxy-regression-test.pl,v 1.135 2008/03/26 10:58:46 fk Exp $
+# $Id: privoxy-regression-test.pl,v 1.149 2008/05/17 14:11:29 fk Exp $
#
# Wish list:
#
# - Update documentation
# - Validate HTTP times.
-# - Understand default.action.master comment syntax
-# and verify that we actually block and unblock what
-# the comments claim we do.
# - Implement a HTTP_VERSION directive or allow to
# specify whole request lines.
# - Support filter regression tests.
sub enlist_new_test ($$$$$$) {
my ($regression_tests, $token, $value, $si, $ri, $number) = @_;
+ my $type;
if ($token eq 'set header') {
l(LL_FILE_LOADING, "Header to set: " . $value);
- ${$regression_tests}[$si][$ri]{'type'} = CLIENT_HEADER_TEST;
- # Implicit default
- $$regression_tests[$si][$ri]{'level'} = CLIENT_HEADER_TEST;
+ $type = CLIENT_HEADER_TEST;
} elsif ($token eq 'request header') {
l(LL_FILE_LOADING, "Header to request: " . $value);
- $$regression_tests[$si][$ri]{'type'} = SERVER_HEADER_TEST;
- # Implicit default
+ $type = SERVER_HEADER_TEST;
$$regression_tests[$si][$ri]{'expected-status-code'} = 200;
- $$regression_tests[$si][$ri]{'level'} = SERVER_HEADER_TEST;
} elsif ($token eq 'trusted cgi request') {
l(LL_FILE_LOADING, "CGI URL to test in a dumb way: " . $value);
- $$regression_tests[$si][$ri]{'type'} = TRUSTED_CGI_REQUEST;
- # Implicit default
+ $type = TRUSTED_CGI_REQUEST;
$$regression_tests[$si][$ri]{'expected-status-code'} = 200;
- $$regression_tests[$si][$ri]{'level'} = TRUSTED_CGI_REQUEST;
} elsif ($token eq 'fetch test') {
l(LL_FILE_LOADING, "URL to test in a dumb way: " . $value);
- $$regression_tests[$si][$ri]{'type'} = DUMB_FETCH_TEST;
- # Implicit default
+ $type = DUMB_FETCH_TEST;
$$regression_tests[$si][$ri]{'expected-status-code'} = 200;
- $$regression_tests[$si][$ri]{'level'} = DUMB_FETCH_TEST;
} elsif ($token eq 'method test') {
l(LL_FILE_LOADING, "Method to test: " . $value);
- $$regression_tests[$si][$ri]{'type'} = METHOD_TEST;
- # Implicit default
+ $type = METHOD_TEST;
$$regression_tests[$si][$ri]{'expected-status-code'} = 200;
- $$regression_tests[$si][$ri]{'level'} = METHOD_TEST;
} elsif ($token eq 'blocked url') {
l(LL_FILE_LOADING, "URL to block-test: " . $value);
- $$regression_tests[$si][$ri]{'type'} = BLOCK_TEST;
- # Implicit default
- $$regression_tests[$si][$ri]{'expected-status-code'} = 403;
- $$regression_tests[$si][$ri]{'level'} = BLOCK_TEST;
+ $type = BLOCK_TEST;
} elsif ($token eq 'url') {
l(LL_FILE_LOADING, "Sticky URL to test: " . $value);
- $$regression_tests[$si][$ri]{'type'} = STICKY_ACTIONS_TEST;
- # Implicit default
- $$regression_tests[$si][$ri]{'level'} = STICKY_ACTIONS_TEST;
- $$regression_tests[$si][$ri]{'url'} = '';
+ $type = STICKY_ACTIONS_TEST;
} else {
}
+ $$regression_tests[$si][$ri]{'type'} = $type;
+ $$regression_tests[$si][$ri]{'level'} = $type;
+
check_for_forbidden_characters($value);
$$regression_tests[$si][$ri]{'data'} = $value;
my $no_checks = 0;
chomp;
-
+
if (/<h2>Contents of Actions File (.*?)</) {
$actionfile = $1;
next;
my $level = $1;
register_dependency($level, $value);
}
+
+ if ($token eq 'sticky actions') {
+
+ # Will be used by each following Sticky URL.
+ $sticky_actions = $value;
+ if ($sticky_actions =~ /{[^}]*\s/) {
+ l(LL_ERROR,
+ "'Sticky Actions' with whitespace inside the " .
+ "action parameters are currently unsupported.");
+ }
+ }
if ($si == -1 || $ri == -1) {
# No beginning of a test detected yet,
l(LL_FILE_LOADING, "Method: " . $value);
$regression_tests[$si][$ri]{'method'} = $value;
- } elsif ($token eq 'sticky actions') {
-
- # Will be used by each following Sticky URL.
- $sticky_actions = $value;
- if ($sticky_actions =~ /{[^}]*\s/) {
- l(LL_ERROR,
- "'Sticky Actions' with whitespace inside the " .
- "action parameters are currently unsupported.");
- }
-
} elsif ($token eq 'url') {
if (defined $sticky_actions) {
- die "What" if defined ($regression_tests[$si][$ri]{'sticky-actions'});
+ die "WTF? Attempted to overwrite Sticky Actions"
+ if defined ($regression_tests[$si][$ri]{'sticky-actions'});
+
l(LL_FILE_LOADING, "Sticky actions: " . $sticky_actions);
$regression_tests[$si][$ri]{'sticky-actions'} = $sticky_actions;
} else {
- l(LL_FILE_LOADING, "Sticky URL without Sticky Actions");
+ l(LL_ERROR, "Sticky URL without Sticky Actions: $value");
}
} else {
my $test_ref = shift;
my %test = %{$test_ref};
my $buffer_ref;
- my $result = 0;
my $status_code;
my $method = $test{'data'};
my $expected_status_code = $test{'expected-status-code'};
$curl_parameters .= '--request ' . $method . ' ';
- # Don't complain in case about the 'missing' body
+ # Don't complain about the 'missing' body
$curl_parameters .= '--head ' if ($method =~ /^HEAD$/i);
$curl_parameters .= PRIVOXY_CGI_URL;
$buffer_ref = get_page_with_curl($curl_parameters);
$status_code = get_status_code($buffer_ref);
- $result = check_status_code_result($status_code, $expected_status_code);
-
- return $result;
+ return check_status_code_result($status_code, $expected_status_code);
}
sub execute_dumb_fetch_test ($) {
my $test_ref = shift;
my %test = %{$test_ref};
my $buffer_ref;
- my $result = 0;
my $status_code;
my $curl_parameters = '';
$buffer_ref = get_page_with_curl($curl_parameters);
$status_code = get_status_code($buffer_ref);
- $result = check_status_code_result($status_code, $expected_status_code);
-
- return $result;
+ return check_status_code_result($status_code, $expected_status_code);
}
sub execute_block_test ($) {
my %final_results = ();
my $final_results_reached = 0;
- die "Unacceptable characterss in $url" if $url =~ m@[\\'"]@;
+ die "Unacceptable characters in $url" if $url =~ m@[\\'"]@;
# XXX: should be URL-encoded properly
$url =~ s@%@%25@g;
$url =~ s@\s@%20@g;
$url =~ s@:@%3A@g;
$url =~ s@/@%2F@g;
- $curl_parameters .= "'" . PRIVOXY_CGI_URL . 'show-url-info?url=' . $url . "'";
+ $curl_parameters .= quote(PRIVOXY_CGI_URL . 'show-url-info?url=' . $url);
foreach (@{get_cgi_page_or_else($curl_parameters)}) {
if (defined $parameter) {
# In case the caller needs to check
- # the action and it's parameter
+ # the action and its parameter
$final_results{$action . $parameter} = 1;
}
- # In case the action doesn't have paramters
+ # In case the action doesn't have parameters
# or the caller doesn't care for the parameter.
$final_results{$action} = 1;
}
my $test_ref = shift;
my $buffer_ref;
my $header;
- my $result = 0;
$buffer_ref = get_show_request_with_curl($test_ref);
$header = get_header($buffer_ref, $test_ref);
- $result = check_header_result($test_ref, $header);
- return $result;
+ return check_header_result($test_ref, $header);
}
sub execute_server_header_regression_test ($) {
my $test_ref = shift;
my $buffer_ref;
my $header;
- my $result = 0;
$buffer_ref = get_head_with_curl($test_ref);
$header = get_server_header($buffer_ref, $test_ref);
- $result = check_header_result($test_ref, $header);
- return $result;
+ return check_header_result($test_ref, $header);
}
my $expect_header = $test{'expect-header'};
my $success = 0;
- $header =~ s@ @ @g if defined($header);
-
if ($expect_header eq 'NO CHANGE') {
if (defined($header) and $header eq $test{'data'}) {
} else {
- $header //= "REMOVAL";
+ $header = "REMOVAL" unless defined $header;
l(LL_VERBOSE_FAILURE,
"Ooops. Got: " . $header . " while expecting: " . $expect_header);
}
} else {
- $header //= "REMOVAL";
+ $header = "REMOVAL" unless defined $header;
l(LL_VERBOSE_FAILURE,
"Ooops. Got: " . $header . " while expecting: SOME CHANGE");
}
} else {
- $header //= "'No matching header'"; # XXX: No header detected to be precise
+ $header = "'No matching header'" unless defined $header; # XXX: No header detected to be precise
l(LL_VERBOSE_FAILURE,
"Ooops. Got: " . $header . " while expecting: " . $expect_header);
}
my $expect_header = $test{'expect-header'};
+ die "get_header called with no expect header" unless defined $expect_header;
+
my $line;
my $processed_request_reached = 0;
my $read_header = 0;
s@^\s*<.*?>@@g;
s@\s*$@@g;
+ # Decode characters we care about.
+ s@"@"@g;
+
$filtered_request .= "\n" . $_;
if (/^$header_to_get/) {
my $header;
my $header_to_get;
+ # XXX: Should be caught before starting to test.
+ l(LL_ERROR, "No expect header for test " . $test{'number'})
+ unless defined $expect_header;
+
if ($expect_header eq 'REMOVAL'
or $expect_header eq 'NO CHANGE'
or $expect_header eq 'SOME CHANGE') {
sub get_page_with_curl ($) {
+ our $proxy;
+
my $parameters = shift;
my @buffer;
my $curl_line = CURL;
my $retries_left = get_cli_option('retries') + 1;
my $failure_reason;
- if (cli_option_is_set('privoxy-address')) {
- $curl_line .= ' --proxy ' . get_cli_option('privoxy-address');
- }
+ $curl_line .= ' --proxy ' . $proxy if (defined $proxy);
# We want to see the HTTP status code
$curl_line .= " --include ";
}
}
- log_message($message) unless ($result && cli_option_is_set('silent'));
+ log_message($message) if (!$result or cli_option_is_set('verbose'));
}
sub quote ($) {
Options and their default values if they have any:
[--debug $cli_options{'debug'}]
+ [--fuzzer-address]
[--fuzzer-feeding]
[--help]
[--level]
[--min-level $cli_options{'min-level'}]
[--privoxy-address]
[--retries $cli_options{'retries'}]
- [--silent]
+ [--verbose]
[--version]
see "perldoc $0" for more information
EOF
GetOptions (
'debug=s' => \$cli_options{'debug'},
'help' => sub { help },
- 'silent' => \$cli_options{'silent'},
'min-level=s' => \$cli_options{'min-level'},
'max-level=s' => \$cli_options{'max-level'},
'privoxy-address=s' => \$cli_options{'privoxy-address'},
+ 'fuzzer-address=s' => \$cli_options{'fuzzer-address'},
'level=s' => \$cli_options{'level'},
'loops=s' => \$cli_options{'loops'},
'test-number=s' => \$cli_options{'test-number'},
'fuzzer-feeding' => \$cli_options{'fuzzer-feeding'},
'retries=s' => \$cli_options{'retries'},
'max-time=s' => \$cli_options{'max-time'},
+ 'verbose' => \$cli_options{'verbose'},
'version' => sub { print_version && exit(0) }
);
$log_level |= $cli_options{'debug'};
return $cli_options{$cli_option};
}
+sub init_proxy_settings($) {
+
+ my $choice = shift;
+ our $proxy = undef;
+
+ if (($choice eq 'fuzz-proxy') and cli_option_is_set('fuzzer-address')) {
+ $proxy = get_cli_option('fuzzer-address');
+ }
+
+ if ((not defined $proxy) or ($choice eq 'vanilla-proxy')) {
+
+ if (cli_option_is_set('privoxy-address')) {
+ $proxy .= get_cli_option('privoxy-address');
+ }
+
+ }
+}
+
sub main () {
init_our_variables();
parse_cli_options();
check_for_curl();
+ init_proxy_settings('vanilla-proxy');
load_regressions_tests();
+ init_proxy_settings('fuzz-proxy');
execute_regression_tests();
}
=head1 SYNOPSIS
-B<privoxy-regression-test> [B<--debug bitmask>] [B<--fuzzer-feeding>] [B<--help>]
-[B<--level level>] [B<--loops count>] [B<--max-level max-level>]
-[B<--max-time max-time>] [B<--min-level min-level>] B<--privoxy-address proxy-address>
-[B<--retries retries>] [B<--silent>] [B<--version>]
+B<privoxy-regression-test> [B<--debug bitmask>] [B<--fuzzer-feeding>]
+[B<--fuzzer-feeding>] [B<--help>] [B<--level level>] [B<--loops count>]
+[B<--max-level max-level>] [B<--max-time max-time>]
+[B<--min-level min-level>] B<--privoxy-address proxy-address>
+[B<--retries retries>] [B<--verbose>] [B<--version>]
=head1 DESCRIPTION
B<--debug bitmask> Add the bitmask provided as integer
to the debug settings.
+B<--fuzzer-address> Listening address used when executing
+the regression tests. Useful to make sure that the requests
+to load the regression tests don't fail due to fuzzing.
+
B<--fuzzer-feeding> Ignore some errors that would otherwise
cause Privoxy-Regression-Test to abort the test because
they shouldn't happen in normal operation. This option is
B<--retries retries> Retry B<retries> times.
-B<--silent> Don't log succesful test runs.
+B<--verbose> Also log succesful test runs.
B<--version> Print version and exit.
projects / privoxy.git / blobdiff