projects / privoxy.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Consistently use quote() in execute_dumb_fetch_test().
[privoxy.git] / tools / privoxy-regression-test.pl
diff --git a/tools/privoxy-regression-test.pl b/tools/privoxy-regression-test.pl
index cdb2b09..da849e6 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.186 2009/06/14 14:29:25 fk Exp $
+# $Id: privoxy-regression-test.pl,v 1.72 2011/06/29 18:34:23 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.4',
  
     CURL => 'curl',
 
  
     CURL => 'curl',
 
@@ -83,19 +83,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 () {
@@ -202,7 +199,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 +217,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 +243,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 +304,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);
 
@@ -326,7 +338,7 @@ sub load_action_files ($) {
 
     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 +367,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 +439,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 +460,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);
         }
     }
 
         }
     }
 
@@ -482,7 +504,7 @@ sub execute_regression_tests () {
         my $failures;
         my $skipped = 0;
 
         my $failures;
         my $skipped = 0;
 
-        for my $s (0 .. @regression_tests - 1) {
+        for (my $s = 0;  $s < @regression_tests; $s++) {
 
             my $r = 0;
 
 
             my $r = 0;
 
@@ -490,6 +512,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 +526,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);
 
@@ -565,11 +589,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 +625,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 +664,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 +741,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 .= quote('--request') . quote($test->{method}) . ' ';
     }
     if ($test->{type} == TRUSTED_CGI_REQUEST) {
     }
     if ($test->{type} == TRUSTED_CGI_REQUEST) {
-        $curl_parameters .= '--referer ' . PRIVOXY_CGI_URL . ' ';
+        $curl_parameters .= quote('--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 +819,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 +913,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 +923,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,13 +944,10 @@ sub check_header_result ($$) {
 
     } else {
 
 
     } else {
 
-        if (defined($header) and $header eq $expect_header) {
+        $success = (defined($header) and $header eq $expect_header);
 
 
-            $success = 1;
-
-        } else {
-
-            $header = "'No matching header'" unless defined $header; # XXX: No header detected to be precise
+        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 . "'");
         }
             l(LL_VERBOSE_FAILURE,
               "Ooops. Got: '" . $header . "' while expecting: '" . $expect_header . "'");
         }
@@ -962,7 +986,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'};
     }
@@ -1281,7 +1305,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) {
@@ -1366,6 +1390,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 +1412,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" . 'Copyright (C) 2007-2011 Fabian Keil <fk@fabiankeil.de>' . "\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 () {
@@ -1410,9 +1459,17 @@ Options and their default values if they have any:
     [--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);
 }
 
@@ -1443,7 +1500,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'},
@@ -1455,7 +1512,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'};
 }
 
@@ -1616,6 +1673,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 +1685,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
 
@@ -1683,7 +1751,7 @@ 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<--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.
The official Privoxy git repository