In parse_http_url(), don't muck around with values
[privoxy.git] / tools / privoxy-regression-test.pl
index dc59755..9b57bea 100755 (executable)
@@ -7,7 +7,7 @@
 # A regression test "framework" for Privoxy. For documentation see:
 # perldoc privoxy-regression-test.pl
 #
-# $Id: privoxy-regression-test.pl,v 1.135 2008/03/26 10:58:46 fk Exp $
+# $Id: privoxy-regression-test.pl,v 1.145 2008/04/12 12:27:51 fk Exp $
 #
 # Wish list:
 #
@@ -237,61 +237,46 @@ sub tokenize ($) {
 sub enlist_new_test ($$$$$$) {
 
     my ($regression_tests, $token, $value, $si, $ri, $number) = @_;
+    my $type;
 
     if ($token eq 'set header') {
 
         l(LL_FILE_LOADING, "Header to set: " . $value);
-        ${$regression_tests}[$si][$ri]{'type'} = CLIENT_HEADER_TEST;
-        # Implicit default
-        $$regression_tests[$si][$ri]{'level'} = CLIENT_HEADER_TEST;
+        $type = CLIENT_HEADER_TEST;
 
     } elsif ($token eq 'request header') {
 
         l(LL_FILE_LOADING, "Header to request: " . $value);
-        $$regression_tests[$si][$ri]{'type'} = SERVER_HEADER_TEST;
-        # Implicit default
+        $type = SERVER_HEADER_TEST;
         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
-        $$regression_tests[$si][$ri]{'level'} = SERVER_HEADER_TEST;
 
     } elsif ($token eq 'trusted cgi request') {
 
         l(LL_FILE_LOADING, "CGI URL to test in a dumb way: " . $value);
-        $$regression_tests[$si][$ri]{'type'} = TRUSTED_CGI_REQUEST;
-        # Implicit default
+        $type = TRUSTED_CGI_REQUEST;
         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
-        $$regression_tests[$si][$ri]{'level'} = TRUSTED_CGI_REQUEST;
 
     } elsif ($token eq 'fetch test') {
 
         l(LL_FILE_LOADING, "URL to test in a dumb way: " . $value);
-        $$regression_tests[$si][$ri]{'type'} = DUMB_FETCH_TEST;
-        # Implicit default
+        $type = DUMB_FETCH_TEST;
         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
-        $$regression_tests[$si][$ri]{'level'} = DUMB_FETCH_TEST;
 
     } elsif ($token eq 'method test') {
 
         l(LL_FILE_LOADING, "Method to test: " . $value);
-        $$regression_tests[$si][$ri]{'type'} = METHOD_TEST;
-        # Implicit default
+        $type = METHOD_TEST;
         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
-        $$regression_tests[$si][$ri]{'level'} = METHOD_TEST;
 
     } elsif ($token eq 'blocked url') {
 
         l(LL_FILE_LOADING, "URL to block-test: " . $value);
-        $$regression_tests[$si][$ri]{'type'} = BLOCK_TEST;
-        # Implicit default
-        $$regression_tests[$si][$ri]{'expected-status-code'} = 403;
-        $$regression_tests[$si][$ri]{'level'} = BLOCK_TEST;
+        $type = BLOCK_TEST;
 
     } elsif ($token eq 'url') {
 
         l(LL_FILE_LOADING, "Sticky URL to test: " . $value);
-        $$regression_tests[$si][$ri]{'type'} = STICKY_ACTIONS_TEST;
-        # Implicit default
-        $$regression_tests[$si][$ri]{'level'} = STICKY_ACTIONS_TEST;
-        $$regression_tests[$si][$ri]{'url'} = ''; 
+        $type = STICKY_ACTIONS_TEST;
 
     } else {
 
@@ -299,6 +284,9 @@ sub enlist_new_test ($$$$$$) {
 
     }
 
+    $$regression_tests[$si][$ri]{'type'} = $type;
+    $$regression_tests[$si][$ri]{'level'} = $type;
+
     check_for_forbidden_characters($value);
 
     $$regression_tests[$si][$ri]{'data'} = $value;
@@ -338,7 +326,7 @@ sub load_action_files ($) {
 
             my $no_checks = 0;
             chomp;
-            
+
             if (/<h2>Contents of Actions File (.*?)</) {
                 $actionfile = $1;
                 next;
@@ -366,6 +354,17 @@ sub load_action_files ($) {
                 my $level = $1;
                 register_dependency($level, $value);
             }
+
+            if ($token eq 'sticky actions') {
+
+                # Will be used by each following Sticky URL.
+                $sticky_actions = $value;
+                if ($sticky_actions =~ /{[^}]*\s/) {
+                    l(LL_ERROR,
+                      "'Sticky Actions' with whitespace inside the " .
+                      "action parameters are currently unsupported.");
+                }
+            }
             
             if ($si == -1 || $ri == -1) {
                 # No beginning of a test detected yet,
@@ -420,24 +419,16 @@ sub load_action_files ($) {
                 l(LL_FILE_LOADING, "Method: " . $value);
                 $regression_tests[$si][$ri]{'method'} = $value;
 
-            } elsif ($token eq 'sticky actions') {
-
-                # Will be used by each following Sticky URL.
-                $sticky_actions = $value;
-                if ($sticky_actions =~ /{[^}]*\s/) {
-                    l(LL_ERROR,
-                      "'Sticky Actions' with whitespace inside the " .
-                      "action parameters are currently unsupported.");
-                }
-
             } elsif ($token eq 'url') {
 
                 if (defined $sticky_actions) {
-                    die "What" if defined ($regression_tests[$si][$ri]{'sticky-actions'});
+                    die "WTF? Attempted to overwrite Sticky Actions"
+                        if defined ($regression_tests[$si][$ri]{'sticky-actions'});
+
                     l(LL_FILE_LOADING, "Sticky actions: " . $sticky_actions);
                     $regression_tests[$si][$ri]{'sticky-actions'} = $sticky_actions;
                 } else {
-                    l(LL_FILE_LOADING, "Sticky URL without Sticky Actions");
+                    l(LL_ERROR, "Sticky URL without Sticky Actions: $value");
                 }
 
             } else {
@@ -625,7 +616,6 @@ sub execute_method_test ($) {
     my $test_ref = shift;
     my %test = %{$test_ref};
     my $buffer_ref;
-    my $result = 0;
     my $status_code;
     my $method = $test{'data'};
 
@@ -633,7 +623,7 @@ sub execute_method_test ($) {
     my $expected_status_code = $test{'expected-status-code'};
 
     $curl_parameters .= '--request ' . $method . ' ';
-    # Don't complain in case about the 'missing' body
+    # Don't complain about the 'missing' body
     $curl_parameters .= '--head ' if ($method =~ /^HEAD$/i);
 
     $curl_parameters .= PRIVOXY_CGI_URL;
@@ -641,9 +631,7 @@ sub execute_method_test ($) {
     $buffer_ref = get_page_with_curl($curl_parameters);
     $status_code = get_status_code($buffer_ref);
 
-    $result = check_status_code_result($status_code, $expected_status_code);
-
-    return $result;
+    return check_status_code_result($status_code, $expected_status_code);
 }
 
 sub execute_dumb_fetch_test ($) {
@@ -651,7 +639,6 @@ sub execute_dumb_fetch_test ($) {
     my $test_ref = shift;
     my %test = %{$test_ref};
     my $buffer_ref;
-    my $result = 0;
     my $status_code;
 
     my $curl_parameters = '';
@@ -669,9 +656,7 @@ sub execute_dumb_fetch_test ($) {
     $buffer_ref = get_page_with_curl($curl_parameters);
     $status_code = get_status_code($buffer_ref);
 
-    $result = check_status_code_result($status_code, $expected_status_code);
-
-    return $result;
+    return check_status_code_result($status_code, $expected_status_code);
 }
 
 sub execute_block_test ($) {
@@ -718,7 +703,7 @@ sub get_final_results ($) {
     my %final_results = ();
     my $final_results_reached = 0;
 
-    die "Unacceptable characterss in $url" if $url =~ m@[\\'"]@;
+    die "Unacceptable characters in $url" if $url =~ m@[\\'"]@;
     # XXX: should be URL-encoded properly
     $url =~ s@%@%25@g;
     $url =~ s@\s@%20@g;
@@ -726,7 +711,7 @@ sub get_final_results ($) {
     $url =~ s@:@%3A@g;
     $url =~ s@/@%2F@g;
 
-    $curl_parameters .= "'" . PRIVOXY_CGI_URL . 'show-url-info?url=' . $url . "'";
+    $curl_parameters .= quote(PRIVOXY_CGI_URL . 'show-url-info?url=' . $url);
 
     foreach (@{get_cgi_page_or_else($curl_parameters)}) {
 
@@ -741,10 +726,10 @@ sub get_final_results ($) {
             
             if (defined $parameter) {
                 # In case the caller needs to check
-                # the action and it's parameter
+                # the action and its parameter
                 $final_results{$action . $parameter} = 1;
             }
-            # In case the action doesn't have paramters
+            # In case the action doesn't have parameters
             # or the caller doesn't care for the parameter.
             $final_results{$action} = 1;
         }
@@ -785,14 +770,12 @@ sub execute_client_header_regression_test ($) {
     my $test_ref = shift;
     my $buffer_ref;
     my $header;
-    my $result = 0;
 
     $buffer_ref = get_show_request_with_curl($test_ref);
 
     $header = get_header($buffer_ref, $test_ref);
-    $result = check_header_result($test_ref, $header);
 
-    return $result;
+    return check_header_result($test_ref, $header);
 }
 
 sub execute_server_header_regression_test ($) {
@@ -800,14 +783,12 @@ sub execute_server_header_regression_test ($) {
     my $test_ref = shift;
     my $buffer_ref;
     my $header;
-    my $result = 0;
 
     $buffer_ref = get_head_with_curl($test_ref);
 
     $header = get_server_header($buffer_ref, $test_ref);
-    $result = check_header_result($test_ref, $header);
 
-    return $result;
+    return check_header_result($test_ref, $header);
 }
 
 
@@ -835,7 +816,7 @@ sub check_header_result ($$) {
 
         } else {
 
-            $header //= "REMOVAL";
+            $header = "REMOVAL" unless defined $header;
             l(LL_VERBOSE_FAILURE,
               "Ooops. Got: " . $header . " while expecting: " . $expect_header);
         }
@@ -863,7 +844,7 @@ sub check_header_result ($$) {
 
         } else {
 
-            $header //= "REMOVAL";
+            $header = "REMOVAL" unless defined $header;
             l(LL_VERBOSE_FAILURE,
               "Ooops. Got: " . $header . " while expecting: SOME CHANGE");
         }
@@ -877,7 +858,7 @@ sub check_header_result ($$) {
 
         } else {
 
-            $header //= "'No matching header'"; # XXX: No header detected to be precise
+            $header = "'No matching header'" unless defined $header; # XXX: No header detected to be precise
             l(LL_VERBOSE_FAILURE,
               "Ooops. Got: " . $header . " while expecting: " . $expect_header);
         }
@@ -906,6 +887,8 @@ sub get_header ($$) {
 
     my $expect_header = $test{'expect-header'};
 
+    die "get_header called with no expect header" unless defined $expect_header;
+
     my $line;
     my $processed_request_reached = 0;
     my $read_header = 0;
@@ -963,6 +946,10 @@ sub get_server_header ($$) {
     my $header;
     my $header_to_get;
 
+    # XXX: Should be caught before starting to test.
+    l(LL_ERROR, "No expect header for test " . $test{'number'})
+        unless defined $expect_header;
+
     if ($expect_header eq 'REMOVAL'
      or $expect_header eq 'NO CHANGE'
      or $expect_header eq 'SOME CHANGE') {