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