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 # Wish list:
  11 #
  12 # - Update documentation
  13 # - Validate HTTP times.
  14 # - Implement a HTTP_VERSION directive or allow to
  15 #   specify whole request lines.
  16 # - Support filter regression tests.
  17 # - Document magic Expect Header values
  18 # - Internal fuzz support?
  19 #
  20 # Copyright (c) 2007-2023 Fabian Keil <fk@fabiankeil.de>
  21 #
  22 # Permission to use, copy, modify, and distribute this software for any
  23 # purpose with or without fee is hereby granted, provided that the above
  24 # copyright notice and this permission notice appear in all copies.
  25 #
  26 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  27 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  28 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  29 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  30 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  31 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  32 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  33 #
  34 ############################################################################
  35
  36 use warnings;
  37 use strict;
  38 use Getopt::Long;
  39
  40 use constant {
  41     PRT_VERSION => 'Privoxy-Regression-Test 0.7.4',
  42
  43     CURL => 'curl',
  44
  45     # CLI option defaults
  46     CLI_RETRIES   => 1,
  47     CLI_LOOPS     => 1,
  48     CLI_MAX_TIME  => 5,
  49     CLI_MIN_LEVEL => 0,
  50     # The reason for a maximum test level is explained in the
  51     # perldoc section TEST LEVELS near the end of this file.
  52     CLI_MAX_LEVEL => 100,
  53     CLI_FORKS     => 0,
  54     CLI_SLEEP_TIME => 0,
  55
  56     PRIVOXY_ADDRESS  => 'http://127.0.0.1:8118/',
  57     PRIVOXY_CGI_URL  => 'http://p.p/',
  58     FELLATIO_URL     => 'http://127.0.0.1:8080/',
  59     LEADING_LOG_DATE => 1,
  60     LEADING_LOG_TIME => 1,
  61
  62     DEBUG_LEVEL_FILE_LOADING    => 0,
  63     DEBUG_LEVEL_PAGE_FETCHING   => 0,
  64     DEBUG_LEVEL_VERBOSE_FAILURE => 1,
  65     # XXX: Only partly implemented and mostly useless.
  66     DEBUG_LEVEL_VERBOSE_SUCCESS => 0,
  67     DEBUG_LEVEL_STATUS          => 1,
  68
  69     # Internal use, don't modify
  70     # Available debug bits:
  71     LL_SOFT_ERROR       =>  1,
  72     LL_VERBOSE_FAILURE  =>  2,
  73     LL_PAGE_FETCHING    =>  4,
  74     LL_FILE_LOADING     =>  8,
  75     LL_VERBOSE_SUCCESS  => 16,
  76     LL_STATUS           => 32,
  77
  78     CLIENT_HEADER_TEST  =>  1,
  79     SERVER_HEADER_TEST  =>  2,
  80     DUMB_FETCH_TEST     =>  3,
  81     METHOD_TEST         =>  4,
  82     STICKY_ACTIONS_TEST =>  5,
  83     TRUSTED_CGI_REQUEST =>  6,
  84     BLOCK_TEST          =>  7,
  85     REDIRECT_TEST       =>108,
  86 };
  87
  88 sub init_our_variables() {
  89
  90     our $leading_log_time = LEADING_LOG_TIME;
  91     our $leading_log_date = LEADING_LOG_DATE;
  92     our $privoxy_cgi_url  = PRIVOXY_CGI_URL;
  93     our $log_level = get_default_log_level();
  94     our $proxy = defined $ENV{'http_proxy'} ? $ENV{'http_proxy'} : PRIVOXY_ADDRESS;
  95 }
  96
  97 sub get_default_log_level() {
  98
  99     my $log_level = 0;
 100
 101     $log_level |= LL_FILE_LOADING    if DEBUG_LEVEL_FILE_LOADING;
 102     $log_level |= LL_PAGE_FETCHING   if DEBUG_LEVEL_PAGE_FETCHING;
 103     $log_level |= LL_VERBOSE_FAILURE if DEBUG_LEVEL_VERBOSE_FAILURE;
 104     $log_level |= LL_VERBOSE_SUCCESS if DEBUG_LEVEL_VERBOSE_SUCCESS;
 105     $log_level |= LL_STATUS          if DEBUG_LEVEL_STATUS;
 106
 107     # This one is supposed to be always on.
 108     $log_level |= LL_SOFT_ERROR;
 109
 110     return $log_level;
 111 }
 112
 113 ############################################################################
 114 #
 115 # File loading functions
 116 #
 117 ############################################################################
 118
 119 sub parse_tag($) {
 120
 121     my $tag = shift;
 122
 123     # Remove anchors
 124     $tag =~ s@[\$\^]@@g;
 125     # Unescape brackets and dots
 126     $tag =~ s@\\(?=[{}().+])@@g;
 127
 128     # log_message("Parsed tag: " . $tag);
 129
 130     check_for_forbidden_characters($tag);
 131
 132     return $tag;
 133 }
 134
 135 sub check_for_forbidden_characters($) {
 136
 137     my $string = shift;
 138     my $allowed = '[-=\dA-Za-z~{}\[\]:./();\t ,+@"_%?&*^|]';
 139
 140     unless ($string =~ m/^$allowed*$/o) {
 141         my $forbidden = $string;
 142         $forbidden =~ s@^$allowed*(.).*@$1@;
 143
 144         log_and_die("'" . $string . "' contains character '" . $forbidden. "' which is unacceptable.");
 145     }
 146 }
 147
 148 sub load_regression_tests() {
 149     if (cli_option_is_set('local-test-file')) {
 150         load_regression_tests_from_file(get_cli_option('local-test-file'));
 151     } else {
 152         load_regression_tests_through_privoxy();
 153     }
 154 }
 155
 156 # XXX: Contains a lot of code duplicated from load_action_files()
 157 #      that should be factored out.
 158 sub load_regression_tests_from_file($) {
 159     my $action_file = shift;
 160
 161     # initialized here
 162     our %actions;
 163     our @regression_tests;
 164
 165     my $si = 0;  # Section index
 166     my $ri = -1; # Regression test index
 167     my $count = 0;
 168
 169     my $ignored = 0;
 170
 171     my $sticky_actions = undef;
 172
 173     l(LL_STATUS, "Gathering regression tests from local file " . $action_file);
 174
 175     open(my $ACTION_FILE, "<", $action_file)
 176         or log_and_die("Failed to open $action_file: $!");
 177
 178     while (<$ACTION_FILE>) {
 179
 180         my $no_checks = 0;
 181         chomp;
 182         my ($token, $value) = tokenize($_);
 183
 184         next unless defined $token;
 185
 186         # Load regression tests
 187
 188         if (token_starts_new_test($token)) {
 189
 190             # Beginning of new regression test.
 191             $ri++;
 192             $count++;
 193             enlist_new_test(\@regression_tests, $token, $value, $si, $ri, $count);
 194             $no_checks = 1; # Already validated by enlist_new_test().
 195         }
 196
 197         if ($token =~ /level\s+(\d+)/i) {
 198
 199             my $level = $1;
 200             register_dependency($level, $value);
 201         }
 202
 203         if ($token eq 'sticky actions') {
 204
 205             # Will be used by each following Sticky URL.
 206             $sticky_actions = $value;
 207             if ($sticky_actions =~ /{[^}]*\s/) {
 208                 log_and_die("'Sticky Actions' with whitespace inside the " .
 209                             "action parameters are currently unsupported.");
 210             }
 211         }
 212
 213         if ($si == -1 || $ri == -1) {
 214             # No beginning of a test detected yet,
 215             # so we don't care about any other test
 216             # attributes.
 217             next;
 218         }
 219
 220         if ($token eq 'expect header') {
 221
 222             l(LL_FILE_LOADING, "Detected expectation: " . $value);
 223             $regression_tests[$si][$ri]{'expect-header'} = $value;
 224
 225         } elsif ($token eq 'tag') {
 226
 227             next if ($ri == -1);
 228
 229             my $tag = parse_tag($value);
 230
 231             # We already checked in parse_tag() after filtering
 232             $no_checks = 1;
 233
 234             l(LL_FILE_LOADING, "Detected TAG: " . $tag);
 235
 236             # Save tag for all tests in this section
 237             do {
 238                 $regression_tests[$si][$ri]{'tag'} = $tag;
 239             } while ($ri-- > 0);
 240
 241             $si++;
 242             $ri = -1;
 243
 244         } elsif ($token eq 'ignore' && $value =~ /Yes/i) {
 245
 246             l(LL_FILE_LOADING, "Ignoring section: " . test_content_as_string($regression_tests[$si][$ri]));
 247             $regression_tests[$si][$ri]{'ignore'} = 1;
 248             $ignored++;
 249
 250         } elsif ($token eq 'expect status code') {
 251
 252             l(LL_FILE_LOADING, "Expecting status code: " . $value);
 253             $regression_tests[$si][$ri]{'expected-status-code'} = $value;
 254
 255         } elsif ($token eq 'level') { # XXX: stupid name
 256
 257             $value =~ s@(\d+).*@$1@;
 258             l(LL_FILE_LOADING, "Level: " . $value);
 259             $regression_tests[$si][$ri]{'level'} = $value;
 260
 261         } elsif ($token eq 'method') {
 262
 263             l(LL_FILE_LOADING, "Method: " . $value);
 264             $regression_tests[$si][$ri]{'method'} = $value;
 265
 266         } elsif ($token eq 'redirect destination') {
 267
 268             l(LL_FILE_LOADING, "Redirect destination: " . $value);
 269             $regression_tests[$si][$ri]{'redirect destination'} = $value;
 270
 271         } elsif ($token eq 'url') {
 272
 273             if (defined $sticky_actions) {
 274                 die "WTF? Attempted to overwrite Sticky Actions"
 275                     if defined ($regression_tests[$si][$ri]{'sticky-actions'});
 276
 277                 l(LL_FILE_LOADING, "Sticky actions: " . $sticky_actions);
 278                 $regression_tests[$si][$ri]{'sticky-actions'} = $sticky_actions;
 279             } else {
 280                 log_and_die("Sticky URL without Sticky Actions in $action_file: $value");
 281             }
 282
 283         } else {
 284
 285             # We don't use it, so we don't need
 286             $no_checks = 1;
 287             l(LL_STATUS, "Enabling no_checks for $token") unless $no_checks;
 288         }
 289
 290         # XXX: Necessary?
 291         unless ($no_checks)  {
 292             check_for_forbidden_characters($value);
 293             check_for_forbidden_characters($token);
 294         }
 295     }
 296
 297     l(LL_FILE_LOADING, "Done loading " . $count . " regression tests."
 298       . " Of which " . $ignored. " will be ignored)\n");
 299
 300 }
 301
 302
 303 sub load_regression_tests_through_privoxy() {
 304
 305     our $privoxy_cgi_url;
 306     our @privoxy_config;
 307     our %privoxy_features;
 308     my @actionfiles;
 309     my $curl_url = '';
 310     my $file_number = 0;
 311     my $feature;
 312     my $privoxy_version = '(Unknown version!)';
 313
 314     $curl_url .= $privoxy_cgi_url;
 315     $curl_url .= 'show-status';
 316
 317     l(LL_STATUS, "Asking Privoxy for the number of action files available ...");
 318
 319     # Dear Privoxy, please reload the config file if necessary ...
 320     get_cgi_page_or_else($curl_url);
 321
 322     # ... so we get the latest one here.
 323     foreach (@{get_cgi_page_or_else($curl_url)}) {
 324
 325         chomp;
 326         if (/<td>(.*?)<\/td><td class=\"buttons\"><a href=\"\/show-status\?file=actions&amp;index=(\d+)\">/) {
 327
 328             my $url = $privoxy_cgi_url . 'show-status?file=actions&index=' . $2;
 329             $actionfiles[$file_number++] = $url;
 330
 331         } elsif (m@config\.html#.*\">([^<]*)</a>\s+(.*)<br>@) {
 332
 333             my $directive = $1 . " " . $2;
 334             push (@privoxy_config, $directive);
 335
 336         } elsif (m@<td><code>([^<]*)</code></td>@) {
 337
 338             $feature = $1;
 339
 340         } elsif (m@<td> (Yes|No) </td>@) {
 341
 342             $privoxy_features{$feature} = $1 if defined $feature;
 343             $feature = undef;
 344
 345         } elsif (m@This is <a href="https?://www.privoxy.org/">Privoxy</a> (\d+\.\d+\.\d+) on@) {
 346             $privoxy_version = $1;
 347         }
 348     }
 349
 350     l(LL_STATUS, "Gathering regression tests from " .
 351       @actionfiles . " action file(s) delivered by Privoxy $privoxy_version.");
 352
 353     load_action_files(\@actionfiles);
 354 }
 355
 356 sub token_starts_new_test($) {
 357
 358     my $token = shift;
 359     my @new_test_directives = ('set header', 'fetch test',
 360          'trusted cgi request', 'request header', 'method test',
 361          'blocked url', 'url', 'redirected url');
 362
 363     foreach my $new_test_directive (@new_test_directives) {
 364         return 1 if $new_test_directive eq $token;
 365     }
 366
 367     return 0;
 368 }
 369
 370 sub tokenize($) {
 371
 372     my ($token, $value) = (undef, undef);
 373
 374     # Remove leading and trailing white space and a
 375     # leading <pre> which is part of the first line.
 376     s@^\s*(<pre>)?@@;
 377     s@\s*$@@;
 378
 379     # Reverse HTML-encoding
 380     # XXX: Seriously incomplete.
 381     s@&quot;@"@g;
 382     s@&amp;@&@g;
 383
 384     # Tokenize
 385     if (/^\#\s*([^=:#]*?)\s*[=]\s*([^#]+)(?:#.*)?$/) {
 386
 387         $token = $1;
 388         $value = $2;
 389
 390         $token =~ s@\s\s+@ @g;
 391         $token =~ tr/[A-Z]/[a-z]/;
 392
 393     } elsif (/^TAG\s*:(.*)$/) {
 394
 395         $token = 'tag';
 396         $value = $1;
 397     }
 398
 399     return ($token, $value);
 400 }
 401
 402 sub enlist_new_test($$$$$$) {
 403
 404     my ($regression_tests, $token, $value, $si, $ri, $number) = @_;
 405     my $type;
 406     my $executor;
 407
 408     if ($token eq 'set header') {
 409
 410         l(LL_FILE_LOADING, "Header to set: " . $value);
 411         $type = CLIENT_HEADER_TEST;
 412         $executor = \&execute_client_header_regression_test;
 413
 414     } elsif ($token eq 'request header') {
 415
 416         l(LL_FILE_LOADING, "Header to request: " . $value);
 417         $type = SERVER_HEADER_TEST;
 418         $executor = \&execute_server_header_regression_test;
 419         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 420
 421     } elsif ($token eq 'trusted cgi request') {
 422
 423         l(LL_FILE_LOADING, "CGI URL to test in a dumb way: " . $value);
 424         $type = TRUSTED_CGI_REQUEST;
 425         $executor = \&execute_dumb_fetch_test;
 426         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 427
 428     } elsif ($token eq 'fetch test') {
 429
 430         l(LL_FILE_LOADING, "URL to test in a dumb way: " . $value);
 431         $type = DUMB_FETCH_TEST;
 432         $executor = \&execute_dumb_fetch_test;
 433         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 434
 435     } elsif ($token eq 'method test') {
 436
 437         l(LL_FILE_LOADING, "Method to test: " . $value);
 438         $type = METHOD_TEST;
 439         $executor = \&execute_method_test;
 440         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 441
 442     } elsif ($token eq 'blocked url') {
 443
 444         l(LL_FILE_LOADING, "URL to block-test: " . $value);
 445         $executor = \&execute_block_test;
 446         $type = BLOCK_TEST;
 447
 448     } elsif ($token eq 'url') {
 449
 450         l(LL_FILE_LOADING, "Sticky URL to test: " . $value);
 451         $type = STICKY_ACTIONS_TEST;
 452         $executor = \&execute_sticky_actions_test;
 453
 454     } elsif ($token eq 'redirected url') {
 455
 456         l(LL_FILE_LOADING, "Redirected URL to test: " . $value);
 457         $type = REDIRECT_TEST;
 458         $executor = \&execute_redirect_test;
 459
 460     } else {
 461
 462         die "Incomplete '" . $token . "' support detected.";
 463     }
 464
 465     $$regression_tests[$si][$ri]{'type'} = $type;
 466     $$regression_tests[$si][$ri]{'level'} = $type;
 467     $$regression_tests[$si][$ri]{'executor'} = $executor;
 468
 469     check_for_forbidden_characters($value);
 470
 471     $$regression_tests[$si][$ri]{'data'} = $value;
 472
 473     # For function that only get passed single tests
 474     $$regression_tests[$si][$ri]{'section-id'} = $si;
 475     $$regression_tests[$si][$ri]{'regression-test-id'} = $ri;
 476     $$regression_tests[$si][$ri]{'number'} = $number - 1;
 477     l(LL_FILE_LOADING,
 478       "Regression test " . $number . " (section:" . $si . "):");
 479 }
 480
 481 sub mark_matching_tests_for_skipping($) {
 482     my $overwrite_condition = shift;
 483
 484     our @regression_tests;
 485
 486     for (my $s = 0;  $s < @regression_tests; $s++) {
 487
 488         my $r = 0;
 489
 490         while (defined $regression_tests[$s][$r]) {
 491
 492             if ($regression_tests[$s][$r]{'data'} eq $overwrite_condition) {
 493                 my $message = sprintf("Marking test %s for ignoring. Overwrite condition: %s.",
 494                                       $regression_tests[$s][$r]{'number'}, $overwrite_condition);
 495
 496                 l(LL_FILE_LOADING, $message);
 497
 498                 # XXX: Should eventually get its own key so get_skip_reason()
 499                 #      can tell about the overwrite condition.
 500                 $regression_tests[$s][$r]{'ignore'} = 1;
 501             }
 502             $r++;
 503         }
 504     }
 505 }
 506
 507
 508 # XXX: Shares a lot of code with load_regression_tests_from_file()
 509 #      that should be factored out.
 510 sub load_action_files($) {
 511
 512     # initialized here
 513     our %actions;
 514     our @regression_tests;
 515
 516     my $actionfiles_ref = shift;
 517     my @actionfiles = @{$actionfiles_ref};
 518
 519     my $si = 0;  # Section index
 520     my $ri = -1; # Regression test index
 521     my $count = 0;
 522
 523     my $ignored = 0;
 524
 525     for my $file_number (0 .. @actionfiles - 1) {
 526
 527         my $curl_url = quote($actionfiles[$file_number]);
 528         my $actionfile = undef;
 529         my $sticky_actions = undef;
 530         my $level_offset = 0;
 531
 532         foreach (@{get_cgi_page_or_else($curl_url)}) {
 533
 534             my $no_checks = 0;
 535             chomp;
 536
 537             if (/<h2>Contents of Actions File (.*?)</) {
 538                 $actionfile = $1;
 539                 next;
 540             }
 541             next unless defined $actionfile;
 542
 543             last if (/<\/pre>/);
 544
 545             my ($token, $value) = tokenize($_);
 546
 547             next unless defined $token;
 548
 549             # Load regression tests
 550             if ($token eq 'default level offset') {
 551
 552                 $level_offset = $value;
 553                 l(LL_FILE_LOADING, "Setting default level offset to " . $level_offset);
 554             }
 555
 556             if (token_starts_new_test($token)) {
 557
 558                 # Beginning of new regression test.
 559                 $ri++;
 560                 $count++;
 561                 enlist_new_test(\@regression_tests, $token, $value, $si, $ri, $count);
 562                 $no_checks = 1; # Already validated by enlist_new_test().
 563                 if ($level_offset != 0) {
 564                     $regression_tests[$si][$ri]{'level'} += $level_offset;
 565                 }
 566             }
 567
 568             if ($token =~ /level\s+(\d+)/i) {
 569
 570                 my $level = $1;
 571                 register_dependency($level, $value);
 572             }
 573
 574             if ($token eq 'sticky actions') {
 575
 576                 # Will be used by each following Sticky URL.
 577                 $sticky_actions = $value;
 578                 if ($sticky_actions =~ /{[^}]*\s/) {
 579                     log_and_die("'Sticky Actions' with whitespace inside the " .
 580                                 "action parameters are currently unsupported.");
 581                 }
 582             }
 583
 584             if ($token eq 'overwrite condition') {
 585
 586                 l(LL_FILE_LOADING, "Detected overwrite condition: " . $value);
 587                 # We can only skip matching tests that have already
 588                 # be loaded but that is exactly what we want anyway.
 589                 mark_matching_tests_for_skipping($value);
 590                 next;
 591             }
 592
 593             if ($si == -1 || $ri == -1) {
 594                 # No beginning of a test detected yet,
 595                 # so we don't care about any other test
 596                 # attributes.
 597                 next;
 598             }
 599
 600             if ($token eq 'expect header') {
 601
 602                 l(LL_FILE_LOADING, "Detected expectation: " . $value);
 603                 $regression_tests[$si][$ri]{'expect-header'} = $value;
 604
 605             } elsif ($token eq 'tag') {
 606
 607                 next if ($ri == -1);
 608
 609                 my $tag = parse_tag($value);
 610
 611                 # We already checked in parse_tag() after filtering
 612                 $no_checks = 1;
 613
 614                 l(LL_FILE_LOADING, "Detected TAG: " . $tag);
 615
 616                 # Save tag for all tests in this section
 617                 do {
 618                     $regression_tests[$si][$ri]{'tag'} = $tag;
 619                 } while ($ri-- > 0);
 620
 621                 $si++;
 622                 $ri = -1;
 623
 624             } elsif ($token eq 'ignore' && $value =~ /Yes/i) {
 625
 626                 l(LL_FILE_LOADING, "Ignoring section: " . test_content_as_string($regression_tests[$si][$ri]));
 627                 $regression_tests[$si][$ri]{'ignore'} = 1;
 628                 $ignored++;
 629
 630             } elsif ($token eq 'expect status code') {
 631
 632                 l(LL_FILE_LOADING, "Expecting status code: " . $value);
 633                 $regression_tests[$si][$ri]{'expected-status-code'} = $value;
 634
 635             } elsif ($token eq 'level') { # XXX: stupid name
 636
 637                 $value =~ s@(\d+).*@$1@;
 638                 l(LL_FILE_LOADING, "Level: " . $value);
 639                 $regression_tests[$si][$ri]{'level'} = $value;
 640
 641             } elsif ($token eq 'method') {
 642
 643                 l(LL_FILE_LOADING, "Method: " . $value);
 644                 $regression_tests[$si][$ri]{'method'} = $value;
 645
 646             } elsif ($token eq 'redirect destination') {
 647
 648                 l(LL_FILE_LOADING, "Redirect destination: " . $value);
 649                 $regression_tests[$si][$ri]{'redirect destination'} = $value;
 650
 651             } elsif ($token eq 'url') {
 652
 653                 if (defined $sticky_actions) {
 654                     die "WTF? Attempted to overwrite Sticky Actions"
 655                         if defined ($regression_tests[$si][$ri]{'sticky-actions'});
 656
 657                     l(LL_FILE_LOADING, "Sticky actions: " . $sticky_actions);
 658                     $regression_tests[$si][$ri]{'sticky-actions'} = $sticky_actions;
 659                 } else {
 660                     log_and_die("Sticky URL without Sticky Actions in $actionfile: $value");
 661                 }
 662
 663             } else {
 664
 665                 # We don't use it, so we don't need
 666                 $no_checks = 1;
 667                 l(LL_STATUS, "Enabling no_checks for $token") unless $no_checks;
 668             }
 669
 670             # XXX: Necessary?
 671             unless ($no_checks)  {
 672                 check_for_forbidden_characters($value);
 673                 check_for_forbidden_characters($token);
 674             }
 675         }
 676     }
 677
 678     l(LL_FILE_LOADING, "Done loading " . $count . " regression tests."
 679       . " Of which " . $ignored. " will be ignored)\n");
 680 }
 681
 682 ############################################################################
 683 #
 684 # Regression test executing functions
 685 #
 686 ############################################################################
 687
 688 # Fisher Yates shuffle from Perl's "How do I shuffle an array randomly?" FAQ
 689 sub fisher_yates_shuffle($) {
 690     my $deck = shift;
 691     my $i = @$deck;
 692     while ($i--) {
 693         my $j = int rand($i+1);
 694         @$deck[$i,$j] = @$deck[$j,$i];
 695     }
 696 }
 697
 698 sub execute_regression_tests() {
 699
 700     our @regression_tests;
 701     my $loops = get_cli_option('loops');
 702     my $all_tests    = 0;
 703     my $all_failures = 0;
 704     my $all_successes = 0;
 705
 706     unless (@regression_tests) {
 707
 708         l(LL_STATUS, "No regression tests found.");
 709         return;
 710     }
 711
 712     l(LL_STATUS, "Executing regression tests ...");
 713
 714     while ($loops-- > 0) {
 715
 716         my $successes = 0;
 717         my $tests = 0;
 718         my $failures;
 719         my $skipped = 0;
 720
 721         if (cli_option_is_set('shuffle-tests')) {
 722
 723             # Shuffle both the test sections and
 724             # the tests they contain.
 725             #
 726             # XXX: With the current data layout, shuffling tests
 727             #      from different sections isn't possible.
 728             #      Is this worth changing the layout?
 729             fisher_yates_shuffle(\@regression_tests);
 730             for (my $s = 0; $s < @regression_tests; $s++) {
 731                 fisher_yates_shuffle($regression_tests[$s]);
 732             }
 733         }
 734
 735         for (my $s = 0; $s < @regression_tests; $s++) {
 736
 737             my $r = 0;
 738
 739             while (defined $regression_tests[$s][$r]) {
 740
 741                 unless (cli_option_is_set('shuffle-tests')) {
 742                     die "Section id mismatch" if ($s != $regression_tests[$s][$r]{'section-id'});
 743                     die "Regression test id mismatch" if ($r != $regression_tests[$s][$r]{'regression-test-id'});
 744                 }
 745                 die "Internal error. Test executor missing."
 746                     unless defined $regression_tests[$s][$r]{executor};
 747
 748                 my $number = $regression_tests[$s][$r]{'number'};
 749                 my $skip_reason = get_skip_reason($regression_tests[$s][$r]);
 750
 751                 if (defined $skip_reason) {
 752
 753                     my $message = "Skipping test " . $number . ": " . $skip_reason . ".";
 754                     log_message($message) if (cli_option_is_set('show-skipped-tests'));
 755                     $skipped++;
 756
 757                 } else {
 758
 759                     my $result = $regression_tests[$s][$r]{executor}($regression_tests[$s][$r]);
 760
 761                     log_result($regression_tests[$s][$r], $result, $tests);
 762
 763                     $successes += $result;
 764                     $tests++;
 765                     sleep(get_cli_option('sleep-time')) if (cli_option_is_set('sleep-time'));
 766                 }
 767                 $r++;
 768             }
 769         }
 770         $failures = $tests - $successes;
 771
 772         log_message("Executed " . $tests . " regression tests. " .
 773             'Skipped ' . $skipped . '. ' .
 774             $successes . " successes, " . $failures . " failures.");
 775
 776         $all_tests     += $tests;
 777         $all_failures  += $failures;
 778         $all_successes += $successes;
 779     }
 780
 781     if (get_cli_option('loops') > 1) {
 782         log_message("Total: Executed " . $all_tests . " regression tests. " .
 783             $all_successes . " successes, " . $all_failures . " failures.");
 784     }
 785 }
 786
 787 sub get_skip_reason($) {
 788     my $test = shift;
 789     my $skip_reason = undef;
 790
 791     if ($test->{'ignore'}) {
 792
 793         $skip_reason = "Ignore flag is set";
 794
 795     } elsif (cli_option_is_set('test-number') and
 796              get_cli_option('test-number') != $test->{'number'}) {
 797
 798         $skip_reason = "Only executing test " . get_cli_option('test-number');
 799
 800     } else {
 801
 802         $skip_reason = level_is_unacceptable($test->{'level'});
 803     }
 804
 805     return $skip_reason;
 806 }
 807
 808 sub level_is_unacceptable($) {
 809     my $level = shift;
 810     my $min_level = get_cli_option('min-level');
 811     my $max_level = get_cli_option('max-level');
 812     my $required_level = cli_option_is_set('level') ?
 813         get_cli_option('level') : $level;
 814     my $reason = undef;
 815
 816     if ($required_level != $level) {
 817
 818         $reason = "Level doesn't match (" . $level .
 819                   " != " . $required_level . ")"
 820
 821     } elsif ($level < $min_level) {
 822
 823         $reason = "Level too low (" . $level . " < " . $min_level . ")";
 824
 825     } elsif ($level > $max_level) {
 826
 827         $reason = "Level too high (" . $level . " > " . $max_level . ")";
 828
 829     } else {
 830
 831         $reason = dependency_unsatisfied($level);
 832     }
 833
 834     return $reason;
 835 }
 836
 837 sub dependency_unsatisfied($) {
 838
 839     my $level = shift;
 840     our %dependencies;
 841     our @privoxy_config;
 842     our %privoxy_features;
 843
 844     my $dependency_problem = undef;
 845
 846     if (defined ($dependencies{$level}{'config line'})) {
 847
 848         my $dependency = $dependencies{$level}{'config line'};
 849         $dependency_problem = "depends on config line matching: '" . $dependency . "'";
 850
 851         foreach (@privoxy_config) {
 852
 853             if (/$dependency/) {
 854                 $dependency_problem = undef;
 855                 last;
 856             }
 857         }
 858
 859     }
 860
 861     if (defined ($dependencies{$level}{'feature status'})
 862         and not defined $dependency_problem) {
 863
 864         my $dependency = $dependencies{$level}{'feature status'};
 865         my ($feature, $status) = $dependency =~ /([^\s]*)\s+(Yes|No)/;
 866
 867         unless (defined($privoxy_features{$feature})
 868                 and ($privoxy_features{$feature} eq $status))
 869         {
 870             $dependency_problem = "depends on '" . $feature .
 871                 "' being set to '" . $status . "'";
 872         }
 873     }
 874
 875     return $dependency_problem;
 876 }
 877
 878 sub register_dependency($$) {
 879
 880     my $level = shift;
 881     my $dependency = shift;
 882     our %dependencies;
 883
 884     if ($dependency =~ /config line\s+(.*)/) {
 885
 886         $dependencies{$level}{'config line'} = $1;
 887
 888     } elsif ($dependency =~ /feature status\s+(.*)/) {
 889
 890         $dependencies{$level}{'feature status'} = $1;
 891
 892     } else {
 893
 894         log_and_die("Didn't recognize dependency: $dependency.");
 895     }
 896 }
 897
 898 sub execute_method_test($) {
 899
 900     my $test = shift;
 901     our $privoxy_cgi_url;
 902
 903     my $buffer_ref;
 904     my $status_code;
 905     my $method = $test->{'data'};
 906
 907     my $curl_parameters = '';
 908     my $expected_status_code = $test->{'expected-status-code'};
 909
 910     $curl_parameters .= '--request ' . $method . ' ';
 911     # Don't complain about the 'missing' body
 912     $curl_parameters .= '--head ' if ($method =~ /^HEAD$/i);
 913
 914     $curl_parameters .= $privoxy_cgi_url;
 915
 916     $buffer_ref = get_page_with_curl($curl_parameters);
 917     $status_code = get_status_code($buffer_ref);
 918
 919     return check_status_code_result($status_code, $expected_status_code);
 920 }
 921
 922 sub execute_redirect_test($) {
 923
 924     my $test = shift;
 925     my $buffer_ref;
 926     my $status_code;
 927
 928     my $curl_parameters = '';
 929     my $url = $test->{'data'};
 930     my $redirect_destination;
 931     my $expected_redirect_destination = $test->{'redirect destination'};
 932
 933     # XXX: Check if a redirect actually applies before doing the request.
 934     #      otherwise the test may hit a real server in failure cases.
 935
 936     $curl_parameters .= '--head ';
 937
 938     $curl_parameters .= quote($url);
 939
 940     $buffer_ref = get_page_with_curl($curl_parameters);
 941     $status_code = get_status_code($buffer_ref);
 942
 943     if ($status_code ne "302") {
 944         l(LL_VERBOSE_FAILURE,
 945           "Ooops. Expected redirect to: '" . $expected_redirect_destination
 946           . "' but got a response with status code: " . $status_code);
 947         return 0;
 948     }
 949     foreach (@{$buffer_ref}) {
 950         if (/^Location: (.*)\r\n/) {
 951             $redirect_destination = $1;
 952             last;
 953         }
 954     }
 955
 956     my $success = ($redirect_destination eq $expected_redirect_destination);
 957
 958     unless ($success) {
 959         l(LL_VERBOSE_FAILURE,
 960           "Ooops. Expected redirect to: '" . $expected_redirect_destination
 961           . "' but the redirect leads to: '" . $redirect_destination. "'");
 962     }
 963
 964     return $success;
 965 }
 966
 967 sub execute_dumb_fetch_test($) {
 968
 969     my $test = shift;
 970     our $privoxy_cgi_url;
 971
 972     my $buffer_ref;
 973     my $status_code;
 974
 975     my $curl_parameters = '';
 976     my $expected_status_code = $test->{'expected-status-code'};
 977
 978     if (defined $test->{method}) {
 979         $curl_parameters .= '--request ' . quote($test->{method}) . ' ';
 980     }
 981     if ($test->{type} == TRUSTED_CGI_REQUEST) {
 982         $curl_parameters .= '--referer ' . quote($privoxy_cgi_url) . ' ';
 983     }
 984
 985     $curl_parameters .= quote($test->{'data'});
 986
 987     $buffer_ref = get_page_with_curl($curl_parameters);
 988     $status_code = get_status_code($buffer_ref);
 989
 990     return check_status_code_result($status_code, $expected_status_code);
 991 }
 992
 993 sub execute_block_test($) {
 994
 995     my $test = shift;
 996     my $url = $test->{'data'};
 997     my $final_results = get_final_results($url);
 998
 999     return defined $final_results->{'+block'};
1000 }
1001
1002 sub execute_sticky_actions_test($) {
1003
1004     my $test = shift;
1005     my $url = $test->{'data'};
1006     my $verified_actions = 0;
1007     # XXX: splitting currently doesn't work for actions whose parameters contain spaces.
1008     my @sticky_actions = split(/\s+/, $test->{'sticky-actions'});
1009     my $final_results = get_final_results($url);
1010
1011     foreach my $sticky_action (@sticky_actions) {
1012
1013         if (defined $final_results->{$sticky_action}) {
1014             # Exact match
1015             $verified_actions++;
1016
1017         } elsif ($sticky_action =~ /-.*\{/) {
1018
1019             # Disabled multi actions aren't explicitly listed as
1020             # disabled and thus have to be checked by verifying
1021             # that they aren't enabled.
1022             $verified_actions++;
1023
1024         } else {
1025             l(LL_VERBOSE_FAILURE,
1026               "Ooops. '$sticky_action' is not among the final results.");
1027         }
1028     }
1029
1030     return $verified_actions == @sticky_actions;
1031 }
1032
1033 sub get_final_results($) {
1034
1035     my $url = shift;
1036     our $privoxy_cgi_url;
1037
1038     my $curl_parameters = '';
1039     my %final_results = ();
1040     my $final_results_reached = 0;
1041
1042     die "Unacceptable characters in $url" if $url =~ m@[\\'"]@;
1043     # XXX: should be URL-encoded properly
1044     $url =~ s@%@%25@g;
1045     $url =~ s@\s@%20@g;
1046     $url =~ s@&@%26@g;
1047     $url =~ s@:@%3A@g;
1048     $url =~ s@/@%2F@g;
1049
1050     $curl_parameters .= quote($privoxy_cgi_url . 'show-url-info?url=' . $url);
1051
1052     foreach (@{get_cgi_page_or_else($curl_parameters)}) {
1053
1054         $final_results_reached = 1 if (m@<h2>Final results:</h2>@);
1055
1056         next unless ($final_results_reached);
1057         last if (m@</td>@);
1058
1059         # Privoxy versions before 3.0.16 add a space
1060         # between action name and parameters, therefore
1061         # the " ?".
1062         if (m@<br>([-+])<a.*>([^>]*)</a>(?: ?(\{.*\}))?@) {
1063             my $action = $1.$2;
1064             my $parameter = $3;
1065
1066             if (defined $parameter) {
1067                 # In case the caller needs to check
1068                 # the action and its parameter
1069                 $final_results{$action . $parameter} = 1;
1070             }
1071             # In case the action doesn't have parameters
1072             # or the caller doesn't care for the parameter.
1073             $final_results{$action} = 1;
1074         }
1075     }
1076
1077     return \%final_results;
1078 }
1079
1080 sub check_status_code_result($$) {
1081
1082     my $status_code = shift;
1083     my $expected_status_code = shift;
1084     my $result = 0;
1085
1086     unless (defined $status_code) {
1087
1088         # XXX: should probably be caught earlier.
1089         l(LL_VERBOSE_FAILURE,
1090           "Ooops. We expected status code " . $expected_status_code . ", but didn't get any status code at all.");
1091
1092     } elsif ($expected_status_code == $status_code) {
1093
1094         $result = 1;
1095         l(LL_VERBOSE_SUCCESS,
1096           "Yay. We expected status code " . $expected_status_code . ", and received: " . $status_code . '.');
1097
1098     } elsif (cli_option_is_set('fuzzer-feeding') and $status_code == 123) {
1099
1100         l(LL_VERBOSE_FAILURE,
1101           "Oh well. Status code lost while fuzzing. Can't check if it was " . $expected_status_code . '.');
1102
1103     } else {
1104
1105         l(LL_VERBOSE_FAILURE,
1106           "Ooops. We expected status code " . $expected_status_code . ", but received: " . $status_code . '.');
1107     }
1108
1109     return $result;
1110 }
1111
1112 sub execute_client_header_regression_test($) {
1113
1114     my $test = shift;
1115     my $buffer_ref;
1116     my $header;
1117
1118     $buffer_ref = get_show_request_with_curl($test);
1119
1120     $header = get_header($buffer_ref, $test);
1121
1122     return check_header_result($test, $header);
1123 }
1124
1125 sub execute_server_header_regression_test($) {
1126
1127     my $test = shift;
1128     my $buffer_ref;
1129     my $header;
1130
1131     $buffer_ref = get_head_with_curl($test);
1132
1133     $header = get_server_header($buffer_ref, $test);
1134
1135     return check_header_result($test, $header);
1136 }
1137
1138 sub interpret_result($) {
1139     my $success = shift;
1140     return $success ? "Success" : "Failure";
1141 }
1142
1143 sub check_header_result($$) {
1144
1145     my $test = shift;
1146     my $header = shift;
1147
1148     my $expect_header = $test->{'expect-header'};
1149     my $success = 0;
1150
1151     if ($expect_header eq 'NO CHANGE') {
1152
1153         $success = (defined($header) and $header eq $test->{'data'});
1154
1155         unless ($success) {
1156             $header = "REMOVAL" unless defined $header;
1157             l(LL_VERBOSE_FAILURE,
1158               "Ooops. Got: '" . $header . "' while expecting: '" . $expect_header . "'");
1159         }
1160
1161     } elsif ($expect_header eq 'REMOVAL') {
1162
1163         # XXX: Use more reliable check here and make sure
1164         # the header has a different name.
1165         $success = not (defined($header) and $header eq $test->{'data'});
1166
1167         unless ($success) {
1168             l(LL_VERBOSE_FAILURE,
1169               "Ooops. Expected removal but: '" . $header . "' is still there.");
1170         }
1171
1172     } elsif ($expect_header eq 'SOME CHANGE') {
1173
1174         $success = (defined($header) and $header ne $test->{'data'});
1175
1176         unless  ($success) {
1177             $header = "REMOVAL" unless defined $header;
1178             l(LL_VERBOSE_FAILURE,
1179               "Ooops. Got: '" . $header . "' while expecting: SOME CHANGE");
1180         }
1181
1182     } else {
1183
1184         $success = (defined($header) and $header eq $expect_header);
1185
1186         unless ($success) {
1187             $header = "No matching header" unless defined $header; # XXX: No header detected to be precise
1188             l(LL_VERBOSE_FAILURE,
1189               "Ooops. Got: '" . $header . "' while expecting: '" . $expect_header . "'");
1190         }
1191     }
1192     return $success;
1193 }
1194
1195 sub get_header_name($) {
1196
1197     my $header = shift;
1198
1199     $header =~ s@(.*?: ).*@$1@;
1200
1201     return $header;
1202 }
1203
1204 sub get_header($$) {
1205
1206     our $filtered_request = '';
1207
1208     my $buffer_ref = shift;
1209     my $test = shift;
1210
1211     my @buffer = @{$buffer_ref};
1212
1213     my $expect_header = $test->{'expect-header'};
1214
1215     die "get_header called with no expect header" unless defined $expect_header;
1216
1217     my $line;
1218     my $processed_request_reached = 0;
1219     my $read_header = 0;
1220     my $processed_request = '';
1221     my $header;
1222     my $header_to_get;
1223
1224     if ($expect_header eq 'REMOVAL'
1225      or $expect_header eq 'NO CHANGE'
1226      or $expect_header eq 'SOME CHANGE') {
1227
1228         $expect_header = $test->{'data'};
1229     }
1230
1231     $header_to_get = get_header_name($expect_header);
1232
1233     foreach (@buffer) {
1234
1235         # Skip everything before the Processed request
1236         if (/Processed Request/) {
1237             $processed_request_reached = 1;
1238             next;
1239         }
1240         next unless $processed_request_reached;
1241
1242         # End loop after the Processed request
1243         last if (/<\/pre>/);
1244
1245         # Ditch tags and leading/trailing white space.
1246         s@^\s*<.*?>@@g;
1247         s@\s*$@@g;
1248
1249         # Decode characters we care about.
1250         s@&quot;@"@g;
1251
1252         $filtered_request .=  "\n" . $_;
1253
1254         if (/^$header_to_get/) {
1255             $read_header = 1;
1256             $header = $_;
1257             last;
1258         }
1259     }
1260
1261     return $header;
1262 }
1263
1264 sub get_server_header($$) {
1265
1266     my $buffer_ref = shift;
1267     my $test = shift;
1268
1269     my @buffer = @{$buffer_ref};
1270
1271     my $expect_header = $test->{'expect-header'};
1272     my $header;
1273     my $header_to_get;
1274
1275     # XXX: Should be caught before starting to test.
1276     log_and_die("No expect header for test " . $test->{'number'})
1277         unless defined $expect_header;
1278
1279     if ($expect_header eq 'REMOVAL'
1280      or $expect_header eq 'NO CHANGE'
1281      or $expect_header eq 'SOME CHANGE') {
1282
1283         $expect_header = $test->{'data'};
1284     }
1285
1286     $header_to_get = get_header_name($expect_header);
1287
1288     foreach (@buffer) {
1289
1290         # XXX: should probably verify that the request
1291         # was actually answered by Fellatio.
1292         if (/^$header_to_get/) {
1293             $header = $_;
1294             $header =~ s@\s*$@@g;
1295             last;
1296         }
1297     }
1298
1299     return $header;
1300 }
1301
1302 sub get_status_code($) {
1303
1304     my $buffer_ref = shift;
1305     our $privoxy_cgi_url;
1306
1307     my $skip_connection_established_response = $privoxy_cgi_url =~ m@^https://@;
1308     my @buffer = @{$buffer_ref};
1309
1310     foreach (@buffer) {
1311
1312         if ($skip_connection_established_response) {
1313
1314             next if (m@^HTTP/1\.1 200 Connection established@);
1315             next if (m@^\r\n$@);
1316             $skip_connection_established_response = 0;
1317         }
1318
1319         if (/^HTTP\/\d\.\d (\d{3})/) {
1320
1321             return $1;
1322
1323         } else {
1324
1325             return '123' if cli_option_is_set('fuzzer-feeding');
1326             chomp;
1327             log_and_die('Unexpected buffer line: "' . $_ . '"');
1328         }
1329     }
1330 }
1331
1332 sub get_test_keys() {
1333     return ('tag', 'data', 'expect-header', 'ignore');
1334 }
1335
1336 # XXX: incomplete
1337 sub test_content_as_string($) {
1338
1339     my $test = shift;
1340
1341     my $s = "\n\t";
1342
1343     foreach my $key (get_test_keys()) {
1344         $test->{$key} = 'Not set' unless (defined $test->{$key});
1345     }
1346
1347     $s .= 'Tag: ' . $test->{'tag'};
1348     $s .= "\n\t";
1349     $s .= 'Set header: ' . $test->{'data'}; # XXX: adjust for other test types
1350     $s .= "\n\t";
1351     $s .= 'Expected header: ' . $test->{'expect-header'};
1352     $s .= "\n\t";
1353     $s .= 'Ignore: ' . $test->{'ignore'};
1354
1355     return $s;
1356 }
1357
1358 sub fuzz_header($) {
1359     my $header = shift;
1360     my $white_space = int(rand(2)) - 1 ? " " : "\t";
1361
1362     $white_space = $white_space x (1 + int(rand(5)));
1363
1364     # Only fuzz white space before the first quoted token.
1365     # (Privoxy doesn't touch white space inside quoted tokens
1366     # and modifying it would cause the tests to fail).
1367     $header =~ s@(^[^"]*?)\s@$1$white_space@g;
1368
1369     return $header;
1370 }
1371
1372 ############################################################################
1373 #
1374 # HTTP fetch functions
1375 #
1376 ############################################################################
1377
1378 sub get_cgi_page_or_else($) {
1379
1380     my $cgi_url = shift;
1381     my $content_ref = get_page_with_curl($cgi_url);
1382     my $status_code = get_status_code($content_ref);
1383
1384     if (200 != $status_code) {
1385
1386         my $log_message = "Failed to fetch Privoxy CGI page '$cgi_url'. " .
1387                           "Received status code ". $status_code .
1388                           " while only 200 is acceptable.";
1389
1390         if (cli_option_is_set('fuzzer-feeding')) {
1391
1392             $log_message .= " Ignored due to fuzzer feeding.";
1393             l(LL_SOFT_ERROR, $log_message)
1394
1395         } else {
1396
1397             log_and_die($log_message);
1398         }
1399     }
1400
1401     return $content_ref;
1402 }
1403
1404 # XXX: misleading name
1405 sub get_show_request_with_curl($) {
1406
1407     our $privoxy_cgi_url;
1408     my $test = shift;
1409
1410     my $curl_parameters = ' ';
1411     my $header = $test->{'data'};
1412
1413     if (cli_option_is_set('header-fuzzing')) {
1414         $header = fuzz_header($header);
1415     }
1416
1417     # Enable the action to test
1418     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test->{'tag'} . '\' ';
1419
1420     # Add the header to filter
1421     if ($privoxy_cgi_url =~ m@^https://@ and $header =~ m@^Host:@) {
1422         $curl_parameters .= '--proxy-header \'' . $header . '\' ';
1423     } else {
1424         $curl_parameters .= '-H \'' . $header . '\' ';
1425     }
1426
1427     $curl_parameters .= ' ';
1428     $curl_parameters .= $privoxy_cgi_url;
1429     $curl_parameters .= 'show-request';
1430
1431     return get_cgi_page_or_else($curl_parameters);
1432 }
1433
1434 sub get_head_with_curl($) {
1435
1436     our $fellatio_url = FELLATIO_URL;
1437     my $test = shift;
1438
1439     my $curl_parameters = ' ';
1440
1441     # Enable the action to test
1442     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test->{'tag'} . '\' ';
1443     # The header to filter
1444     $curl_parameters .= '-H \'X-Gimme-Head-With: ' . $test->{'data'} . '\' ';
1445     $curl_parameters .= '--head ';
1446
1447     $curl_parameters .= ' ';
1448     $curl_parameters .= $fellatio_url;
1449
1450     return get_page_with_curl($curl_parameters);
1451 }
1452
1453 sub get_page_with_curl($) {
1454
1455     our $proxy;
1456
1457     my $parameters = shift;
1458     my @buffer;
1459     my $curl_line = get_cli_option('curl');
1460     my $retries_left = get_cli_option('retries') + 1;
1461     my $failure_reason;
1462
1463     if (defined $proxy) {
1464         $curl_line .= ' --proxy ' . quote($proxy);
1465     }
1466     # We want to see the HTTP status code
1467     $curl_line .= " --include ";
1468     # Let Privoxy emit two log messages less.
1469     $curl_line .= ' -H \'Proxy-Connection:\' ' unless $parameters =~ /Proxy-Connection:/;
1470     $curl_line .= ' -H \'Connection: close\' ' unless $parameters =~ /Connection:/;
1471     # We don't care about fetch statistic.
1472     $curl_line .= " -s ";
1473     # We do care about the failure reason if any.
1474     $curl_line .= " -S ";
1475     # We want to advertise ourselves
1476     $curl_line .= " --user-agent '" . PRT_VERSION . "' ";
1477     # We aren't too patient
1478     $curl_line .= " --max-time '" . get_cli_option('max-time') . "' ";
1479     # We don't want curl to treat "[]", "{}" etc. special
1480     $curl_line .= " --globoff ";
1481
1482     $curl_line .= $parameters;
1483     # XXX: still necessary?
1484     $curl_line .= ' 2>&1';
1485
1486     l(LL_PAGE_FETCHING, "Executing: " . $curl_line);
1487
1488     do {
1489         @buffer = `$curl_line`;
1490
1491         if ($?) {
1492             log_and_die("Executing '$curl_line' failed.") unless @buffer;
1493             $failure_reason = array_as_string(\@buffer);
1494             chomp $failure_reason;
1495             l(LL_SOFT_ERROR, "Fetch failure: '" . $failure_reason . $! ."'");
1496         }
1497     } while ($? && --$retries_left);
1498
1499     unless ($retries_left) {
1500         log_and_die("Running curl failed " . get_cli_option('retries') .
1501                     " times in a row. Last error: '" . $failure_reason . "'.");
1502     }
1503
1504     return \@buffer;
1505 }
1506
1507
1508 ############################################################################
1509 #
1510 # Log functions
1511 #
1512 ############################################################################
1513
1514 sub array_as_string($) {
1515     my $array_ref = shift;
1516     my $string = '';
1517
1518     foreach (@{$array_ref}) {
1519         $string .= $_;
1520     }
1521
1522     return $string;
1523 }
1524
1525 sub show_test($) {
1526     my $test = shift;
1527     log_message('Test is:' . test_content_as_string($test));
1528 }
1529
1530 # Conditional log
1531 sub l($$) {
1532     our $log_level;
1533     my $this_level = shift;
1534     my $message = shift;
1535
1536     log_message($message) if ($log_level & $this_level);
1537 }
1538
1539 sub log_and_die($) {
1540     my $message = shift;
1541
1542     log_message('Oh noes. ' . $message . ' Fatal error. Exiting.');
1543     exit;
1544 }
1545
1546 sub log_message($) {
1547
1548     my $message = shift;
1549
1550     our $logfile;
1551     our $no_logging;
1552     our $leading_log_date;
1553     our $leading_log_time;
1554
1555     my $time_stamp = '';
1556     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime time;
1557
1558     if ($leading_log_date || $leading_log_time) {
1559
1560         if ($leading_log_date) {
1561             $year += 1900;
1562             $mon  += 1;
1563             $time_stamp = sprintf("%i-%.2i-%.2i", $year, $mon, $mday);
1564         }
1565
1566         if ($leading_log_time) {
1567             $time_stamp .= ' ' if $leading_log_date;
1568             $time_stamp.= sprintf("%.2i:%.2i:%.2i", $hour, $min, $sec);
1569         }
1570
1571         $message = $time_stamp . ": " . $message;
1572     }
1573
1574     printf("%s\n", $message);
1575 }
1576
1577 sub log_result($$) {
1578
1579     our $filtered_request;
1580
1581     my $test = shift;
1582     my $result = shift;
1583     my $number = shift;
1584
1585     my $message = sprintf("%s for test %d",
1586                           interpret_result($result),
1587                           $test->{'number'});
1588
1589     if (cli_option_is_set('verbose')) {
1590         $message .= sprintf(" (%d/%d/%d)", $number,
1591                             $test->{'section-id'},
1592                             $test->{'regression-test-id'});
1593     }
1594
1595     $message .= '. ';
1596
1597     if ($test->{'type'} == CLIENT_HEADER_TEST) {
1598
1599         $message .= 'Header ';
1600         $message .= quote($test->{'data'});
1601         $message .= ' and tag ';
1602         $message .= quote($test->{'tag'});
1603
1604     } elsif ($test->{'type'} == SERVER_HEADER_TEST) {
1605
1606         $message .= 'Request Header ';
1607         $message .= quote($test->{'data'});
1608         $message .= ' and tag ';
1609         $message .= quote($test->{'tag'});
1610
1611     } elsif ($test->{'type'} == DUMB_FETCH_TEST) {
1612
1613         $message .= 'URL ';
1614         $message .= quote($test->{'data'});
1615         $message .= ' and expected status code ';
1616         $message .= quote($test->{'expected-status-code'});
1617
1618     } elsif ($test->{'type'} == TRUSTED_CGI_REQUEST) {
1619
1620         $message .= 'CGI URL ';
1621         $message .= quote($test->{'data'});
1622         $message .= ' and expected status code ';
1623         $message .= quote($test->{'expected-status-code'});
1624
1625     } elsif ($test->{'type'} == METHOD_TEST) {
1626
1627         $message .= 'HTTP method ';
1628         $message .= quote($test->{'data'});
1629         $message .= ' and expected status code ';
1630         $message .= quote($test->{'expected-status-code'});
1631
1632     } elsif ($test->{'type'} == BLOCK_TEST) {
1633
1634         $message .= 'Supposedly-blocked URL: ';
1635         $message .= quote($test->{'data'});
1636
1637     } elsif ($test->{'type'} == STICKY_ACTIONS_TEST) {
1638
1639         $message .= 'Sticky Actions: ';
1640         $message .= quote($test->{'sticky-actions'});
1641         $message .= ' and URL: ';
1642         $message .= quote($test->{'data'});
1643
1644     } elsif ($test->{'type'} == REDIRECT_TEST) {
1645
1646         $message .= 'Redirected URL: ';
1647         $message .= quote($test->{'data'});
1648         $message .= ' and redirect destination: ';
1649         $message .= quote($test->{'redirect destination'});
1650
1651     } else {
1652
1653         die "Incomplete support for test type " . $test->{'type'} .  " detected.";
1654     }
1655
1656     log_message($message) if (!$result or cli_option_is_set('verbose'));
1657 }
1658
1659 sub quote($) {
1660     my $s = shift;
1661     return '\'' . $s . '\'';
1662 }
1663
1664 sub print_version() {
1665     printf PRT_VERSION . "\n";
1666 }
1667
1668 sub list_test_types() {
1669     my %test_types = (
1670         'Client header test'  => CLIENT_HEADER_TEST,
1671         'Server header test'  =>  2,
1672         'Dumb fetch test'     =>  3,
1673         'Method test'         =>  4,
1674         'Sticky action test'  =>  5,
1675         'Trusted CGI test'    =>  6,
1676         'Block test'          =>  7,
1677         'Redirect test'       => 108,
1678     );
1679
1680     print "\nThe supported test types and their default levels are:\n";
1681     foreach my $test_type (sort { $test_types{$a} <=> $test_types{$b} } keys %test_types) {
1682         printf "     %-20s -> %3.d\n", $test_type, $test_types{$test_type};
1683     }
1684 }
1685
1686 sub help() {
1687
1688     our %cli_options;
1689     our $privoxy_cgi_url;
1690
1691     print_version();
1692
1693     print << "    EOF"
1694
1695 Options and their default values if they have any:
1696     [--check-bad-ssl]
1697     [--curl $cli_options{'curl'}]
1698     [--debug $cli_options{'debug'}]
1699     [--forks $cli_options{'forks'}]
1700     [--fuzzer-address]
1701     [--fuzzer-feeding]
1702     [--help]
1703     [--header-fuzzing]
1704     [--level]
1705     [--local-test-file]
1706     [--loops $cli_options{'loops'}]
1707     [--max-level $cli_options{'max-level'}]
1708     [--max-time $cli_options{'max-time'}]
1709     [--min-level $cli_options{'min-level'}]
1710     [--privoxy-address $cli_options{'privoxy-address'}]
1711     [--privoxy-cgi-prefix $privoxy_cgi_url]
1712     [--retries $cli_options{'retries'}]
1713     [--show-skipped-tests]
1714     [--shuffle-tests]
1715     [--sleep-time $cli_options{'sleep-time'}]
1716     [--test-number]
1717     [--verbose]
1718     [--version]
1719     EOF
1720     ;
1721
1722     list_test_types();
1723
1724     print << "    EOF"
1725
1726 Try "perldoc $0" for more information
1727     EOF
1728     ;
1729
1730     exit(0);
1731 }
1732
1733 sub init_cli_options() {
1734
1735     our %cli_options;
1736     our $log_level;
1737     our $proxy;
1738
1739     $cli_options{'curl'}      = CURL;
1740     $cli_options{'debug'}     = $log_level;
1741     $cli_options{'forks'}     = CLI_FORKS;
1742     $cli_options{'loops'}     = CLI_LOOPS;
1743     $cli_options{'max-level'} = CLI_MAX_LEVEL;
1744     $cli_options{'max-time'}  = CLI_MAX_TIME;
1745     $cli_options{'min-level'} = CLI_MIN_LEVEL;
1746     $cli_options{'sleep-time'}= CLI_SLEEP_TIME;
1747     $cli_options{'retries'}   = CLI_RETRIES;
1748     $cli_options{'privoxy-address'} = $proxy;
1749 }
1750
1751 sub parse_cli_options() {
1752
1753     our %cli_options;
1754     our $log_level;
1755     our $privoxy_cgi_url;
1756
1757     init_cli_options();
1758
1759     GetOptions (
1760         'check-bad-ssl'      => \$cli_options{'check-bad-ssl'},
1761         'curl=s'             => \$cli_options{'curl'},
1762         'debug=i'            => \$cli_options{'debug'},
1763         'forks=i'            => \$cli_options{'forks'},
1764         'fuzzer-address=s'   => \$cli_options{'fuzzer-address'},
1765         'fuzzer-feeding'     => \$cli_options{'fuzzer-feeding'},
1766         'header-fuzzing'     => \$cli_options{'header-fuzzing'},
1767         'help'               => \&help,
1768         'level=i'            => \$cli_options{'level'},
1769         'local-test-file=s'  => \$cli_options{'local-test-file'},
1770         'loops=i'            => \$cli_options{'loops'},
1771         'max-level=i'        => \$cli_options{'max-level'},
1772         'max-time=i'         => \$cli_options{'max-time'},
1773         'min-level=i'        => \$cli_options{'min-level'},
1774         'privoxy-address=s'  => \$cli_options{'privoxy-address'},
1775         'privoxy-cgi-prefix=s' => \$privoxy_cgi_url, # XXX: Should use cli_options()
1776         'retries=i'          => \$cli_options{'retries'},
1777         'shuffle-tests'      => \$cli_options{'shuffle-tests'},
1778         'show-skipped-tests' => \$cli_options{'show-skipped-tests'},
1779         'sleep-time=i'       => \$cli_options{'sleep-time'},
1780         'test-number=i'      => \$cli_options{'test-number'},
1781         'verbose'            => \$cli_options{'verbose'},
1782         'version'            => sub {print_version && exit(0)}
1783     ) or exit(1);
1784     $log_level |= $cli_options{'debug'};
1785
1786     if ($cli_options{'min-level'} > $cli_options{'max-level'}) {
1787         log_message("Increasing --max-level to --min-level " . $cli_options{'min-level'});
1788         $cli_options{'max-level'} = $cli_options{'min-level'};
1789     }
1790 }
1791
1792 sub cli_option_is_set($) {
1793
1794     our %cli_options;
1795     my $cli_option = shift;
1796
1797     return defined $cli_options{$cli_option};
1798 }
1799
1800 sub get_cli_option($) {
1801
1802     our %cli_options;
1803     my $cli_option = shift;
1804
1805     die "Unknown CLI option: $cli_option" unless defined $cli_options{$cli_option};
1806
1807     return $cli_options{$cli_option};
1808 }
1809
1810 sub init_proxy_settings($) {
1811
1812     my $choice = shift;
1813     our $proxy = undef;
1814
1815     if (($choice eq 'fuzz-proxy') and cli_option_is_set('fuzzer-address')) {
1816         $proxy = get_cli_option('fuzzer-address');
1817     }
1818
1819     if ((not defined $proxy) or ($choice eq 'vanilla-proxy')) {
1820
1821         if (cli_option_is_set('privoxy-address')) {
1822             $proxy .=  get_cli_option('privoxy-address');
1823         }
1824     }
1825 }
1826
1827 sub start_forks($) {
1828     my $forks = shift;
1829
1830     log_and_die("Invalid --fork value: " . $forks . ".") if ($forks < 0);
1831
1832     foreach my $fork (1 .. $forks) {
1833         log_message("Starting fork $fork");
1834         my $pid = fork();
1835         if (defined $pid && !$pid) {
1836             return;
1837         }
1838     }
1839 }
1840
1841 sub check_bad_ssl() {
1842     my $failures = 0;
1843     my @bad_ssl_urls_to_check = (
1844         "https://expired.badssl.com/",
1845         "https://wrong.host.badssl.com/",
1846         "https://self-signed.badssl.com/",
1847         "https://untrusted-root.badssl.com/",
1848         "https://no-common-name.badssl.com/", # XXX: Certificate has expired ...
1849         "https://no-subject.badssl.com/", # XXX: Certificate has expired ...
1850         "https://incomplete-chain.badssl.com/",
1851         );
1852     # This is needed for get_status_code() to skip the
1853     # status code from the "HTTP/1.1 200 Connection established"
1854     # reply.
1855     our $privoxy_cgi_url = "https://p.p/";
1856
1857     log_message("Requesting pages from badssl.com with various " .
1858         "certificate problems. This will only work if Privoxy " .
1859         "has been configured properly and can reach the Internet.");
1860
1861     foreach my $url_to_check (@bad_ssl_urls_to_check) {
1862         my ($buffer_ref, $status_code);
1863         log_message("Requesting $url_to_check");
1864
1865         $buffer_ref = get_page_with_curl($url_to_check);
1866         $status_code = get_status_code($buffer_ref);
1867
1868         if (!check_status_code_result($status_code, "403")) {
1869             $failures++;
1870         }
1871
1872     }
1873     if ($failures == 0) {
1874         log_message("All requests resulted in status code 403 as expected.");
1875     } else {
1876         log_message("There were $failures requests that did not result in status code 403!");
1877     }
1878
1879     return $failures;
1880 }
1881
1882 sub main() {
1883
1884     init_our_variables();
1885     parse_cli_options();
1886     init_proxy_settings('vanilla-proxy');
1887     if (cli_option_is_set('check-bad-ssl')) {
1888         exit check_bad_ssl();
1889     }
1890     load_regression_tests();
1891     init_proxy_settings('fuzz-proxy');
1892     start_forks(get_cli_option('forks')) if cli_option_is_set('forks');
1893     execute_regression_tests();
1894 }
1895
1896 main();
1897
1898 =head1 NAME
1899
1900 B<privoxy-regression-test> - A regression test "framework" for Privoxy.
1901
1902 =head1 SYNOPSIS
1903
1904 B<privoxy-regression-test> [B<--check-bad-ssl>] [B<--curl curl>] [B<--debug bitmask>]
1905 [B<--forks> forks] [B<--fuzzer-feeding>] [B<--fuzzer-feeding>] [B<--help>] [B<--level level>]
1906 [B<--local-test-file testfile>] [B<--loops count>] [B<--max-level max-level>]
1907 [B<--max-time max-time>] [B<--min-level min-level>] B<--privoxy-address proxy-address>
1908 B<--privoxy-cgi-prefix cgi-prefix> [B<--retries retries>] [B<--test-number test-number>]
1909 [B<--show-skipped-tests>] [B<--sleep-time> seconds] [B<--verbose>]
1910 [B<--version>]
1911
1912 =head1 DESCRIPTION
1913
1914 Privoxy-Regression-Test is supposed to one day become
1915 a regression test suite for Privoxy. It's not quite there
1916 yet, however, and can currently only test header actions,
1917 check the returned status code for requests to arbitrary
1918 URLs and verify which actions are applied to them.
1919
1920 Client header actions are tested by requesting
1921 B<http://p.p/show-request> and checking whether
1922 or not Privoxy modified the original request as expected.
1923
1924 The original request contains both the header the action-to-be-tested
1925 acts upon and an additional tagger-triggering header that enables
1926 the action to test.
1927
1928 Applied actions are checked through B<http://p.p/show-url-info>.
1929
1930 =head1 CONFIGURATION FILE SYNTAX
1931
1932 Privoxy-Regression-Test's configuration is embedded in
1933 Privoxy action files and loaded through Privoxy's web interface.
1934
1935 It makes testing a Privoxy version running on a remote system easier
1936 and should prevent you from updating your tests without updating Privoxy's
1937 configuration accordingly.
1938
1939 A client-header-action test section looks like this:
1940
1941     # Set Header    = Referer: http://www.example.org.zwiebelsuppe.exit/
1942     # Expect Header = Referer: http://www.example.org/
1943     {+client-header-filter{hide-tor-exit-notation} -hide-referer}
1944     TAG:^client-header-filter\{hide-tor-exit-notation\}$
1945
1946 The example above causes Privoxy-Regression-Test to set
1947 the header B<Referer: http://www.example.org.zwiebelsuppe.exit/>
1948 and to expect it to be modified to
1949 B<Referer: http://www.example.org/>.
1950
1951 When testing this section, Privoxy-Regression-Test will set the header
1952 B<X-Privoxy-Control: client-header-filter{hide-tor-exit-notation}>
1953 causing the B<privoxy-control> tagger to create the tag
1954 B<client-header-filter{hide-tor-exit-notation}> which will finally
1955 cause Privoxy to enable the action section.
1956
1957 Note that the actions itself are only used by Privoxy,
1958 Privoxy-Regression-Test ignores them and will be happy
1959 as long as the expectations are satisfied.
1960
1961 A fetch test looks like this:
1962
1963     # Fetch Test = http://p.p/user-manual
1964     # Expect Status Code = 302
1965
1966 It tells Privoxy-Regression-Test to request B<http://p.p/user-manual>
1967 and to expect a response with the HTTP status code B<302>. Obviously that's
1968 not a very thorough test and mainly useful to get some code coverage
1969 for Valgrind or to verify that the templates are installed correctly.
1970
1971 If you want to test CGI pages that require a trusted
1972 referer, you can use:
1973
1974     # Trusted CGI Request = http://p.p/edit-actions
1975
1976 It works like ordinary fetch tests, but sets the referer
1977 header to a trusted value.
1978
1979 If no explicit status code expectation is set, B<200> is used.
1980
1981 To verify that a URL is blocked, use:
1982
1983     # Blocked URL = http://www.example.com/blocked
1984
1985 To verify that a specific set of actions is applied to an URL, use:
1986
1987     # Sticky Actions = +block{foo} +handle-as-empty-document -handle-as-image
1988     # URL = http://www.example.org/my-first-url
1989
1990 The sticky actions will be checked for all URLs below it
1991 until the next sticky actions directive.
1992
1993 To verify that requests for a URL get redirected, use:
1994
1995     # Redirected URL = http://www.example.com/redirect-me
1996     # Redirect Destination = http://www.example.org/redirected
1997
1998 To skip a test, add the following line:
1999
2000     # Ignore = Yes
2001
2002 The difference between a skipped test and a removed one is that removing
2003 a test affects the numbers of the following tests, while a skipped test
2004 is still loaded and thus keeps the test numbers unchanged.
2005
2006 Sometimes user modifications intentionally conflict with tests in the
2007 default configuration and thus cause test failures. Adding the Ignore
2008 directive to the failing tests works but is inconvenient as the directive
2009 is likely to get lost with the next update.
2010
2011 Overwrite conditions are an alternative and can be added in any action
2012 file as long as the come after the test that is expected to fail.
2013 They cause all previous tests that match the condition to be skipped.
2014
2015 It is recommended to put the overwrite condition below the custom Privoxy
2016 section that causes the expected test failure and before the custom test
2017 that verifies that tests the now expected behaviour. Example:
2018
2019     # The following section is expected to overwrite a section in
2020     # default.action, whose effect is being tested. Thus also disable
2021     # the test that is now expected to fail and add a new one.
2022     #
2023     {+block{Facebook makes Firefox even more unstable. Do not want.}}
2024     # Overwrite condition = http://apps.facebook.com/onthefarm/track.php?creative=&cat=friendvisit&subcat=weeds&key=a789a971dc687bee4c20c044834fabdd&next=index.php%3Fref%3Dnotif%26visitId%3D898835505
2025     # Blocked URL = http://apps.facebook.com/
2026     .facebook./
2027
2028 =head1 TEST LEVELS
2029
2030 All tests have test levels to let the user
2031 control which ones to execute (see I<OPTIONS> below).
2032 Test levels are either set with the B<Level> directive,
2033 or implicitly through the test type.
2034
2035 Redirect tests default to level 108, block tests to level 7,
2036 fetch tests to level 6, "Sticky Actions" tests default to
2037 level 5, tests for trusted CGI requests to level 3 and
2038 client-header-action tests to level 1.
2039
2040 The current redirect test level is above the default
2041 max-level value as failed tests will result in outgoing
2042 connections. Use the B<--max-level> option to run them
2043 as well.
2044
2045 The "Default level offset" directive can be used to change
2046 the default level by a given value. This directive affects
2047 all tests located after it until the end of the file or a another
2048 "Default level offset" directive is reached. The purpose of this
2049 directive is to make it more convenient to skip similar tests in
2050 a given file without having to remove or disable the tests completely.
2051
2052 =head1 OPTIONS
2053
2054 B<--check-bad-ssl> Instead of running the regression tests
2055 as described above, request pages from badssl.com with bad
2056 certificates to verify that Privoxy is detecting the
2057 certificate issues. Only works if Privoxy has been compiled
2058 with FEATURE_HTTPS_INSPECTION, has been configured properly
2059 and can reach the Internet.
2060
2061 B<--curl curl> Use a non-default curl binary.
2062
2063 B<--debug bitmask> Add the bitmask provided as integer
2064 to the debug settings.
2065
2066 B<--forks forks> Number of forks to start before executing
2067 the regression tests. This is mainly useful for stress-testing.
2068
2069 B<--fuzzer-address> Listening address used when executing
2070 the regression tests. Useful to make sure that the requests
2071 to load the regression tests don't fail due to fuzzing.
2072
2073 B<--fuzzer-feeding> Ignore some errors that would otherwise
2074 cause Privoxy-Regression-Test to abort the test because
2075 they shouldn't happen in normal operation. This option is
2076 intended to be used if Privoxy-Regression-Test is only
2077 used to feed a fuzzer in which case there's a high chance
2078 that Privoxy gets an invalid request and returns an error
2079 message.
2080
2081 B<--help> Shows available command line options.
2082
2083 B<--header-fuzzing> Modifies linear white space in
2084 headers in a way that should not affect the test result.
2085
2086 B<--level level> Only execute tests with the specified B<level>.
2087
2088 B<--local-test-file test-file> Do not get the tests
2089 through Privoxy's web interface, but use a single local
2090 file. Not recommended for testing Privoxy, but can be useful
2091 to "misappropriate" Privoxy-Regression-Test to test other
2092 stuff, like webserver configurations.
2093
2094 B<--loop count> Loop through the regression tests B<count> times.
2095 Useful to feed a fuzzer, or when doing stress tests with
2096 several Privoxy-Regression-Test instances running at the same
2097 time.
2098
2099 B<--max-level max-level> Only execute tests with a B<level>
2100 below or equal to the numerical B<max-level>.
2101
2102 B<--max-time max-time> Give Privoxy B<max-time> seconds
2103 to return data. Increasing the default may make sense when
2104 Privoxy is run through Valgrind, decreasing the default may
2105 make sense when Privoxy-Regression-Test is used to feed
2106 a fuzzer.
2107
2108 B<--min-level min-level> Only execute tests with a B<level>
2109 above or equal to the numerical B<min-level>.
2110 If the B<min-level> is larger than the B<max-level>,
2111 the B<max-level> is set to the B<min-level>.
2112
2113 B<--privoxy-address proxy-address> Privoxy's listening address.
2114 If it's not set, the value of the environment variable http_proxy
2115 will be used unless the variable isn't set in which case
2116 http://127.0.0.1:8118/ will be used. B<proxy-address> has to
2117 be specified in http_proxy syntax.
2118
2119 B<--privoxy-cgi-prefix privoxy-cgi-prefix> The prefix to use when
2120 building URLs that are supposed to reach Privoxy's CGI interface.
2121 If it's not set, B<http://p.p/> is used, which is supposed to work
2122 with the default Privoxy configuration.
2123 If Privoxy has been built with B<FEATURE_HTTPS_INSPECTION> enabled,
2124 and if https inspection is activated with the B<+https-inspection>
2125 action, this option can be used with
2126 B<https://p.p/> provided the system running Privoxy-Regression-Test
2127 has been configured to trust the certificate used by Privoxy.
2128 Note that there are currently two tests in the official
2129 B<regression-tests.action> file that are expected to fail when
2130 using a B<privoxy-cgi-prefix> with B<https://> and aren't automatically
2131 skipped.
2132
2133 B<--retries retries> Retry B<retries> times.
2134
2135 B<--test-number test-number> Only run the test with the specified
2136 number.
2137
2138 B<--show-skipped-tests> Log skipped tests even if verbose mode is off.
2139
2140 B<--shuffle-tests> Shuffle test sections and their tests before
2141 executing them. When combined with B<--forks>, this can increase
2142 the chances of detecting race conditions. Of course some problems
2143 are easier to detect without this option.
2144
2145 B<--sleep-time seconds> Wait B<seconds> between tests. Useful when
2146 debugging issues with systems that don't log with millisecond precision.
2147
2148 B<--verbose> Log successful tests as well. By default only
2149 the failures are logged.
2150
2151 B<--version> Print version and exit.
2152
2153 The second dash is optional, options can be shortened,
2154 as long as there are no ambiguities.
2155
2156 =head1 PRIVOXY CONFIGURATION
2157
2158 Privoxy-Regression-Test is shipped with B<regression-tests.action>
2159 which aims to test all official client-header modifying actions
2160 and can be used to verify that the templates and the user manual
2161 files are installed correctly.
2162
2163 To use it, it has to be copied in Privoxy's configuration
2164 directory, and afterwards referenced in Privoxy's configuration
2165 file with the line:
2166
2167     actionsfile regression-tests.action
2168
2169 In general, its tests are supposed to work without changing
2170 any other action files, unless you already added lots of
2171 taggers yourself. If you are using taggers that cause problems,
2172 you might have to temporary disable them for Privoxy's CGI pages.
2173
2174 Some of the regression tests rely on Privoxy features that
2175 may be disabled in your configuration. Tests with a level below
2176 7 are supposed to work with all Privoxy configurations (provided
2177 you didn't build with FEATURE_GRACEFUL_TERMINATION).
2178
2179 Tests with level 9 require Privoxy to deliver the User Manual,
2180 tests with level 12 require the CGI editor to be enabled.
2181
2182 =head1 CAVEATS
2183
2184 Expect the configuration file syntax to change with future releases.
2185
2186 =head1 LIMITATIONS
2187
2188 As Privoxy's B<show-request> page only shows client headers,
2189 Privoxy-Regression-Test can't use it to test Privoxy actions
2190 that modify server headers.
2191
2192 As Privoxy-Regression-Test relies on Privoxy's tag feature to
2193 control the actions to test, it currently only works with
2194 Privoxy 3.0.7 or later.
2195
2196 At the moment Privoxy-Regression-Test fetches Privoxy's
2197 configuration page through I<curl>(1), therefore you have to
2198 have I<curl> installed, otherwise you won't be able to run
2199 Privoxy-Regression-Test in a meaningful way.
2200
2201 =head1 SEE ALSO
2202
2203 privoxy(8) curl(1)
2204
2205 =head1 AUTHOR
2206
2207 Fabian Keil <fk@fabiankeil.de>
2208
2209 =cut