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.155 2008/06/28 16:39:59 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.2',
  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, "Loading regression tests from action file(s) delivered by Privoxy.");
 314
 315     for my $file_number (0 .. @actionfiles - 1) {
 316
 317         my $curl_url = ' "' . $actionfiles[$file_number] . '"';
 318         my $actionfile = undef;
 319         my $sticky_actions = undef;
 320
 321         foreach (@{get_cgi_page_or_else($curl_url)}) {
 322
 323             my $no_checks = 0;
 324             chomp;
 325
 326             if (/<h2>Contents of Actions File (.*?)</) {
 327                 $actionfile = $1;
 328                 next;
 329             }
 330             next unless defined $actionfile;
 331
 332             last if (/<\/pre>/);
 333
 334             my ($token, $value) = tokenize($_);
 335
 336             next unless defined $token;
 337
 338             # Load regression tests
 339
 340             if (token_starts_new_test($token)) {
 341
 342                 # Beginning of new regression test.
 343                 $ri++;
 344                 $count++;
 345                 enlist_new_test(\@regression_tests, $token, $value, $si, $ri, $count);
 346             }
 347
 348             if ($token =~ /level\s+(\d+)/i) {
 349
 350                 my $level = $1;
 351                 register_dependency($level, $value);
 352             }
 353
 354             if ($token eq 'sticky actions') {
 355
 356                 # Will be used by each following Sticky URL.
 357                 $sticky_actions = $value;
 358                 if ($sticky_actions =~ /{[^}]*\s/) {
 359                     l(LL_ERROR,
 360                       "'Sticky Actions' with whitespace inside the " .
 361                       "action parameters are currently unsupported.");
 362                 }
 363             }
 364
 365             if ($si == -1 || $ri == -1) {
 366                 # No beginning of a test detected yet,
 367                 # so we don't care about any other test
 368                 # attributes.
 369                 next;
 370             }
 371
 372             if ($token eq 'expect header') {
 373
 374                 l(LL_FILE_LOADING, "Detected expectation: " . $value);
 375                 $regression_tests[$si][$ri]{'expect-header'} = $value;
 376
 377             } elsif ($token eq 'tag') {
 378
 379                 next if ($ri == -1);
 380
 381                 my $tag = parse_tag($value);
 382
 383                 # We already checked in parse_tag() after filtering
 384                 $no_checks = 1;
 385
 386                 l(LL_FILE_LOADING, "Detected TAG: " . $tag);
 387
 388                 # Save tag for all tests in this section
 389                 do {
 390                     $regression_tests[$si][$ri]{'tag'} = $tag;
 391                 } while ($ri-- > 0);
 392
 393                 $si++;
 394                 $ri = -1;
 395
 396             } elsif ($token eq 'ignore' && $value =~ /Yes/i) {
 397
 398                 l(LL_FILE_LOADING, "Ignoring section: " . test_content_as_string($regression_tests[$si][$ri]));
 399                 $regression_tests[$si][$ri]{'ignore'} = 1;
 400                 $ignored++;
 401
 402             } elsif ($token eq 'expect status code') {
 403
 404                 l(LL_FILE_LOADING, "Expecting status code: " . $value);
 405                 $regression_tests[$si][$ri]{'expected-status-code'} = $value;
 406
 407             } elsif ($token eq 'level') { # XXX: stupid name
 408
 409                 $value =~ s@(\d+).*@$1@;
 410                 l(LL_FILE_LOADING, "Level: " . $value);
 411                 $regression_tests[$si][$ri]{'level'} = $value;
 412
 413             } elsif ($token eq 'method') {
 414
 415                 l(LL_FILE_LOADING, "Method: " . $value);
 416                 $regression_tests[$si][$ri]{'method'} = $value;
 417
 418             } elsif ($token eq 'url') {
 419
 420                 if (defined $sticky_actions) {
 421                     die "WTF? Attempted to overwrite Sticky Actions"
 422                         if defined ($regression_tests[$si][$ri]{'sticky-actions'});
 423
 424                     l(LL_FILE_LOADING, "Sticky actions: " . $sticky_actions);
 425                     $regression_tests[$si][$ri]{'sticky-actions'} = $sticky_actions;
 426                 } else {
 427                     l(LL_ERROR, "Sticky URL without Sticky Actions: $value");
 428                 }
 429
 430             } else {
 431
 432                 # We don't use it, so we don't need
 433                 $no_checks = 1;
 434             }
 435             # XXX: Neccessary?
 436             check_for_forbidden_characters($value) unless $no_checks;
 437             check_for_forbidden_characters($token);
 438         }
 439     }
 440
 441     l(LL_FILE_LOADING, "Done loading " . $count . " regression tests."
 442       . " Of which " . $ignored. " will be ignored)\n");
 443 }
 444
 445 ############################################################################
 446 #
 447 # Regression test executing functions
 448 #
 449 ############################################################################
 450
 451 sub execute_regression_tests () {
 452
 453     our @regression_tests;
 454     my $loops = get_cli_option('loops');
 455     my $all_tests    = 0;
 456     my $all_failures = 0;
 457     my $all_successes = 0;
 458
 459     unless (@regression_tests) {
 460
 461         l(LL_STATUS, "No regression tests found.");
 462         return;
 463     }
 464
 465     l(LL_STATUS, "Executing regression tests ...");
 466
 467     while ($loops-- > 0) {
 468
 469         my $successes = 0;
 470         my $tests = 0;
 471         my $failures;
 472         my $skipped = 0;
 473
 474         for my $s (0 .. @regression_tests - 1) {
 475
 476             my $r = 0;
 477
 478             while (defined $regression_tests[$s][$r]) {
 479
 480                 die "Section id mismatch" if ($s != $regression_tests[$s][$r]{'section-id'});
 481                 die "Regression test id mismatch" if ($r != $regression_tests[$s][$r]{'regression-test-id'});
 482
 483                 my $number = $regression_tests[$s][$r]{'number'};
 484
 485                 if ($regression_tests[$s][$r]{'ignore'}
 486                     or level_is_unacceptable($regression_tests[$s][$r]{'level'})
 487                     or test_number_is_unacceptable($number)) {
 488
 489                     $skipped++;
 490
 491                 } else {
 492
 493                     my $result = execute_regression_test($regression_tests[$s][$r]);
 494
 495                     log_result($regression_tests[$s][$r], $result, $tests);
 496
 497                     $successes += $result;
 498                     $tests++;
 499                 }
 500                 $r++;
 501             }
 502         }
 503         $failures = $tests - $successes;
 504
 505         log_message("Executed " . $tests . " regression tests. " .
 506             'Skipped ' . $skipped . '. ' .
 507             $successes . " successes, " . $failures . " failures.");
 508
 509         $all_tests    += $tests;
 510         $all_failures += $failures;
 511         $all_successes += $successes;
 512
 513     }
 514
 515     if (get_cli_option('loops') > 1) {
 516         log_message("Total: Executed " . $all_tests . " regression tests. " .
 517             $all_successes . " successes, " . $all_failures . " failures.");
 518     }
 519 }
 520
 521 sub level_is_unacceptable ($) {
 522     my $level = shift;
 523     return ((cli_option_is_set('level') and get_cli_option('level') != $level)
 524             or ($level < get_cli_option('min-level'))
 525             or ($level > get_cli_option('max-level'))
 526             or dependency_unsatisfied($level)
 527             );
 528 }
 529
 530 sub test_number_is_unacceptable ($) {
 531     my $test_number = shift;
 532     return (cli_option_is_set('test-number')
 533             and get_cli_option('test-number') != $test_number)
 534 }
 535
 536 sub dependency_unsatisfied ($) {
 537
 538     my $level = shift;
 539     our %dependencies;
 540     our @privoxy_config;
 541     my $dependency_problem = 0;
 542
 543     if (defined ($dependencies{$level}{'config line'})) {
 544
 545         my $dependency = $dependencies{$level}{'config line'};
 546         $dependency_problem = 1;
 547
 548         foreach (@privoxy_config) {
 549
 550              $dependency_problem = 0 if (/$dependency/);
 551         }
 552     }
 553
 554     return $dependency_problem;
 555 }
 556
 557 sub register_dependency ($$) {
 558
 559     my $level = shift;
 560     my $dependency = shift;
 561     our %dependencies;
 562
 563     if ($dependency =~ /config line\s+(.*)/) {
 564
 565        $dependencies{$level}{'config line'} = $1;
 566     }
 567 }
 568
 569 # XXX: somewhat misleading name
 570 sub execute_regression_test ($) {
 571
 572     my $test_ref = shift;
 573     my %test = %{$test_ref};
 574     my $result = 0;
 575
 576     if ($test{'type'} == CLIENT_HEADER_TEST) {
 577
 578         $result = execute_client_header_regression_test($test_ref);
 579
 580     } elsif ($test{'type'} == SERVER_HEADER_TEST) {
 581
 582         $result = execute_server_header_regression_test($test_ref);
 583
 584     } elsif ($test{'type'} == DUMB_FETCH_TEST
 585           or $test{'type'} == TRUSTED_CGI_REQUEST) {
 586
 587         $result = execute_dumb_fetch_test($test_ref);
 588
 589     } elsif ($test{'type'} == METHOD_TEST) {
 590
 591         $result = execute_method_test($test_ref);
 592
 593     } elsif ($test{'type'} == BLOCK_TEST) {
 594
 595         $result = execute_block_test($test_ref);
 596
 597     } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
 598
 599         $result = execute_sticky_actions_test($test_ref);
 600
 601     } else {
 602
 603         die "Unsupported test type detected: " . $test{'type'};
 604
 605     }
 606
 607     return $result;
 608 }
 609
 610 sub execute_method_test ($) {
 611
 612     my $test_ref = shift;
 613     my %test = %{$test_ref};
 614     my $buffer_ref;
 615     my $status_code;
 616     my $method = $test{'data'};
 617
 618     my $curl_parameters = '';
 619     my $expected_status_code = $test{'expected-status-code'};
 620
 621     $curl_parameters .= '--request ' . $method . ' ';
 622     # Don't complain about the 'missing' body
 623     $curl_parameters .= '--head ' if ($method =~ /^HEAD$/i);
 624
 625     $curl_parameters .= PRIVOXY_CGI_URL;
 626
 627     $buffer_ref = get_page_with_curl($curl_parameters);
 628     $status_code = get_status_code($buffer_ref);
 629
 630     return check_status_code_result($status_code, $expected_status_code);
 631 }
 632
 633 sub execute_dumb_fetch_test ($) {
 634
 635     my $test_ref = shift;
 636     my %test = %{$test_ref};
 637     my $buffer_ref;
 638     my $status_code;
 639
 640     my $curl_parameters = '';
 641     my $expected_status_code = $test{'expected-status-code'};
 642
 643     if (defined $test{method}) {
 644         $curl_parameters .= '--request ' . $test{method} . ' ';
 645     }
 646     if ($test{type} == TRUSTED_CGI_REQUEST) {
 647         $curl_parameters .= '--referer ' . PRIVOXY_CGI_URL . ' ';
 648     }
 649
 650     $curl_parameters .= $test{'data'};
 651
 652     $buffer_ref = get_page_with_curl($curl_parameters);
 653     $status_code = get_status_code($buffer_ref);
 654
 655     return check_status_code_result($status_code, $expected_status_code);
 656 }
 657
 658 sub execute_block_test ($) {
 659
 660     my $test = shift;
 661     my $url = $test->{'data'};
 662     my $final_results = get_final_results($url);
 663
 664     return defined $final_results->{'+block'};
 665 }
 666
 667 sub execute_sticky_actions_test ($) {
 668
 669     my $test = shift;
 670     my $url = $test->{'data'};
 671     my $verified_actions = 0;
 672     # XXX: splitting currently doesn't work for actions whose parameters contain spaces.
 673     my @sticky_actions = split(/\s+/, $test->{'sticky-actions'});
 674     my $final_results = get_final_results($url);
 675
 676     foreach my $sticky_action (@sticky_actions) {
 677         if (defined $final_results->{$sticky_action}) {
 678             # Exact match
 679             $verified_actions++;
 680         }elsif ($sticky_action =~ /-.*\{/ and
 681                 not defined $final_results->{$sticky_action}) {
 682             # Disabled multi actions aren't explicitly listed as
 683             # disabled and thus have to be checked by verifying
 684             # that they aren't enabled.
 685             $verified_actions++;
 686         } else {
 687             l(LL_VERBOSE_FAILURE,
 688               "Ooops. '$sticky_action' is not among the final results.");
 689         }
 690     }
 691
 692     return $verified_actions == @sticky_actions;
 693 }
 694
 695 sub get_final_results ($) {
 696
 697     my $url = shift;
 698     my $curl_parameters = '';
 699     my %final_results = ();
 700     my $final_results_reached = 0;
 701
 702     die "Unacceptable characters in $url" if $url =~ m@[\\'"]@;
 703     # XXX: should be URL-encoded properly
 704     $url =~ s@%@%25@g;
 705     $url =~ s@\s@%20@g;
 706     $url =~ s@&@%26@g;
 707     $url =~ s@:@%3A@g;
 708     $url =~ s@/@%2F@g;
 709
 710     $curl_parameters .= quote(PRIVOXY_CGI_URL . 'show-url-info?url=' . $url);
 711
 712     foreach (@{get_cgi_page_or_else($curl_parameters)}) {
 713
 714         $final_results_reached = 1 if (m@<h2>Final results:</h2>@);
 715
 716         next unless ($final_results_reached);
 717         last if (m@</td>@);
 718
 719         if (m@<br>([-+])<a.*>([^>]*)</a>(?: (\{.*\}))?@) {
 720             my $action = $1.$2;
 721             my $parameter = $3;
 722
 723             if (defined $parameter) {
 724                 # In case the caller needs to check
 725                 # the action and its parameter
 726                 $final_results{$action . $parameter} = 1;
 727             }
 728             # In case the action doesn't have parameters
 729             # or the caller doesn't care for the parameter.
 730             $final_results{$action} = 1;
 731         }
 732     }
 733
 734     return \%final_results;
 735 }
 736
 737 sub check_status_code_result ($$) {
 738
 739     my $status_code = shift;
 740     my $expected_status_code = shift;
 741     my $result = 0;
 742
 743     unless (defined $status_code) {
 744
 745         # XXX: should probably be caught earlier.
 746         l(LL_VERBOSE_FAILURE,
 747           "Ooops. We expected status code " . $expected_status_code . ", but didn't get any status code at all.");
 748
 749     } elsif ($expected_status_code == $status_code) {
 750
 751         $result = 1;
 752         l(LL_VERBOSE_SUCCESS,
 753           "Yay. We expected status code " . $expected_status_code . ", and received: " . $status_code . '.');
 754
 755     } elsif (cli_option_is_set('fuzzer-feeding') and $status_code == 123) {
 756
 757         l(LL_VERBOSE_FAILURE,
 758           "Oh well. Status code lost while fuzzing. Can't check if it was " . $expected_status_code . '.');
 759
 760     } else {
 761
 762         l(LL_VERBOSE_FAILURE,
 763           "Ooops. We expected status code " . $expected_status_code . ", but received: " . $status_code . '.');
 764
 765     }
 766
 767     return $result;
 768 }
 769
 770 sub execute_client_header_regression_test ($) {
 771
 772     my $test_ref = shift;
 773     my $buffer_ref;
 774     my $header;
 775
 776     $buffer_ref = get_show_request_with_curl($test_ref);
 777
 778     $header = get_header($buffer_ref, $test_ref);
 779
 780     return check_header_result($test_ref, $header);
 781 }
 782
 783 sub execute_server_header_regression_test ($) {
 784
 785     my $test_ref = shift;
 786     my $buffer_ref;
 787     my $header;
 788
 789     $buffer_ref = get_head_with_curl($test_ref);
 790
 791     $header = get_server_header($buffer_ref, $test_ref);
 792
 793     return check_header_result($test_ref, $header);
 794 }
 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
1106 sub get_head_with_curl ($) {
1107
1108     our $fellatio_url = FELLATIO_URL;
1109     my $test_ref = shift;
1110     my %test = %{$test_ref};
1111
1112     my $curl_parameters = ' ';
1113
1114     # Enable the action to test
1115     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
1116     # The header to filter
1117     $curl_parameters .= '-H \'X-Gimme-Head-With: ' . $test{'data'} . '\' ';
1118     $curl_parameters .= '--head ';
1119
1120     $curl_parameters .= ' ';
1121     $curl_parameters .= $fellatio_url;
1122
1123     return get_page_with_curl($curl_parameters);
1124 }
1125
1126
1127 sub get_page_with_curl ($) {
1128
1129     our $proxy;
1130
1131     my $parameters = shift;
1132     my @buffer;
1133     my $curl_line = CURL;
1134     my $retries_left = get_cli_option('retries') + 1;
1135     my $failure_reason;
1136
1137     $curl_line .= ' --proxy ' . $proxy if (defined $proxy);
1138
1139     # We want to see the HTTP status code
1140     $curl_line .= " --include ";
1141     # Let Privoxy emit two log messages less.
1142     $curl_line .= ' -H \'Proxy-Connection:\' ' unless $parameters =~ /Proxy-Connection:/;
1143     $curl_line .= ' -H \'Connection: close\' ' unless $parameters =~ /Connection:/;
1144     # We don't care about fetch statistic.
1145     $curl_line .= " -s ";
1146     # We do care about the failure reason if any.
1147     $curl_line .= " -S ";
1148     # We want to advertise ourselves
1149     $curl_line .= " --user-agent '" . PRT_VERSION . "' ";
1150     # We aren't too patient
1151     $curl_line .= " --max-time '" . get_cli_option('max-time') . "' ";
1152
1153     $curl_line .= $parameters;
1154     # XXX: still necessary?
1155     $curl_line .= ' 2>&1';
1156
1157     l(LL_PAGE_FETCHING, "Executing: " . $curl_line);
1158
1159     do {
1160         @buffer = `$curl_line`;
1161
1162         if ($?) {
1163             $failure_reason = array_as_string(\@buffer);
1164             chomp $failure_reason;
1165             l(LL_SOFT_ERROR, "Fetch failure: '" . $failure_reason . $! ."'");
1166         }
1167     } while ($? && --$retries_left);
1168
1169     unless ($retries_left) {
1170         l(LL_ERROR,
1171           "Running curl failed " . get_cli_option('retries') .
1172           " times in a row. Last error: '" . $failure_reason . "'.");
1173     }
1174
1175     return \@buffer;
1176 }
1177
1178
1179 ############################################################################
1180 #
1181 # Log functions
1182 #
1183 ############################################################################
1184
1185 sub array_as_string ($) {
1186     my $array_ref = shift;
1187     my $string = '';
1188
1189     foreach (@{$array_ref}) {
1190         $string .= $_;
1191     }
1192
1193     return $string;
1194 }
1195
1196
1197 sub show_test ($) {
1198     my $test_ref = shift;
1199     log_message('Test is:' . test_content_as_string($test_ref));
1200 }
1201
1202 # Conditional log
1203 sub l ($$) {
1204     our $log_level;
1205     my $this_level = shift;
1206     my $message = shift;
1207
1208     return unless ($log_level & $this_level);
1209
1210     if (LL_ERROR & $this_level) {
1211         $message = 'Oh noes. ' . $message . ' Fatal error. Exiting.';
1212     }
1213
1214     log_message($message);
1215
1216     if (LL_ERROR & $this_level) {
1217         exit;
1218     }
1219 }
1220
1221 sub log_message ($) {
1222
1223     my $message = shift;
1224
1225     our $logfile;
1226     our $no_logging;
1227     our $leading_log_date;
1228     our $leading_log_time;
1229
1230     my $time_stamp = '';
1231     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime time;
1232
1233     if ($leading_log_date || $leading_log_time) {
1234
1235         if ($leading_log_date) {
1236             $year += 1900;
1237             $mon  += 1;
1238             $time_stamp = sprintf("%i/%.2i/%.2i", $year, $mon, $mday);
1239         }
1240
1241         if ($leading_log_time) {
1242             $time_stamp .= ' ' if $leading_log_date;
1243             $time_stamp.= sprintf("%.2i:%.2i:%.2i", $hour, $min, $sec);
1244         }
1245
1246         $message = $time_stamp . ": " . $message;
1247     }
1248
1249
1250     printf(STDERR "%s\n", $message);
1251
1252 }
1253
1254 sub log_result ($$) {
1255
1256     our $verbose_test_description;
1257     our $filtered_request;
1258
1259     my $test_ref = shift;
1260     my $result = shift;
1261     my $number = shift;
1262
1263     my %test = %{$test_ref};
1264     my $message = '';
1265
1266     $message .= interpret_result($result);
1267     $message .= " for test ";
1268     $message .= $number;
1269     $message .= '/';
1270     $message .= $test{'number'};
1271     $message .= '/';
1272     $message .= $test{'section-id'};
1273     $message .= '/';
1274     $message .= $test{'regression-test-id'};
1275     $message .= '.';
1276
1277     if ($verbose_test_description) {
1278
1279         if ($test{'type'} == CLIENT_HEADER_TEST) {
1280
1281             $message .= ' Header ';
1282             $message .= quote($test{'data'});
1283             $message .= ' and tag ';
1284             $message .= quote($test{'tag'});
1285
1286         } elsif ($test{'type'} == SERVER_HEADER_TEST) {
1287
1288             $message .= ' Request Header ';
1289             $message .= quote($test{'data'});
1290             $message .= ' and tag ';
1291             $message .= quote($test{'tag'});
1292
1293         } elsif ($test{'type'} == DUMB_FETCH_TEST) {
1294
1295             $message .= ' URL ';
1296             $message .= quote($test{'data'});
1297             $message .= ' and expected status code ';
1298             $message .= quote($test{'expected-status-code'});
1299
1300         } elsif ($test{'type'} == TRUSTED_CGI_REQUEST) {
1301
1302             $message .= ' CGI URL ';
1303             $message .= quote($test{'data'});
1304             $message .= ' and expected status code ';
1305             $message .= quote($test{'expected-status-code'});
1306
1307         } elsif ($test{'type'} == METHOD_TEST) {
1308
1309             $message .= ' HTTP method ';
1310             $message .= quote($test{'data'});
1311             $message .= ' and expected status code ';
1312             $message .= quote($test{'expected-status-code'});
1313
1314         } elsif ($test{'type'} == BLOCK_TEST) {
1315
1316             $message .= ' Supposedly-blocked URL: ';
1317             $message .= quote($test{'data'});
1318
1319         } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
1320
1321             $message .= ' Sticky Actions: ';
1322             $message .= quote($test{'sticky-actions'});
1323             $message .= ' and URL: ';
1324             $message .= quote($test{'data'});
1325
1326         } else {
1327
1328             die "Incomplete support for test type " . $test{'type'} .  " detected.";
1329
1330         }
1331     }
1332
1333     log_message($message) if (!$result or cli_option_is_set('verbose'));
1334 }
1335
1336 sub quote ($) {
1337     my $s = shift;
1338     return '\'' . $s . '\'';
1339 }
1340
1341 sub print_version () {
1342     printf PRT_VERSION . "\n" . 'Copyright (C) 2007-2008 Fabian Keil <fk@fabiankeil.de>' . "\n";
1343 }
1344
1345 sub help () {
1346
1347     our %cli_options;
1348
1349     print_version();
1350
1351     print << "    EOF"
1352
1353 Options and their default values if they have any:
1354     [--debug $cli_options{'debug'}]
1355     [--forks $cli_options{'forks'}]
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     $cli_options{'forks'}    = CLI_FORKS;
1387 }
1388
1389 sub parse_cli_options () {
1390
1391     our %cli_options;
1392     our $log_level;
1393
1394     init_cli_options();
1395
1396     GetOptions (
1397                 'debug=s' => \$cli_options{'debug'},
1398                 'forks=s' => \$cli_options{'forks'},
1399                 'help'     => sub { help },
1400                 'header-fuzzing' => \$cli_options{'header-fuzzing'},
1401                 'min-level=s' => \$cli_options{'min-level'},
1402                 'max-level=s' => \$cli_options{'max-level'},
1403                 'privoxy-address=s' => \$cli_options{'privoxy-address'},
1404                 'fuzzer-address=s' => \$cli_options{'fuzzer-address'},
1405                 'level=s' => \$cli_options{'level'},
1406                 'loops=s' => \$cli_options{'loops'},
1407                 'test-number=s' => \$cli_options{'test-number'},
1408                 'fuzzer-feeding' => \$cli_options{'fuzzer-feeding'},
1409                 'retries=s' => \$cli_options{'retries'},
1410                 'max-time=s' => \$cli_options{'max-time'},
1411                 'verbose' => \$cli_options{'verbose'},
1412                 'version'  => sub { print_version && exit(0) }
1413     );
1414     $log_level |= $cli_options{'debug'};
1415 }
1416
1417 sub cli_option_is_set ($) {
1418
1419     our %cli_options;
1420     my $cli_option = shift;
1421
1422     return defined $cli_options{$cli_option};
1423 }
1424
1425 sub get_cli_option ($) {
1426
1427     our %cli_options;
1428     my $cli_option = shift;
1429
1430     die "Unknown CLI option: $cli_option" unless defined $cli_options{$cli_option};
1431
1432     return $cli_options{$cli_option};
1433 }
1434
1435 sub init_proxy_settings($) {
1436
1437     my $choice = shift;
1438     our $proxy = undef;
1439
1440     if (($choice eq 'fuzz-proxy') and cli_option_is_set('fuzzer-address')) {
1441         $proxy = get_cli_option('fuzzer-address');
1442     }
1443
1444     if ((not defined $proxy) or ($choice eq 'vanilla-proxy')) {
1445
1446         if (cli_option_is_set('privoxy-address')) {
1447             $proxy .=  get_cli_option('privoxy-address');
1448         }
1449
1450     }
1451 }
1452
1453 sub start_forks($) {
1454     my $forks = shift;
1455
1456     l(LL_ERROR, "Invalid --fork value: " . $forks . ".") if ($forks < 0);
1457
1458     foreach my $fork (1 .. $forks) {
1459         log_message("Starting fork $fork");
1460         my $pid = fork();
1461         if (defined $pid && !$pid) {
1462             return;
1463         }
1464     }
1465 }
1466
1467
1468 sub main () {
1469
1470     init_our_variables();
1471     parse_cli_options();
1472     check_for_curl();
1473     init_proxy_settings('vanilla-proxy');
1474     load_regressions_tests();
1475     init_proxy_settings('fuzz-proxy');
1476     start_forks(get_cli_option('forks')) if cli_option_is_set('forks');
1477     execute_regression_tests();
1478 }
1479
1480 main();
1481
1482 =head1 NAME
1483
1484 B<privoxy-regression-test> - A regression test "framework" for Privoxy.
1485
1486 =head1 SYNOPSIS
1487
1488 B<privoxy-regression-test> [B<--debug bitmask>] [B<--forks> forks]
1489 [B<--fuzzer-feeding>] [B<--fuzzer-feeding>] [B<--help>] [B<--level level>]
1490 [B<--loops count>] [B<--max-level max-level>] [B<--max-time max-time>]
1491 [B<--min-level min-level>] B<--privoxy-address proxy-address>
1492 [B<--retries retries>] [B<--verbose>] [B<--version>]
1493
1494 =head1 DESCRIPTION
1495
1496 Privoxy-Regression-Test is supposed to one day become
1497 a regression test suite for Privoxy. It's not quite there
1498 yet, however, and can currently only test header actions,
1499 check the returned status code for requests to arbitrary
1500 URLs and verify which actions are applied to them.
1501
1502 Client header actions are tested by requesting
1503 B<http://p.p/show-request> and checking whether
1504 or not Privoxy modified the original request as expected.
1505
1506 The original request contains both the header the action-to-be-tested
1507 acts upon and an additional tagger-triggering header that enables
1508 the action to test.
1509
1510 Applied actions are checked through B<http://p.p/show-url-info>.
1511
1512 =head1 CONFIGURATION FILE SYNTAX
1513
1514 Privoxy-Regression-Test's configuration is embedded in
1515 Privoxy action files and loaded through Privoxy's web interface.
1516
1517 It makes testing a Privoxy version running on a remote system easier
1518 and should prevent you from updating your tests without updating Privoxy's
1519 configuration accordingly.
1520
1521 A client-header-action test section looks like this:
1522
1523     # Set Header    = Referer: http://www.example.org.zwiebelsuppe.exit/
1524     # Expect Header = Referer: http://www.example.org/
1525     {+client-header-filter{hide-tor-exit-notation} -hide-referer}
1526     TAG:^client-header-filter\{hide-tor-exit-notation\}$
1527
1528 The example above causes Privoxy-Regression-Test to set
1529 the header B<Referer: http://www.example.org.zwiebelsuppe.exit/>
1530 and to expect it to be modified to
1531 B<Referer: http://www.example.org/>.
1532
1533 When testing this section, Privoxy-Regression-Test will set the header
1534 B<X-Privoxy-Control: client-header-filter{hide-tor-exit-notation}>
1535 causing the B<privoxy-control> tagger to create the tag
1536 B<client-header-filter{hide-tor-exit-notation}> which will finally
1537 cause Privoxy to enable the action section.
1538
1539 Note that the actions itself are only used by Privoxy,
1540 Privoxy-Regression-Test ignores them and will be happy
1541 as long as the expectations are satisfied.
1542
1543 A fetch test looks like this:
1544
1545     # Fetch Test = http://p.p/user-manual
1546     # Expect Status Code = 302
1547
1548 It tells Privoxy-Regression-Test to request B<http://p.p/user-manual>
1549 and to expect a response with the HTTP status code B<302>. Obviously that's
1550 not a very thorough test and mainly useful to get some code coverage
1551 for Valgrind or to verify that the templates are installed correctly.
1552
1553 If you want to test CGI pages that require a trusted
1554 referer, you can use:
1555
1556     # Trusted CGI Request = http://p.p/edit-actions
1557
1558 It works like ordinary fetch tests, but sets the referer
1559 header to a trusted value.
1560
1561 If no explicit status code expectation is set, B<200> is used.
1562
1563 To verify that a URL is blocked, use:
1564
1565     # Blocked URL = http://www.example.com/blocked
1566
1567 To verify that a specific set of actions is applied to an URL, use:
1568
1569     # Sticky Actions = +block{foo} +handle-as-empty-document -handle-as-image
1570     # URL = http://www.example.org/my-first-url
1571
1572 The sticky actions will be checked for all URLs below it
1573 until the next sticky actions directive.
1574
1575 =head1 TEST LEVELS
1576
1577 All tests have test levels to let the user
1578 control which ones to execute (see I<OPTIONS> below).
1579 Test levels are either set with the B<Level> directive,
1580 or implicitly through the test type.
1581
1582 Block tests default to level 7, fetch tests to level 6,
1583 "Sticky Actions" tests default to level 5, tests for trusted CGI
1584 requests to level 3 and client-header-action tests to level 1.
1585
1586 =head1 OPTIONS
1587
1588 B<--debug bitmask> Add the bitmask provided as integer
1589 to the debug settings.
1590
1591 B<--forks forks> Number of forks to start before executing
1592 the regression tests. This is mainly useful for stress-testing.
1593
1594 B<--fuzzer-address> Listening address used when executing
1595 the regression tests. Useful to make sure that the requests
1596 to load the regression tests don't fail due to fuzzing.
1597
1598 B<--fuzzer-feeding> Ignore some errors that would otherwise
1599 cause Privoxy-Regression-Test to abort the test because
1600 they shouldn't happen in normal operation. This option is
1601 intended to be used if Privoxy-Regression-Test is only
1602 used to feed a fuzzer in which case there's a high chance
1603 that Privoxy gets an invalid request and returns an error
1604 message.
1605
1606 B<--help> Shows available command line options.
1607
1608 B<--header-fuzzing> Modifies linear white space in
1609 headers in a way that should not affect the test result.
1610
1611 B<--level level> Only execute tests with the specified B<level>.
1612
1613 B<--loop count> Loop through the regression tests B<count> times.
1614 Useful to feed a fuzzer, or when doing stress tests with
1615 several Privoxy-Regression-Test instances running at the same
1616 time.
1617
1618 B<--max-level max-level> Only execute tests with a B<level>
1619 below or equal to the numerical B<max-level>.
1620
1621 B<--max-time max-time> Give Privoxy B<max-time> seconds
1622 to return data. Increasing the default may make sense when
1623 Privoxy is run through Valgrind, decreasing the default may
1624 make sense when Privoxy-Regression-Test is used to feed
1625 a fuzzer.
1626
1627 B<--min-level min-level> Only execute tests with a B<level>
1628 above or equal to the numerical B<min-level>.
1629
1630 B<--privoxy-address proxy-address> Privoxy's listening address.
1631 If it's not set, the value of the environment variable http_proxy
1632 will be used. B<proxy-address> has to be specified in http_proxy
1633 syntax.
1634
1635 B<--retries retries> Retry B<retries> times.
1636
1637 B<--verbose> Also log succesful test runs.
1638
1639 B<--version> Print version and exit.
1640
1641 The second dash is optional, options can be shortened,
1642 as long as there are no ambiguities.
1643
1644 =head1 PRIVOXY CONFIGURATION
1645
1646 Privoxy-Regression-Test is shipped with B<regression-tests.action>
1647 which aims to test all official client-header modifying actions
1648 and can be used to verify that the templates and the user manual
1649 files are installed correctly.
1650
1651 To use it, it has to be copied in Privoxy's configuration
1652 directory, and afterwards referenced in Privoxy's configuration
1653 file with the line:
1654
1655     actionsfile regression-tests.action
1656
1657 In general, its tests are supposed to work without changing
1658 any other action files, unless you already added lots of
1659 taggers yourself. If you are using taggers that cause problems,
1660 you might have to temporary disable them for Privoxy's CGI pages.
1661
1662 Some of the regression tests rely on Privoxy features that
1663 may be disabled in your configuration. Tests with a level below
1664 7 are supposed to work with all Privoxy configurations (provided
1665 you didn't build with FEATURE_GRACEFUL_TERMINATION).
1666
1667 Tests with level 9 require Privoxy to deliver the User Manual,
1668 tests with level 12 require the CGI editor to be enabled.
1669
1670 =head1 CAVEATS
1671
1672 Expect the configuration file syntax to change with future releases.
1673
1674 =head1 LIMITATIONS
1675
1676 As Privoxy's B<show-request> page only shows client headers,
1677 Privoxy-Regression-Test can't use it to test Privoxy actions
1678 that modify server headers.
1679
1680 As Privoxy-Regression-Test relies on Privoxy's tag feature to
1681 control the actions to test, it currently only works with
1682 Privoxy 3.0.7 or later.
1683
1684 At the moment Privoxy-Regression-Test fetches Privoxy's
1685 configuration page through I<curl>(1), therefore you have to
1686 have I<curl> installed, otherwise you won't be able to run
1687 Privoxy-Regression-Test in a meaningful way.
1688
1689 =head1 SEE ALSO
1690
1691 privoxy(1) curl(1)
1692
1693 =head1 AUTHOR
1694
1695 Fabian Keil <fk@fabiankeil.de>
1696
1697 =cut