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.157 2008/07/03 11:32:14 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, "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 sub interpret_result ($) {
 797     my $success = shift;
 798     return $success ? "Success" : "Failure";
 799 }
 800
 801 sub check_header_result ($$) {
 802
 803     my $test_ref = shift;
 804     my $header = shift;
 805
 806     my %test = %{$test_ref};
 807     my $expect_header = $test{'expect-header'};
 808     my $success = 0;
 809
 810     if ($expect_header eq 'NO CHANGE') {
 811
 812         if (defined($header) and $header eq $test{'data'}) {
 813
 814             $success = 1;
 815
 816         } else {
 817
 818             $header = "REMOVAL" unless defined $header;
 819             l(LL_VERBOSE_FAILURE,
 820               "Ooops. Got: " . $header . " while expecting: " . $expect_header);
 821         }
 822
 823     } elsif ($expect_header eq 'REMOVAL') {
 824
 825         if (defined($header) and $header eq $test{'data'}) {
 826
 827             l(LL_VERBOSE_FAILURE,
 828               "Ooops. Expected removal but: " . $header . " is still there.");
 829
 830         } else {
 831
 832             # XXX: Use more reliable check here and make sure
 833             # the header has a different name.
 834             $success = 1;
 835
 836         }
 837
 838     } elsif ($expect_header eq 'SOME CHANGE') {
 839
 840         if (defined($header) and not $header eq $test{'data'}) {
 841
 842             $success = 1;
 843
 844         } else {
 845
 846             $header = "REMOVAL" unless defined $header;
 847             l(LL_VERBOSE_FAILURE,
 848               "Ooops. Got: " . $header . " while expecting: SOME CHANGE");
 849         }
 850
 851
 852     } else {
 853
 854         if (defined($header) and $header eq $expect_header) {
 855
 856             $success = 1;
 857
 858         } else {
 859
 860             $header = "'No matching header'" unless defined $header; # XXX: No header detected to be precise
 861             l(LL_VERBOSE_FAILURE,
 862               "Ooops. Got: " . $header . " while expecting: " . $expect_header);
 863         }
 864     }
 865     return $success;
 866 }
 867
 868 sub get_header_name ($) {
 869
 870     my $header = shift;
 871
 872     $header =~ s@(.*?: ).*@$1@;
 873
 874     return $header;
 875 }
 876
 877 sub get_header ($$) {
 878
 879     our $filtered_request = '';
 880
 881     my $buffer_ref = shift;
 882     my $test_ref = shift;
 883
 884     my %test = %{$test_ref};
 885     my @buffer = @{$buffer_ref};
 886
 887     my $expect_header = $test{'expect-header'};
 888
 889     die "get_header called with no expect header" unless defined $expect_header;
 890
 891     my $line;
 892     my $processed_request_reached = 0;
 893     my $read_header = 0;
 894     my $processed_request = '';
 895     my $header;
 896     my $header_to_get;
 897
 898     if ($expect_header eq 'REMOVAL'
 899      or $expect_header eq 'NO CHANGE'
 900      or  $expect_header eq 'SOME CHANGE') {
 901
 902         $expect_header = $test{'data'};
 903
 904     }
 905
 906     $header_to_get = get_header_name($expect_header);
 907
 908     foreach (@buffer) {
 909
 910         # Skip everything before the Processed request
 911         if (/Processed Request/) {
 912             $processed_request_reached = 1;
 913             next;
 914         }
 915         next unless $processed_request_reached;
 916
 917         # End loop after the Processed request
 918         last if (/<\/pre>/);
 919
 920         # Ditch tags and leading/trailing white space.
 921         s@^\s*<.*?>@@g;
 922         s@\s*$@@g;
 923
 924         # Decode characters we care about.
 925         s@&quot;@"@g;
 926
 927         $filtered_request .=  "\n" . $_;
 928
 929         if (/^$header_to_get/) {
 930             $read_header = 1;
 931             $header = $_;
 932             last;
 933         }
 934     }
 935
 936     return $header;
 937 }
 938
 939 sub get_server_header ($$) {
 940
 941     my $buffer_ref = shift;
 942     my $test_ref = shift;
 943
 944     my %test = %{$test_ref};
 945     my @buffer = @{$buffer_ref};
 946
 947     my $expect_header = $test{'expect-header'};
 948     my $header;
 949     my $header_to_get;
 950
 951     # XXX: Should be caught before starting to test.
 952     l(LL_ERROR, "No expect header for test " . $test{'number'})
 953         unless defined $expect_header;
 954
 955     if ($expect_header eq 'REMOVAL'
 956      or $expect_header eq 'NO CHANGE'
 957      or $expect_header eq 'SOME CHANGE') {
 958
 959         $expect_header = $test{'data'};
 960
 961     }
 962
 963     $header_to_get = get_header_name($expect_header);
 964
 965     foreach (@buffer) {
 966
 967         # XXX: should probably verify that the request
 968         # was actually answered by Fellatio.
 969         if (/^$header_to_get/) {
 970             $header = $_;
 971             $header =~ s@\s*$@@g;
 972             last;
 973         }
 974     }
 975
 976     return $header;
 977 }
 978
 979 sub get_status_code ($) {
 980
 981     my $buffer_ref = shift;
 982     my @buffer = @{$buffer_ref};
 983
 984     foreach (@buffer) {
 985
 986         if (/^HTTP\/\d\.\d (\d{3})/) {
 987
 988             return $1;
 989
 990         } else {
 991
 992             return '123' if cli_option_is_set('fuzzer-feeding');
 993             chomp;
 994             l(LL_ERROR, 'Unexpected buffer line: "' . $_ . '"');
 995         }
 996     }
 997 }
 998
 999 sub get_test_keys () {
1000     return ('tag', 'data', 'expect-header', 'ignore');
1001 }
1002
1003 # XXX: incomplete
1004 sub test_content_as_string ($) {
1005
1006     my $test_ref = shift;
1007     my %test = %{$test_ref};
1008
1009     my $s = "\n\t";
1010
1011     foreach my $key (get_test_keys()) {
1012         $test{$key} = 'Not set' unless (defined $test{$key});
1013     }
1014
1015     $s .= 'Tag: ' . $test{'tag'};
1016     $s .= "\n\t";
1017     $s .= 'Set header: ' . $test{'data'}; # XXX: adjust for other test types
1018     $s .= "\n\t";
1019     $s .= 'Expected header: ' . $test{'expect-header'};
1020     $s .= "\n\t";
1021     $s .= 'Ignore: ' . $test{'ignore'};
1022
1023     return $s;
1024 }
1025
1026 sub fuzz_header($) {
1027     my $header = shift;
1028     my $white_space = int(rand(2)) - 1 ? " " : "\t";
1029
1030     $white_space = $white_space x (1 + int(rand(5)));
1031
1032     # Only fuzz white space before the first quoted token.
1033     # (Privoxy doesn't touch white space inside quoted tokens
1034     # and modifying it would cause the tests to fail).
1035     $header =~ s@(^[^"]*?)\s@$1$white_space@g;
1036
1037     return $header;
1038 }
1039
1040 ############################################################################
1041 #
1042 # HTTP fetch functions
1043 #
1044 ############################################################################
1045
1046 sub check_for_curl () {
1047     my $curl = CURL;
1048     l(LL_ERROR, "No curl found.") unless (`which $curl`);
1049 }
1050
1051 sub get_cgi_page_or_else ($) {
1052
1053     my $cgi_url = shift;
1054     my $content_ref = get_page_with_curl($cgi_url);
1055     my $status_code = get_status_code($content_ref);
1056
1057     if (200 != $status_code) {
1058
1059         my $log_message = "Failed to fetch Privoxy CGI Page. " .
1060                           "Received status code ". $status_code .
1061                           " while only 200 is acceptable.";
1062
1063         if (cli_option_is_set('fuzzer-feeding')) {
1064
1065             $log_message .= " Ignored due to fuzzer feeding.";
1066             l(LL_SOFT_ERROR, $log_message)
1067
1068         } else {
1069
1070             l(LL_ERROR, $log_message);
1071
1072         }
1073     }
1074
1075     return $content_ref;
1076 }
1077
1078 # XXX: misleading name
1079 sub get_show_request_with_curl ($) {
1080
1081     our $privoxy_cgi_url;
1082     my $test_ref = shift;
1083     my %test = %{$test_ref};
1084
1085     my $curl_parameters = ' ';
1086     my $header = $test{'data'};
1087
1088     if (cli_option_is_set('header-fuzzing')) {
1089         $header = fuzz_header($header);
1090     }
1091
1092     # Enable the action to test
1093     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
1094     # The header to filter
1095     $curl_parameters .= '-H \'' . $header . '\' ';
1096
1097     $curl_parameters .= ' ';
1098     $curl_parameters .= $privoxy_cgi_url;
1099     $curl_parameters .= 'show-request';
1100
1101     return get_cgi_page_or_else($curl_parameters);
1102 }
1103
1104 sub get_head_with_curl ($) {
1105
1106     our $fellatio_url = FELLATIO_URL;
1107     my $test_ref = shift;
1108     my %test = %{$test_ref};
1109
1110     my $curl_parameters = ' ';
1111
1112     # Enable the action to test
1113     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
1114     # The header to filter
1115     $curl_parameters .= '-H \'X-Gimme-Head-With: ' . $test{'data'} . '\' ';
1116     $curl_parameters .= '--head ';
1117
1118     $curl_parameters .= ' ';
1119     $curl_parameters .= $fellatio_url;
1120
1121     return get_page_with_curl($curl_parameters);
1122 }
1123
1124 sub get_page_with_curl ($) {
1125
1126     our $proxy;
1127
1128     my $parameters = shift;
1129     my @buffer;
1130     my $curl_line = CURL;
1131     my $retries_left = get_cli_option('retries') + 1;
1132     my $failure_reason;
1133
1134     $curl_line .= ' --proxy ' . $proxy if (defined $proxy);
1135
1136     # We want to see the HTTP status code
1137     $curl_line .= " --include ";
1138     # Let Privoxy emit two log messages less.
1139     $curl_line .= ' -H \'Proxy-Connection:\' ' unless $parameters =~ /Proxy-Connection:/;
1140     $curl_line .= ' -H \'Connection: close\' ' unless $parameters =~ /Connection:/;
1141     # We don't care about fetch statistic.
1142     $curl_line .= " -s ";
1143     # We do care about the failure reason if any.
1144     $curl_line .= " -S ";
1145     # We want to advertise ourselves
1146     $curl_line .= " --user-agent '" . PRT_VERSION . "' ";
1147     # We aren't too patient
1148     $curl_line .= " --max-time '" . get_cli_option('max-time') . "' ";
1149
1150     $curl_line .= $parameters;
1151     # XXX: still necessary?
1152     $curl_line .= ' 2>&1';
1153
1154     l(LL_PAGE_FETCHING, "Executing: " . $curl_line);
1155
1156     do {
1157         @buffer = `$curl_line`;
1158
1159         if ($?) {
1160             $failure_reason = array_as_string(\@buffer);
1161             chomp $failure_reason;
1162             l(LL_SOFT_ERROR, "Fetch failure: '" . $failure_reason . $! ."'");
1163         }
1164     } while ($? && --$retries_left);
1165
1166     unless ($retries_left) {
1167         l(LL_ERROR,
1168           "Running curl failed " . get_cli_option('retries') .
1169           " times in a row. Last error: '" . $failure_reason . "'.");
1170     }
1171
1172     return \@buffer;
1173 }
1174
1175
1176 ############################################################################
1177 #
1178 # Log functions
1179 #
1180 ############################################################################
1181
1182 sub array_as_string ($) {
1183     my $array_ref = shift;
1184     my $string = '';
1185
1186     foreach (@{$array_ref}) {
1187         $string .= $_;
1188     }
1189
1190     return $string;
1191 }
1192
1193 sub show_test ($) {
1194     my $test_ref = shift;
1195     log_message('Test is:' . test_content_as_string($test_ref));
1196 }
1197
1198 # Conditional log
1199 sub l ($$) {
1200     our $log_level;
1201     my $this_level = shift;
1202     my $message = shift;
1203
1204     return unless ($log_level & $this_level);
1205
1206     if (LL_ERROR & $this_level) {
1207         $message = 'Oh noes. ' . $message . ' Fatal error. Exiting.';
1208     }
1209
1210     log_message($message);
1211
1212     if (LL_ERROR & $this_level) {
1213         exit;
1214     }
1215 }
1216
1217 sub log_message ($) {
1218
1219     my $message = shift;
1220
1221     our $logfile;
1222     our $no_logging;
1223     our $leading_log_date;
1224     our $leading_log_time;
1225
1226     my $time_stamp = '';
1227     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime time;
1228
1229     if ($leading_log_date || $leading_log_time) {
1230
1231         if ($leading_log_date) {
1232             $year += 1900;
1233             $mon  += 1;
1234             $time_stamp = sprintf("%i/%.2i/%.2i", $year, $mon, $mday);
1235         }
1236
1237         if ($leading_log_time) {
1238             $time_stamp .= ' ' if $leading_log_date;
1239             $time_stamp.= sprintf("%.2i:%.2i:%.2i", $hour, $min, $sec);
1240         }
1241
1242         $message = $time_stamp . ": " . $message;
1243     }
1244
1245
1246     printf(STDERR "%s\n", $message);
1247
1248 }
1249
1250 sub log_result ($$) {
1251
1252     our $verbose_test_description;
1253     our $filtered_request;
1254
1255     my $test_ref = shift;
1256     my $result = shift;
1257     my $number = shift;
1258
1259     my %test = %{$test_ref};
1260     my $message = '';
1261
1262     $message .= interpret_result($result);
1263     $message .= " for test ";
1264     $message .= $number;
1265     $message .= '/';
1266     $message .= $test{'number'};
1267     $message .= '/';
1268     $message .= $test{'section-id'};
1269     $message .= '/';
1270     $message .= $test{'regression-test-id'};
1271     $message .= '.';
1272
1273     if ($verbose_test_description) {
1274
1275         if ($test{'type'} == CLIENT_HEADER_TEST) {
1276
1277             $message .= ' Header ';
1278             $message .= quote($test{'data'});
1279             $message .= ' and tag ';
1280             $message .= quote($test{'tag'});
1281
1282         } elsif ($test{'type'} == SERVER_HEADER_TEST) {
1283
1284             $message .= ' Request Header ';
1285             $message .= quote($test{'data'});
1286             $message .= ' and tag ';
1287             $message .= quote($test{'tag'});
1288
1289         } elsif ($test{'type'} == DUMB_FETCH_TEST) {
1290
1291             $message .= ' URL ';
1292             $message .= quote($test{'data'});
1293             $message .= ' and expected status code ';
1294             $message .= quote($test{'expected-status-code'});
1295
1296         } elsif ($test{'type'} == TRUSTED_CGI_REQUEST) {
1297
1298             $message .= ' CGI URL ';
1299             $message .= quote($test{'data'});
1300             $message .= ' and expected status code ';
1301             $message .= quote($test{'expected-status-code'});
1302
1303         } elsif ($test{'type'} == METHOD_TEST) {
1304
1305             $message .= ' HTTP method ';
1306             $message .= quote($test{'data'});
1307             $message .= ' and expected status code ';
1308             $message .= quote($test{'expected-status-code'});
1309
1310         } elsif ($test{'type'} == BLOCK_TEST) {
1311
1312             $message .= ' Supposedly-blocked URL: ';
1313             $message .= quote($test{'data'});
1314
1315         } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
1316
1317             $message .= ' Sticky Actions: ';
1318             $message .= quote($test{'sticky-actions'});
1319             $message .= ' and URL: ';
1320             $message .= quote($test{'data'});
1321
1322         } else {
1323
1324             die "Incomplete support for test type " . $test{'type'} .  " detected.";
1325
1326         }
1327     }
1328
1329     log_message($message) if (!$result or cli_option_is_set('verbose'));
1330 }
1331
1332 sub quote ($) {
1333     my $s = shift;
1334     return '\'' . $s . '\'';
1335 }
1336
1337 sub print_version () {
1338     printf PRT_VERSION . "\n" . 'Copyright (C) 2007-2008 Fabian Keil <fk@fabiankeil.de>' . "\n";
1339 }
1340
1341 sub help () {
1342
1343     our %cli_options;
1344
1345     print_version();
1346
1347     print << "    EOF"
1348
1349 Options and their default values if they have any:
1350     [--debug $cli_options{'debug'}]
1351     [--forks $cli_options{'forks'}]
1352     [--fuzzer-address]
1353     [--fuzzer-feeding]
1354     [--help]
1355     [--header-fuzzing]
1356     [--level]
1357     [--loops $cli_options{'loops'}]
1358     [--max-level $cli_options{'max-level'}]
1359     [--max-time $cli_options{'max-time'}]
1360     [--min-level $cli_options{'min-level'}]
1361     [--privoxy-address]
1362     [--retries $cli_options{'retries'}]
1363     [--verbose]
1364     [--version]
1365 see "perldoc $0" for more information
1366     EOF
1367     ;
1368     exit(0);
1369 }
1370
1371 sub init_cli_options () {
1372
1373     our %cli_options;
1374     our $log_level;
1375
1376     $cli_options{'min-level'} = CLI_MIN_LEVEL;
1377     $cli_options{'max-level'} = CLI_MAX_LEVEL;
1378     $cli_options{'debug'}  = $log_level;
1379     $cli_options{'loops'}  = CLI_LOOPS;
1380     $cli_options{'max-time'}  = CLI_MAX_TIME;
1381     $cli_options{'retries'}  = CLI_RETRIES;
1382     $cli_options{'forks'}    = CLI_FORKS;
1383 }
1384
1385 sub parse_cli_options () {
1386
1387     our %cli_options;
1388     our $log_level;
1389
1390     init_cli_options();
1391
1392     GetOptions (
1393                 'debug=s' => \$cli_options{'debug'},
1394                 'forks=s' => \$cli_options{'forks'},
1395                 'help'     => sub { help },
1396                 'header-fuzzing' => \$cli_options{'header-fuzzing'},
1397                 'min-level=s' => \$cli_options{'min-level'},
1398                 'max-level=s' => \$cli_options{'max-level'},
1399                 'privoxy-address=s' => \$cli_options{'privoxy-address'},
1400                 'fuzzer-address=s' => \$cli_options{'fuzzer-address'},
1401                 'level=s' => \$cli_options{'level'},
1402                 'loops=s' => \$cli_options{'loops'},
1403                 'test-number=s' => \$cli_options{'test-number'},
1404                 'fuzzer-feeding' => \$cli_options{'fuzzer-feeding'},
1405                 'retries=s' => \$cli_options{'retries'},
1406                 'max-time=s' => \$cli_options{'max-time'},
1407                 'verbose' => \$cli_options{'verbose'},
1408                 'version'  => sub { print_version && exit(0) }
1409     );
1410     $log_level |= $cli_options{'debug'};
1411 }
1412
1413 sub cli_option_is_set ($) {
1414
1415     our %cli_options;
1416     my $cli_option = shift;
1417
1418     return defined $cli_options{$cli_option};
1419 }
1420
1421 sub get_cli_option ($) {
1422
1423     our %cli_options;
1424     my $cli_option = shift;
1425
1426     die "Unknown CLI option: $cli_option" unless defined $cli_options{$cli_option};
1427
1428     return $cli_options{$cli_option};
1429 }
1430
1431 sub init_proxy_settings($) {
1432
1433     my $choice = shift;
1434     our $proxy = undef;
1435
1436     if (($choice eq 'fuzz-proxy') and cli_option_is_set('fuzzer-address')) {
1437         $proxy = get_cli_option('fuzzer-address');
1438     }
1439
1440     if ((not defined $proxy) or ($choice eq 'vanilla-proxy')) {
1441
1442         if (cli_option_is_set('privoxy-address')) {
1443             $proxy .=  get_cli_option('privoxy-address');
1444         }
1445
1446     }
1447 }
1448
1449 sub start_forks($) {
1450     my $forks = shift;
1451
1452     l(LL_ERROR, "Invalid --fork value: " . $forks . ".") if ($forks < 0);
1453
1454     foreach my $fork (1 .. $forks) {
1455         log_message("Starting fork $fork");
1456         my $pid = fork();
1457         if (defined $pid && !$pid) {
1458             return;
1459         }
1460     }
1461 }
1462
1463 sub main () {
1464
1465     init_our_variables();
1466     parse_cli_options();
1467     check_for_curl();
1468     init_proxy_settings('vanilla-proxy');
1469     load_regressions_tests();
1470     init_proxy_settings('fuzz-proxy');
1471     start_forks(get_cli_option('forks')) if cli_option_is_set('forks');
1472     execute_regression_tests();
1473 }
1474
1475 main();
1476
1477 =head1 NAME
1478
1479 B<privoxy-regression-test> - A regression test "framework" for Privoxy.
1480
1481 =head1 SYNOPSIS
1482
1483 B<privoxy-regression-test> [B<--debug bitmask>] [B<--forks> forks]
1484 [B<--fuzzer-feeding>] [B<--fuzzer-feeding>] [B<--help>] [B<--level level>]
1485 [B<--loops count>] [B<--max-level max-level>] [B<--max-time max-time>]
1486 [B<--min-level min-level>] B<--privoxy-address proxy-address>
1487 [B<--retries retries>] [B<--verbose>] [B<--version>]
1488
1489 =head1 DESCRIPTION
1490
1491 Privoxy-Regression-Test is supposed to one day become
1492 a regression test suite for Privoxy. It's not quite there
1493 yet, however, and can currently only test header actions,
1494 check the returned status code for requests to arbitrary
1495 URLs and verify which actions are applied to them.
1496
1497 Client header actions are tested by requesting
1498 B<http://p.p/show-request> and checking whether
1499 or not Privoxy modified the original request as expected.
1500
1501 The original request contains both the header the action-to-be-tested
1502 acts upon and an additional tagger-triggering header that enables
1503 the action to test.
1504
1505 Applied actions are checked through B<http://p.p/show-url-info>.
1506
1507 =head1 CONFIGURATION FILE SYNTAX
1508
1509 Privoxy-Regression-Test's configuration is embedded in
1510 Privoxy action files and loaded through Privoxy's web interface.
1511
1512 It makes testing a Privoxy version running on a remote system easier
1513 and should prevent you from updating your tests without updating Privoxy's
1514 configuration accordingly.
1515
1516 A client-header-action test section looks like this:
1517
1518     # Set Header    = Referer: http://www.example.org.zwiebelsuppe.exit/
1519     # Expect Header = Referer: http://www.example.org/
1520     {+client-header-filter{hide-tor-exit-notation} -hide-referer}
1521     TAG:^client-header-filter\{hide-tor-exit-notation\}$
1522
1523 The example above causes Privoxy-Regression-Test to set
1524 the header B<Referer: http://www.example.org.zwiebelsuppe.exit/>
1525 and to expect it to be modified to
1526 B<Referer: http://www.example.org/>.
1527
1528 When testing this section, Privoxy-Regression-Test will set the header
1529 B<X-Privoxy-Control: client-header-filter{hide-tor-exit-notation}>
1530 causing the B<privoxy-control> tagger to create the tag
1531 B<client-header-filter{hide-tor-exit-notation}> which will finally
1532 cause Privoxy to enable the action section.
1533
1534 Note that the actions itself are only used by Privoxy,
1535 Privoxy-Regression-Test ignores them and will be happy
1536 as long as the expectations are satisfied.
1537
1538 A fetch test looks like this:
1539
1540     # Fetch Test = http://p.p/user-manual
1541     # Expect Status Code = 302
1542
1543 It tells Privoxy-Regression-Test to request B<http://p.p/user-manual>
1544 and to expect a response with the HTTP status code B<302>. Obviously that's
1545 not a very thorough test and mainly useful to get some code coverage
1546 for Valgrind or to verify that the templates are installed correctly.
1547
1548 If you want to test CGI pages that require a trusted
1549 referer, you can use:
1550
1551     # Trusted CGI Request = http://p.p/edit-actions
1552
1553 It works like ordinary fetch tests, but sets the referer
1554 header to a trusted value.
1555
1556 If no explicit status code expectation is set, B<200> is used.
1557
1558 To verify that a URL is blocked, use:
1559
1560     # Blocked URL = http://www.example.com/blocked
1561
1562 To verify that a specific set of actions is applied to an URL, use:
1563
1564     # Sticky Actions = +block{foo} +handle-as-empty-document -handle-as-image
1565     # URL = http://www.example.org/my-first-url
1566
1567 The sticky actions will be checked for all URLs below it
1568 until the next sticky actions directive.
1569
1570 =head1 TEST LEVELS
1571
1572 All tests have test levels to let the user
1573 control which ones to execute (see I<OPTIONS> below).
1574 Test levels are either set with the B<Level> directive,
1575 or implicitly through the test type.
1576
1577 Block tests default to level 7, fetch tests to level 6,
1578 "Sticky Actions" tests default to level 5, tests for trusted CGI
1579 requests to level 3 and client-header-action tests to level 1.
1580
1581 =head1 OPTIONS
1582
1583 B<--debug bitmask> Add the bitmask provided as integer
1584 to the debug settings.
1585
1586 B<--forks forks> Number of forks to start before executing
1587 the regression tests. This is mainly useful for stress-testing.
1588
1589 B<--fuzzer-address> Listening address used when executing
1590 the regression tests. Useful to make sure that the requests
1591 to load the regression tests don't fail due to fuzzing.
1592
1593 B<--fuzzer-feeding> Ignore some errors that would otherwise
1594 cause Privoxy-Regression-Test to abort the test because
1595 they shouldn't happen in normal operation. This option is
1596 intended to be used if Privoxy-Regression-Test is only
1597 used to feed a fuzzer in which case there's a high chance
1598 that Privoxy gets an invalid request and returns an error
1599 message.
1600
1601 B<--help> Shows available command line options.
1602
1603 B<--header-fuzzing> Modifies linear white space in
1604 headers in a way that should not affect the test result.
1605
1606 B<--level level> Only execute tests with the specified B<level>.
1607
1608 B<--loop count> Loop through the regression tests B<count> times.
1609 Useful to feed a fuzzer, or when doing stress tests with
1610 several Privoxy-Regression-Test instances running at the same
1611 time.
1612
1613 B<--max-level max-level> Only execute tests with a B<level>
1614 below or equal to the numerical B<max-level>.
1615
1616 B<--max-time max-time> Give Privoxy B<max-time> seconds
1617 to return data. Increasing the default may make sense when
1618 Privoxy is run through Valgrind, decreasing the default may
1619 make sense when Privoxy-Regression-Test is used to feed
1620 a fuzzer.
1621
1622 B<--min-level min-level> Only execute tests with a B<level>
1623 above or equal to the numerical B<min-level>.
1624
1625 B<--privoxy-address proxy-address> Privoxy's listening address.
1626 If it's not set, the value of the environment variable http_proxy
1627 will be used. B<proxy-address> has to be specified in http_proxy
1628 syntax.
1629
1630 B<--retries retries> Retry B<retries> times.
1631
1632 B<--verbose> Also log succesful test runs.
1633
1634 B<--version> Print version and exit.
1635
1636 The second dash is optional, options can be shortened,
1637 as long as there are no ambiguities.
1638
1639 =head1 PRIVOXY CONFIGURATION
1640
1641 Privoxy-Regression-Test is shipped with B<regression-tests.action>
1642 which aims to test all official client-header modifying actions
1643 and can be used to verify that the templates and the user manual
1644 files are installed correctly.
1645
1646 To use it, it has to be copied in Privoxy's configuration
1647 directory, and afterwards referenced in Privoxy's configuration
1648 file with the line:
1649
1650     actionsfile regression-tests.action
1651
1652 In general, its tests are supposed to work without changing
1653 any other action files, unless you already added lots of
1654 taggers yourself. If you are using taggers that cause problems,
1655 you might have to temporary disable them for Privoxy's CGI pages.
1656
1657 Some of the regression tests rely on Privoxy features that
1658 may be disabled in your configuration. Tests with a level below
1659 7 are supposed to work with all Privoxy configurations (provided
1660 you didn't build with FEATURE_GRACEFUL_TERMINATION).
1661
1662 Tests with level 9 require Privoxy to deliver the User Manual,
1663 tests with level 12 require the CGI editor to be enabled.
1664
1665 =head1 CAVEATS
1666
1667 Expect the configuration file syntax to change with future releases.
1668
1669 =head1 LIMITATIONS
1670
1671 As Privoxy's B<show-request> page only shows client headers,
1672 Privoxy-Regression-Test can't use it to test Privoxy actions
1673 that modify server headers.
1674
1675 As Privoxy-Regression-Test relies on Privoxy's tag feature to
1676 control the actions to test, it currently only works with
1677 Privoxy 3.0.7 or later.
1678
1679 At the moment Privoxy-Regression-Test fetches Privoxy's
1680 configuration page through I<curl>(1), therefore you have to
1681 have I<curl> installed, otherwise you won't be able to run
1682 Privoxy-Regression-Test in a meaningful way.
1683
1684 =head1 SEE ALSO
1685
1686 privoxy(1) curl(1)
1687
1688 =head1 AUTHOR
1689
1690 Fabian Keil <fk@fabiankeil.de>
1691
1692 =cut