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