Workaround for firefox hanging on blocked javascript pages

[privoxy.git] / tools / privoxy-regression-test.pl

diff --git a/tools/privoxy-regression-test.pl b/tools/privoxy-regression-test.pl
index 82a39d6..e75d2cc 100755 (executable)
--- a/tools/privoxy-regression-test.pl
+++ b/tools/privoxy-regression-test.pl
@@ -7,7 +7,7 @@
 # A regression test "framework" for Privoxy. For documentation see:
 # perldoc privoxy-regression-test.pl
 #
 # A regression test "framework" for Privoxy. For documentation see:
 # perldoc privoxy-regression-test.pl
 #

-# $Id: privoxy-regression-test.pl,v 1.183 2009/06/05 18:55:21 fk Exp $
+# $Id: privoxy-regression-test.pl,v 1.200 2010/01/03 13:46:38 fk Exp $

 #
 # Wish list:
 #
 #
 # Wish list:
 #


@@ -40,7 +40,7 @@ use strict;
 use Getopt::Long;
 
 use constant {
 use Getopt::Long;
 
 use constant {

-    PRT_VERSION => 'Privoxy-Regression-Test 0.3',
+    PRT_VERSION => 'Privoxy-Regression-Test 0.4',

  
     CURL => 'curl',
 
  
     CURL => 'curl',
 


@@ -83,6 +83,7 @@ use constant {
     STICKY_ACTIONS_TEST =>  5,
     TRUSTED_CGI_REQUEST =>  6,
     BLOCK_TEST          =>  7,
     STICKY_ACTIONS_TEST =>  5,
     TRUSTED_CGI_REQUEST =>  6,
     BLOCK_TEST          =>  7,

+    REDIRECT_TEST       =>108,

 };
 
 sub init_our_variables () {
 };
 
 sub init_our_variables () {


@@ -202,7 +203,7 @@ sub token_starts_new_test ($) {
     my $token = shift;
     my @new_test_directives = ('set header', 'fetch test',
          'trusted cgi request', 'request header', 'method test',
     my $token = shift;
     my @new_test_directives = ('set header', 'fetch test',
          'trusted cgi request', 'request header', 'method test',

-         'blocked url', 'url');
+         'blocked url', 'url', 'redirected url');

 
     foreach my $new_test_directive (@new_test_directives) {
         return 1 if $new_test_directive eq $token;
 
     foreach my $new_test_directive (@new_test_directives) {
         return 1 if $new_test_directive eq $token;


@@ -225,7 +226,7 @@ sub tokenize ($) {
     s@&@&@g;
 
     # Tokenize
     s@&@&@g;
 
     # Tokenize

-    if (/^\#\s*([^=:#]*?)\s*[=]\s*([^#]+)$/) {
+    if (/^\#\s*([^=:#]*?)\s*[=]\s*([^#]+)(?:#.*)?$/) {

 
         $token = $1;
         $value = $2;
 
         $token = $1;
         $value = $2;


@@ -246,45 +247,59 @@ sub enlist_new_test ($$$$$$) {
 
     my ($regression_tests, $token, $value, $si, $ri, $number) = @_;
     my $type;
 
     my ($regression_tests, $token, $value, $si, $ri, $number) = @_;
     my $type;

+    my $executor;

 
     if ($token eq 'set header') {
 
         l(LL_FILE_LOADING, "Header to set: " . $value);
         $type = CLIENT_HEADER_TEST;
 
     if ($token eq 'set header') {
 
         l(LL_FILE_LOADING, "Header to set: " . $value);
         $type = CLIENT_HEADER_TEST;

+        $executor = \&execute_client_header_regression_test;

 
     } elsif ($token eq 'request header') {
 
         l(LL_FILE_LOADING, "Header to request: " . $value);
         $type = SERVER_HEADER_TEST;
 
     } elsif ($token eq 'request header') {
 
         l(LL_FILE_LOADING, "Header to request: " . $value);
         $type = SERVER_HEADER_TEST;

+        $executor = \&execute_server_header_regression_test;

         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 
     } elsif ($token eq 'trusted cgi request') {
 
         l(LL_FILE_LOADING, "CGI URL to test in a dumb way: " . $value);
         $type = TRUSTED_CGI_REQUEST;
         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 
     } elsif ($token eq 'trusted cgi request') {
 
         l(LL_FILE_LOADING, "CGI URL to test in a dumb way: " . $value);
         $type = TRUSTED_CGI_REQUEST;

+        $executor = \&execute_dumb_fetch_test;

         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 
     } elsif ($token eq 'fetch test') {
 
         l(LL_FILE_LOADING, "URL to test in a dumb way: " . $value);
         $type = DUMB_FETCH_TEST;
         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 
     } elsif ($token eq 'fetch test') {
 
         l(LL_FILE_LOADING, "URL to test in a dumb way: " . $value);
         $type = DUMB_FETCH_TEST;

+        $executor = \&execute_dumb_fetch_test;

         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 
     } elsif ($token eq 'method test') {
 
         l(LL_FILE_LOADING, "Method to test: " . $value);
         $type = METHOD_TEST;
         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 
     } elsif ($token eq 'method test') {
 
         l(LL_FILE_LOADING, "Method to test: " . $value);
         $type = METHOD_TEST;

+        $executor = \&execute_method_test;

         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 
     } elsif ($token eq 'blocked url') {
 
         l(LL_FILE_LOADING, "URL to block-test: " . $value);
         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 
     } elsif ($token eq 'blocked url') {
 
         l(LL_FILE_LOADING, "URL to block-test: " . $value);

+        $executor = \&execute_block_test;

         $type = BLOCK_TEST;
 
     } elsif ($token eq 'url') {
 
         l(LL_FILE_LOADING, "Sticky URL to test: " . $value);
         $type = STICKY_ACTIONS_TEST;
         $type = BLOCK_TEST;
 
     } elsif ($token eq 'url') {
 
         l(LL_FILE_LOADING, "Sticky URL to test: " . $value);
         $type = STICKY_ACTIONS_TEST;

+        $executor = \&execute_sticky_actions_test;
+
+    } elsif ($token eq 'redirected url') {
+
+        l(LL_FILE_LOADING, "Redirected URL to test: " . $value);
+        $type = REDIRECT_TEST;
+        $executor = \&execute_redirect_test;

 
     } else {
 
 
     } else {
 


@@ -293,6 +308,7 @@ sub enlist_new_test ($$$$$$) {
 
     $$regression_tests[$si][$ri]{'type'} = $type;
     $$regression_tests[$si][$ri]{'level'} = $type;
 
     $$regression_tests[$si][$ri]{'type'} = $type;
     $$regression_tests[$si][$ri]{'level'} = $type;

+    $$regression_tests[$si][$ri]{'executor'} = $executor;

 
     check_for_forbidden_characters($value);
 
 
     check_for_forbidden_characters($value);
 


@@ -426,6 +442,11 @@ sub load_action_files ($) {
                 l(LL_FILE_LOADING, "Method: " . $value);
                 $regression_tests[$si][$ri]{'method'} = $value;
 
                 l(LL_FILE_LOADING, "Method: " . $value);
                 $regression_tests[$si][$ri]{'method'} = $value;
 

+            } elsif ($token eq 'redirect destination') {
+
+                l(LL_FILE_LOADING, "Redirect destination: " . $value);
+                $regression_tests[$si][$ri]{'redirect destination'} = $value;
+

             } elsif ($token eq 'url') {
 
                 if (defined $sticky_actions) {
             } elsif ($token eq 'url') {
 
                 if (defined $sticky_actions) {


@@ -490,6 +511,8 @@ sub execute_regression_tests () {
 
                 die "Section id mismatch" if ($s != $regression_tests[$s][$r]{'section-id'});
                 die "Regression test id mismatch" if ($r != $regression_tests[$s][$r]{'regression-test-id'});
 
                 die "Section id mismatch" if ($s != $regression_tests[$s][$r]{'section-id'});
                 die "Regression test id mismatch" if ($r != $regression_tests[$s][$r]{'regression-test-id'});

+                die "Internal error. Test executor missing."
+                    unless defined $regression_tests[$s][$r]{executor};

 
                 my $number = $regression_tests[$s][$r]{'number'};
                 my $skip_reason = get_skip_reason($regression_tests[$s][$r]);
 
                 my $number = $regression_tests[$s][$r]{'number'};
                 my $skip_reason = get_skip_reason($regression_tests[$s][$r]);


@@ -502,7 +525,7 @@ sub execute_regression_tests () {
 
                 } else {
 
 
                 } else {
 

-                    my $result = execute_regression_test($regression_tests[$s][$r]);
+                    my $result = $regression_tests[$s][$r]{executor}($regression_tests[$s][$r]);

 
                     log_result($regression_tests[$s][$r], $result, $tests);
 
 
                     log_result($regression_tests[$s][$r], $result, $tests);
 


@@ -601,7 +624,10 @@ sub dependency_unsatisfied ($) {
             }
         }
 
             }
         }
 

-    } elsif (defined ($dependencies{$level}{'feature status'})) {
+    }
+
+    if (defined ($dependencies{$level}{'feature status'})
+        and not defined $dependency_problem) {

 
         my $dependency = $dependencies{$level}{'feature status'};
         my ($feature, $status) = $dependency =~ /([^\s]*)\s+(Yes|No)/;
 
         my $dependency = $dependencies{$level}{'feature status'};
         my ($feature, $status) = $dependency =~ /([^\s]*)\s+(Yes|No)/;


@@ -637,65 +663,71 @@ sub register_dependency ($$) {
     }
 }
 
     }
 }
 

-# XXX: somewhat misleading name
-sub execute_regression_test ($) {
+sub execute_method_test ($) {

 
     my $test = shift;
 
     my $test = shift;

-    my $result = 0;
-
-    if ($test->{'type'} == CLIENT_HEADER_TEST) {
-
-        $result = execute_client_header_regression_test($test);
-
-    } elsif ($test->{'type'} == SERVER_HEADER_TEST) {
-
-        $result = execute_server_header_regression_test($test);
-
-    } elsif ($test->{'type'} == DUMB_FETCH_TEST
-          or $test->{'type'} == TRUSTED_CGI_REQUEST) {
-
-        $result = execute_dumb_fetch_test($test);
-
-    } elsif ($test->{'type'} == METHOD_TEST) {
-
-        $result = execute_method_test($test);
-
-    } elsif ($test->{'type'} == BLOCK_TEST) {
-
-        $result = execute_block_test($test);
+    my $buffer_ref;
+    my $status_code;
+    my $method = $test->{'data'};

 
 

-    } elsif ($test->{'type'} == STICKY_ACTIONS_TEST) {
+    my $curl_parameters = '';
+    my $expected_status_code = $test->{'expected-status-code'};

 
 

-        $result = execute_sticky_actions_test($test);
+    $curl_parameters .= '--request ' . $method . ' ';
+    # Don't complain about the 'missing' body
+    $curl_parameters .= '--head ' if ($method =~ /^HEAD$/i);

 
 

-    } else {
+    $curl_parameters .= PRIVOXY_CGI_URL;

 
 

-        die "Unsupported test type detected: " . $test->{'type'};
-    }
+    $buffer_ref = get_page_with_curl($curl_parameters);
+    $status_code = get_status_code($buffer_ref);

 
 

-    return $result;
+    return check_status_code_result($status_code, $expected_status_code);

 }
 
 }
 

-sub execute_method_test ($) {
+sub execute_redirect_test ($) {

 
     my $test = shift;
     my $buffer_ref;
     my $status_code;
 
     my $test = shift;
     my $buffer_ref;
     my $status_code;

-    my $method = $test->{'data'};

 
     my $curl_parameters = '';
 
     my $curl_parameters = '';

-    my $expected_status_code = $test->{'expected-status-code'};
+    my $url = $test->{'data'};
+    my $redirect_destination;
+    my $expected_redirect_destination = $test->{'redirect destination'};

 
 

-    $curl_parameters .= '--request ' . $method . ' ';
-    # Don't complain about the 'missing' body
-    $curl_parameters .= '--head ' if ($method =~ /^HEAD$/i);
+    # XXX: Check if a redirect actualy applies before doing the request.
+    #      otherwise the test may hit a real server in failure cases.

 
 

-    $curl_parameters .= PRIVOXY_CGI_URL;
+    $curl_parameters .= '--head ';
+
+    $curl_parameters .= quote($url);

 
     $buffer_ref = get_page_with_curl($curl_parameters);
     $status_code = get_status_code($buffer_ref);
 
 
     $buffer_ref = get_page_with_curl($curl_parameters);
     $status_code = get_status_code($buffer_ref);
 

-    return check_status_code_result($status_code, $expected_status_code);
+    if ($status_code ne "302") {
+        l(LL_VERBOSE_FAILURE,
+          "Ooops. Expected redirect to: '" . $expected_redirect_destination
+          . "' but got a response with status code: " . $status_code);
+        return 0;
+    }
+    foreach (@{$buffer_ref}) {
+        if (/^Location: (.*)\r\n/) {
+            $redirect_destination = $1;
+            last;
+        }
+    }
+
+    my $success = ($redirect_destination eq $expected_redirect_destination);
+
+    unless ($success) {
+        l(LL_VERBOSE_FAILURE,
+          "Ooops. Expected redirect to: '" . $expected_redirect_destination
+          . "' but the redirect leads to: '" . $redirect_destination. "'");
+    }
+
+    return $success;

 }
 
 sub execute_dumb_fetch_test ($) {
 }
 
 sub execute_dumb_fetch_test ($) {


@@ -786,7 +818,10 @@ sub get_final_results ($) {
         next unless ($final_results_reached);
         last if (m@</td>@);
 
         next unless ($final_results_reached);
         last if (m@</td>@);
 

-        if (m@<br>([-+])<a.*>([^>]*)</a>(?: (\{.*\}))?@) {
+        # Privoxy versions before 3.0.16 add a space
+        # between action name and parameters, therefore
+        # the " ?".
+        if (m@<br>([-+])<a.*>([^>]*)</a>(?: ?(\{.*\}))?@) {

             my $action = $1.$2;
             my $parameter = $3;
             
             my $action = $1.$2;
             my $parameter = $3;
             


@@ -923,7 +958,7 @@ sub check_header_result ($$) {
 
         } else {
 
 
         } else {
 

-            $header = "'No matching header'" unless defined $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 . "'");
         }
             l(LL_VERBOSE_FAILURE,
               "Ooops. Got: '" . $header . "' while expecting: '" . $expect_header . "'");
         }


@@ -1104,11 +1139,6 @@ sub fuzz_header($) {
 #
 ############################################################################
 
 #
 ############################################################################
 

-sub check_for_curl () {
-    my $curl = CURL;
-    log_and_die("No curl found.") unless (`which $curl`);
-}
-

 sub get_cgi_page_or_else ($) {
 
     my $cgi_url = shift;
 sub get_cgi_page_or_else ($) {
 
     my $cgi_url = shift;


@@ -1215,6 +1245,7 @@ sub get_page_with_curl ($) {
         @buffer = `$curl_line`;
 
         if ($?) {
         @buffer = `$curl_line`;
 
         if ($?) {

+            log_and_die("Executing '$curl_line' failed.") unless @buffer;

             $failure_reason = array_as_string(\@buffer);
             chomp $failure_reason;
             l(LL_SOFT_ERROR, "Fetch failure: '" . $failure_reason . $! ."'");
             $failure_reason = array_as_string(\@buffer);
             chomp $failure_reason;
             l(LL_SOFT_ERROR, "Fetch failure: '" . $failure_reason . $! ."'");


@@ -1370,6 +1401,13 @@ sub log_result ($$) {
             $message .= ' and URL: ';
             $message .= quote($test->{'data'});
 
             $message .= ' and URL: ';
             $message .= quote($test->{'data'});
 

+        } elsif ($test->{'type'} == REDIRECT_TEST) {
+
+            $message .= ' Redirected URL: ';
+            $message .= quote($test->{'data'});
+            $message .= ' and redirect destination: ';
+            $message .= quote($test->{'redirect destination'});
+

         } else {
 
             die "Incomplete support for test type " . $test->{'type'} .  " detected.";
         } else {
 
             die "Incomplete support for test type " . $test->{'type'} .  " detected.";


@@ -1447,7 +1485,7 @@ sub parse_cli_options () {
         'fuzzer-address=s'   => \$cli_options{'fuzzer-address'},
         'fuzzer-feeding'     => \$cli_options{'fuzzer-feeding'},
         'header-fuzzing'     => \$cli_options{'header-fuzzing'},
         'fuzzer-address=s'   => \$cli_options{'fuzzer-address'},
         'fuzzer-feeding'     => \$cli_options{'fuzzer-feeding'},
         'header-fuzzing'     => \$cli_options{'header-fuzzing'},

-        'help'               => sub {help},
+        'help'               => \&help,

         'level=s'            => \$cli_options{'level'},
         'loops=s'            => \$cli_options{'loops'},
         'max-level=s'        => \$cli_options{'max-level'},
         'level=s'            => \$cli_options{'level'},
         'loops=s'            => \$cli_options{'loops'},
         'max-level=s'        => \$cli_options{'max-level'},


@@ -1459,7 +1497,7 @@ sub parse_cli_options () {
         'test-number=s'      => \$cli_options{'test-number'},
         'verbose'            => \$cli_options{'verbose'},
         'version'            => sub {print_version && exit(0)}
         'test-number=s'      => \$cli_options{'test-number'},
         'verbose'            => \$cli_options{'verbose'},
         'version'            => sub {print_version && exit(0)}

-    );
+    ) or exit(1);

     $log_level |= $cli_options{'debug'};
 }
 
     $log_level |= $cli_options{'debug'};
 }
 


@@ -1516,7 +1554,6 @@ sub main () {
 
     init_our_variables();
     parse_cli_options();
 
     init_our_variables();
     parse_cli_options();

-    check_for_curl();

     init_proxy_settings('vanilla-proxy');
     load_regressions_tests();
     init_proxy_settings('fuzz-proxy');
     init_proxy_settings('vanilla-proxy');
     load_regressions_tests();
     init_proxy_settings('fuzz-proxy');


@@ -1621,6 +1658,11 @@ To verify that a specific set of actions is applied to an URL, use:
 The sticky actions will be checked for all URLs below it
 until the next sticky actions directive.
 
 The sticky actions will be checked for all URLs below it
 until the next sticky actions directive.
 

+To verify that requests for a URL get redirected, use:
+
+    # Redirected URL = http://www.example.com/redirect-me
+    # Redirect Destination = http://www.example.org/redirected
+

 =head1 TEST LEVELS
 
 All tests have test levels to let the user
 =head1 TEST LEVELS
 
 All tests have test levels to let the user


@@ -1628,9 +1670,15 @@ control which ones to execute (see I<OPTIONS> below).
 Test levels are either set with the B<Level> directive,
 or implicitly through the test type.
 
 Test levels are either set with the B<Level> directive,
 or implicitly through the test type.
 

-Block tests default to level 7, fetch tests to level 6,
-"Sticky Actions" tests default to level 5, tests for trusted CGI
-requests to level 3 and client-header-action tests to level 1.
+Redirect tests default to level 108, block tests to level 7,
+fetch tests to level 6, "Sticky Actions" tests default to
+level 5, tests for trusted CGI requests to level 3 and
+client-header-action tests to level 1.
+
+The current redirect test level is above the default
+max-level value as failed tests will result in outgoing
+connections. Use the B<--max-level> option to run them
+as well.

 
 =head1 OPTIONS
 
 
 =head1 OPTIONS