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.159 2008/08/22 16:53:06 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 # - Document magic Expect Header values
  20 # - Internal fuzz support?
  21 #
  22 # Copyright (c) 2007-2008 Fabian Keil <fk@fabiankeil.de>
  23 #
  24 # Permission to use, copy, modify, and distribute this software for any
  25 # purpose with or without fee is hereby granted, provided that the above
  26 # copyright notice and this permission notice appear in all copies.
  27 #
  28 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  29 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  30 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  31 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  32 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  33 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  34 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  35 #
  36 ############################################################################
  37
  38 use warnings;
  39 use strict;
  40 use Getopt::Long;
  41
  42 use constant {
  43                PRT_VERSION => 'Privoxy-Regression-Test 0.3',
  44
  45                CURL => 'curl',
  46
  47                # CLI option defaults
  48                CLI_RETRIES   => 1,
  49                CLI_LOOPS     => 1,
  50                CLI_MAX_TIME  => 5,
  51                CLI_MIN_LEVEL => 0,
  52                CLI_MAX_LEVEL => 25,
  53                CLI_FORKS     => 0,
  54
  55                PRIVOXY_CGI_URL => 'http://p.p/',
  56                FELLATIO_URL    => 'http://127.0.0.1:8080/',
  57                LEADING_LOG_DATE => 1,
  58                LEADING_LOG_TIME => 1,
  59
  60                DEBUG_LEVEL_FILE_LOADING    => 0,
  61                DEBUG_LEVEL_PAGE_FETCHING   => 0,
  62
  63                VERBOSE_TEST_DESCRIPTION    => 1,
  64
  65                DEBUG_LEVEL_VERBOSE_FAILURE => 1,
  66                # XXX: Only partly implemented and mostly useless.
  67                DEBUG_LEVEL_VERBOSE_SUCCESS => 0,
  68                DEBUG_LEVEL_STATUS          => 1,
  69
  70                # Internal use, don't modify
  71                # Available debug bits:
  72                LL_ERROR                   =>  1,
  73                LL_VERBOSE_FAILURE         =>  2,
  74                LL_PAGE_FETCHING           =>  4,
  75                LL_FILE_LOADING            =>  8,
  76                LL_VERBOSE_SUCCESS         => 16,
  77                LL_STATUS                  => 32,
  78                LL_SOFT_ERROR              => 64,
  79
  80                CLIENT_HEADER_TEST         =>  1,
  81                SERVER_HEADER_TEST         =>  2,
  82                DUMB_FETCH_TEST            =>  3,
  83                METHOD_TEST                =>  4,
  84                STICKY_ACTIONS_TEST        =>  5,
  85                TRUSTED_CGI_REQUEST        =>  6,
  86                BLOCK_TEST                 =>  7,
  87 };
  88
  89 sub init_our_variables () {
  90
  91     our $leading_log_time = LEADING_LOG_TIME;
  92     our $leading_log_date = LEADING_LOG_DATE;
  93
  94     our $privoxy_cgi_url  = PRIVOXY_CGI_URL;
  95
  96     our $verbose_test_description = VERBOSE_TEST_DESCRIPTION;
  97
  98     our $log_level = get_default_log_level();
  99
 100 }
 101
 102 sub get_default_log_level () {
 103
 104     my $log_level = 0;
 105
 106     $log_level |= LL_FILE_LOADING    if DEBUG_LEVEL_FILE_LOADING;
 107     $log_level |= LL_PAGE_FETCHING   if DEBUG_LEVEL_PAGE_FETCHING;
 108     $log_level |= LL_VERBOSE_FAILURE if DEBUG_LEVEL_VERBOSE_FAILURE;
 109     $log_level |= LL_VERBOSE_SUCCESS if DEBUG_LEVEL_VERBOSE_SUCCESS;
 110     $log_level |= LL_STATUS          if DEBUG_LEVEL_STATUS;
 111
 112     # These are intended to be always on.
 113     $log_level |= LL_SOFT_ERROR;
 114     $log_level |= LL_ERROR;
 115
 116     return $log_level;
 117 }
 118
 119 ############################################################################
 120 #
 121 # File loading functions
 122 #
 123 ############################################################################
 124
 125 sub parse_tag ($) {
 126
 127     my $tag = shift;
 128
 129     # Remove anchors
 130     $tag =~ s@[\$\^]@@g;
 131     # Unescape brackets and dots
 132     $tag =~ s@\\(?=[{}().+])@@g;
 133
 134     # log_message("Parsed tag: " . $tag);
 135
 136     check_for_forbidden_characters($tag);
 137
 138     return $tag;
 139 }
 140
 141 sub check_for_forbidden_characters ($) {
 142
 143     my $tag = shift; # XXX: also used to check values though.
 144     my $allowed = '[-=\dA-Za-z~{}:.\/();\s,+@"_%\?&*^]';
 145
 146     unless ($tag =~ m/^$allowed*$/) {
 147         my $forbidden = $tag;
 148         $forbidden =~ s@^$allowed*(.).*@$1@;
 149
 150         l(LL_ERROR, "'" . $tag . "' contains character '" . $forbidden. "' which is unacceptable.");
 151     }
 152 }
 153
 154 sub load_regressions_tests () {
 155
 156     our $privoxy_cgi_url;
 157     our @privoxy_config;
 158     my @actionfiles;
 159     my $curl_url = '';
 160     my $file_number = 0;
 161
 162     $curl_url .= $privoxy_cgi_url;
 163     $curl_url .= 'show-status';
 164
 165     l(LL_STATUS, "Asking Privoxy for the number of action files available ...");
 166
 167     foreach (@{get_cgi_page_or_else($curl_url)}) {
 168
 169         chomp;
 170         if (/<td>(.*?)<\/td><td class=\"buttons\"><a href=\"\/show-status\?file=actions&amp;index=(\d+)\">/) {
 171
 172             my $url = $privoxy_cgi_url . 'show-status?file=actions&index=' . $2;
 173             $actionfiles[$file_number++] = $url;
 174
 175         } elsif (m@config\.html#.*\">([^<]*)</a>\s+(.*)<br>@) {
 176
 177             my $directive = $1 . " " . $2;
 178             push (@privoxy_config, $directive);
 179         }
 180     }
 181
 182     l(LL_FILE_LOADING, "Recognized " . @actionfiles . " actions files");
 183
 184     load_action_files(\@actionfiles);
 185 }
 186
 187 sub token_starts_new_test ($) {
 188
 189     my $token = shift;
 190     my @new_test_directives = ('set header', 'fetch test',
 191          'trusted cgi request', 'request header', 'method test',
 192          'blocked url', 'url');
 193
 194     foreach my $new_test_directive (@new_test_directives) {
 195         return 1 if $new_test_directive eq $token;
 196     }
 197     return 0;
 198
 199 }
 200
 201 sub tokenize ($) {
 202
 203     my ($token, $value) = (undef, undef);
 204
 205     # Remove leading and trailing white space.
 206     s@^\s*@@;
 207     s@\s*$@@;
 208
 209     # Reverse HTML-encoding
 210     # XXX: Seriously imcomplete.
 211     s@&quot;@"@g;
 212     s@&amp;@&@g;
 213
 214     # Tokenize
 215     if (/^\#\s*([^=:]*?)\s*[=]\s*(.+?)\s*$/) {
 216
 217         $token = $1;
 218         $value = $2;
 219
 220         $token =~ s@\s\s+@ @g;
 221         $token =~ tr/[A-Z]/[a-z]/;
 222
 223     } elsif (/^TAG\s*:(.*)$/) {
 224
 225         $token = 'tag';
 226         $value = $1;
 227
 228     }
 229
 230     return ($token, $value);
 231 }
 232
 233 sub enlist_new_test ($$$$$$) {
 234
 235     my ($regression_tests, $token, $value, $si, $ri, $number) = @_;
 236     my $type;
 237
 238     if ($token eq 'set header') {
 239
 240         l(LL_FILE_LOADING, "Header to set: " . $value);
 241         $type = CLIENT_HEADER_TEST;
 242
 243     } elsif ($token eq 'request header') {
 244
 245         l(LL_FILE_LOADING, "Header to request: " . $value);
 246         $type = SERVER_HEADER_TEST;
 247         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 248
 249     } elsif ($token eq 'trusted cgi request') {
 250
 251         l(LL_FILE_LOADING, "CGI URL to test in a dumb way: " . $value);
 252         $type = TRUSTED_CGI_REQUEST;
 253         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 254
 255     } elsif ($token eq 'fetch test') {
 256
 257         l(LL_FILE_LOADING, "URL to test in a dumb way: " . $value);
 258         $type = DUMB_FETCH_TEST;
 259         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 260
 261     } elsif ($token eq 'method test') {
 262
 263         l(LL_FILE_LOADING, "Method to test: " . $value);
 264         $type = METHOD_TEST;
 265         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 266
 267     } elsif ($token eq 'blocked url') {
 268
 269         l(LL_FILE_LOADING, "URL to block-test: " . $value);
 270         $type = BLOCK_TEST;
 271
 272     } elsif ($token eq 'url') {
 273
 274         l(LL_FILE_LOADING, "Sticky URL to test: " . $value);
 275         $type = STICKY_ACTIONS_TEST;
 276
 277     } else {
 278
 279         die "Incomplete '" . $token . "' support detected.";
 280
 281     }
 282
 283     $$regression_tests[$si][$ri]{'type'} = $type;
 284     $$regression_tests[$si][$ri]{'level'} = $type;
 285
 286     check_for_forbidden_characters($value);
 287
 288     $$regression_tests[$si][$ri]{'data'} = $value;
 289
 290     # For function that only get passed single tests
 291     $$regression_tests[$si][$ri]{'section-id'} = $si;
 292     $$regression_tests[$si][$ri]{'regression-test-id'} = $ri;
 293     $$regression_tests[$si][$ri]{'number'} = $number - 1;
 294     l(LL_FILE_LOADING,
 295       "Regression test " . $number . " (section:" . $si . "):");
 296 }
 297
 298 sub load_action_files ($) {
 299
 300     # initialized here
 301     our %actions;
 302     our @regression_tests;
 303
 304     my $actionfiles_ref = shift;
 305     my @actionfiles = @{$actionfiles_ref};
 306
 307     my $si = 0;  # Section index
 308     my $ri = -1; # Regression test index
 309     my $count = 0;
 310
 311     my $ignored = 0;
 312
 313     l(LL_STATUS, "Gathering regression tests from " .
 314       @actionfiles . " 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 sub interpret_result ($) {
 798     my $success = shift;
 799     return $success ? "Success" : "Failure";
 800 }
 801
 802 sub check_header_result ($$) {
 803
 804     my $test_ref = shift;
 805     my $header = shift;
 806
 807     my %test = %{$test_ref};
 808     my $expect_header = $test{'expect-header'};
 809     my $success = 0;
 810
 811     if ($expect_header eq 'NO CHANGE') {
 812
 813         if (defined($header) and $header eq $test{'data'}) {
 814
 815             $success = 1;
 816
 817         } else {
 818
 819             $header = "REMOVAL" unless defined $header;
 820             l(LL_VERBOSE_FAILURE,
 821               "Ooops. Got: " . $header . " while expecting: " . $expect_header);
 822         }
 823
 824     } elsif ($expect_header eq 'REMOVAL') {
 825
 826         if (defined($header) and $header eq $test{'data'}) {
 827
 828             l(LL_VERBOSE_FAILURE,
 829               "Ooops. Expected removal but: " . $header . " is still there.");
 830
 831         } else {
 832
 833             # XXX: Use more reliable check here and make sure
 834             # the header has a different name.
 835             $success = 1;
 836
 837         }
 838
 839     } elsif ($expect_header eq 'SOME CHANGE') {
 840
 841         if (defined($header) and not $header eq $test{'data'}) {
 842
 843             $success = 1;
 844
 845         } else {
 846
 847             $header = "REMOVAL" unless defined $header;
 848             l(LL_VERBOSE_FAILURE,
 849               "Ooops. Got: " . $header . " while expecting: SOME CHANGE");
 850         }
 851
 852
 853     } else {
 854
 855         if (defined($header) and $header eq $expect_header) {
 856
 857             $success = 1;
 858
 859         } else {
 860
 861             $header = "'No matching header'" unless defined $header; # XXX: No header detected to be precise
 862             l(LL_VERBOSE_FAILURE,
 863               "Ooops. Got: " . $header . " while expecting: " . $expect_header);
 864         }
 865     }
 866     return $success;
 867 }
 868
 869 sub get_header_name ($) {
 870
 871     my $header = shift;
 872
 873     $header =~ s@(.*?: ).*@$1@;
 874
 875     return $header;
 876 }
 877
 878 sub get_header ($$) {
 879
 880     our $filtered_request = '';
 881
 882     my $buffer_ref = shift;
 883     my $test_ref = shift;
 884
 885     my %test = %{$test_ref};
 886     my @buffer = @{$buffer_ref};
 887
 888     my $expect_header = $test{'expect-header'};
 889
 890     die "get_header called with no expect header" unless defined $expect_header;
 891
 892     my $line;
 893     my $processed_request_reached = 0;
 894     my $read_header = 0;
 895     my $processed_request = '';
 896     my $header;
 897     my $header_to_get;
 898
 899     if ($expect_header eq 'REMOVAL'
 900      or $expect_header eq 'NO CHANGE'
 901      or  $expect_header eq 'SOME CHANGE') {
 902
 903         $expect_header = $test{'data'};
 904
 905     }
 906
 907     $header_to_get = get_header_name($expect_header);
 908
 909     foreach (@buffer) {
 910
 911         # Skip everything before the Processed request
 912         if (/Processed Request/) {
 913             $processed_request_reached = 1;
 914             next;
 915         }
 916         next unless $processed_request_reached;
 917
 918         # End loop after the Processed request
 919         last if (/<\/pre>/);
 920
 921         # Ditch tags and leading/trailing white space.
 922         s@^\s*<.*?>@@g;
 923         s@\s*$@@g;
 924
 925         # Decode characters we care about.
 926         s@&quot;@"@g;
 927
 928         $filtered_request .=  "\n" . $_;
 929
 930         if (/^$header_to_get/) {
 931             $read_header = 1;
 932             $header = $_;
 933             last;
 934         }
 935     }
 936
 937     return $header;
 938 }
 939
 940 sub get_server_header ($$) {
 941
 942     my $buffer_ref = shift;
 943     my $test_ref = shift;
 944
 945     my %test = %{$test_ref};
 946     my @buffer = @{$buffer_ref};
 947
 948     my $expect_header = $test{'expect-header'};
 949     my $header;
 950     my $header_to_get;
 951
 952     # XXX: Should be caught before starting to test.
 953     l(LL_ERROR, "No expect header for test " . $test{'number'})
 954         unless defined $expect_header;
 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 sub fuzz_header($) {
1028     my $header = shift;
1029     my $white_space = int(rand(2)) - 1 ? " " : "\t";
1030
1031     $white_space = $white_space x (1 + int(rand(5)));
1032
1033     # Only fuzz white space before the first quoted token.
1034     # (Privoxy doesn't touch white space inside quoted tokens
1035     # and modifying it would cause the tests to fail).
1036     $header =~ s@(^[^"]*?)\s@$1$white_space@g;
1037
1038     return $header;
1039 }
1040
1041 ############################################################################
1042 #
1043 # HTTP fetch functions
1044 #
1045 ############################################################################
1046
1047 sub check_for_curl () {
1048     my $curl = CURL;
1049     l(LL_ERROR, "No curl found.") unless (`which $curl`);
1050 }
1051
1052 sub get_cgi_page_or_else ($) {
1053
1054     my $cgi_url = shift;
1055     my $content_ref = get_page_with_curl($cgi_url);
1056     my $status_code = get_status_code($content_ref);
1057
1058     if (200 != $status_code) {
1059
1060         my $log_message = "Failed to fetch Privoxy CGI Page. " .
1061                           "Received status code ". $status_code .
1062                           " while only 200 is acceptable.";
1063
1064         if (cli_option_is_set('fuzzer-feeding')) {
1065
1066             $log_message .= " Ignored due to fuzzer feeding.";
1067             l(LL_SOFT_ERROR, $log_message)
1068
1069         } else {
1070
1071             l(LL_ERROR, $log_message);
1072
1073         }
1074     }
1075
1076     return $content_ref;
1077 }
1078
1079 # XXX: misleading name
1080 sub get_show_request_with_curl ($) {
1081
1082     our $privoxy_cgi_url;
1083     my $test_ref = shift;
1084     my %test = %{$test_ref};
1085
1086     my $curl_parameters = ' ';
1087     my $header = $test{'data'};
1088
1089     if (cli_option_is_set('header-fuzzing')) {
1090         $header = fuzz_header($header);
1091     }
1092
1093     # Enable the action to test
1094     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
1095     # The header to filter
1096     $curl_parameters .= '-H \'' . $header . '\' ';
1097
1098     $curl_parameters .= ' ';
1099     $curl_parameters .= $privoxy_cgi_url;
1100     $curl_parameters .= 'show-request';
1101
1102     return get_cgi_page_or_else($curl_parameters);
1103 }
1104
1105 sub get_head_with_curl ($) {
1106
1107     our $fellatio_url = FELLATIO_URL;
1108     my $test_ref = shift;
1109     my %test = %{$test_ref};
1110
1111     my $curl_parameters = ' ';
1112
1113     # Enable the action to test
1114     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
1115     # The header to filter
1116     $curl_parameters .= '-H \'X-Gimme-Head-With: ' . $test{'data'} . '\' ';
1117     $curl_parameters .= '--head ';
1118
1119     $curl_parameters .= ' ';
1120     $curl_parameters .= $fellatio_url;
1121
1122     return get_page_with_curl($curl_parameters);
1123 }
1124
1125 sub get_page_with_curl ($) {
1126
1127     our $proxy;
1128
1129     my $parameters = shift;
1130     my @buffer;
1131     my $curl_line = CURL;
1132     my $retries_left = get_cli_option('retries') + 1;
1133     my $failure_reason;
1134
1135     $curl_line .= ' --proxy ' . $proxy if (defined $proxy);
1136
1137     # We want to see the HTTP status code
1138     $curl_line .= " --include ";
1139     # Let Privoxy emit two log messages less.
1140     $curl_line .= ' -H \'Proxy-Connection:\' ' unless $parameters =~ /Proxy-Connection:/;
1141     $curl_line .= ' -H \'Connection: close\' ' unless $parameters =~ /Connection:/;
1142     # We don't care about fetch statistic.
1143     $curl_line .= " -s ";
1144     # We do care about the failure reason if any.
1145     $curl_line .= " -S ";
1146     # We want to advertise ourselves
1147     $curl_line .= " --user-agent '" . PRT_VERSION . "' ";
1148     # We aren't too patient
1149     $curl_line .= " --max-time '" . get_cli_option('max-time') . "' ";
1150
1151     $curl_line .= $parameters;
1152     # XXX: still necessary?
1153     $curl_line .= ' 2>&1';
1154
1155     l(LL_PAGE_FETCHING, "Executing: " . $curl_line);
1156
1157     do {
1158         @buffer = `$curl_line`;
1159
1160         if ($?) {
1161             $failure_reason = array_as_string(\@buffer);
1162             chomp $failure_reason;
1163             l(LL_SOFT_ERROR, "Fetch failure: '" . $failure_reason . $! ."'");
1164         }
1165     } while ($? && --$retries_left);
1166
1167     unless ($retries_left) {
1168         l(LL_ERROR,
1169           "Running curl failed " . get_cli_option('retries') .
1170           " times in a row. Last error: '" . $failure_reason . "'.");
1171     }
1172
1173     return \@buffer;
1174 }
1175
1176
1177 ############################################################################
1178 #
1179 # Log functions
1180 #
1181 ############################################################################
1182
1183 sub array_as_string ($) {
1184     my $array_ref = shift;
1185     my $string = '';
1186
1187     foreach (@{$array_ref}) {
1188         $string .= $_;
1189     }
1190
1191     return $string;
1192 }
1193
1194 sub show_test ($) {
1195     my $test_ref = shift;
1196     log_message('Test is:' . test_content_as_string($test_ref));
1197 }
1198
1199 # Conditional log
1200 sub l ($$) {
1201     our $log_level;
1202     my $this_level = shift;
1203     my $message = shift;
1204
1205     return unless ($log_level & $this_level);
1206
1207     if (LL_ERROR & $this_level) {
1208         $message = 'Oh noes. ' . $message . ' Fatal error. Exiting.';
1209     }
1210
1211     log_message($message);
1212
1213     if (LL_ERROR & $this_level) {
1214         exit;
1215     }
1216 }
1217
1218 sub log_message ($) {
1219
1220     my $message = shift;
1221
1222     our $logfile;
1223     our $no_logging;
1224     our $leading_log_date;
1225     our $leading_log_time;
1226
1227     my $time_stamp = '';
1228     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime time;
1229
1230     if ($leading_log_date || $leading_log_time) {
1231
1232         if ($leading_log_date) {
1233             $year += 1900;
1234             $mon  += 1;
1235             $time_stamp = sprintf("%i/%.2i/%.2i", $year, $mon, $mday);
1236         }
1237
1238         if ($leading_log_time) {
1239             $time_stamp .= ' ' if $leading_log_date;
1240             $time_stamp.= sprintf("%.2i:%.2i:%.2i", $hour, $min, $sec);
1241         }
1242
1243         $message = $time_stamp . ": " . $message;
1244     }
1245
1246
1247     printf(STDERR "%s\n", $message);
1248
1249 }
1250
1251 sub log_result ($$) {
1252
1253     our $verbose_test_description;
1254     our $filtered_request;
1255
1256     my $test_ref = shift;
1257     my $result = shift;
1258     my $number = shift;
1259
1260     my %test = %{$test_ref};
1261     my $message = '';
1262
1263     $message .= interpret_result($result);
1264     $message .= " for test ";
1265     $message .= $number;
1266     $message .= '/';
1267     $message .= $test{'number'};
1268     $message .= '/';
1269     $message .= $test{'section-id'};
1270     $message .= '/';
1271     $message .= $test{'regression-test-id'};
1272     $message .= '.';
1273
1274     if ($verbose_test_description) {
1275
1276         if ($test{'type'} == CLIENT_HEADER_TEST) {
1277
1278             $message .= ' Header ';
1279             $message .= quote($test{'data'});
1280             $message .= ' and tag ';
1281             $message .= quote($test{'tag'});
1282
1283         } elsif ($test{'type'} == SERVER_HEADER_TEST) {
1284
1285             $message .= ' Request Header ';
1286             $message .= quote($test{'data'});
1287             $message .= ' and tag ';
1288             $message .= quote($test{'tag'});
1289
1290         } elsif ($test{'type'} == DUMB_FETCH_TEST) {
1291
1292             $message .= ' URL ';
1293             $message .= quote($test{'data'});
1294             $message .= ' and expected status code ';
1295             $message .= quote($test{'expected-status-code'});
1296
1297         } elsif ($test{'type'} == TRUSTED_CGI_REQUEST) {
1298
1299             $message .= ' CGI URL ';
1300             $message .= quote($test{'data'});
1301             $message .= ' and expected status code ';
1302             $message .= quote($test{'expected-status-code'});
1303
1304         } elsif ($test{'type'} == METHOD_TEST) {
1305
1306             $message .= ' HTTP method ';
1307             $message .= quote($test{'data'});
1308             $message .= ' and expected status code ';
1309             $message .= quote($test{'expected-status-code'});
1310
1311         } elsif ($test{'type'} == BLOCK_TEST) {
1312
1313             $message .= ' Supposedly-blocked URL: ';
1314             $message .= quote($test{'data'});
1315
1316         } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
1317
1318             $message .= ' Sticky Actions: ';
1319             $message .= quote($test{'sticky-actions'});
1320             $message .= ' and URL: ';
1321             $message .= quote($test{'data'});
1322
1323         } else {
1324
1325             die "Incomplete support for test type " . $test{'type'} .  " detected.";
1326
1327         }
1328     }
1329
1330     log_message($message) if (!$result or cli_option_is_set('verbose'));
1331 }
1332
1333 sub quote ($) {
1334     my $s = shift;
1335     return '\'' . $s . '\'';
1336 }
1337
1338 sub print_version () {
1339     printf PRT_VERSION . "\n" . 'Copyright (C) 2007-2008 Fabian Keil <fk@fabiankeil.de>' . "\n";
1340 }
1341
1342 sub help () {
1343
1344     our %cli_options;
1345
1346     print_version();
1347
1348     print << "    EOF"
1349
1350 Options and their default values if they have any:
1351     [--debug $cli_options{'debug'}]
1352     [--forks $cli_options{'forks'}]
1353     [--fuzzer-address]
1354     [--fuzzer-feeding]
1355     [--help]
1356     [--header-fuzzing]
1357     [--level]
1358     [--loops $cli_options{'loops'}]
1359     [--max-level $cli_options{'max-level'}]
1360     [--max-time $cli_options{'max-time'}]
1361     [--min-level $cli_options{'min-level'}]
1362     [--privoxy-address]
1363     [--retries $cli_options{'retries'}]
1364     [--test-number]
1365     [--verbose]
1366     [--version]
1367 see "perldoc $0" for more information
1368     EOF
1369     ;
1370     exit(0);
1371 }
1372
1373 sub init_cli_options () {
1374
1375     our %cli_options;
1376     our $log_level;
1377
1378     $cli_options{'min-level'} = CLI_MIN_LEVEL;
1379     $cli_options{'max-level'} = CLI_MAX_LEVEL;
1380     $cli_options{'debug'}  = $log_level;
1381     $cli_options{'loops'}  = CLI_LOOPS;
1382     $cli_options{'max-time'}  = CLI_MAX_TIME;
1383     $cli_options{'retries'}  = CLI_RETRIES;
1384     $cli_options{'forks'}    = CLI_FORKS;
1385 }
1386
1387 sub parse_cli_options () {
1388
1389     our %cli_options;
1390     our $log_level;
1391
1392     init_cli_options();
1393
1394     GetOptions (
1395                 'debug=s' => \$cli_options{'debug'},
1396                 'forks=s' => \$cli_options{'forks'},
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 start_forks($) {
1452     my $forks = shift;
1453
1454     l(LL_ERROR, "Invalid --fork value: " . $forks . ".") if ($forks < 0);
1455
1456     foreach my $fork (1 .. $forks) {
1457         log_message("Starting fork $fork");
1458         my $pid = fork();
1459         if (defined $pid && !$pid) {
1460             return;
1461         }
1462     }
1463 }
1464
1465 sub main () {
1466
1467     init_our_variables();
1468     parse_cli_options();
1469     check_for_curl();
1470     init_proxy_settings('vanilla-proxy');
1471     load_regressions_tests();
1472     init_proxy_settings('fuzz-proxy');
1473     start_forks(get_cli_option('forks')) if cli_option_is_set('forks');
1474     execute_regression_tests();
1475 }
1476
1477 main();
1478
1479 =head1 NAME
1480
1481 B<privoxy-regression-test> - A regression test "framework" for Privoxy.
1482
1483 =head1 SYNOPSIS
1484
1485 B<privoxy-regression-test> [B<--debug bitmask>] [B<--forks> forks]
1486 [B<--fuzzer-feeding>] [B<--fuzzer-feeding>] [B<--help>] [B<--level level>]
1487 [B<--loops count>] [B<--max-level max-level>] [B<--max-time max-time>]
1488 [B<--min-level min-level>] B<--privoxy-address proxy-address>
1489 [B<--retries retries>] [B<--test-number test-number>] [B<--verbose>]
1490 [B<--version>]
1491
1492 =head1 DESCRIPTION
1493
1494 Privoxy-Regression-Test is supposed to one day become
1495 a regression test suite for Privoxy. It's not quite there
1496 yet, however, and can currently only test header actions,
1497 check the returned status code for requests to arbitrary
1498 URLs and verify which actions are applied to them.
1499
1500 Client header actions are tested by requesting
1501 B<http://p.p/show-request> and checking whether
1502 or not Privoxy modified the original request as expected.
1503
1504 The original request contains both the header the action-to-be-tested
1505 acts upon and an additional tagger-triggering header that enables
1506 the action to test.
1507
1508 Applied actions are checked through B<http://p.p/show-url-info>.
1509
1510 =head1 CONFIGURATION FILE SYNTAX
1511
1512 Privoxy-Regression-Test's configuration is embedded in
1513 Privoxy action files and loaded through Privoxy's web interface.
1514
1515 It makes testing a Privoxy version running on a remote system easier
1516 and should prevent you from updating your tests without updating Privoxy's
1517 configuration accordingly.
1518
1519 A client-header-action test section looks like this:
1520
1521     # Set Header    = Referer: http://www.example.org.zwiebelsuppe.exit/
1522     # Expect Header = Referer: http://www.example.org/
1523     {+client-header-filter{hide-tor-exit-notation} -hide-referer}
1524     TAG:^client-header-filter\{hide-tor-exit-notation\}$
1525
1526 The example above causes Privoxy-Regression-Test to set
1527 the header B<Referer: http://www.example.org.zwiebelsuppe.exit/>
1528 and to expect it to be modified to
1529 B<Referer: http://www.example.org/>.
1530
1531 When testing this section, Privoxy-Regression-Test will set the header
1532 B<X-Privoxy-Control: client-header-filter{hide-tor-exit-notation}>
1533 causing the B<privoxy-control> tagger to create the tag
1534 B<client-header-filter{hide-tor-exit-notation}> which will finally
1535 cause Privoxy to enable the action section.
1536
1537 Note that the actions itself are only used by Privoxy,
1538 Privoxy-Regression-Test ignores them and will be happy
1539 as long as the expectations are satisfied.
1540
1541 A fetch test looks like this:
1542
1543     # Fetch Test = http://p.p/user-manual
1544     # Expect Status Code = 302
1545
1546 It tells Privoxy-Regression-Test to request B<http://p.p/user-manual>
1547 and to expect a response with the HTTP status code B<302>. Obviously that's
1548 not a very thorough test and mainly useful to get some code coverage
1549 for Valgrind or to verify that the templates are installed correctly.
1550
1551 If you want to test CGI pages that require a trusted
1552 referer, you can use:
1553
1554     # Trusted CGI Request = http://p.p/edit-actions
1555
1556 It works like ordinary fetch tests, but sets the referer
1557 header to a trusted value.
1558
1559 If no explicit status code expectation is set, B<200> is used.
1560
1561 To verify that a URL is blocked, use:
1562
1563     # Blocked URL = http://www.example.com/blocked
1564
1565 To verify that a specific set of actions is applied to an URL, use:
1566
1567     # Sticky Actions = +block{foo} +handle-as-empty-document -handle-as-image
1568     # URL = http://www.example.org/my-first-url
1569
1570 The sticky actions will be checked for all URLs below it
1571 until the next sticky actions directive.
1572
1573 =head1 TEST LEVELS
1574
1575 All tests have test levels to let the user
1576 control which ones to execute (see I<OPTIONS> below).
1577 Test levels are either set with the B<Level> directive,
1578 or implicitly through the test type.
1579
1580 Block tests default to level 7, fetch tests to level 6,
1581 "Sticky Actions" tests default to level 5, tests for trusted CGI
1582 requests to level 3 and client-header-action tests to level 1.
1583
1584 =head1 OPTIONS
1585
1586 B<--debug bitmask> Add the bitmask provided as integer
1587 to the debug settings.
1588
1589 B<--forks forks> Number of forks to start before executing
1590 the regression tests. This is mainly useful for stress-testing.
1591
1592 B<--fuzzer-address> Listening address used when executing
1593 the regression tests. Useful to make sure that the requests
1594 to load the regression tests don't fail due to fuzzing.
1595
1596 B<--fuzzer-feeding> Ignore some errors that would otherwise
1597 cause Privoxy-Regression-Test to abort the test because
1598 they shouldn't happen in normal operation. This option is
1599 intended to be used if Privoxy-Regression-Test is only
1600 used to feed a fuzzer in which case there's a high chance
1601 that Privoxy gets an invalid request and returns an error
1602 message.
1603
1604 B<--help> Shows available command line options.
1605
1606 B<--header-fuzzing> Modifies linear white space in
1607 headers in a way that should not affect the test result.
1608
1609 B<--level level> Only execute tests with the specified B<level>.
1610
1611 B<--loop count> Loop through the regression tests B<count> times.
1612 Useful to feed a fuzzer, or when doing stress tests with
1613 several Privoxy-Regression-Test instances running at the same
1614 time.
1615
1616 B<--max-level max-level> Only execute tests with a B<level>
1617 below or equal to the numerical B<max-level>.
1618
1619 B<--max-time max-time> Give Privoxy B<max-time> seconds
1620 to return data. Increasing the default may make sense when
1621 Privoxy is run through Valgrind, decreasing the default may
1622 make sense when Privoxy-Regression-Test is used to feed
1623 a fuzzer.
1624
1625 B<--min-level min-level> Only execute tests with a B<level>
1626 above or equal to the numerical B<min-level>.
1627
1628 B<--privoxy-address proxy-address> Privoxy's listening address.
1629 If it's not set, the value of the environment variable http_proxy
1630 will be used. B<proxy-address> has to be specified in http_proxy
1631 syntax.
1632
1633 B<--retries retries> Retry B<retries> times.
1634
1635 B<--test-number test-number> Only run the test with the specified
1636 number.
1637
1638 B<--verbose> Also log succesful test runs.
1639
1640 B<--version> Print version and exit.
1641
1642 The second dash is optional, options can be shortened,
1643 as long as there are no ambiguities.
1644
1645 =head1 PRIVOXY CONFIGURATION
1646
1647 Privoxy-Regression-Test is shipped with B<regression-tests.action>
1648 which aims to test all official client-header modifying actions
1649 and can be used to verify that the templates and the user manual
1650 files are installed correctly.
1651
1652 To use it, it has to be copied in Privoxy's configuration
1653 directory, and afterwards referenced in Privoxy's configuration
1654 file with the line:
1655
1656     actionsfile regression-tests.action
1657
1658 In general, its tests are supposed to work without changing
1659 any other action files, unless you already added lots of
1660 taggers yourself. If you are using taggers that cause problems,
1661 you might have to temporary disable them for Privoxy's CGI pages.
1662
1663 Some of the regression tests rely on Privoxy features that
1664 may be disabled in your configuration. Tests with a level below
1665 7 are supposed to work with all Privoxy configurations (provided
1666 you didn't build with FEATURE_GRACEFUL_TERMINATION).
1667
1668 Tests with level 9 require Privoxy to deliver the User Manual,
1669 tests with level 12 require the CGI editor to be enabled.
1670
1671 =head1 CAVEATS
1672
1673 Expect the configuration file syntax to change with future releases.
1674
1675 =head1 LIMITATIONS
1676
1677 As Privoxy's B<show-request> page only shows client headers,
1678 Privoxy-Regression-Test can't use it to test Privoxy actions
1679 that modify server headers.
1680
1681 As Privoxy-Regression-Test relies on Privoxy's tag feature to
1682 control the actions to test, it currently only works with
1683 Privoxy 3.0.7 or later.
1684
1685 At the moment Privoxy-Regression-Test fetches Privoxy's
1686 configuration page through I<curl>(1), therefore you have to
1687 have I<curl> installed, otherwise you won't be able to run
1688 Privoxy-Regression-Test in a meaningful way.
1689
1690 =head1 SEE ALSO
1691
1692 privoxy(1) curl(1)
1693
1694 =head1 AUTHOR
1695
1696 Fabian Keil <fk@fabiankeil.de>
1697
1698 =cut