- Add the directives "Sticky Actions" and "URL" which allow
[privoxy.git] / tools / privoxy-regression-test.pl
index 4fc9096..dc59755 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.104 2008/01/21 18:23:49 fk Exp $
+# $Id: privoxy-regression-test.pl,v 1.135 2008/03/26 10:58:46 fk Exp $
 #
 # Wish list:
 #
@@ -45,9 +45,9 @@ use strict;
 use Getopt::Long;
 
 use constant {
-               PRT_VERSION                => 'Privoxy-Regression-Test 0.2',
+               PRT_VERSION => 'Privoxy-Regression-Test 0.2',
  
-              CURL                       => 'curl',
+              CURL => 'curl',
 
                # CLI option defaults
               CLI_RETRIES  => 1,
@@ -85,7 +85,9 @@ use constant {
                SERVER_HEADER_TEST         =>  2,
                DUMB_FETCH_TEST            =>  3,
                METHOD_TEST                =>  4,
+               STICKY_ACTIONS_TEST        =>  5,
                TRUSTED_CGI_REQUEST        =>  6,
+               BLOCK_TEST                 =>  7,
 };
 
 sub init_our_variables () {
@@ -143,7 +145,7 @@ sub parse_tag ($) {
 sub check_for_forbidden_characters ($) {
 
     my $tag = shift; # XXX: also used to check values though.
-    my $allowed = '[-=\dA-Za-z{}:.\/();\s,+@"_%\?&]';
+    my $allowed = '[-=\dA-Za-z~{}:.\/();\s,+@"_%\?&*^]';
 
     unless ($tag =~ m/^$allowed*$/) {
         my $forbidden = $tag;
@@ -156,8 +158,9 @@ sub check_for_forbidden_characters ($) {
 sub load_regressions_tests () {
 
     our $privoxy_cgi_url;
+    our @privoxy_config;
     my @actionfiles;
-    my $curl_url        = '';
+    my $curl_url = '';
     my $file_number = 0;
 
     $curl_url .= $privoxy_cgi_url;
@@ -167,10 +170,16 @@ sub load_regressions_tests () {
 
     foreach (@{get_cgi_page_or_else($curl_url)}) {
 
+        chomp;
         if (/<td>(.*?)<\/td><td class=\"buttons\"><a href=\"\/show-status\?file=actions&amp;index=(\d+)\">/) {
 
             my $url = $privoxy_cgi_url . 'show-status?file=actions&index=' . $2;
             $actionfiles[$file_number++] = $url;
+
+        } elsif (m@config\.html#.*\">([^<]*)</a>\s+(.*)<br>@) {
+
+            my $directive = $1 . " " . $2;
+            push (@privoxy_config, $directive);
         }
     }
 
@@ -182,8 +191,9 @@ sub load_regressions_tests () {
 sub token_starts_new_test ($) {
 
     my $token = shift;
-    my @new_test_directives =
-        ('set header', 'fetch test', 'trusted cgi request', 'request header', 'method test');
+    my @new_test_directives = ('set header', 'fetch test',
+         'trusted cgi request', 'request header', 'method test',
+         'blocked url', 'url');
 
     foreach my $new_test_directive (@new_test_directives) {
         return 1 if $new_test_directive eq $token;
@@ -203,14 +213,17 @@ sub tokenize ($) {
     # Reverse HTML-encoding
     # XXX: Seriously imcomplete. 
     s@&quot;@"@g;
+    s@&amp;@&@g;
 
     # Tokenize
-    if (/^\#\s*([^=]*?)\s*[=]\s*(.*?)\s*$/) {
+    if (/^\#\s*([^=:]*?)\s*[=]\s*(.+?)\s*$/) {
 
         $token = $1;
-        $token =~ tr/[A-Z]/[a-z]/;
         $value = $2;
 
+        $token =~ s@\s\s+@ @g;
+        $token =~ tr/[A-Z]/[a-z]/;
+
     } elsif (/^TAG\s*:(.*)$/) {
 
         $token = 'tag';
@@ -264,6 +277,22 @@ sub enlist_new_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;
+
+    } 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'} = ''; 
+
     } else {
 
         die "Incomplete '" . $token . "' support detected."; 
@@ -303,6 +332,7 @@ sub load_action_files ($) {
 
         my $curl_url = ' "' . $actionfiles[$file_number] . '"';
         my $actionfile = undef;
+        my $sticky_actions = undef;
 
         foreach (@{get_cgi_page_or_else($curl_url)}) {
 
@@ -330,6 +360,12 @@ sub load_action_files ($) {
                 $count++;
                 enlist_new_test(\@regression_tests, $token, $value, $si, $ri, $count);
             }
+
+            if ($token =~ /level\s+(\d+)/i) {
+
+                my $level = $1;
+                register_dependency($level, $value);
+            }
             
             if ($si == -1 || $ri == -1) {
                 # No beginning of a test detected yet,
@@ -383,7 +419,29 @@ 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'});
+                    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");
+                }
+
             } else {
+
                 # We don't use it, so we don't need
                 $no_checks = 1;
             }
@@ -467,7 +525,6 @@ sub execute_regression_tests () {
 
     }
 
-
     if (get_cli_option('loops') > 1) {
         log_message("Total: Executed " . $all_tests . " regression tests. " .
             $all_successes . " successes, " . $all_failures . " failures.");
@@ -479,6 +536,7 @@ sub level_is_unacceptable ($) {
     return ((cli_option_is_set('level') and get_cli_option('level') != $level)
             or ($level < get_cli_option('min-level'))
             or ($level > get_cli_option('max-level'))
+            or dependency_unsatisfied($level)
             );
 }
 
@@ -488,6 +546,38 @@ sub test_number_is_unacceptable ($) {
             and get_cli_option('test-number') != $test_number)
 }
 
+sub dependency_unsatisfied ($) {
+
+    my $level = shift;
+    our %dependencies;
+    our @privoxy_config;
+    my $dependency_problem = 0;
+
+    if (defined ($dependencies{$level}{'config line'})) {
+
+        my $dependency = $dependencies{$level}{'config line'};
+        $dependency_problem = 1;
+
+        foreach (@privoxy_config) {
+
+             $dependency_problem = 0 if (/$dependency/);
+        }
+    }
+
+    return $dependency_problem;
+}
+
+sub register_dependency ($$) {
+
+    my $level = shift;
+    my $dependency = shift;
+    our %dependencies;
+
+    if ($dependency =~ /config line\s+(.*)/) {
+
+       $dependencies{$level}{'config line'} = $1;
+    }
+}
 
 # XXX: somewhat misleading name
 sub execute_regression_test ($) {
@@ -513,13 +603,20 @@ sub execute_regression_test ($) {
 
         $result = execute_method_test($test_ref);
 
+    } elsif ($test{'type'} == BLOCK_TEST) {
+
+        $result = execute_block_test($test_ref);
+
+    } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
+
+        $result = execute_sticky_actions_test($test_ref);
+
     } else {
 
-        die "Unsuported test type detected: " . $test{'type'};
+        die "Unsupported test type detected: " . $test{'type'};
 
     }
 
-
     return $result;
 }
 
@@ -535,14 +632,9 @@ sub execute_method_test ($) {
     my $curl_parameters = '';
     my $expected_status_code = $test{'expected-status-code'};
 
-    if ($method =~ /HEAD/i) {
-
-        $curl_parameters .= '--head ';
-
-    } else {
-
-        $curl_parameters .= '-X ' . $method . ' ';
-    }
+    $curl_parameters .= '--request ' . $method . ' ';
+    # Don't complain in case about the 'missing' body
+    $curl_parameters .= '--head ' if ($method =~ /^HEAD$/i);
 
     $curl_parameters .= PRIVOXY_CGI_URL;
 
@@ -554,7 +646,6 @@ sub execute_method_test ($) {
     return $result;
 }
 
-
 sub execute_dumb_fetch_test ($) {
 
     my $test_ref = shift;
@@ -567,7 +658,7 @@ sub execute_dumb_fetch_test ($) {
     my $expected_status_code = $test{'expected-status-code'};
 
     if (defined $test{method}) {
-        $curl_parameters .= '-X ' . $test{method} . ' ';
+        $curl_parameters .= '--request ' . $test{method} . ' ';
     }
     if ($test{type} == TRUSTED_CGI_REQUEST) {
         $curl_parameters .= '--referer ' . PRIVOXY_CGI_URL . ' ';
@@ -583,6 +674,85 @@ sub execute_dumb_fetch_test ($) {
     return $result;
 }
 
+sub execute_block_test ($) {
+
+    my $test = shift;
+    my $url = $test->{'data'};
+    my $final_results = get_final_results($url);
+
+    return defined $final_results->{'+block'};
+}
+
+sub execute_sticky_actions_test ($) {
+
+    my $test = shift;
+    my $url = $test->{'data'};
+    my $verified_actions = 0;
+    # XXX: splitting currently doesn't work for actions whose parameters contain spaces.
+    my @sticky_actions = split(/\s+/, $test->{'sticky-actions'});
+    my $final_results = get_final_results($url);
+
+    foreach my $sticky_action (@sticky_actions) {
+        if (defined $final_results->{$sticky_action}) {
+            # Exact match
+            $verified_actions++;
+        }elsif ($sticky_action =~ /-.*\{/ and
+                not defined $final_results->{$sticky_action}) {
+            # Disabled multi actions aren't explicitly listed as
+            # disabled and thus have to be checked by verifying
+            # that they aren't enabled.
+            $verified_actions++;
+        } else {
+            l(LL_VERBOSE_FAILURE,
+              "Ooops. '$sticky_action' is not among the final results.");
+        }
+    }
+
+    return $verified_actions == @sticky_actions;
+}
+
+sub get_final_results ($) {
+
+    my $url = shift;
+    my $curl_parameters = '';
+    my %final_results = ();
+    my $final_results_reached = 0;
+
+    die "Unacceptable characterss in $url" if $url =~ m@[\\'"]@;
+    # XXX: should be URL-encoded properly
+    $url =~ s@%@%25@g;
+    $url =~ s@\s@%20@g;
+    $url =~ s@&@%26@g;
+    $url =~ s@:@%3A@g;
+    $url =~ s@/@%2F@g;
+
+    $curl_parameters .= "'" . PRIVOXY_CGI_URL . 'show-url-info?url=' . $url . "'";
+
+    foreach (@{get_cgi_page_or_else($curl_parameters)}) {
+
+        $final_results_reached = 1 if (m@<h2>Final results:</h2>@);
+
+        next unless ($final_results_reached);
+        last if (m@</td>@);
+
+        if (m@<br>([-+])<a.*>([^>]*)</a>(?: (\{.*\}))?@) {
+            my $action = $1.$2;
+            my $parameter = $3;
+            
+            if (defined $parameter) {
+                # In case the caller needs to check
+                # the action and it's parameter
+                $final_results{$action . $parameter} = 1;
+            }
+            # In case the action doesn't have paramters
+            # or the caller doesn't care for the parameter.
+            $final_results{$action} = 1;
+        }
+    }
+
+    return \%final_results;
+}
+
 sub check_status_code_result ($$) {
 
     my $status_code = shift;
@@ -715,7 +885,6 @@ sub check_header_result ($$) {
     return $success;
 }
 
-
 sub get_header_name ($) {
 
     my $header = shift;
@@ -796,7 +965,7 @@ sub get_server_header ($$) {
 
     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'};
 
@@ -806,7 +975,7 @@ sub get_server_header ($$) {
 
     foreach (@buffer) {
 
-        # XXX: shoul probably verify that the request
+        # XXX: should probably verify that the request
         # was actually answered by Fellatio.
         if (/^$header_to_get/) {
             $header = $_;
@@ -818,53 +987,6 @@ sub get_server_header ($$) {
     return $header;
 }
 
-sub get_header_to_check ($) {
-
-    # No longer in use but not removed yet.
-
-    my $buffer_ref = shift;
-    my $header;
-    my @buffer = @{$buffer_ref}; 
-    my $line;
-    my $processed_request_reached = 0;
-    my $read_header = 0;
-    my $processed_request = '';
-
-    l(LL_ERROR, "You are not supposed to use get_header_to_()!");
-
-    foreach (@buffer) {
-
-        # Skip everything before the Processed request
-        if (/Processed Request/) {
-            $processed_request_reached = 1;
-            next;
-        }
-        next unless $processed_request_reached;
-
-        # End loop after the Processed request
-        last if (/<\/pre>/);
-
-        # Ditch tags and leading/trailing white space.
-        s@^\s*<.*?>@@g;
-        s@\s*$@@g;
-
-        $processed_request .= $_;
-         
-        if (/^X-Privoxy-Regression-Test/) {
-            $read_header = 1;
-            next;
-        }
-
-        if ($read_header) {
-            $header = $_;
-            $read_header = 0;
-        }
-
-    }
-
-    return $header;
-}
-
 sub get_status_code ($) {
 
     my $buffer_ref = shift;
@@ -898,7 +1020,6 @@ sub test_content_as_string ($) {
     my $s = "\n\t";
 
     foreach my $key (get_test_keys()) {
-        #$test{$key} = $test{$key} // 'undefined';
         $test{$key} = 'Not set' unless (defined $test{$key});
     }
 
@@ -1005,6 +1126,8 @@ sub get_page_with_curl ($) {
         $curl_line .= ' --proxy ' . get_cli_option('privoxy-address');
     }
 
+    # We want to see the HTTP status code
+    $curl_line .= " --include ";
     # Let Privoxy emit two log messages less.
     $curl_line .= ' -H \'Proxy-Connection:\' ' unless $parameters =~ /Proxy-Connection:/;
     $curl_line .= ' -H \'Connection: close\' ' unless $parameters =~ /Connection:/;
@@ -1012,8 +1135,6 @@ sub get_page_with_curl ($) {
     $curl_line .= " -s ";
     # We do care about the failure reason if any.
     $curl_line .= " -S ";
-    # We want to see the HTTP status code
-    $curl_line .= " --include ";
     # We want to advertise ourselves
     $curl_line .= " --user-agent '" . PRT_VERSION . "' ";
     # We aren't too patient
@@ -1180,6 +1301,18 @@ sub log_result ($$) {
             $message .= ' and expected status code ';
             $message .= quote($test{'expected-status-code'});
 
+        } elsif ($test{'type'} == BLOCK_TEST) {
+
+            $message .= ' Supposedly-blocked URL: ';
+            $message .= quote($test{'data'});
+
+        } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
+
+            $message .= ' Sticky Actions: ';
+            $message .= quote($test{'sticky-actions'});
+            $message .= ' and URL: ';
+            $message .= quote($test{'data'});
+
         } else {
 
             die "Incomplete support for test type " . $test{'type'} .  " detected.";
@@ -1272,7 +1405,6 @@ sub cli_option_is_set ($) {
     return defined $cli_options{$cli_option};
 }
 
-
 sub get_cli_option ($) {
 
     our %cli_options;
@@ -1283,7 +1415,6 @@ sub get_cli_option ($) {
     return $cli_options{$cli_option};
 }
 
-
 sub main () {
 
     init_our_variables();
@@ -1310,18 +1441,20 @@ B<privoxy-regression-test> [B<--debug bitmask>] [B<--fuzzer-feeding>] [B<--help>
 
 Privoxy-Regression-Test is supposed to one day become
 a regression test suite for Privoxy. It's not quite there
-yet, however, and can currently only test client header
-actions and check the returned status code for requests
-to arbitrary URLs.
+yet, however, and can currently only test header actions,
+check the returned status code for requests to arbitrary
+URLs and verify which actions are applied to them.
 
 Client header actions are tested by requesting
-B<http://config.privoxy.org/show-request> and checking whether
+B<http://p.p/show-request> and checking whether
 or not Privoxy modified the original request as expected.
 
 The original request contains both the header the action-to-be-tested
 acts upon and an additional tagger-triggering header that enables
 the action to test.
 
+Applied actions are checked through B<http://p.p/show-url-info>.
+
 =head1 CONFIGURATION FILE SYNTAX
 
 Privoxy-Regression-Test's configuration is embedded in
@@ -1366,21 +1499,35 @@ for Valgrind or to verify that the templates are installed correctly.
 If you want to test CGI pages that require a trusted
 referer, you can use:
 
-    # Trusted CGI Request =  http://p.p/edit-actions
+    # Trusted CGI Request = http://p.p/edit-actions
 
 It works like ordinary fetch tests, but sets the referer
 header to a trusted value.
 
 If no explicit status code expectation is set, B<200> is used.
 
-Additionally all tests have test levels to let the user
+To verify that a URL is blocked, use:
+
+    # Blocked URL = http://www.example.com/blocked
+
+To verify that a specific set of actions is applied to an URL, use:
+
+    # Sticky Actions = +block{foo} +handle-as-empty-document -handle-as-image
+    # URL = http://www.example.org/my-first-url
+
+The sticky actions will be checked for all URLs below it
+until the next sticky actions directive.
+
+=head1 TEST LEVELS
+
+All tests have test levels to let the user
 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.
 
-Fetch tests default to level 6, tests for trusted
-CGI requests to level 3 and client-header-action tests
-to level 1.
+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.
 
 =head1 OPTIONS