# A regression test "framework" for Privoxy. For documentation see:
# perldoc privoxy-regression-test.pl
#
-# $Id: privoxy-regression-test.pl,v 1.95 2016/05/12 08:42:50 fabiankeil Exp $
-#
# Wish list:
#
# - Update documentation
# - Document magic Expect Header values
# - Internal fuzz support?
#
-# Copyright (c) 2007-2016 Fabian Keil <fk@fabiankeil.de>
+# Copyright (c) 2007-2020 Fabian Keil <fk@fabiankeil.de>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
use Getopt::Long;
use constant {
- PRT_VERSION => 'Privoxy-Regression-Test 0.6',
+ PRT_VERSION => 'Privoxy-Regression-Test 0.7.1',
CURL => 'curl',
REDIRECT_TEST =>108,
};
-sub init_our_variables () {
+sub init_our_variables() {
our $leading_log_time = LEADING_LOG_TIME;
our $leading_log_date = LEADING_LOG_DATE;
our $log_level = get_default_log_level();
}
-sub get_default_log_level () {
+sub get_default_log_level() {
my $log_level = 0;
#
############################################################################
-sub parse_tag ($) {
+sub parse_tag($) {
my $tag = shift;
return $tag;
}
-sub check_for_forbidden_characters ($) {
+sub check_for_forbidden_characters($) {
my $string = shift;
- my $allowed = '[-=\dA-Za-z~{}:./();\t ,+@"_%?&*^]';
+ my $allowed = '[-=\dA-Za-z~{}\[\]:./();\t ,+@"_%?&*^]';
unless ($string =~ m/^$allowed*$/o) {
my $forbidden = $string;
# XXX: Contains a lot of code duplicated from load_action_files()
# that should be factored out.
-sub load_regression_tests_from_file ($) {
+sub load_regression_tests_from_file($) {
my $action_file = shift;
# initialized here
l(LL_FILE_LOADING, "Sticky actions: " . $sticky_actions);
$regression_tests[$si][$ri]{'sticky-actions'} = $sticky_actions;
} else {
- log_and_die("Sticky URL without Sticky Actions: $value");
+ log_and_die("Sticky URL without Sticky Actions in $action_file: $value");
}
} else {
}
-sub load_regression_tests_through_privoxy () {
+sub load_regression_tests_through_privoxy() {
our $privoxy_cgi_url;
our @privoxy_config;
load_action_files(\@actionfiles);
}
-sub token_starts_new_test ($) {
+sub token_starts_new_test($) {
my $token = shift;
my @new_test_directives = ('set header', 'fetch test',
return 0;
}
-sub tokenize ($) {
+sub tokenize($) {
my ($token, $value) = (undef, undef);
- # Remove leading and trailing white space.
- s@^\s*@@;
+ # Remove leading and trailing white space and a
+ # a leading <pre> which is part of the first line.
+ s@^\s*(<pre>)?@@;
s@\s*$@@;
# Reverse HTML-encoding
return ($token, $value);
}
-sub enlist_new_test ($$$$$$) {
+sub enlist_new_test($$$$$$) {
my ($regression_tests, $token, $value, $si, $ri, $number) = @_;
my $type;
# XXX: Shares a lot of code with load_regression_tests_from_file()
# that should be factored out.
-sub load_action_files ($) {
+sub load_action_files($) {
# initialized here
our %actions;
l(LL_FILE_LOADING, "Sticky actions: " . $sticky_actions);
$regression_tests[$si][$ri]{'sticky-actions'} = $sticky_actions;
} else {
- log_and_die("Sticky URL without Sticky Actions: $value");
+ log_and_die("Sticky URL without Sticky Actions in $actionfile: $value");
}
} else {
############################################################################
# Fisher Yates shuffle from Perl's "How do I shuffle an array randomly?" FAQ
-sub fisher_yates_shuffle ($) {
+sub fisher_yates_shuffle($) {
my $deck = shift;
my $i = @$deck;
while ($i--) {
}
}
-sub execute_regression_tests () {
+sub execute_regression_tests() {
our @regression_tests;
my $loops = get_cli_option('loops');
}
}
-sub get_skip_reason ($) {
+sub get_skip_reason($) {
my $test = shift;
my $skip_reason = undef;
return $skip_reason;
}
-sub level_is_unacceptable ($) {
+sub level_is_unacceptable($) {
my $level = shift;
my $min_level = get_cli_option('min-level');
my $max_level = get_cli_option('max-level');
return $reason;
}
-sub dependency_unsatisfied ($) {
+sub dependency_unsatisfied($) {
my $level = shift;
our %dependencies;
return $dependency_problem;
}
-sub register_dependency ($$) {
+sub register_dependency($$) {
my $level = shift;
my $dependency = shift;
}
}
-sub execute_method_test ($) {
+sub execute_method_test($) {
my $test = shift;
my $buffer_ref;
return check_status_code_result($status_code, $expected_status_code);
}
-sub execute_redirect_test ($) {
+sub execute_redirect_test($) {
my $test = shift;
my $buffer_ref;
return $success;
}
-sub execute_dumb_fetch_test ($) {
+sub execute_dumb_fetch_test($) {
my $test = shift;
my $buffer_ref;
return check_status_code_result($status_code, $expected_status_code);
}
-sub execute_block_test ($) {
+sub execute_block_test($) {
my $test = shift;
my $url = $test->{'data'};
return defined $final_results->{'+block'};
}
-sub execute_sticky_actions_test ($) {
+sub execute_sticky_actions_test($) {
my $test = shift;
my $url = $test->{'data'};
return $verified_actions == @sticky_actions;
}
-sub get_final_results ($) {
+sub get_final_results($) {
my $url = shift;
my $curl_parameters = '';
return \%final_results;
}
-sub check_status_code_result ($$) {
+sub check_status_code_result($$) {
my $status_code = shift;
my $expected_status_code = shift;
return $result;
}
-sub execute_client_header_regression_test ($) {
+sub execute_client_header_regression_test($) {
my $test = shift;
my $buffer_ref;
return check_header_result($test, $header);
}
-sub execute_server_header_regression_test ($) {
+sub execute_server_header_regression_test($) {
my $test = shift;
my $buffer_ref;
return check_header_result($test, $header);
}
-sub interpret_result ($) {
+sub interpret_result($) {
my $success = shift;
return $success ? "Success" : "Failure";
}
-sub check_header_result ($$) {
+sub check_header_result($$) {
my $test = shift;
my $header = shift;
return $success;
}
-sub get_header_name ($) {
+sub get_header_name($) {
my $header = shift;
return $header;
}
-sub get_header ($$) {
+sub get_header($$) {
our $filtered_request = '';
return $header;
}
-sub get_server_header ($$) {
+sub get_server_header($$) {
my $buffer_ref = shift;
my $test = shift;
return $header;
}
-sub get_status_code ($) {
+sub get_status_code($) {
my $buffer_ref = shift;
my @buffer = @{$buffer_ref};
}
}
-sub get_test_keys () {
+sub get_test_keys() {
return ('tag', 'data', 'expect-header', 'ignore');
}
# XXX: incomplete
-sub test_content_as_string ($) {
+sub test_content_as_string($) {
my $test = shift;
#
############################################################################
-sub get_cgi_page_or_else ($) {
+sub get_cgi_page_or_else($) {
my $cgi_url = shift;
my $content_ref = get_page_with_curl($cgi_url);
}
# XXX: misleading name
-sub get_show_request_with_curl ($) {
+sub get_show_request_with_curl($) {
our $privoxy_cgi_url;
my $test = shift;
return get_cgi_page_or_else($curl_parameters);
}
-sub get_head_with_curl ($) {
+sub get_head_with_curl($) {
our $fellatio_url = FELLATIO_URL;
my $test = shift;
return get_page_with_curl($curl_parameters);
}
-sub get_page_with_curl ($) {
+sub get_page_with_curl($) {
our $proxy;
$curl_line .= " --user-agent '" . PRT_VERSION . "' ";
# We aren't too patient
$curl_line .= " --max-time '" . get_cli_option('max-time') . "' ";
+ # We don't want curl to treat "[]", "{}" etc. special
+ $curl_line .= " --globoff ";
$curl_line .= $parameters;
# XXX: still necessary?
#
############################################################################
-sub array_as_string ($) {
+sub array_as_string($) {
my $array_ref = shift;
my $string = '';
return $string;
}
-sub show_test ($) {
+sub show_test($) {
my $test = shift;
log_message('Test is:' . test_content_as_string($test));
}
# Conditional log
-sub l ($$) {
+sub l($$) {
our $log_level;
my $this_level = shift;
my $message = shift;
log_message($message) if ($log_level & $this_level);
}
-sub log_and_die ($) {
+sub log_and_die($) {
my $message = shift;
log_message('Oh noes. ' . $message . ' Fatal error. Exiting.');
exit;
}
-sub log_message ($) {
+sub log_message($) {
my $message = shift;
printf("%s\n", $message);
}
-sub log_result ($$) {
+sub log_result($$) {
our $filtered_request;
log_message($message) if (!$result or cli_option_is_set('verbose'));
}
-sub quote ($) {
+sub quote($) {
my $s = shift;
return '\'' . $s . '\'';
}
-sub print_version () {
+sub print_version() {
printf PRT_VERSION . "\n";
}
-sub list_test_types () {
+sub list_test_types() {
my %test_types = (
'Client header test' => CLIENT_HEADER_TEST,
'Server header test' => 2,
}
}
-sub help () {
+sub help() {
our %cli_options;
exit(0);
}
-sub init_cli_options () {
+sub init_cli_options() {
our %cli_options;
our $log_level;
$cli_options{'retries'} = CLI_RETRIES;
}
-sub parse_cli_options () {
+sub parse_cli_options() {
our %cli_options;
our $log_level;
$log_level |= $cli_options{'debug'};
}
-sub cli_option_is_set ($) {
+sub cli_option_is_set($) {
our %cli_options;
my $cli_option = shift;
return defined $cli_options{$cli_option};
}
-sub get_cli_option ($) {
+sub get_cli_option($) {
our %cli_options;
my $cli_option = shift;
}
}
-sub main () {
+sub main() {
init_our_variables();
parse_cli_options();
To skip a test, add the following line:
-# Ignore = Yes
+ # Ignore = Yes
The difference between a skipped test and a removed one is that removing
a test affects the numbers of the following tests, while a skipped test
Overwrite conditions are an alternative and can be added in any action
file as long as the come after the test that is expected to fail.
-They causes all previous tests a matching the condition to be skipped.
+They cause all previous tests that match the condition to be skipped.
It is recommended to put the overwrite condition below the custom Privoxy
section that causes the expected test failure and before the custom test
that verifies that tests the now expected behaviour. Example:
-# The following section is expected to overwrite a section in
-# default.action, whose effect is tested. Thus also disable the
-# test that is now expected to fail and add a new one.
-#
-{+block{Facebook makes Firefox even more unstable. Do not want.}}
-# Overwrite condition = http://apps.facebook.com/onthefarm/track.php?creative=&cat=friendvisit&subcat=weeds&key=a789a971dc687bee4c20c044834fabdd&next=index.php%3Fref%3Dnotif%26visitId%3D898835505
-# Blocked URL = http://apps.facebook.com/
-.facebook./
+ # The following section is expected to overwrite a section in
+ # default.action, whose effect is being tested. Thus also disable
+ # the test that is now expected to fail and add a new one.
+ #
+ {+block{Facebook makes Firefox even more unstable. Do not want.}}
+ # Overwrite condition = http://apps.facebook.com/onthefarm/track.php?creative=&cat=friendvisit&subcat=weeds&key=a789a971dc687bee4c20c044834fabdd&next=index.php%3Fref%3Dnotif%26visitId%3D898835505
+ # Blocked URL = http://apps.facebook.com/
+ .facebook./
=head1 TEST LEVELS
projects / privoxy.git / blobdiff