Include the Privoxy version in the output
[privoxy.git] / tools / privoxy-regression-test.pl
index 9fc4e99..60e9d69 100755 (executable)
@@ -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.187 2009/06/15 17:11:38 fk Exp $
+# $Id: privoxy-regression-test.pl,v 1.83 2013/01/06 18:14:17 fabiankeil Exp $
 #
 # Wish list:
 #
 #
 # Wish list:
 #
@@ -19,7 +19,7 @@
 # - Document magic Expect Header values
 # - Internal fuzz support?
 #
 # - Document magic Expect Header values
 # - Internal fuzz support?
 #
-# Copyright (c) 2007-2009 Fabian Keil <fk@fabiankeil.de>
+# Copyright (c) 2007-2011 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
 #
 # Permission to use, copy, modify, and distribute this software for any
 # purpose with or without fee is hereby granted, provided that the above
@@ -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.5',
  
     CURL => 'curl',
 
  
     CURL => 'curl',
 
@@ -52,6 +52,7 @@ use constant {
     # XXX: why limit at all?
     CLI_MAX_LEVEL => 100,
     CLI_FORKS     => 0,
     # XXX: why limit at all?
     CLI_MAX_LEVEL => 100,
     CLI_FORKS     => 0,
+    CLI_SLEEP_TIME => 0,
 
     PRIVOXY_CGI_URL  => 'http://p.p/',
     FELLATIO_URL     => 'http://127.0.0.1:8080/',
 
     PRIVOXY_CGI_URL  => 'http://p.p/',
     FELLATIO_URL     => 'http://127.0.0.1:8080/',
@@ -83,19 +84,16 @@ 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 () {
 
     our $leading_log_time = LEADING_LOG_TIME;
     our $leading_log_date = LEADING_LOG_DATE;
 };
 
 sub init_our_variables () {
 
     our $leading_log_time = LEADING_LOG_TIME;
     our $leading_log_date = LEADING_LOG_DATE;
-
     our $privoxy_cgi_url  = PRIVOXY_CGI_URL;
     our $privoxy_cgi_url  = PRIVOXY_CGI_URL;
-
     our $verbose_test_description = VERBOSE_TEST_DESCRIPTION;
     our $verbose_test_description = VERBOSE_TEST_DESCRIPTION;
-
     our $log_level = get_default_log_level();
     our $log_level = get_default_log_level();
-
 }
 
 sub get_default_log_level () {
 }
 
 sub get_default_log_level () {
@@ -149,7 +147,162 @@ sub check_for_forbidden_characters ($) {
     }
 }
 
     }
 }
 
-sub load_regressions_tests () {
+sub load_regression_tests() {
+    if (cli_option_is_set('local-test-file')) {
+        load_regression_tests_from_file(get_cli_option('local-test-file'));
+    } else {
+        load_regression_tests_through_privoxy();
+    }
+}
+
+# XXX: Contains a lot of code duplicated from load_action_files()
+#      that should be factored out.
+sub load_regression_tests_from_file ($) {
+    my $action_file = shift;
+
+    # initialized here
+    our %actions;
+    our @regression_tests;
+
+    my $si = 0;  # Section index
+    my $ri = -1; # Regression test index
+    my $count = 0;
+
+    my $ignored = 0;
+
+    my $sticky_actions = undef;
+
+    l(LL_STATUS, "Gathering regression tests from local file " . $action_file);
+
+    open(my $ACTION_FILE, "<", $action_file)
+        or log_and_die("Failed to open $action_file: $!");
+
+    while (<$ACTION_FILE>) {
+
+        my $no_checks = 0;
+        chomp;
+        my ($token, $value) = tokenize($_);
+
+        next unless defined $token;
+
+        # Load regression tests
+
+        if (token_starts_new_test($token)) {
+
+            # Beginning of new regression test.
+            $ri++;
+            $count++;
+            enlist_new_test(\@regression_tests, $token, $value, $si, $ri, $count);
+            $no_checks = 1; # Already validated by enlist_new_test().
+        }
+
+        if ($token =~ /level\s+(\d+)/i) {
+
+            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/) {
+                log_and_die("'Sticky Actions' with whitespace inside the " .
+                            "action parameters are currently unsupported.");
+            }
+        }
+
+        if ($si == -1 || $ri == -1) {
+            # No beginning of a test detected yet,
+            # so we don't care about any other test
+            # attributes.
+            next;
+        }
+
+        if ($token eq 'expect header') {
+
+            l(LL_FILE_LOADING, "Detected expectation: " . $value);
+            $regression_tests[$si][$ri]{'expect-header'} = $value;
+
+        } elsif ($token eq 'tag') {
+
+            next if ($ri == -1);
+
+            my $tag = parse_tag($value);
+
+            # We already checked in parse_tag() after filtering
+            $no_checks = 1;
+
+            l(LL_FILE_LOADING, "Detected TAG: " . $tag);
+
+            # Save tag for all tests in this section
+            do {
+                $regression_tests[$si][$ri]{'tag'} = $tag;
+            } while ($ri-- > 0);
+
+            $si++;
+            $ri = -1;
+
+        } elsif ($token eq 'ignore' && $value =~ /Yes/i) {
+
+            l(LL_FILE_LOADING, "Ignoring section: " . test_content_as_string($regression_tests[$si][$ri]));
+            $regression_tests[$si][$ri]{'ignore'} = 1;
+            $ignored++;
+
+        } elsif ($token eq 'expect status code') {
+
+            l(LL_FILE_LOADING, "Expecting status code: " . $value);
+            $regression_tests[$si][$ri]{'expected-status-code'} = $value;
+
+        } elsif ($token eq 'level') { # XXX: stupid name
+
+            $value =~ s@(\d+).*@$1@;
+            l(LL_FILE_LOADING, "Level: " . $value);
+            $regression_tests[$si][$ri]{'level'} = $value;
+
+        } elsif ($token eq 'method') {
+
+            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) {
+                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 {
+                log_and_die("Sticky URL without Sticky Actions: $value");
+            }
+
+        } else {
+
+            # We don't use it, so we don't need
+            $no_checks = 1;
+            l(LL_STATUS, "Enabling no_checks for $token") unless $no_checks;
+        }
+
+        # XXX: Necessary?
+        unless ($no_checks)  {
+            check_for_forbidden_characters($value);
+            check_for_forbidden_characters($token);
+        }
+    }
+
+    l(LL_FILE_LOADING, "Done loading " . $count . " regression tests."
+      . " Of which " . $ignored. " will be ignored)\n");
+
+}
+
+
+sub load_regression_tests_through_privoxy () {
 
     our $privoxy_cgi_url;
     our @privoxy_config;
 
     our $privoxy_cgi_url;
     our @privoxy_config;
@@ -158,6 +311,7 @@ sub load_regressions_tests () {
     my $curl_url = '';
     my $file_number = 0;
     my $feature;
     my $curl_url = '';
     my $file_number = 0;
     my $feature;
+    my $privoxy_version = '(Unknown version!)';
 
     $curl_url .= $privoxy_cgi_url;
     $curl_url .= 'show-status';
 
     $curl_url .= $privoxy_cgi_url;
     $curl_url .= 'show-status';
@@ -189,10 +343,14 @@ sub load_regressions_tests () {
 
             $privoxy_features{$feature} = $1 if defined $feature;
             $feature = undef;
 
             $privoxy_features{$feature} = $1 if defined $feature;
             $feature = undef;
+
+        } elsif (m@This is <a href="http://www.privoxy.org/">Privoxy</a> (\d+\.\d+\.\d+) on@) {
+            $privoxy_version = $1;
         }
     }
 
         }
     }
 
-    l(LL_FILE_LOADING, "Recognized " . @actionfiles . " actions files");
+    l(LL_STATUS, "Gathering regression tests from " .
+      @actionfiles . " action file(s) delivered by Privoxy $privoxy_version.");
 
     load_action_files(\@actionfiles);
 }
 
     load_action_files(\@actionfiles);
 }
@@ -202,7 +360,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;
@@ -220,7 +378,7 @@ sub tokenize ($) {
     s@\s*$@@;
 
     # Reverse HTML-encoding
     s@\s*$@@;
 
     # Reverse HTML-encoding
-    # XXX: Seriously imcomplete. 
+    # XXX: Seriously incomplete.
     s@&quot;@"@g;
     s@&amp;@&@g;
 
     s@&quot;@"@g;
     s@&amp;@&@g;
 
@@ -246,45 +404,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 +465,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);
 
@@ -306,6 +479,8 @@ sub enlist_new_test ($$$$$$) {
       "Regression test " . $number . " (section:" . $si . "):");
 }
 
       "Regression test " . $number . " (section:" . $si . "):");
 }
 
+# XXX: Shares a lot of code with load_regression_tests_from_file()
+#      that should be factored out.
 sub load_action_files ($) {
 
     # initialized here
 sub load_action_files ($) {
 
     # initialized here
@@ -321,12 +496,9 @@ sub load_action_files ($) {
 
     my $ignored = 0;
 
 
     my $ignored = 0;
 
-    l(LL_STATUS, "Gathering regression tests from " .
-      @actionfiles . " action file(s) delivered by Privoxy.");
-
     for my $file_number (0 .. @actionfiles - 1) {
 
     for my $file_number (0 .. @actionfiles - 1) {
 
-        my $curl_url = ' "' . $actionfiles[$file_number] . '"';
+        my $curl_url = quote($actionfiles[$file_number]);
         my $actionfile = undef;
         my $sticky_actions = undef;
 
         my $actionfile = undef;
         my $sticky_actions = undef;
 
@@ -355,6 +527,7 @@ sub load_action_files ($) {
                 $ri++;
                 $count++;
                 enlist_new_test(\@regression_tests, $token, $value, $si, $ri, $count);
                 $ri++;
                 $count++;
                 enlist_new_test(\@regression_tests, $token, $value, $si, $ri, $count);
+                $no_checks = 1; # Already validated by enlist_new_test().
             }
 
             if ($token =~ /level\s+(\d+)/i) {
             }
 
             if ($token =~ /level\s+(\d+)/i) {
@@ -426,6 +599,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) {
@@ -442,10 +620,14 @@ sub load_action_files ($) {
 
                 # We don't use it, so we don't need
                 $no_checks = 1;
 
                 # We don't use it, so we don't need
                 $no_checks = 1;
+                l(LL_STATUS, "Enabling no_checks for $token") unless $no_checks;
+            }
+
+            # XXX: Necessary?
+            unless ($no_checks)  {
+                check_for_forbidden_characters($value);
+                check_for_forbidden_characters($token);
             }
             }
-            # XXX: Neccessary?
-            check_for_forbidden_characters($value) unless $no_checks;
-            check_for_forbidden_characters($token);
         }
     }
 
         }
     }
 
@@ -459,6 +641,16 @@ sub load_action_files ($) {
 #
 ############################################################################
 
 #
 ############################################################################
 
+# Fisher Yates shuffle from Perl's "How do I shuffle an array randomly?" FAQ
+sub fisher_yates_shuffle ($) {
+    my $deck = shift;
+    my $i = @$deck;
+    while ($i--) {
+        my $j = int rand($i+1);
+        @$deck[$i,$j] = @$deck[$j,$i];
+    }
+}
+
 sub execute_regression_tests () {
 
     our @regression_tests;
 sub execute_regression_tests () {
 
     our @regression_tests;
@@ -482,14 +674,32 @@ sub execute_regression_tests () {
         my $failures;
         my $skipped = 0;
 
         my $failures;
         my $skipped = 0;
 
-        for my $s (0 .. @regression_tests - 1) {
+        if (cli_option_is_set('shuffle-tests')) {
+
+            # Shuffle both the test sections and
+            # the tests they contain.
+            #
+            # XXX: With the current data layout, shuffling tests
+            #      from different sections isn't possible.
+            #      Is this worth changing the layout?
+            fisher_yates_shuffle(\@regression_tests);
+            for (my $s = 0;  $s < @regression_tests; $s++) {
+                fisher_yates_shuffle($regression_tests[$s]);
+            }
+        }
+
+        for (my $s = 0;  $s < @regression_tests; $s++) {
 
             my $r = 0;
 
             while (defined $regression_tests[$s][$r]) {
 
 
             my $r = 0;
 
             while (defined $regression_tests[$s][$r]) {
 
-                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'});
+                unless (cli_option_is_set('shuffle-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 "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,12 +712,13 @@ 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);
 
                     $successes += $result;
                     $tests++;
 
                     log_result($regression_tests[$s][$r], $result, $tests);
 
                     $successes += $result;
                     $tests++;
+                    sleep(get_cli_option('sleep-time')) if (cli_option_is_set('sleep-time'));
                 }
                 $r++;
             }
                 }
                 $r++;
             }
@@ -565,11 +776,11 @@ sub level_is_unacceptable ($) {
 
     } elsif ($level < $min_level) {
 
 
     } elsif ($level < $min_level) {
 
-        $reason = "Level to low (" . $level . " < " . $min_level . ")";
+        $reason = "Level too low (" . $level . " < " . $min_level . ")";
 
     } elsif ($level > $max_level) {
 
 
     } elsif ($level > $max_level) {
 
-        $reason = "Level to high (" . $level . " > " . $max_level . ")";
+        $reason = "Level too high (" . $level . " > " . $max_level . ")";
 
     } else {
 
 
     } else {
 
@@ -601,7 +812,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 +851,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 actually 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 ($) {
@@ -708,13 +928,13 @@ sub execute_dumb_fetch_test ($) {
     my $expected_status_code = $test->{'expected-status-code'};
 
     if (defined $test->{method}) {
     my $expected_status_code = $test->{'expected-status-code'};
 
     if (defined $test->{method}) {
-        $curl_parameters .= '--request ' . $test->{method} . ' ';
+        $curl_parameters .= '--request ' . quote($test->{method}) . ' ';
     }
     if ($test->{type} == TRUSTED_CGI_REQUEST) {
     }
     if ($test->{type} == TRUSTED_CGI_REQUEST) {
-        $curl_parameters .= '--referer ' . PRIVOXY_CGI_URL . ' ';
+        $curl_parameters .= '--referer ' . quote(PRIVOXY_CGI_URL) . ' ';
     }
 
     }
 
-    $curl_parameters .= $test->{'data'};
+    $curl_parameters .= quote($test->{'data'});
 
     $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);
@@ -786,7 +1006,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;
             
@@ -877,12 +1100,9 @@ sub check_header_result ($$) {
 
     if ($expect_header eq 'NO CHANGE') {
 
 
     if ($expect_header eq 'NO CHANGE') {
 
-        if (defined($header) and $header eq $test->{'data'}) {
-
-            $success = 1;
-
-        } else {
+        $success = (defined($header) and $header eq $test->{'data'});
 
 
+        unless ($success) {
             $header = "REMOVAL" unless defined $header;
             l(LL_VERBOSE_FAILURE,
               "Ooops. Got: '" . $header . "' while expecting: '" . $expect_header . "'");
             $header = "REMOVAL" unless defined $header;
             l(LL_VERBOSE_FAILURE,
               "Ooops. Got: '" . $header . "' while expecting: '" . $expect_header . "'");
@@ -890,26 +1110,20 @@ sub check_header_result ($$) {
 
     } elsif ($expect_header eq 'REMOVAL') {
 
 
     } elsif ($expect_header eq 'REMOVAL') {
 
-        if (defined($header) and $header eq $test->{'data'}) {
+        # XXX: Use more reliable check here and make sure
+        # the header has a different name.
+        $success = not (defined($header) and $header eq $test->{'data'});
 
 
+        unless ($success) {
             l(LL_VERBOSE_FAILURE,
               "Ooops. Expected removal but: '" . $header . "' is still there.");
             l(LL_VERBOSE_FAILURE,
               "Ooops. Expected removal but: '" . $header . "' is still there.");
-
-        } else {
-
-            # XXX: Use more reliable check here and make sure
-            # the header has a different name.
-            $success = 1;
         }
 
     } elsif ($expect_header eq 'SOME CHANGE') {
 
         }
 
     } elsif ($expect_header eq 'SOME CHANGE') {
 
-        if (defined($header) and not $header eq $test->{'data'}) {
-
-            $success = 1;
-
-        } else {
+        $success = (defined($header) and $header ne $test->{'data'});
 
 
+        unless  ($success) {
             $header = "REMOVAL" unless defined $header;
             l(LL_VERBOSE_FAILURE,
               "Ooops. Got: '" . $header . "' while expecting: SOME CHANGE");
             $header = "REMOVAL" unless defined $header;
             l(LL_VERBOSE_FAILURE,
               "Ooops. Got: '" . $header . "' while expecting: SOME CHANGE");
@@ -917,12 +1131,9 @@ sub check_header_result ($$) {
 
     } else {
 
 
     } else {
 
-        if (defined($header) and $header eq $expect_header) {
-
-            $success = 1;
-
-        } else {
+        $success = (defined($header) and $header eq $expect_header);
 
 
+        unless ($success) {
             $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 . "'");
             $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 . "'");
@@ -962,7 +1173,7 @@ sub get_header ($$) {
 
     if ($expect_header eq 'REMOVAL'
      or $expect_header eq 'NO CHANGE'
 
     if ($expect_header eq 'REMOVAL'
      or $expect_header eq 'NO CHANGE'
-     or  $expect_header eq 'SOME CHANGE') {
+     or $expect_header eq 'SOME CHANGE') {
 
         $expect_header = $test->{'data'};
     }
 
         $expect_header = $test->{'data'};
     }
@@ -1184,8 +1395,9 @@ sub get_page_with_curl ($) {
     my $retries_left = get_cli_option('retries') + 1;
     my $failure_reason;
 
     my $retries_left = get_cli_option('retries') + 1;
     my $failure_reason;
 
-    $curl_line .= ' --proxy ' . $proxy if (defined $proxy);
-
+    if (defined $proxy) {
+        $curl_line .= ' --proxy ' . quote($proxy);
+    }
     # We want to see the HTTP status code
     $curl_line .= " --include ";
     # Let Privoxy emit two log messages less.
     # We want to see the HTTP status code
     $curl_line .= " --include ";
     # Let Privoxy emit two log messages less.
@@ -1281,7 +1493,7 @@ sub log_message ($) {
         if ($leading_log_date) {
             $year += 1900;
             $mon  += 1;
         if ($leading_log_date) {
             $year += 1900;
             $mon  += 1;
-            $time_stamp = sprintf("%i/%.2i/%.2i", $year, $mon, $mday);
+            $time_stamp = sprintf("%i-%.2i-%.2i", $year, $mon, $mday);
         }
 
         if ($leading_log_time) {
         }
 
         if ($leading_log_time) {
@@ -1292,7 +1504,7 @@ sub log_message ($) {
         $message = $time_stamp . ": " . $message;
     }
 
         $message = $time_stamp . ": " . $message;
     }
 
-    printf(STDERR "%s\n", $message);
+    printf("%s\n", $message);
 }
 
 sub log_result ($$) {
 }
 
 sub log_result ($$) {
@@ -1366,6 +1578,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.";
@@ -1381,7 +1600,25 @@ sub quote ($) {
 }
 
 sub print_version () {
 }
 
 sub print_version () {
-    printf PRT_VERSION . "\n" . 'Copyright (C) 2007-2009 Fabian Keil <fk@fabiankeil.de>' . "\n";
+    printf PRT_VERSION . "\n";
+}
+
+sub list_test_types () {
+    my %test_types = (
+        'Client header test'  => CLIENT_HEADER_TEST,
+        'Server header test'  =>  2,
+        'Dumb fetch test'     =>  3,
+        'Method test'         =>  4,
+        'Sticky action test'  =>  5,
+        'Trusted CGI test'    =>  6,
+        'Block test'          =>  7,
+        'Redirect test'       => 108,
+    );
+
+    print "\nThe supported test types and their default levels are:\n";
+    foreach my $test_type (sort { $test_types{$a} <=> $test_types{$b} } keys %test_types) {
+        printf "     %-20s -> %3.d\n", $test_type, $test_types{$test_type};
+    }
 }
 
 sub help () {
 }
 
 sub help () {
@@ -1400,6 +1637,7 @@ Options and their default values if they have any:
     [--help]
     [--header-fuzzing]
     [--level]
     [--help]
     [--header-fuzzing]
     [--level]
+    [--local-test-file]
     [--loops $cli_options{'loops'}]
     [--max-level $cli_options{'max-level'}]
     [--max-time $cli_options{'max-time'}]
     [--loops $cli_options{'loops'}]
     [--max-level $cli_options{'max-level'}]
     [--max-time $cli_options{'max-time'}]
@@ -1407,12 +1645,22 @@ Options and their default values if they have any:
     [--privoxy-address]
     [--retries $cli_options{'retries'}]
     [--show-skipped-tests]
     [--privoxy-address]
     [--retries $cli_options{'retries'}]
     [--show-skipped-tests]
+    [--shuffle-tests]
+    [--sleep-time $cli_options{'sleep-time'}]
     [--test-number]
     [--verbose]
     [--version]
     [--test-number]
     [--verbose]
     [--version]
-see "perldoc $0" for more information
     EOF
     ;
     EOF
     ;
+
+    list_test_types();
+
+    print << "    EOF"
+
+Try "perldoc $0" for more information
+    EOF
+    ;
+
     exit(0);
 }
 
     exit(0);
 }
 
@@ -1427,6 +1675,7 @@ sub init_cli_options () {
     $cli_options{'max-level'} = CLI_MAX_LEVEL;
     $cli_options{'max-time'}  = CLI_MAX_TIME;
     $cli_options{'min-level'} = CLI_MIN_LEVEL;
     $cli_options{'max-level'} = CLI_MAX_LEVEL;
     $cli_options{'max-time'}  = CLI_MAX_TIME;
     $cli_options{'min-level'} = CLI_MIN_LEVEL;
+    $cli_options{'sleep-time'}= CLI_SLEEP_TIME;
     $cli_options{'retries'}   = CLI_RETRIES;
 }
 
     $cli_options{'retries'}   = CLI_RETRIES;
 }
 
@@ -1438,24 +1687,27 @@ sub parse_cli_options () {
     init_cli_options();
 
     GetOptions (
     init_cli_options();
 
     GetOptions (
-        'debug=s'            => \$cli_options{'debug'},
-        'forks=s'            => \$cli_options{'forks'},
+        'debug=i'            => \$cli_options{'debug'},
+        'forks=i'            => \$cli_options{'forks'},
         '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},
-        'level=s'            => \$cli_options{'level'},
-        'loops=s'            => \$cli_options{'loops'},
-        'max-level=s'        => \$cli_options{'max-level'},
-        'max-time=s'         => \$cli_options{'max-time'},
-        'min-level=s'        => \$cli_options{'min-level'},
+        'help'               => \&help,
+        'level=i'            => \$cli_options{'level'},
+        'local-test-file=s'  => \$cli_options{'local-test-file'},
+        'loops=i'            => \$cli_options{'loops'},
+        'max-level=i'        => \$cli_options{'max-level'},
+        'max-time=i'         => \$cli_options{'max-time'},
+        'min-level=i'        => \$cli_options{'min-level'},
         'privoxy-address=s'  => \$cli_options{'privoxy-address'},
         'privoxy-address=s'  => \$cli_options{'privoxy-address'},
-        'retries=s'          => \$cli_options{'retries'},
+        'retries=i'          => \$cli_options{'retries'},
+        'shuffle-tests'      => \$cli_options{'shuffle-tests'},
         'show-skipped-tests' => \$cli_options{'show-skipped-tests'},
         'show-skipped-tests' => \$cli_options{'show-skipped-tests'},
-        'test-number=s'      => \$cli_options{'test-number'},
+        'sleep-time=i'       => \$cli_options{'sleep-time'},
+        'test-number=i'      => \$cli_options{'test-number'},
         'verbose'            => \$cli_options{'verbose'},
         'version'            => sub {print_version && exit(0)}
         'verbose'            => \$cli_options{'verbose'},
         'version'            => sub {print_version && exit(0)}
-    );
+    ) or exit(1);
     $log_level |= $cli_options{'debug'};
 }
 
     $log_level |= $cli_options{'debug'};
 }
 
@@ -1513,7 +1765,7 @@ sub main () {
     init_our_variables();
     parse_cli_options();
     init_proxy_settings('vanilla-proxy');
     init_our_variables();
     parse_cli_options();
     init_proxy_settings('vanilla-proxy');
-    load_regressions_tests();
+    load_regression_tests();
     init_proxy_settings('fuzz-proxy');
     start_forks(get_cli_option('forks')) if cli_option_is_set('forks');
     execute_regression_tests();
     init_proxy_settings('fuzz-proxy');
     start_forks(get_cli_option('forks')) if cli_option_is_set('forks');
     execute_regression_tests();
@@ -1529,10 +1781,10 @@ B<privoxy-regression-test> - A regression test "framework" for Privoxy.
 
 B<privoxy-regression-test> [B<--debug bitmask>] [B<--forks> forks]
 [B<--fuzzer-feeding>] [B<--fuzzer-feeding>] [B<--help>] [B<--level level>]
 
 B<privoxy-regression-test> [B<--debug bitmask>] [B<--forks> forks]
 [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<--local-test-file testfile>] [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<--test-number test-number>]
 [B<--retries retries>] [B<--test-number test-number>]
-[B<--show-skipped-tests>] [B<--verbose>]
+[B<--show-skipped-tests>] [B<--sleep-time> seconds] [B<--verbose>]
 [B<--version>]
 
 =head1 DESCRIPTION
 [B<--version>]
 
 =head1 DESCRIPTION
@@ -1616,6 +1868,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
@@ -1623,9 +1880,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
 
@@ -1654,6 +1917,12 @@ headers in a way that should not affect the test result.
 
 B<--level level> Only execute tests with the specified B<level>. 
 
 
 B<--level level> Only execute tests with the specified B<level>. 
 
+B<--local-test-file test-file> Do not get the tests
+through Privoxy's web interface, but use a single local
+file. Not recommended for testing Privoxy, but can be useful
+to "misappropriate" Privoxy-Regression-Test to test other
+stuff, like webserver configurations.
+
 B<--loop count> Loop through the regression tests B<count> times. 
 Useful to feed a fuzzer, or when doing stress tests with
 several Privoxy-Regression-Test instances running at the same
 B<--loop count> Loop through the regression tests B<count> times. 
 Useful to feed a fuzzer, or when doing stress tests with
 several Privoxy-Regression-Test instances running at the same
@@ -1683,7 +1952,15 @@ number.
 
 B<--show-skipped-tests> Log skipped tests even if verbose mode is off.
 
 
 B<--show-skipped-tests> Log skipped tests even if verbose mode is off.
 
-B<--verbose> Log succesful tests as well. By default only
+B<--shuffle-tests> Shuffle test sections and their tests before
+executing them. When combined with B<--forks>, this can increase
+the chances of detecting race conditions. Of course some problems
+are easier to detect without this option.
+
+B<--sleep-time seconds> Wait B<seconds> between tests. Useful when
+debugging issues with systems that don't log with millisecond precision.
+
+B<--verbose> Log successful tests as well. By default only
 the failures are logged.
 
 B<--version> Print version and exit.
 the failures are logged.
 
 B<--version> Print version and exit.