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