tools/privoxy-regression-test.pl

   1 #!/usr/bin/perl
   2
   3 ############################################################################
   4 #
   5 # Privoxy-Regression-Test
   6 #
   7 # A regression test "framework" for Privoxy. For documentation see:
   8 # perldoc privoxy-regression-test.pl
   9 #
  10 # $Id: privoxy-regression-test.pl,v 1.146 2008/05/02 10:16:37 fk Exp $
  11 #
  12 # Wish list:
  13 #
  14 # - Update documentation
  15 # - Validate HTTP times.
  16 # - Understand default.action.master comment syntax
  17 #   and verify that we actually block and unblock what
  18 #   the comments claim we do.
  19 # - Implement a HTTP_VERSION directive or allow to
  20 #   specify whole request lines.
  21 # - Support filter regression tests.
  22 # - Add option to fork regression tests and run them in parallel,
  23 #   possibly optional forever.
  24 # - Document magic Expect Header values
  25 # - Internal fuzz support?
  26 #
  27 # Copyright (c) 2007-2008 Fabian Keil <fk@fabiankeil.de>
  28 #
  29 # Permission to use, copy, modify, and distribute this software for any
  30 # purpose with or without fee is hereby granted, provided that the above
  31 # copyright notice and this permission notice appear in all copies.
  32 #
  33 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  34 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  35 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  36 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  37 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  38 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  39 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  40 #
  41 ############################################################################
  42
  43 use warnings;
  44 use strict;
  45 use Getopt::Long;
  46
  47 use constant {
  48                PRT_VERSION => 'Privoxy-Regression-Test 0.2',
  49
  50                CURL => 'curl',
  51
  52                # CLI option defaults
  53                CLI_RETRIES  => 1,
  54                CLI_LOOPS    => 1,
  55                CLI_MAX_TIME => 5,
  56                CLI_MIN_LEVEL => 0,
  57                CLI_MAX_LEVEL => 25,
  58
  59                PRIVOXY_CGI_URL => 'http://p.p/',
  60                FELLATIO_URL    => 'http://10.0.0.1:8080/',
  61                LEADING_LOG_DATE => 1,
  62                LEADING_LOG_TIME => 1,
  63
  64                DEBUG_LEVEL_FILE_LOADING    => 0,
  65                DEBUG_LEVEL_PAGE_FETCHING   => 0,
  66
  67                VERBOSE_TEST_DESCRIPTION    => 1,
  68
  69                DEBUG_LEVEL_VERBOSE_FAILURE => 1,
  70                # XXX: Only partly implemented and mostly useless.
  71                DEBUG_LEVEL_VERBOSE_SUCCESS => 0,
  72                DEBUG_LEVEL_STATUS          => 1,
  73
  74                # Internal use, don't modify
  75                # Available debug bits:
  76                LL_ERROR                   =>  1,
  77                LL_VERBOSE_FAILURE         =>  2,
  78                LL_PAGE_FETCHING           =>  4,
  79                LL_FILE_LOADING            =>  8,
  80                LL_VERBOSE_SUCCESS         => 16,
  81                LL_STATUS                  => 32,
  82                LL_SOFT_ERROR              => 64,
  83
  84                CLIENT_HEADER_TEST         =>  1,
  85                SERVER_HEADER_TEST         =>  2,
  86                DUMB_FETCH_TEST            =>  3,
  87                METHOD_TEST                =>  4,
  88                STICKY_ACTIONS_TEST        =>  5,
  89                TRUSTED_CGI_REQUEST        =>  6,
  90                BLOCK_TEST                 =>  7,
  91 };
  92
  93 sub init_our_variables () {
  94
  95     our $leading_log_time = LEADING_LOG_TIME;
  96     our $leading_log_date = LEADING_LOG_DATE;
  97
  98     our $privoxy_cgi_url  = PRIVOXY_CGI_URL;
  99
 100     our $verbose_test_description = VERBOSE_TEST_DESCRIPTION;
 101
 102     our $log_level = get_default_log_level();
 103
 104 }
 105
 106 sub get_default_log_level () {
 107
 108     my $log_level = 0;
 109
 110     $log_level |= LL_FILE_LOADING    if DEBUG_LEVEL_FILE_LOADING;
 111     $log_level |= LL_PAGE_FETCHING   if DEBUG_LEVEL_PAGE_FETCHING;
 112     $log_level |= LL_VERBOSE_FAILURE if DEBUG_LEVEL_VERBOSE_FAILURE;
 113     $log_level |= LL_VERBOSE_SUCCESS if DEBUG_LEVEL_VERBOSE_SUCCESS;
 114     $log_level |= LL_STATUS          if DEBUG_LEVEL_STATUS;
 115
 116     # These are intended to be always on.
 117     $log_level |= LL_SOFT_ERROR;
 118     $log_level |= LL_ERROR;
 119
 120     return $log_level;
 121 }
 122
 123 ############################################################################
 124 #
 125 # File loading functions
 126 #
 127 ############################################################################
 128
 129 sub parse_tag ($) {
 130
 131     my $tag = shift;
 132
 133     # Remove anchors
 134     $tag =~ s@[\$\^]@@g;
 135     # Unescape brackets and dots
 136     $tag =~ s@\\(?=[{}().+])@@g;
 137
 138     # log_message("Parsed tag: " . $tag);
 139
 140     check_for_forbidden_characters($tag);
 141
 142     return $tag;
 143 }
 144
 145 sub check_for_forbidden_characters ($) {
 146
 147     my $tag = shift; # XXX: also used to check values though.
 148     my $allowed = '[-=\dA-Za-z~{}:.\/();\s,+@"_%\?&*^]';
 149
 150     unless ($tag =~ m/^$allowed*$/) {
 151         my $forbidden = $tag;
 152         $forbidden =~ s@^$allowed*(.).*@$1@;
 153
 154         l(LL_ERROR, "'" . $tag . "' contains character '" . $forbidden. "' which is unacceptable.");
 155     }
 156 }
 157
 158 sub load_regressions_tests () {
 159
 160     our $privoxy_cgi_url;
 161     our @privoxy_config;
 162     my @actionfiles;
 163     my $curl_url = '';
 164     my $file_number = 0;
 165
 166     $curl_url .= $privoxy_cgi_url;
 167     $curl_url .= 'show-status';
 168
 169     l(LL_STATUS, "Asking Privoxy for the number of action files available ...");
 170
 171     foreach (@{get_cgi_page_or_else($curl_url)}) {
 172
 173         chomp;
 174         if (/<td>(.*?)<\/td><td class=\"buttons\"><a href=\"\/show-status\?file=actions&amp;index=(\d+)\">/) {
 175
 176             my $url = $privoxy_cgi_url . 'show-status?file=actions&index=' . $2;
 177             $actionfiles[$file_number++] = $url;
 178
 179         } elsif (m@config\.html#.*\">([^<]*)</a>\s+(.*)<br>@) {
 180
 181             my $directive = $1 . " " . $2;
 182             push (@privoxy_config, $directive);
 183         }
 184     }
 185
 186     l(LL_FILE_LOADING, "Recognized " . @actionfiles . " actions files");
 187
 188     load_action_files(\@actionfiles);
 189 }
 190
 191 sub token_starts_new_test ($) {
 192
 193     my $token = shift;
 194     my @new_test_directives = ('set header', 'fetch test',
 195          'trusted cgi request', 'request header', 'method test',
 196          'blocked url', 'url');
 197
 198     foreach my $new_test_directive (@new_test_directives) {
 199         return 1 if $new_test_directive eq $token;
 200     }
 201     return 0;
 202
 203 }
 204
 205 sub tokenize ($) {
 206
 207     my ($token, $value) = (undef, undef);
 208
 209     # Remove leading and trailing white space.
 210     s@^\s*@@;
 211     s@\s*$@@;
 212
 213     # Reverse HTML-encoding
 214     # XXX: Seriously imcomplete.
 215     s@&quot;@"@g;
 216     s@&amp;@&@g;
 217
 218     # Tokenize
 219     if (/^\#\s*([^=:]*?)\s*[=]\s*(.+?)\s*$/) {
 220
 221         $token = $1;
 222         $value = $2;
 223
 224         $token =~ s@\s\s+@ @g;
 225         $token =~ tr/[A-Z]/[a-z]/;
 226
 227     } elsif (/^TAG\s*:(.*)$/) {
 228
 229         $token = 'tag';
 230         $value = $1;
 231
 232     }
 233
 234     return ($token, $value);
 235 }
 236
 237 sub enlist_new_test ($$$$$$) {
 238
 239     my ($regression_tests, $token, $value, $si, $ri, $number) = @_;
 240     my $type;
 241
 242     if ($token eq 'set header') {
 243
 244         l(LL_FILE_LOADING, "Header to set: " . $value);
 245         $type = CLIENT_HEADER_TEST;
 246
 247     } elsif ($token eq 'request header') {
 248
 249         l(LL_FILE_LOADING, "Header to request: " . $value);
 250         $type = SERVER_HEADER_TEST;
 251         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 252
 253     } elsif ($token eq 'trusted cgi request') {
 254
 255         l(LL_FILE_LOADING, "CGI URL to test in a dumb way: " . $value);
 256         $type = TRUSTED_CGI_REQUEST;
 257         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 258
 259     } elsif ($token eq 'fetch test') {
 260
 261         l(LL_FILE_LOADING, "URL to test in a dumb way: " . $value);
 262         $type = DUMB_FETCH_TEST;
 263         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 264
 265     } elsif ($token eq 'method test') {
 266
 267         l(LL_FILE_LOADING, "Method to test: " . $value);
 268         $type = METHOD_TEST;
 269         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 270
 271     } elsif ($token eq 'blocked url') {
 272
 273         l(LL_FILE_LOADING, "URL to block-test: " . $value);
 274         $type = BLOCK_TEST;
 275
 276     } elsif ($token eq 'url') {
 277
 278         l(LL_FILE_LOADING, "Sticky URL to test: " . $value);
 279         $type = STICKY_ACTIONS_TEST;
 280
 281     } else {
 282
 283         die "Incomplete '" . $token . "' support detected.";
 284
 285     }
 286
 287     $$regression_tests[$si][$ri]{'type'} = $type;
 288     $$regression_tests[$si][$ri]{'level'} = $type;
 289
 290     check_for_forbidden_characters($value);
 291
 292     $$regression_tests[$si][$ri]{'data'} = $value;
 293
 294     # For function that only get passed single tests
 295     $$regression_tests[$si][$ri]{'section-id'} = $si;
 296     $$regression_tests[$si][$ri]{'regression-test-id'} = $ri;
 297     $$regression_tests[$si][$ri]{'number'} = $number - 1;
 298     l(LL_FILE_LOADING,
 299       "Regression test " . $number . " (section:" . $si . "):");
 300 }
 301
 302 sub load_action_files ($) {
 303
 304     # initialized here
 305     our %actions;
 306     our @regression_tests;
 307
 308     my $actionfiles_ref = shift;
 309     my @actionfiles = @{$actionfiles_ref};
 310
 311     my $si = 0;  # Section index
 312     my $ri = -1; # Regression test index
 313     my $count = 0;
 314
 315     my $ignored = 0;
 316
 317     l(LL_STATUS, "Loading regression tests from action file(s) delivered by Privoxy.");
 318
 319     for my $file_number (0 .. @actionfiles - 1) {
 320
 321         my $curl_url = ' "' . $actionfiles[$file_number] . '"';
 322         my $actionfile = undef;
 323         my $sticky_actions = undef;
 324
 325         foreach (@{get_cgi_page_or_else($curl_url)}) {
 326
 327             my $no_checks = 0;
 328             chomp;
 329
 330             if (/<h2>Contents of Actions File (.*?)</) {
 331                 $actionfile = $1;
 332                 next;
 333             }
 334             next unless defined $actionfile;
 335
 336             last if (/<\/pre>/);
 337
 338             my ($token, $value) = tokenize($_);
 339
 340             next unless defined $token;
 341
 342             # Load regression tests
 343
 344             if (token_starts_new_test($token)) {
 345
 346                 # Beginning of new regression test.
 347                 $ri++;
 348                 $count++;
 349                 enlist_new_test(\@regression_tests, $token, $value, $si, $ri, $count);
 350             }
 351
 352             if ($token =~ /level\s+(\d+)/i) {
 353
 354                 my $level = $1;
 355                 register_dependency($level, $value);
 356             }
 357
 358             if ($token eq 'sticky actions') {
 359
 360                 # Will be used by each following Sticky URL.
 361                 $sticky_actions = $value;
 362                 if ($sticky_actions =~ /{[^}]*\s/) {
 363                     l(LL_ERROR,
 364                       "'Sticky Actions' with whitespace inside the " .
 365                       "action parameters are currently unsupported.");
 366                 }
 367             }
 368
 369             if ($si == -1 || $ri == -1) {
 370                 # No beginning of a test detected yet,
 371                 # so we don't care about any other test
 372                 # attributes.
 373                 next;
 374             }
 375
 376             if ($token eq 'expect header') {
 377
 378                 l(LL_FILE_LOADING, "Detected expectation: " . $value);
 379                 $regression_tests[$si][$ri]{'expect-header'} = $value;
 380
 381             } elsif ($token eq 'tag') {
 382
 383                 next if ($ri == -1);
 384
 385                 my $tag = parse_tag($value);
 386
 387                 # We already checked in parse_tag() after filtering
 388                 $no_checks = 1;
 389
 390                 l(LL_FILE_LOADING, "Detected TAG: " . $tag);
 391
 392                 # Save tag for all tests in this section
 393                 do {
 394                     $regression_tests[$si][$ri]{'tag'} = $tag;
 395                 } while ($ri-- > 0);
 396
 397                 $si++;
 398                 $ri = -1;
 399
 400             } elsif ($token eq 'ignore' && $value =~ /Yes/i) {
 401
 402                 l(LL_FILE_LOADING, "Ignoring section: " . test_content_as_string($regression_tests[$si][$ri]));
 403                 $regression_tests[$si][$ri]{'ignore'} = 1;
 404                 $ignored++;
 405
 406             } elsif ($token eq 'expect status code') {
 407
 408                 l(LL_FILE_LOADING, "Expecting status code: " . $value);
 409                 $regression_tests[$si][$ri]{'expected-status-code'} = $value;
 410
 411             } elsif ($token eq 'level') { # XXX: stupid name
 412
 413                 $value =~ s@(\d+).*@$1@;
 414                 l(LL_FILE_LOADING, "Level: " . $value);
 415                 $regression_tests[$si][$ri]{'level'} = $value;
 416
 417             } elsif ($token eq 'method') {
 418
 419                 l(LL_FILE_LOADING, "Method: " . $value);
 420                 $regression_tests[$si][$ri]{'method'} = $value;
 421
 422             } elsif ($token eq 'url') {
 423
 424                 if (defined $sticky_actions) {
 425                     die "WTF? Attempted to overwrite Sticky Actions"
 426                         if defined ($regression_tests[$si][$ri]{'sticky-actions'});
 427
 428                     l(LL_FILE_LOADING, "Sticky actions: " . $sticky_actions);
 429                     $regression_tests[$si][$ri]{'sticky-actions'} = $sticky_actions;
 430                 } else {
 431                     l(LL_ERROR, "Sticky URL without Sticky Actions: $value");
 432                 }
 433
 434             } else {
 435
 436                 # We don't use it, so we don't need
 437                 $no_checks = 1;
 438             }
 439             # XXX: Neccessary?
 440             check_for_forbidden_characters($value) unless $no_checks;
 441             check_for_forbidden_characters($token);
 442         }
 443     }
 444
 445     l(LL_FILE_LOADING, "Done loading " . $count . " regression tests."
 446       . " Of which " . $ignored. " will be ignored)\n");
 447 }
 448
 449 ############################################################################
 450 #
 451 # Regression test executing functions
 452 #
 453 ############################################################################
 454
 455 sub execute_regression_tests () {
 456
 457     our @regression_tests;
 458     my $loops = get_cli_option('loops');
 459     my $all_tests    = 0;
 460     my $all_failures = 0;
 461     my $all_successes = 0;
 462
 463     unless (@regression_tests) {
 464
 465         l(LL_STATUS, "No regression tests found.");
 466         return;
 467     }
 468
 469     l(LL_STATUS, "Executing regression tests ...");
 470
 471     while ($loops-- > 0) {
 472
 473         my $successes = 0;
 474         my $tests = 0;
 475         my $failures;
 476         my $skipped = 0;
 477
 478         for my $s (0 .. @regression_tests - 1) {
 479
 480             my $r = 0;
 481
 482             while (defined $regression_tests[$s][$r]) {
 483
 484                 die "Section id mismatch" if ($s != $regression_tests[$s][$r]{'section-id'});
 485                 die "Regression test id mismatch" if ($r != $regression_tests[$s][$r]{'regression-test-id'});
 486
 487                 my $number = $regression_tests[$s][$r]{'number'};
 488
 489                 if ($regression_tests[$s][$r]{'ignore'}
 490                     or level_is_unacceptable($regression_tests[$s][$r]{'level'})
 491                     or test_number_is_unacceptable($number)) {
 492
 493                     $skipped++;
 494
 495                 } else {
 496
 497                     my $result = execute_regression_test($regression_tests[$s][$r]);
 498
 499                     log_result($regression_tests[$s][$r], $result, $tests);
 500
 501                     $successes += $result;
 502                     $tests++;
 503                 }
 504                 $r++;
 505             }
 506         }
 507         $failures = $tests - $successes;
 508
 509         log_message("Executed " . $tests . " regression tests. " .
 510             'Skipped ' . $skipped . '. ' .
 511             $successes . " successes, " . $failures . " failures.");
 512
 513         $all_tests    += $tests;
 514         $all_failures += $failures;
 515         $all_successes += $successes;
 516
 517     }
 518
 519     if (get_cli_option('loops') > 1) {
 520         log_message("Total: Executed " . $all_tests . " regression tests. " .
 521             $all_successes . " successes, " . $all_failures . " failures.");
 522     }
 523 }
 524
 525 sub level_is_unacceptable ($) {
 526     my $level = shift;
 527     return ((cli_option_is_set('level') and get_cli_option('level') != $level)
 528             or ($level < get_cli_option('min-level'))
 529             or ($level > get_cli_option('max-level'))
 530             or dependency_unsatisfied($level)
 531             );
 532 }
 533
 534 sub test_number_is_unacceptable ($) {
 535     my $test_number = shift;
 536     return (cli_option_is_set('test-number')
 537             and get_cli_option('test-number') != $test_number)
 538 }
 539
 540 sub dependency_unsatisfied ($) {
 541
 542     my $level = shift;
 543     our %dependencies;
 544     our @privoxy_config;
 545     my $dependency_problem = 0;
 546
 547     if (defined ($dependencies{$level}{'config line'})) {
 548
 549         my $dependency = $dependencies{$level}{'config line'};
 550         $dependency_problem = 1;
 551
 552         foreach (@privoxy_config) {
 553
 554              $dependency_problem = 0 if (/$dependency/);
 555         }
 556     }
 557
 558     return $dependency_problem;
 559 }
 560
 561 sub register_dependency ($$) {
 562
 563     my $level = shift;
 564     my $dependency = shift;
 565     our %dependencies;
 566
 567     if ($dependency =~ /config line\s+(.*)/) {
 568
 569        $dependencies{$level}{'config line'} = $1;
 570     }
 571 }
 572
 573 # XXX: somewhat misleading name
 574 sub execute_regression_test ($) {
 575
 576     my $test_ref = shift;
 577     my %test = %{$test_ref};
 578     my $result = 0;
 579
 580     if ($test{'type'} == CLIENT_HEADER_TEST) {
 581
 582         $result = execute_client_header_regression_test($test_ref);
 583
 584     } elsif ($test{'type'} == SERVER_HEADER_TEST) {
 585
 586         $result = execute_server_header_regression_test($test_ref);
 587
 588     } elsif ($test{'type'} == DUMB_FETCH_TEST
 589           or $test{'type'} == TRUSTED_CGI_REQUEST) {
 590
 591         $result = execute_dumb_fetch_test($test_ref);
 592
 593     } elsif ($test{'type'} == METHOD_TEST) {
 594
 595         $result = execute_method_test($test_ref);
 596
 597     } elsif ($test{'type'} == BLOCK_TEST) {
 598
 599         $result = execute_block_test($test_ref);
 600
 601     } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
 602
 603         $result = execute_sticky_actions_test($test_ref);
 604
 605     } else {
 606
 607         die "Unsupported test type detected: " . $test{'type'};
 608
 609     }
 610
 611     return $result;
 612 }
 613
 614 sub execute_method_test ($) {
 615
 616     my $test_ref = shift;
 617     my %test = %{$test_ref};
 618     my $buffer_ref;
 619     my $status_code;
 620     my $method = $test{'data'};
 621
 622     my $curl_parameters = '';
 623     my $expected_status_code = $test{'expected-status-code'};
 624
 625     $curl_parameters .= '--request ' . $method . ' ';
 626     # Don't complain about the 'missing' body
 627     $curl_parameters .= '--head ' if ($method =~ /^HEAD$/i);
 628
 629     $curl_parameters .= PRIVOXY_CGI_URL;
 630
 631     $buffer_ref = get_page_with_curl($curl_parameters);
 632     $status_code = get_status_code($buffer_ref);
 633
 634     return check_status_code_result($status_code, $expected_status_code);
 635 }
 636
 637 sub execute_dumb_fetch_test ($) {
 638
 639     my $test_ref = shift;
 640     my %test = %{$test_ref};
 641     my $buffer_ref;
 642     my $status_code;
 643
 644     my $curl_parameters = '';
 645     my $expected_status_code = $test{'expected-status-code'};
 646
 647     if (defined $test{method}) {
 648         $curl_parameters .= '--request ' . $test{method} . ' ';
 649     }
 650     if ($test{type} == TRUSTED_CGI_REQUEST) {
 651         $curl_parameters .= '--referer ' . PRIVOXY_CGI_URL . ' ';
 652     }
 653
 654     $curl_parameters .= $test{'data'};
 655
 656     $buffer_ref = get_page_with_curl($curl_parameters);
 657     $status_code = get_status_code($buffer_ref);
 658
 659     return check_status_code_result($status_code, $expected_status_code);
 660 }
 661
 662 sub execute_block_test ($) {
 663
 664     my $test = shift;
 665     my $url = $test->{'data'};
 666     my $final_results = get_final_results($url);
 667
 668     return defined $final_results->{'+block'};
 669 }
 670
 671 sub execute_sticky_actions_test ($) {
 672
 673     my $test = shift;
 674     my $url = $test->{'data'};
 675     my $verified_actions = 0;
 676     # XXX: splitting currently doesn't work for actions whose parameters contain spaces.
 677     my @sticky_actions = split(/\s+/, $test->{'sticky-actions'});
 678     my $final_results = get_final_results($url);
 679
 680     foreach my $sticky_action (@sticky_actions) {
 681         if (defined $final_results->{$sticky_action}) {
 682             # Exact match
 683             $verified_actions++;
 684         }elsif ($sticky_action =~ /-.*\{/ and
 685                 not defined $final_results->{$sticky_action}) {
 686             # Disabled multi actions aren't explicitly listed as
 687             # disabled and thus have to be checked by verifying
 688             # that they aren't enabled.
 689             $verified_actions++;
 690         } else {
 691             l(LL_VERBOSE_FAILURE,
 692               "Ooops. '$sticky_action' is not among the final results.");
 693         }
 694     }
 695
 696     return $verified_actions == @sticky_actions;
 697 }
 698
 699 sub get_final_results ($) {
 700
 701     my $url = shift;
 702     my $curl_parameters = '';
 703     my %final_results = ();
 704     my $final_results_reached = 0;
 705
 706     die "Unacceptable characters in $url" if $url =~ m@[\\'"]@;
 707     # XXX: should be URL-encoded properly
 708     $url =~ s@%@%25@g;
 709     $url =~ s@\s@%20@g;
 710     $url =~ s@&@%26@g;
 711     $url =~ s@:@%3A@g;
 712     $url =~ s@/@%2F@g;
 713
 714     $curl_parameters .= quote(PRIVOXY_CGI_URL . 'show-url-info?url=' . $url);
 715
 716     foreach (@{get_cgi_page_or_else($curl_parameters)}) {
 717
 718         $final_results_reached = 1 if (m@<h2>Final results:</h2>@);
 719
 720         next unless ($final_results_reached);
 721         last if (m@</td>@);
 722
 723         if (m@<br>([-+])<a.*>([^>]*)</a>(?: (\{.*\}))?@) {
 724             my $action = $1.$2;
 725             my $parameter = $3;
 726
 727             if (defined $parameter) {
 728                 # In case the caller needs to check
 729                 # the action and its parameter
 730                 $final_results{$action . $parameter} = 1;
 731             }
 732             # In case the action doesn't have parameters
 733             # or the caller doesn't care for the parameter.
 734             $final_results{$action} = 1;
 735         }
 736     }
 737
 738     return \%final_results;
 739 }
 740
 741 sub check_status_code_result ($$) {
 742
 743     my $status_code = shift;
 744     my $expected_status_code = shift;
 745     my $result = 0;
 746
 747     if ($expected_status_code == $status_code) {
 748
 749         $result = 1;
 750         l(LL_VERBOSE_SUCCESS,
 751           "Yay. We expected status code " . $expected_status_code . ", and received: " . $status_code . '.');
 752
 753     } elsif (cli_option_is_set('fuzzer-feeding') and $status_code == 123) {
 754
 755         l(LL_VERBOSE_FAILURE,
 756           "Oh well. Status code lost while fuzzing. Can't check if it was " . $expected_status_code . '.');
 757
 758     } else {
 759
 760         l(LL_VERBOSE_FAILURE,
 761           "Ooops. We expected status code " . $expected_status_code . ", but received: " . $status_code . '.');
 762
 763     }
 764
 765     return $result;
 766 }
 767
 768 sub execute_client_header_regression_test ($) {
 769
 770     my $test_ref = shift;
 771     my $buffer_ref;
 772     my $header;
 773
 774     $buffer_ref = get_show_request_with_curl($test_ref);
 775
 776     $header = get_header($buffer_ref, $test_ref);
 777
 778     return check_header_result($test_ref, $header);
 779 }
 780
 781 sub execute_server_header_regression_test ($) {
 782
 783     my $test_ref = shift;
 784     my $buffer_ref;
 785     my $header;
 786
 787     $buffer_ref = get_head_with_curl($test_ref);
 788
 789     $header = get_server_header($buffer_ref, $test_ref);
 790
 791     return check_header_result($test_ref, $header);
 792 }
 793
 794
 795 sub interpret_result ($) {
 796     my $success = shift;
 797     return $success ? "Success" : "Failure";
 798 }
 799
 800 sub check_header_result ($$) {
 801
 802     my $test_ref = shift;
 803     my $header = shift;
 804
 805     my %test = %{$test_ref};
 806     my $expect_header = $test{'expect-header'};
 807     my $success = 0;
 808
 809     $header =~ s@   @ @g if defined($header);
 810
 811     if ($expect_header eq 'NO CHANGE') {
 812
 813         if (defined($header) and $header eq $test{'data'}) {
 814
 815             $success = 1;
 816
 817         } else {
 818
 819             $header = "REMOVAL" unless defined $header;
 820             l(LL_VERBOSE_FAILURE,
 821               "Ooops. Got: " . $header . " while expecting: " . $expect_header);
 822         }
 823
 824     } elsif ($expect_header eq 'REMOVAL') {
 825
 826         if (defined($header) and $header eq $test{'data'}) {
 827
 828             l(LL_VERBOSE_FAILURE,
 829               "Ooops. Expected removal but: " . $header . " is still there.");
 830
 831         } else {
 832
 833             # XXX: Use more reliable check here and make sure
 834             # the header has a different name.
 835             $success = 1;
 836
 837         }
 838
 839     } elsif ($expect_header eq 'SOME CHANGE') {
 840
 841         if (defined($header) and not $header eq $test{'data'}) {
 842
 843             $success = 1;
 844
 845         } else {
 846
 847             $header = "REMOVAL" unless defined $header;
 848             l(LL_VERBOSE_FAILURE,
 849               "Ooops. Got: " . $header . " while expecting: SOME CHANGE");
 850         }
 851
 852
 853     } else {
 854
 855         if (defined($header) and $header eq $expect_header) {
 856
 857             $success = 1;
 858
 859         } else {
 860
 861             $header = "'No matching header'" unless defined $header; # XXX: No header detected to be precise
 862             l(LL_VERBOSE_FAILURE,
 863               "Ooops. Got: " . $header . " while expecting: " . $expect_header);
 864         }
 865     }
 866     return $success;
 867 }
 868
 869 sub get_header_name ($) {
 870
 871     my $header = shift;
 872
 873     $header =~ s@(.*?: ).*@$1@;
 874
 875     return $header;
 876 }
 877
 878 sub get_header ($$) {
 879
 880     our $filtered_request = '';
 881
 882     my $buffer_ref = shift;
 883     my $test_ref = shift;
 884
 885     my %test = %{$test_ref};
 886     my @buffer = @{$buffer_ref};
 887
 888     my $expect_header = $test{'expect-header'};
 889
 890     die "get_header called with no expect header" unless defined $expect_header;
 891
 892     my $line;
 893     my $processed_request_reached = 0;
 894     my $read_header = 0;
 895     my $processed_request = '';
 896     my $header;
 897     my $header_to_get;
 898
 899     if ($expect_header eq 'REMOVAL'
 900      or $expect_header eq 'NO CHANGE'
 901      or  $expect_header eq 'SOME CHANGE') {
 902
 903         $expect_header = $test{'data'};
 904
 905     }
 906
 907     $header_to_get = get_header_name($expect_header);
 908
 909     foreach (@buffer) {
 910
 911         # Skip everything before the Processed request
 912         if (/Processed Request/) {
 913             $processed_request_reached = 1;
 914             next;
 915         }
 916         next unless $processed_request_reached;
 917
 918         # End loop after the Processed request
 919         last if (/<\/pre>/);
 920
 921         # Ditch tags and leading/trailing white space.
 922         s@^\s*<.*?>@@g;
 923         s@\s*$@@g;
 924
 925         $filtered_request .=  "\n" . $_;
 926
 927         if (/^$header_to_get/) {
 928             $read_header = 1;
 929             $header = $_;
 930             last;
 931         }
 932     }
 933
 934     return $header;
 935 }
 936
 937 sub get_server_header ($$) {
 938
 939     my $buffer_ref = shift;
 940     my $test_ref = shift;
 941
 942     my %test = %{$test_ref};
 943     my @buffer = @{$buffer_ref};
 944
 945     my $expect_header = $test{'expect-header'};
 946     my $header;
 947     my $header_to_get;
 948
 949     # XXX: Should be caught before starting to test.
 950     l(LL_ERROR, "No expect header for test " . $test{'number'})
 951         unless defined $expect_header;
 952
 953     if ($expect_header eq 'REMOVAL'
 954      or $expect_header eq 'NO CHANGE'
 955      or $expect_header eq 'SOME CHANGE') {
 956
 957         $expect_header = $test{'data'};
 958
 959     }
 960
 961     $header_to_get = get_header_name($expect_header);
 962
 963     foreach (@buffer) {
 964
 965         # XXX: should probably verify that the request
 966         # was actually answered by Fellatio.
 967         if (/^$header_to_get/) {
 968             $header = $_;
 969             $header =~ s@\s*$@@g;
 970             last;
 971         }
 972     }
 973
 974     return $header;
 975 }
 976
 977 sub get_status_code ($) {
 978
 979     my $buffer_ref = shift;
 980     my @buffer = @{$buffer_ref};
 981
 982     foreach (@buffer) {
 983
 984         if (/^HTTP\/\d\.\d (\d{3})/) {
 985
 986             return $1;
 987
 988         } else {
 989
 990             return '123' if cli_option_is_set('fuzzer-feeding');
 991             chomp;
 992             l(LL_ERROR, 'Unexpected buffer line: "' . $_ . '"');
 993         }
 994     }
 995 }
 996
 997 sub get_test_keys () {
 998     return ('tag', 'data', 'expect-header', 'ignore');
 999 }
1000
1001 # XXX: incomplete
1002 sub test_content_as_string ($) {
1003
1004     my $test_ref = shift;
1005     my %test = %{$test_ref};
1006
1007     my $s = "\n\t";
1008
1009     foreach my $key (get_test_keys()) {
1010         $test{$key} = 'Not set' unless (defined $test{$key});
1011     }
1012
1013     $s .= 'Tag: ' . $test{'tag'};
1014     $s .= "\n\t";
1015     $s .= 'Set header: ' . $test{'data'}; # XXX: adjust for other test types
1016     $s .= "\n\t";
1017     $s .= 'Expected header: ' . $test{'expect-header'};
1018     $s .= "\n\t";
1019     $s .= 'Ignore: ' . $test{'ignore'};
1020
1021     return $s;
1022 }
1023
1024 ############################################################################
1025 #
1026 # HTTP fetch functions
1027 #
1028 ############################################################################
1029
1030 sub check_for_curl () {
1031     my $curl = CURL;
1032     l(LL_ERROR, "No curl found.") unless (`which $curl`);
1033 }
1034
1035 sub get_cgi_page_or_else ($) {
1036
1037     my $cgi_url = shift;
1038     my $content_ref = get_page_with_curl($cgi_url);
1039     my $status_code = get_status_code($content_ref);
1040
1041     if (200 != $status_code) {
1042
1043         my $log_message = "Failed to fetch Privoxy CGI Page. " .
1044                           "Received status code ". $status_code .
1045                           " while only 200 is acceptable.";
1046
1047         if (cli_option_is_set('fuzzer-feeding')) {
1048
1049             $log_message .= " Ignored due to fuzzer feeding.";
1050             l(LL_SOFT_ERROR, $log_message)
1051
1052         } else {
1053
1054             l(LL_ERROR, $log_message);
1055
1056         }
1057     }
1058
1059     return $content_ref;
1060 }
1061
1062 sub get_show_request_with_curl ($) {
1063
1064     our $privoxy_cgi_url;
1065     my $test_ref = shift;
1066     my %test = %{$test_ref};
1067
1068     my $curl_parameters = ' ';
1069
1070     # Enable the action to test
1071     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
1072     # The header to filter
1073     $curl_parameters .= '-H \'' . $test{'data'} . '\' ';
1074
1075     $curl_parameters .= ' ';
1076     $curl_parameters .= $privoxy_cgi_url;
1077     $curl_parameters .= 'show-request';
1078
1079     return get_cgi_page_or_else($curl_parameters);
1080 }
1081
1082
1083 sub get_head_with_curl ($) {
1084
1085     our $fellatio_url = FELLATIO_URL;
1086     my $test_ref = shift;
1087     my %test = %{$test_ref};
1088
1089     my $curl_parameters = ' ';
1090
1091     # Enable the action to test
1092     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
1093     # The header to filter
1094     $curl_parameters .= '-H \'X-Gimme-Head-With: ' . $test{'data'} . '\' ';
1095     $curl_parameters .= '--head ';
1096
1097     $curl_parameters .= ' ';
1098     $curl_parameters .= $fellatio_url;
1099
1100     return get_page_with_curl($curl_parameters);
1101 }
1102
1103
1104 sub get_page_with_curl ($) {
1105
1106     my $parameters = shift;
1107     my @buffer;
1108     my $curl_line = CURL;
1109     my $retries_left = get_cli_option('retries') + 1;
1110     my $failure_reason;
1111
1112     if (cli_option_is_set('privoxy-address')) {
1113         $curl_line .= ' --proxy ' . get_cli_option('privoxy-address');
1114     }
1115
1116     # We want to see the HTTP status code
1117     $curl_line .= " --include ";
1118     # Let Privoxy emit two log messages less.
1119     $curl_line .= ' -H \'Proxy-Connection:\' ' unless $parameters =~ /Proxy-Connection:/;
1120     $curl_line .= ' -H \'Connection: close\' ' unless $parameters =~ /Connection:/;
1121     # We don't care about fetch statistic.
1122     $curl_line .= " -s ";
1123     # We do care about the failure reason if any.
1124     $curl_line .= " -S ";
1125     # We want to advertise ourselves
1126     $curl_line .= " --user-agent '" . PRT_VERSION . "' ";
1127     # We aren't too patient
1128     $curl_line .= " --max-time '" . get_cli_option('max-time') . "' ";
1129
1130     $curl_line .= $parameters;
1131     # XXX: still necessary?
1132     $curl_line .= ' 2>&1';
1133
1134     l(LL_PAGE_FETCHING, "Executing: " . $curl_line);
1135
1136     do {
1137         @buffer = `$curl_line`;
1138
1139         if ($?) {
1140             $failure_reason = array_as_string(\@buffer);
1141             chomp $failure_reason;
1142             l(LL_SOFT_ERROR, "Fetch failure: '" . $failure_reason . $! ."'");
1143         }
1144     } while ($? && --$retries_left);
1145
1146     unless ($retries_left) {
1147         l(LL_ERROR,
1148           "Running curl failed " . get_cli_option('retries') .
1149           " times in a row. Last error: '" . $failure_reason . "'.");
1150     }
1151
1152     return \@buffer;
1153 }
1154
1155
1156 ############################################################################
1157 #
1158 # Log functions
1159 #
1160 ############################################################################
1161
1162 sub array_as_string ($) {
1163     my $array_ref = shift;
1164     my $string = '';
1165
1166     foreach (@{$array_ref}) {
1167         $string .= $_;
1168     }
1169
1170     return $string;
1171 }
1172
1173
1174 sub show_test ($) {
1175     my $test_ref = shift;
1176     log_message('Test is:' . test_content_as_string($test_ref));
1177 }
1178
1179 # Conditional log
1180 sub l ($$) {
1181     our $log_level;
1182     my $this_level = shift;
1183     my $message = shift;
1184
1185     return unless ($log_level & $this_level);
1186
1187     if (LL_ERROR & $this_level) {
1188         $message = 'Oh noes. ' . $message . ' Fatal error. Exiting.';
1189     }
1190
1191     log_message($message);
1192
1193     if (LL_ERROR & $this_level) {
1194         exit;
1195     }
1196 }
1197
1198 sub log_message ($) {
1199
1200     my $message = shift;
1201
1202     our $logfile;
1203     our $no_logging;
1204     our $leading_log_date;
1205     our $leading_log_time;
1206
1207     my $time_stamp = '';
1208     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime time;
1209
1210     if ($leading_log_date || $leading_log_time) {
1211
1212         if ($leading_log_date) {
1213             $year += 1900;
1214             $mon  += 1;
1215             $time_stamp = sprintf("%i/%.2i/%.2i", $year, $mon, $mday);
1216         }
1217
1218         if ($leading_log_time) {
1219             $time_stamp .= ' ' if $leading_log_date;
1220             $time_stamp.= sprintf("%.2i:%.2i:%.2i", $hour, $min, $sec);
1221         }
1222
1223         $message = $time_stamp . ": " . $message;
1224     }
1225
1226
1227     printf(STDERR "%s\n", $message);
1228
1229 }
1230
1231 sub log_result ($$) {
1232
1233     our $verbose_test_description;
1234     our $filtered_request;
1235
1236     my $test_ref = shift;
1237     my $result = shift;
1238     my $number = shift;
1239
1240     my %test = %{$test_ref};
1241     my $message = '';
1242
1243     $message .= interpret_result($result);
1244     $message .= " for test ";
1245     $message .= $number;
1246     $message .= '/';
1247     $message .= $test{'number'};
1248     $message .= '/';
1249     $message .= $test{'section-id'};
1250     $message .= '/';
1251     $message .= $test{'regression-test-id'};
1252     $message .= '.';
1253
1254     if ($verbose_test_description) {
1255
1256         if ($test{'type'} == CLIENT_HEADER_TEST) {
1257
1258             $message .= ' Header ';
1259             $message .= quote($test{'data'});
1260             $message .= ' and tag ';
1261             $message .= quote($test{'tag'});
1262
1263         } elsif ($test{'type'} == SERVER_HEADER_TEST) {
1264
1265             $message .= ' Request Header ';
1266             $message .= quote($test{'data'});
1267             $message .= ' and tag ';
1268             $message .= quote($test{'tag'});
1269
1270         } elsif ($test{'type'} == DUMB_FETCH_TEST) {
1271
1272             $message .= ' URL ';
1273             $message .= quote($test{'data'});
1274             $message .= ' and expected status code ';
1275             $message .= quote($test{'expected-status-code'});
1276
1277         } elsif ($test{'type'} == TRUSTED_CGI_REQUEST) {
1278
1279             $message .= ' CGI URL ';
1280             $message .= quote($test{'data'});
1281             $message .= ' and expected status code ';
1282             $message .= quote($test{'expected-status-code'});
1283
1284         } elsif ($test{'type'} == METHOD_TEST) {
1285
1286             $message .= ' HTTP method ';
1287             $message .= quote($test{'data'});
1288             $message .= ' and expected status code ';
1289             $message .= quote($test{'expected-status-code'});
1290
1291         } elsif ($test{'type'} == BLOCK_TEST) {
1292
1293             $message .= ' Supposedly-blocked URL: ';
1294             $message .= quote($test{'data'});
1295
1296         } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
1297
1298             $message .= ' Sticky Actions: ';
1299             $message .= quote($test{'sticky-actions'});
1300             $message .= ' and URL: ';
1301             $message .= quote($test{'data'});
1302
1303         } else {
1304
1305             die "Incomplete support for test type " . $test{'type'} .  " detected.";
1306
1307         }
1308     }
1309
1310     log_message($message) if (!$result or cli_option_is_set('verbose'));
1311 }
1312
1313 sub quote ($) {
1314     my $s = shift;
1315     return '\'' . $s . '\'';
1316 }
1317
1318 sub print_version () {
1319     printf PRT_VERSION . "\n" . 'Copyright (C) 2007-2008 Fabian Keil <fk@fabiankeil.de>' . "\n";
1320 }
1321
1322 sub help () {
1323
1324     our %cli_options;
1325
1326     print_version();
1327
1328     print << "    EOF"
1329
1330 Options and their default values if they have any:
1331     [--debug $cli_options{'debug'}]
1332     [--fuzzer-feeding]
1333     [--help]
1334     [--level]
1335     [--loops $cli_options{'loops'}]
1336     [--max-level $cli_options{'max-level'}]
1337     [--max-time $cli_options{'max-time'}]
1338     [--min-level $cli_options{'min-level'}]
1339     [--privoxy-address]
1340     [--retries $cli_options{'retries'}]
1341     [--verbose]
1342     [--version]
1343 see "perldoc $0" for more information
1344     EOF
1345     ;
1346     exit(0);
1347 }
1348
1349 sub init_cli_options () {
1350
1351     our %cli_options;
1352     our $log_level;
1353
1354     $cli_options{'min-level'} = CLI_MIN_LEVEL;
1355     $cli_options{'max-level'} = CLI_MAX_LEVEL;
1356     $cli_options{'debug'}  = $log_level;
1357     $cli_options{'loops'}  = CLI_LOOPS;
1358     $cli_options{'max-time'}  = CLI_MAX_TIME;
1359     $cli_options{'retries'}  = CLI_RETRIES;
1360 }
1361
1362 sub parse_cli_options () {
1363
1364     our %cli_options;
1365     our $log_level;
1366
1367     init_cli_options();
1368
1369     GetOptions (
1370                 'debug=s' => \$cli_options{'debug'},
1371                 'help'     => sub { help },
1372                 'min-level=s' => \$cli_options{'min-level'},
1373                 'max-level=s' => \$cli_options{'max-level'},
1374                 'privoxy-address=s' => \$cli_options{'privoxy-address'},
1375                 'level=s' => \$cli_options{'level'},
1376                 'loops=s' => \$cli_options{'loops'},
1377                 'test-number=s' => \$cli_options{'test-number'},
1378                 'fuzzer-feeding' => \$cli_options{'fuzzer-feeding'},
1379                 'retries=s' => \$cli_options{'retries'},
1380                 'max-time=s' => \$cli_options{'max-time'},
1381                 'verbose' => \$cli_options{'verbose'},
1382                 'version'  => sub { print_version && exit(0) }
1383     );
1384     $log_level |= $cli_options{'debug'};
1385 }
1386
1387 sub cli_option_is_set ($) {
1388
1389     our %cli_options;
1390     my $cli_option = shift;
1391
1392     return defined $cli_options{$cli_option};
1393 }
1394
1395 sub get_cli_option ($) {
1396
1397     our %cli_options;
1398     my $cli_option = shift;
1399
1400     die "Unknown CLI option: $cli_option" unless defined $cli_options{$cli_option};
1401
1402     return $cli_options{$cli_option};
1403 }
1404
1405 sub main () {
1406
1407     init_our_variables();
1408     parse_cli_options();
1409     check_for_curl();
1410     load_regressions_tests();
1411     execute_regression_tests();
1412 }
1413
1414 main();
1415
1416 =head1 NAME
1417
1418 B<privoxy-regression-test> - A regression test "framework" for Privoxy.
1419
1420 =head1 SYNOPSIS
1421
1422 B<privoxy-regression-test> [B<--debug bitmask>] [B<--fuzzer-feeding>] [B<--help>]
1423 [B<--level level>] [B<--loops count>] [B<--max-level max-level>]
1424 [B<--max-time max-time>] [B<--min-level min-level>] B<--privoxy-address proxy-address>
1425 [B<--retries retries>] [B<--verbose>] [B<--version>]
1426
1427 =head1 DESCRIPTION
1428
1429 Privoxy-Regression-Test is supposed to one day become
1430 a regression test suite for Privoxy. It's not quite there
1431 yet, however, and can currently only test header actions,
1432 check the returned status code for requests to arbitrary
1433 URLs and verify which actions are applied to them.
1434
1435 Client header actions are tested by requesting
1436 B<http://p.p/show-request> and checking whether
1437 or not Privoxy modified the original request as expected.
1438
1439 The original request contains both the header the action-to-be-tested
1440 acts upon and an additional tagger-triggering header that enables
1441 the action to test.
1442
1443 Applied actions are checked through B<http://p.p/show-url-info>.
1444
1445 =head1 CONFIGURATION FILE SYNTAX
1446
1447 Privoxy-Regression-Test's configuration is embedded in
1448 Privoxy action files and loaded through Privoxy's web interface.
1449
1450 It makes testing a Privoxy version running on a remote system easier
1451 and should prevent you from updating your tests without updating Privoxy's
1452 configuration accordingly.
1453
1454 A client-header-action test section looks like this:
1455
1456     # Set Header    = Referer: http://www.example.org.zwiebelsuppe.exit/
1457     # Expect Header = Referer: http://www.example.org/
1458     {+client-header-filter{hide-tor-exit-notation} -hide-referer}
1459     TAG:^client-header-filter\{hide-tor-exit-notation\}$
1460
1461 The example above causes Privoxy-Regression-Test to set
1462 the header B<Referer: http://www.example.org.zwiebelsuppe.exit/>
1463 and to expect it to be modified to
1464 B<Referer: http://www.example.org/>.
1465
1466 When testing this section, Privoxy-Regression-Test will set the header
1467 B<X-Privoxy-Control: client-header-filter{hide-tor-exit-notation}>
1468 causing the B<privoxy-control> tagger to create the tag
1469 B<client-header-filter{hide-tor-exit-notation}> which will finally
1470 cause Privoxy to enable the action section.
1471
1472 Note that the actions itself are only used by Privoxy,
1473 Privoxy-Regression-Test ignores them and will be happy
1474 as long as the expectations are satisfied.
1475
1476 A fetch test looks like this:
1477
1478     # Fetch Test = http://p.p/user-manual
1479     # Expect Status Code = 302
1480
1481 It tells Privoxy-Regression-Test to request B<http://p.p/user-manual>
1482 and to expect a response with the HTTP status code B<302>. Obviously that's
1483 not a very thorough test and mainly useful to get some code coverage
1484 for Valgrind or to verify that the templates are installed correctly.
1485
1486 If you want to test CGI pages that require a trusted
1487 referer, you can use:
1488
1489     # Trusted CGI Request = http://p.p/edit-actions
1490
1491 It works like ordinary fetch tests, but sets the referer
1492 header to a trusted value.
1493
1494 If no explicit status code expectation is set, B<200> is used.
1495
1496 To verify that a URL is blocked, use:
1497
1498     # Blocked URL = http://www.example.com/blocked
1499
1500 To verify that a specific set of actions is applied to an URL, use:
1501
1502     # Sticky Actions = +block{foo} +handle-as-empty-document -handle-as-image
1503     # URL = http://www.example.org/my-first-url
1504
1505 The sticky actions will be checked for all URLs below it
1506 until the next sticky actions directive.
1507
1508 =head1 TEST LEVELS
1509
1510 All tests have test levels to let the user
1511 control which ones to execute (see I<OPTIONS> below).
1512 Test levels are either set with the B<Level> directive,
1513 or implicitly through the test type.
1514
1515 Block tests default to level 7, fetch tests to level 6,
1516 "Sticky Actions" tests default to level 5, tests for trusted CGI
1517 requests to level 3 and client-header-action tests to level 1.
1518
1519 =head1 OPTIONS
1520
1521 B<--debug bitmask> Add the bitmask provided as integer
1522 to the debug settings.
1523
1524 B<--fuzzer-feeding> Ignore some errors that would otherwise
1525 cause Privoxy-Regression-Test to abort the test because
1526 they shouldn't happen in normal operation. This option is
1527 intended to be used if Privoxy-Regression-Test is only
1528 used to feed a fuzzer in which case there's a high chance
1529 that Privoxy gets an invalid request and returns an error
1530 message.
1531
1532 B<--help> Shows available command line options.
1533
1534 B<--level level> Only execute tests with the specified B<level>.
1535
1536 B<--loop count> Loop through the regression tests B<count> times.
1537 Useful to feed a fuzzer, or when doing stress tests with
1538 several Privoxy-Regression-Test instances running at the same
1539 time.
1540
1541 B<--max-level max-level> Only execute tests with a B<level>
1542 below or equal to the numerical B<max-level>.
1543
1544 B<--max-time max-time> Give Privoxy B<max-time> seconds
1545 to return data. Increasing the default may make sense when
1546 Privoxy is run through Valgrind, decreasing the default may
1547 make sense when Privoxy-Regression-Test is used to feed
1548 a fuzzer.
1549
1550 B<--min-level min-level> Only execute tests with a B<level>
1551 above or equal to the numerical B<min-level>.
1552
1553 B<--privoxy-address proxy-address> Privoxy's listening address.
1554 If it's not set, the value of the environment variable http_proxy
1555 will be used. B<proxy-address> has to be specified in http_proxy
1556 syntax.
1557
1558 B<--retries retries> Retry B<retries> times.
1559
1560 B<--verbose> Also log succesful test runs.
1561
1562 B<--version> Print version and exit.
1563
1564 The second dash is optional, options can be shortened,
1565 as long as there are no ambiguities.
1566
1567 =head1 PRIVOXY CONFIGURATION
1568
1569 Privoxy-Regression-Test is shipped with B<regression-tests.action>
1570 which aims to test all official client-header modifying actions
1571 and can be used to verify that the templates and the user manual
1572 files are installed correctly.
1573
1574 To use it, it has to be copied in Privoxy's configuration
1575 directory, and afterwards referenced in Privoxy's configuration
1576 file with the line:
1577
1578     actionsfile regression-tests.action
1579
1580 In general, its tests are supposed to work without changing
1581 any other action files, unless you already added lots of
1582 taggers yourself. If you are using taggers that cause problems,
1583 you might have to temporary disable them for Privoxy's CGI pages.
1584
1585 Some of the regression tests rely on Privoxy features that
1586 may be disabled in your configuration. Tests with a level below
1587 7 are supposed to work with all Privoxy configurations (provided
1588 you didn't build with FEATURE_GRACEFUL_TERMINATION).
1589
1590 Tests with level 9 require Privoxy to deliver the User Manual,
1591 tests with level 12 require the CGI editor to be enabled.
1592
1593 =head1 CAVEATS
1594
1595 Expect the configuration file syntax to change with future releases.
1596
1597 =head1 LIMITATIONS
1598
1599 As Privoxy's B<show-request> page only shows client headers,
1600 Privoxy-Regression-Test can't use it to test Privoxy actions
1601 that modify server headers.
1602
1603 As Privoxy-Regression-Test relies on Privoxy's tag feature to
1604 control the actions to test, it currently only works with
1605 Privoxy 3.0.7 or later.
1606
1607 At the moment Privoxy-Regression-Test fetches Privoxy's
1608 configuration page through I<curl>(1), therefore you have to
1609 have I<curl> installed, otherwise you won't be able to run
1610 Privoxy-Regression-Test in a meaningful way.
1611
1612 =head1 SEE ALSO
1613
1614 privoxy(1) curl(1)
1615
1616 =head1 AUTHOR
1617
1618 Fabian Keil <fk@fabiankeil.de>
1619
1620 =cut