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.160 2008/10/25 15:39:27 fk Exp $
  11 #
  12 # Wish list:
  13 #
  14 # - Update documentation
  15 # - Validate HTTP times.
  16 # - Implement a HTTP_VERSION directive or allow to
  17 #   specify whole request lines.
  18 # - Support filter regression tests.
  19 # - Document magic Expect Header values
  20 # - Internal fuzz support?
  21 #
  22 # Copyright (c) 2007-2008 Fabian Keil <fk@fabiankeil.de>
  23 #
  24 # Permission to use, copy, modify, and distribute this software for any
  25 # purpose with or without fee is hereby granted, provided that the above
  26 # copyright notice and this permission notice appear in all copies.
  27 #
  28 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  29 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  30 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  31 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  32 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  33 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  34 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  35 #
  36 ############################################################################
  37
  38 use warnings;
  39 use strict;
  40 use Getopt::Long;
  41
  42 use constant {
  43                PRT_VERSION => 'Privoxy-Regression-Test 0.3',
  44
  45                CURL => 'curl',
  46
  47                # CLI option defaults
  48                CLI_RETRIES   => 1,
  49                CLI_LOOPS     => 1,
  50                CLI_MAX_TIME  => 5,
  51                CLI_MIN_LEVEL => 0,
  52                CLI_MAX_LEVEL => 25,
  53                CLI_FORKS     => 0,
  54
  55                PRIVOXY_CGI_URL => 'http://p.p/',
  56                FELLATIO_URL    => 'http://127.0.0.1:8080/',
  57                LEADING_LOG_DATE => 1,
  58                LEADING_LOG_TIME => 1,
  59
  60                DEBUG_LEVEL_FILE_LOADING    => 0,
  61                DEBUG_LEVEL_PAGE_FETCHING   => 0,
  62
  63                VERBOSE_TEST_DESCRIPTION    => 1,
  64
  65                DEBUG_LEVEL_VERBOSE_FAILURE => 1,
  66                # XXX: Only partly implemented and mostly useless.
  67                DEBUG_LEVEL_VERBOSE_SUCCESS => 0,
  68                DEBUG_LEVEL_STATUS          => 1,
  69
  70                # Internal use, don't modify
  71                # Available debug bits:
  72                LL_ERROR                   =>  1,
  73                LL_VERBOSE_FAILURE         =>  2,
  74                LL_PAGE_FETCHING           =>  4,
  75                LL_FILE_LOADING            =>  8,
  76                LL_VERBOSE_SUCCESS         => 16,
  77                LL_STATUS                  => 32,
  78                LL_SOFT_ERROR              => 64,
  79
  80                CLIENT_HEADER_TEST         =>  1,
  81                SERVER_HEADER_TEST         =>  2,
  82                DUMB_FETCH_TEST            =>  3,
  83                METHOD_TEST                =>  4,
  84                STICKY_ACTIONS_TEST        =>  5,
  85                TRUSTED_CGI_REQUEST        =>  6,
  86                BLOCK_TEST                 =>  7,
  87 };
  88
  89 sub init_our_variables () {
  90
  91     our $leading_log_time = LEADING_LOG_TIME;
  92     our $leading_log_date = LEADING_LOG_DATE;
  93
  94     our $privoxy_cgi_url  = PRIVOXY_CGI_URL;
  95
  96     our $verbose_test_description = VERBOSE_TEST_DESCRIPTION;
  97
  98     our $log_level = get_default_log_level();
  99
 100 }
 101
 102 sub get_default_log_level () {
 103
 104     my $log_level = 0;
 105
 106     $log_level |= LL_FILE_LOADING    if DEBUG_LEVEL_FILE_LOADING;
 107     $log_level |= LL_PAGE_FETCHING   if DEBUG_LEVEL_PAGE_FETCHING;
 108     $log_level |= LL_VERBOSE_FAILURE if DEBUG_LEVEL_VERBOSE_FAILURE;
 109     $log_level |= LL_VERBOSE_SUCCESS if DEBUG_LEVEL_VERBOSE_SUCCESS;
 110     $log_level |= LL_STATUS          if DEBUG_LEVEL_STATUS;
 111
 112     # These are intended to be always on.
 113     $log_level |= LL_SOFT_ERROR;
 114     $log_level |= LL_ERROR;
 115
 116     return $log_level;
 117 }
 118
 119 ############################################################################
 120 #
 121 # File loading functions
 122 #
 123 ############################################################################
 124
 125 sub parse_tag ($) {
 126
 127     my $tag = shift;
 128
 129     # Remove anchors
 130     $tag =~ s@[\$\^]@@g;
 131     # Unescape brackets and dots
 132     $tag =~ s@\\(?=[{}().+])@@g;
 133
 134     # log_message("Parsed tag: " . $tag);
 135
 136     check_for_forbidden_characters($tag);
 137
 138     return $tag;
 139 }
 140
 141 sub check_for_forbidden_characters ($) {
 142
 143     my $tag = shift; # XXX: also used to check values though.
 144     my $allowed = '[-=\dA-Za-z~{}:.\/();\s,+@"_%\?&*^]';
 145
 146     unless ($tag =~ m/^$allowed*$/) {
 147         my $forbidden = $tag;
 148         $forbidden =~ s@^$allowed*(.).*@$1@;
 149
 150         l(LL_ERROR, "'" . $tag . "' contains character '" . $forbidden. "' which is unacceptable.");
 151     }
 152 }
 153
 154 sub load_regressions_tests () {
 155
 156     our $privoxy_cgi_url;
 157     our @privoxy_config;
 158     our %privoxy_features;
 159     my @actionfiles;
 160     my $curl_url = '';
 161     my $file_number = 0;
 162     my $feature;
 163
 164     $curl_url .= $privoxy_cgi_url;
 165     $curl_url .= 'show-status';
 166
 167     l(LL_STATUS, "Asking Privoxy for the number of action files available ...");
 168
 169     foreach (@{get_cgi_page_or_else($curl_url)}) {
 170
 171         chomp;
 172         if (/<td>(.*?)<\/td><td class=\"buttons\"><a href=\"\/show-status\?file=actions&amp;index=(\d+)\">/) {
 173
 174             my $url = $privoxy_cgi_url . 'show-status?file=actions&index=' . $2;
 175             $actionfiles[$file_number++] = $url;
 176
 177         } elsif (m@config\.html#.*\">([^<]*)</a>\s+(.*)<br>@) {
 178
 179             my $directive = $1 . " " . $2;
 180             push (@privoxy_config, $directive);
 181
 182         } elsif (m@<td><code>([^<]*)</code></td>@) {
 183
 184             $feature = $1;
 185
 186         } elsif (m@<td> (Yes|No) </td>@) {
 187
 188             $privoxy_features{$feature} = $1 if defined $feature;
 189             $feature = undef;
 190         }
 191     }
 192
 193     l(LL_FILE_LOADING, "Recognized " . @actionfiles . " actions files");
 194
 195     load_action_files(\@actionfiles);
 196 }
 197
 198 sub token_starts_new_test ($) {
 199
 200     my $token = shift;
 201     my @new_test_directives = ('set header', 'fetch test',
 202          'trusted cgi request', 'request header', 'method test',
 203          'blocked url', 'url');
 204
 205     foreach my $new_test_directive (@new_test_directives) {
 206         return 1 if $new_test_directive eq $token;
 207     }
 208     return 0;
 209
 210 }
 211
 212 sub tokenize ($) {
 213
 214     my ($token, $value) = (undef, undef);
 215
 216     # Remove leading and trailing white space.
 217     s@^\s*@@;
 218     s@\s*$@@;
 219
 220     # Reverse HTML-encoding
 221     # XXX: Seriously imcomplete.
 222     s@&quot;@"@g;
 223     s@&amp;@&@g;
 224
 225     # Tokenize
 226     if (/^\#\s*([^=:]*?)\s*[=]\s*(.+?)\s*$/) {
 227
 228         $token = $1;
 229         $value = $2;
 230
 231         $token =~ s@\s\s+@ @g;
 232         $token =~ tr/[A-Z]/[a-z]/;
 233
 234     } elsif (/^TAG\s*:(.*)$/) {
 235
 236         $token = 'tag';
 237         $value = $1;
 238
 239     }
 240
 241     return ($token, $value);
 242 }
 243
 244 sub enlist_new_test ($$$$$$) {
 245
 246     my ($regression_tests, $token, $value, $si, $ri, $number) = @_;
 247     my $type;
 248
 249     if ($token eq 'set header') {
 250
 251         l(LL_FILE_LOADING, "Header to set: " . $value);
 252         $type = CLIENT_HEADER_TEST;
 253
 254     } elsif ($token eq 'request header') {
 255
 256         l(LL_FILE_LOADING, "Header to request: " . $value);
 257         $type = SERVER_HEADER_TEST;
 258         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 259
 260     } elsif ($token eq 'trusted cgi request') {
 261
 262         l(LL_FILE_LOADING, "CGI URL to test in a dumb way: " . $value);
 263         $type = TRUSTED_CGI_REQUEST;
 264         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 265
 266     } elsif ($token eq 'fetch test') {
 267
 268         l(LL_FILE_LOADING, "URL to test in a dumb way: " . $value);
 269         $type = DUMB_FETCH_TEST;
 270         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 271
 272     } elsif ($token eq 'method test') {
 273
 274         l(LL_FILE_LOADING, "Method to test: " . $value);
 275         $type = METHOD_TEST;
 276         $$regression_tests[$si][$ri]{'expected-status-code'} = 200;
 277
 278     } elsif ($token eq 'blocked url') {
 279
 280         l(LL_FILE_LOADING, "URL to block-test: " . $value);
 281         $type = BLOCK_TEST;
 282
 283     } elsif ($token eq 'url') {
 284
 285         l(LL_FILE_LOADING, "Sticky URL to test: " . $value);
 286         $type = STICKY_ACTIONS_TEST;
 287
 288     } else {
 289
 290         die "Incomplete '" . $token . "' support detected.";
 291
 292     }
 293
 294     $$regression_tests[$si][$ri]{'type'} = $type;
 295     $$regression_tests[$si][$ri]{'level'} = $type;
 296
 297     check_for_forbidden_characters($value);
 298
 299     $$regression_tests[$si][$ri]{'data'} = $value;
 300
 301     # For function that only get passed single tests
 302     $$regression_tests[$si][$ri]{'section-id'} = $si;
 303     $$regression_tests[$si][$ri]{'regression-test-id'} = $ri;
 304     $$regression_tests[$si][$ri]{'number'} = $number - 1;
 305     l(LL_FILE_LOADING,
 306       "Regression test " . $number . " (section:" . $si . "):");
 307 }
 308
 309 sub load_action_files ($) {
 310
 311     # initialized here
 312     our %actions;
 313     our @regression_tests;
 314
 315     my $actionfiles_ref = shift;
 316     my @actionfiles = @{$actionfiles_ref};
 317
 318     my $si = 0;  # Section index
 319     my $ri = -1; # Regression test index
 320     my $count = 0;
 321
 322     my $ignored = 0;
 323
 324     l(LL_STATUS, "Gathering regression tests from " .
 325       @actionfiles . " action file(s) delivered by Privoxy.");
 326
 327     for my $file_number (0 .. @actionfiles - 1) {
 328
 329         my $curl_url = ' "' . $actionfiles[$file_number] . '"';
 330         my $actionfile = undef;
 331         my $sticky_actions = undef;
 332
 333         foreach (@{get_cgi_page_or_else($curl_url)}) {
 334
 335             my $no_checks = 0;
 336             chomp;
 337
 338             if (/<h2>Contents of Actions File (.*?)</) {
 339                 $actionfile = $1;
 340                 next;
 341             }
 342             next unless defined $actionfile;
 343
 344             last if (/<\/pre>/);
 345
 346             my ($token, $value) = tokenize($_);
 347
 348             next unless defined $token;
 349
 350             # Load regression tests
 351
 352             if (token_starts_new_test($token)) {
 353
 354                 # Beginning of new regression test.
 355                 $ri++;
 356                 $count++;
 357                 enlist_new_test(\@regression_tests, $token, $value, $si, $ri, $count);
 358             }
 359
 360             if ($token =~ /level\s+(\d+)/i) {
 361
 362                 my $level = $1;
 363                 register_dependency($level, $value);
 364             }
 365
 366             if ($token eq 'sticky actions') {
 367
 368                 # Will be used by each following Sticky URL.
 369                 $sticky_actions = $value;
 370                 if ($sticky_actions =~ /{[^}]*\s/) {
 371                     l(LL_ERROR,
 372                       "'Sticky Actions' with whitespace inside the " .
 373                       "action parameters are currently unsupported.");
 374                 }
 375             }
 376
 377             if ($si == -1 || $ri == -1) {
 378                 # No beginning of a test detected yet,
 379                 # so we don't care about any other test
 380                 # attributes.
 381                 next;
 382             }
 383
 384             if ($token eq 'expect header') {
 385
 386                 l(LL_FILE_LOADING, "Detected expectation: " . $value);
 387                 $regression_tests[$si][$ri]{'expect-header'} = $value;
 388
 389             } elsif ($token eq 'tag') {
 390
 391                 next if ($ri == -1);
 392
 393                 my $tag = parse_tag($value);
 394
 395                 # We already checked in parse_tag() after filtering
 396                 $no_checks = 1;
 397
 398                 l(LL_FILE_LOADING, "Detected TAG: " . $tag);
 399
 400                 # Save tag for all tests in this section
 401                 do {
 402                     $regression_tests[$si][$ri]{'tag'} = $tag;
 403                 } while ($ri-- > 0);
 404
 405                 $si++;
 406                 $ri = -1;
 407
 408             } elsif ($token eq 'ignore' && $value =~ /Yes/i) {
 409
 410                 l(LL_FILE_LOADING, "Ignoring section: " . test_content_as_string($regression_tests[$si][$ri]));
 411                 $regression_tests[$si][$ri]{'ignore'} = 1;
 412                 $ignored++;
 413
 414             } elsif ($token eq 'expect status code') {
 415
 416                 l(LL_FILE_LOADING, "Expecting status code: " . $value);
 417                 $regression_tests[$si][$ri]{'expected-status-code'} = $value;
 418
 419             } elsif ($token eq 'level') { # XXX: stupid name
 420
 421                 $value =~ s@(\d+).*@$1@;
 422                 l(LL_FILE_LOADING, "Level: " . $value);
 423                 $regression_tests[$si][$ri]{'level'} = $value;
 424
 425             } elsif ($token eq 'method') {
 426
 427                 l(LL_FILE_LOADING, "Method: " . $value);
 428                 $regression_tests[$si][$ri]{'method'} = $value;
 429
 430             } elsif ($token eq 'url') {
 431
 432                 if (defined $sticky_actions) {
 433                     die "WTF? Attempted to overwrite Sticky Actions"
 434                         if defined ($regression_tests[$si][$ri]{'sticky-actions'});
 435
 436                     l(LL_FILE_LOADING, "Sticky actions: " . $sticky_actions);
 437                     $regression_tests[$si][$ri]{'sticky-actions'} = $sticky_actions;
 438                 } else {
 439                     l(LL_ERROR, "Sticky URL without Sticky Actions: $value");
 440                 }
 441
 442             } else {
 443
 444                 # We don't use it, so we don't need
 445                 $no_checks = 1;
 446             }
 447             # XXX: Neccessary?
 448             check_for_forbidden_characters($value) unless $no_checks;
 449             check_for_forbidden_characters($token);
 450         }
 451     }
 452
 453     l(LL_FILE_LOADING, "Done loading " . $count . " regression tests."
 454       . " Of which " . $ignored. " will be ignored)\n");
 455 }
 456
 457 ############################################################################
 458 #
 459 # Regression test executing functions
 460 #
 461 ############################################################################
 462
 463 sub execute_regression_tests () {
 464
 465     our @regression_tests;
 466     my $loops = get_cli_option('loops');
 467     my $all_tests    = 0;
 468     my $all_failures = 0;
 469     my $all_successes = 0;
 470
 471     unless (@regression_tests) {
 472
 473         l(LL_STATUS, "No regression tests found.");
 474         return;
 475     }
 476
 477     l(LL_STATUS, "Executing regression tests ...");
 478
 479     while ($loops-- > 0) {
 480
 481         my $successes = 0;
 482         my $tests = 0;
 483         my $failures;
 484         my $skipped = 0;
 485
 486         for my $s (0 .. @regression_tests - 1) {
 487
 488             my $r = 0;
 489
 490             while (defined $regression_tests[$s][$r]) {
 491
 492                 die "Section id mismatch" if ($s != $regression_tests[$s][$r]{'section-id'});
 493                 die "Regression test id mismatch" if ($r != $regression_tests[$s][$r]{'regression-test-id'});
 494
 495                 my $number = $regression_tests[$s][$r]{'number'};
 496
 497                 if ($regression_tests[$s][$r]{'ignore'}
 498                     or level_is_unacceptable($regression_tests[$s][$r]{'level'})
 499                     or test_number_is_unacceptable($number)) {
 500
 501                     $skipped++;
 502
 503                 } else {
 504
 505                     my $result = execute_regression_test($regression_tests[$s][$r]);
 506
 507                     log_result($regression_tests[$s][$r], $result, $tests);
 508
 509                     $successes += $result;
 510                     $tests++;
 511                 }
 512                 $r++;
 513             }
 514         }
 515         $failures = $tests - $successes;
 516
 517         log_message("Executed " . $tests . " regression tests. " .
 518             'Skipped ' . $skipped . '. ' .
 519             $successes . " successes, " . $failures . " failures.");
 520
 521         $all_tests    += $tests;
 522         $all_failures += $failures;
 523         $all_successes += $successes;
 524
 525     }
 526
 527     if (get_cli_option('loops') > 1) {
 528         log_message("Total: Executed " . $all_tests . " regression tests. " .
 529             $all_successes . " successes, " . $all_failures . " failures.");
 530     }
 531 }
 532
 533 sub level_is_unacceptable ($) {
 534     my $level = shift;
 535     return ((cli_option_is_set('level') and get_cli_option('level') != $level)
 536             or ($level < get_cli_option('min-level'))
 537             or ($level > get_cli_option('max-level'))
 538             or dependency_unsatisfied($level)
 539             );
 540 }
 541
 542 sub test_number_is_unacceptable ($) {
 543     my $test_number = shift;
 544     return (cli_option_is_set('test-number')
 545             and get_cli_option('test-number') != $test_number)
 546 }
 547
 548 sub dependency_unsatisfied ($) {
 549
 550     my $level = shift;
 551     our %dependencies;
 552     our @privoxy_config;
 553     our %privoxy_features;
 554
 555     my $dependency_problem = 0;
 556
 557     if (defined ($dependencies{$level}{'config line'})) {
 558
 559         my $dependency = $dependencies{$level}{'config line'};
 560         $dependency_problem = 1;
 561
 562         foreach (@privoxy_config) {
 563
 564              $dependency_problem = 0 if (/$dependency/);
 565              last;
 566         }
 567
 568     } elsif (defined ($dependencies{$level}{'feature status'})) {
 569
 570         my $dependency = $dependencies{$level}{'feature status'};
 571         $dependency_problem = 1;
 572         my ($feature, $status) = $dependency =~ /([^\s]*)\s+(Yes|No)/;
 573
 574         if (defined($privoxy_features{$feature})
 575             and ($privoxy_features{$feature} eq $status))
 576         {
 577             $dependency_problem = 0;
 578         }
 579     }
 580
 581     return $dependency_problem;
 582 }
 583
 584 sub register_dependency ($$) {
 585
 586     my $level = shift;
 587     my $dependency = shift;
 588     our %dependencies;
 589
 590     if ($dependency =~ /config line\s+(.*)/) {
 591
 592         $dependencies{$level}{'config line'} = $1;
 593
 594     } elsif ($dependency =~ /feature status\s+(.*)/) {
 595
 596         $dependencies{$level}{'feature status'} = $1;
 597
 598     }
 599 }
 600
 601 # XXX: somewhat misleading name
 602 sub execute_regression_test ($) {
 603
 604     my $test_ref = shift;
 605     my %test = %{$test_ref};
 606     my $result = 0;
 607
 608     if ($test{'type'} == CLIENT_HEADER_TEST) {
 609
 610         $result = execute_client_header_regression_test($test_ref);
 611
 612     } elsif ($test{'type'} == SERVER_HEADER_TEST) {
 613
 614         $result = execute_server_header_regression_test($test_ref);
 615
 616     } elsif ($test{'type'} == DUMB_FETCH_TEST
 617           or $test{'type'} == TRUSTED_CGI_REQUEST) {
 618
 619         $result = execute_dumb_fetch_test($test_ref);
 620
 621     } elsif ($test{'type'} == METHOD_TEST) {
 622
 623         $result = execute_method_test($test_ref);
 624
 625     } elsif ($test{'type'} == BLOCK_TEST) {
 626
 627         $result = execute_block_test($test_ref);
 628
 629     } elsif ($test{'type'} == STICKY_ACTIONS_TEST) {
 630
 631         $result = execute_sticky_actions_test($test_ref);
 632
 633     } else {
 634
 635         die "Unsupported test type detected: " . $test{'type'};
 636
 637     }
 638
 639     return $result;
 640 }
 641
 642 sub execute_method_test ($) {
 643
 644     my $test_ref = shift;
 645     my %test = %{$test_ref};
 646     my $buffer_ref;
 647     my $status_code;
 648     my $method = $test{'data'};
 649
 650     my $curl_parameters = '';
 651     my $expected_status_code = $test{'expected-status-code'};
 652
 653     $curl_parameters .= '--request ' . $method . ' ';
 654     # Don't complain about the 'missing' body
 655     $curl_parameters .= '--head ' if ($method =~ /^HEAD$/i);
 656
 657     $curl_parameters .= PRIVOXY_CGI_URL;
 658
 659     $buffer_ref = get_page_with_curl($curl_parameters);
 660     $status_code = get_status_code($buffer_ref);
 661
 662     return check_status_code_result($status_code, $expected_status_code);
 663 }
 664
 665 sub execute_dumb_fetch_test ($) {
 666
 667     my $test_ref = shift;
 668     my %test = %{$test_ref};
 669     my $buffer_ref;
 670     my $status_code;
 671
 672     my $curl_parameters = '';
 673     my $expected_status_code = $test{'expected-status-code'};
 674
 675     if (defined $test{method}) {
 676         $curl_parameters .= '--request ' . $test{method} . ' ';
 677     }
 678     if ($test{type} == TRUSTED_CGI_REQUEST) {
 679         $curl_parameters .= '--referer ' . PRIVOXY_CGI_URL . ' ';
 680     }
 681
 682     $curl_parameters .= $test{'data'};
 683
 684     $buffer_ref = get_page_with_curl($curl_parameters);
 685     $status_code = get_status_code($buffer_ref);
 686
 687     return check_status_code_result($status_code, $expected_status_code);
 688 }
 689
 690 sub execute_block_test ($) {
 691
 692     my $test = shift;
 693     my $url = $test->{'data'};
 694     my $final_results = get_final_results($url);
 695
 696     return defined $final_results->{'+block'};
 697 }
 698
 699 sub execute_sticky_actions_test ($) {
 700
 701     my $test = shift;
 702     my $url = $test->{'data'};
 703     my $verified_actions = 0;
 704     # XXX: splitting currently doesn't work for actions whose parameters contain spaces.
 705     my @sticky_actions = split(/\s+/, $test->{'sticky-actions'});
 706     my $final_results = get_final_results($url);
 707
 708     foreach my $sticky_action (@sticky_actions) {
 709         if (defined $final_results->{$sticky_action}) {
 710             # Exact match
 711             $verified_actions++;
 712         }elsif ($sticky_action =~ /-.*\{/ and
 713                 not defined $final_results->{$sticky_action}) {
 714             # Disabled multi actions aren't explicitly listed as
 715             # disabled and thus have to be checked by verifying
 716             # that they aren't enabled.
 717             $verified_actions++;
 718         } else {
 719             l(LL_VERBOSE_FAILURE,
 720               "Ooops. '$sticky_action' is not among the final results.");
 721         }
 722     }
 723
 724     return $verified_actions == @sticky_actions;
 725 }
 726
 727 sub get_final_results ($) {
 728
 729     my $url = shift;
 730     my $curl_parameters = '';
 731     my %final_results = ();
 732     my $final_results_reached = 0;
 733
 734     die "Unacceptable characters in $url" if $url =~ m@[\\'"]@;
 735     # XXX: should be URL-encoded properly
 736     $url =~ s@%@%25@g;
 737     $url =~ s@\s@%20@g;
 738     $url =~ s@&@%26@g;
 739     $url =~ s@:@%3A@g;
 740     $url =~ s@/@%2F@g;
 741
 742     $curl_parameters .= quote(PRIVOXY_CGI_URL . 'show-url-info?url=' . $url);
 743
 744     foreach (@{get_cgi_page_or_else($curl_parameters)}) {
 745
 746         $final_results_reached = 1 if (m@<h2>Final results:</h2>@);
 747
 748         next unless ($final_results_reached);
 749         last if (m@</td>@);
 750
 751         if (m@<br>([-+])<a.*>([^>]*)</a>(?: (\{.*\}))?@) {
 752             my $action = $1.$2;
 753             my $parameter = $3;
 754
 755             if (defined $parameter) {
 756                 # In case the caller needs to check
 757                 # the action and its parameter
 758                 $final_results{$action . $parameter} = 1;
 759             }
 760             # In case the action doesn't have parameters
 761             # or the caller doesn't care for the parameter.
 762             $final_results{$action} = 1;
 763         }
 764     }
 765
 766     return \%final_results;
 767 }
 768
 769 sub check_status_code_result ($$) {
 770
 771     my $status_code = shift;
 772     my $expected_status_code = shift;
 773     my $result = 0;
 774
 775     unless (defined $status_code) {
 776
 777         # XXX: should probably be caught earlier.
 778         l(LL_VERBOSE_FAILURE,
 779           "Ooops. We expected status code " . $expected_status_code . ", but didn't get any status code at all.");
 780
 781     } elsif ($expected_status_code == $status_code) {
 782
 783         $result = 1;
 784         l(LL_VERBOSE_SUCCESS,
 785           "Yay. We expected status code " . $expected_status_code . ", and received: " . $status_code . '.');
 786
 787     } elsif (cli_option_is_set('fuzzer-feeding') and $status_code == 123) {
 788
 789         l(LL_VERBOSE_FAILURE,
 790           "Oh well. Status code lost while fuzzing. Can't check if it was " . $expected_status_code . '.');
 791
 792     } else {
 793
 794         l(LL_VERBOSE_FAILURE,
 795           "Ooops. We expected status code " . $expected_status_code . ", but received: " . $status_code . '.');
 796
 797     }
 798
 799     return $result;
 800 }
 801
 802 sub execute_client_header_regression_test ($) {
 803
 804     my $test_ref = shift;
 805     my $buffer_ref;
 806     my $header;
 807
 808     $buffer_ref = get_show_request_with_curl($test_ref);
 809
 810     $header = get_header($buffer_ref, $test_ref);
 811
 812     return check_header_result($test_ref, $header);
 813 }
 814
 815 sub execute_server_header_regression_test ($) {
 816
 817     my $test_ref = shift;
 818     my $buffer_ref;
 819     my $header;
 820
 821     $buffer_ref = get_head_with_curl($test_ref);
 822
 823     $header = get_server_header($buffer_ref, $test_ref);
 824
 825     return check_header_result($test_ref, $header);
 826 }
 827
 828 sub interpret_result ($) {
 829     my $success = shift;
 830     return $success ? "Success" : "Failure";
 831 }
 832
 833 sub check_header_result ($$) {
 834
 835     my $test_ref = shift;
 836     my $header = shift;
 837
 838     my %test = %{$test_ref};
 839     my $expect_header = $test{'expect-header'};
 840     my $success = 0;
 841
 842     if ($expect_header eq 'NO CHANGE') {
 843
 844         if (defined($header) and $header eq $test{'data'}) {
 845
 846             $success = 1;
 847
 848         } else {
 849
 850             $header = "REMOVAL" unless defined $header;
 851             l(LL_VERBOSE_FAILURE,
 852               "Ooops. Got: " . $header . " while expecting: " . $expect_header);
 853         }
 854
 855     } elsif ($expect_header eq 'REMOVAL') {
 856
 857         if (defined($header) and $header eq $test{'data'}) {
 858
 859             l(LL_VERBOSE_FAILURE,
 860               "Ooops. Expected removal but: " . $header . " is still there.");
 861
 862         } else {
 863
 864             # XXX: Use more reliable check here and make sure
 865             # the header has a different name.
 866             $success = 1;
 867
 868         }
 869
 870     } elsif ($expect_header eq 'SOME CHANGE') {
 871
 872         if (defined($header) and not $header eq $test{'data'}) {
 873
 874             $success = 1;
 875
 876         } else {
 877
 878             $header = "REMOVAL" unless defined $header;
 879             l(LL_VERBOSE_FAILURE,
 880               "Ooops. Got: " . $header . " while expecting: SOME CHANGE");
 881         }
 882
 883
 884     } else {
 885
 886         if (defined($header) and $header eq $expect_header) {
 887
 888             $success = 1;
 889
 890         } else {
 891
 892             $header = "'No matching header'" unless defined $header; # XXX: No header detected to be precise
 893             l(LL_VERBOSE_FAILURE,
 894               "Ooops. Got: " . $header . " while expecting: " . $expect_header);
 895         }
 896     }
 897     return $success;
 898 }
 899
 900 sub get_header_name ($) {
 901
 902     my $header = shift;
 903
 904     $header =~ s@(.*?: ).*@$1@;
 905
 906     return $header;
 907 }
 908
 909 sub get_header ($$) {
 910
 911     our $filtered_request = '';
 912
 913     my $buffer_ref = shift;
 914     my $test_ref = shift;
 915
 916     my %test = %{$test_ref};
 917     my @buffer = @{$buffer_ref};
 918
 919     my $expect_header = $test{'expect-header'};
 920
 921     die "get_header called with no expect header" unless defined $expect_header;
 922
 923     my $line;
 924     my $processed_request_reached = 0;
 925     my $read_header = 0;
 926     my $processed_request = '';
 927     my $header;
 928     my $header_to_get;
 929
 930     if ($expect_header eq 'REMOVAL'
 931      or $expect_header eq 'NO CHANGE'
 932      or  $expect_header eq 'SOME CHANGE') {
 933
 934         $expect_header = $test{'data'};
 935
 936     }
 937
 938     $header_to_get = get_header_name($expect_header);
 939
 940     foreach (@buffer) {
 941
 942         # Skip everything before the Processed request
 943         if (/Processed Request/) {
 944             $processed_request_reached = 1;
 945             next;
 946         }
 947         next unless $processed_request_reached;
 948
 949         # End loop after the Processed request
 950         last if (/<\/pre>/);
 951
 952         # Ditch tags and leading/trailing white space.
 953         s@^\s*<.*?>@@g;
 954         s@\s*$@@g;
 955
 956         # Decode characters we care about.
 957         s@&quot;@"@g;
 958
 959         $filtered_request .=  "\n" . $_;
 960
 961         if (/^$header_to_get/) {
 962             $read_header = 1;
 963             $header = $_;
 964             last;
 965         }
 966     }
 967
 968     return $header;
 969 }
 970
 971 sub get_server_header ($$) {
 972
 973     my $buffer_ref = shift;
 974     my $test_ref = shift;
 975
 976     my %test = %{$test_ref};
 977     my @buffer = @{$buffer_ref};
 978
 979     my $expect_header = $test{'expect-header'};
 980     my $header;
 981     my $header_to_get;
 982
 983     # XXX: Should be caught before starting to test.
 984     l(LL_ERROR, "No expect header for test " . $test{'number'})
 985         unless defined $expect_header;
 986
 987     if ($expect_header eq 'REMOVAL'
 988      or $expect_header eq 'NO CHANGE'
 989      or $expect_header eq 'SOME CHANGE') {
 990
 991         $expect_header = $test{'data'};
 992
 993     }
 994
 995     $header_to_get = get_header_name($expect_header);
 996
 997     foreach (@buffer) {
 998
 999         # XXX: should probably verify that the request
1000         # was actually answered by Fellatio.
1001         if (/^$header_to_get/) {
1002             $header = $_;
1003             $header =~ s@\s*$@@g;
1004             last;
1005         }
1006     }
1007
1008     return $header;
1009 }
1010
1011 sub get_status_code ($) {
1012
1013     my $buffer_ref = shift;
1014     my @buffer = @{$buffer_ref};
1015
1016     foreach (@buffer) {
1017
1018         if (/^HTTP\/\d\.\d (\d{3})/) {
1019
1020             return $1;
1021
1022         } else {
1023
1024             return '123' if cli_option_is_set('fuzzer-feeding');
1025             chomp;
1026             l(LL_ERROR, 'Unexpected buffer line: "' . $_ . '"');
1027         }
1028     }
1029 }
1030
1031 sub get_test_keys () {
1032     return ('tag', 'data', 'expect-header', 'ignore');
1033 }
1034
1035 # XXX: incomplete
1036 sub test_content_as_string ($) {
1037
1038     my $test_ref = shift;
1039     my %test = %{$test_ref};
1040
1041     my $s = "\n\t";
1042
1043     foreach my $key (get_test_keys()) {
1044         $test{$key} = 'Not set' unless (defined $test{$key});
1045     }
1046
1047     $s .= 'Tag: ' . $test{'tag'};
1048     $s .= "\n\t";
1049     $s .= 'Set header: ' . $test{'data'}; # XXX: adjust for other test types
1050     $s .= "\n\t";
1051     $s .= 'Expected header: ' . $test{'expect-header'};
1052     $s .= "\n\t";
1053     $s .= 'Ignore: ' . $test{'ignore'};
1054
1055     return $s;
1056 }
1057
1058 sub fuzz_header($) {
1059     my $header = shift;
1060     my $white_space = int(rand(2)) - 1 ? " " : "\t";
1061
1062     $white_space = $white_space x (1 + int(rand(5)));
1063
1064     # Only fuzz white space before the first quoted token.
1065     # (Privoxy doesn't touch white space inside quoted tokens
1066     # and modifying it would cause the tests to fail).
1067     $header =~ s@(^[^"]*?)\s@$1$white_space@g;
1068
1069     return $header;
1070 }
1071
1072 ############################################################################
1073 #
1074 # HTTP fetch functions
1075 #
1076 ############################################################################
1077
1078 sub check_for_curl () {
1079     my $curl = CURL;
1080     l(LL_ERROR, "No curl found.") unless (`which $curl`);
1081 }
1082
1083 sub get_cgi_page_or_else ($) {
1084
1085     my $cgi_url = shift;
1086     my $content_ref = get_page_with_curl($cgi_url);
1087     my $status_code = get_status_code($content_ref);
1088
1089     if (200 != $status_code) {
1090
1091         my $log_message = "Failed to fetch Privoxy CGI Page. " .
1092                           "Received status code ". $status_code .
1093                           " while only 200 is acceptable.";
1094
1095         if (cli_option_is_set('fuzzer-feeding')) {
1096
1097             $log_message .= " Ignored due to fuzzer feeding.";
1098             l(LL_SOFT_ERROR, $log_message)
1099
1100         } else {
1101
1102             l(LL_ERROR, $log_message);
1103
1104         }
1105     }
1106
1107     return $content_ref;
1108 }
1109
1110 # XXX: misleading name
1111 sub get_show_request_with_curl ($) {
1112
1113     our $privoxy_cgi_url;
1114     my $test_ref = shift;
1115     my %test = %{$test_ref};
1116
1117     my $curl_parameters = ' ';
1118     my $header = $test{'data'};
1119
1120     if (cli_option_is_set('header-fuzzing')) {
1121         $header = fuzz_header($header);
1122     }
1123
1124     # Enable the action to test
1125     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
1126     # The header to filter
1127     $curl_parameters .= '-H \'' . $header . '\' ';
1128
1129     $curl_parameters .= ' ';
1130     $curl_parameters .= $privoxy_cgi_url;
1131     $curl_parameters .= 'show-request';
1132
1133     return get_cgi_page_or_else($curl_parameters);
1134 }
1135
1136 sub get_head_with_curl ($) {
1137
1138     our $fellatio_url = FELLATIO_URL;
1139     my $test_ref = shift;
1140     my %test = %{$test_ref};
1141
1142     my $curl_parameters = ' ';
1143
1144     # Enable the action to test
1145     $curl_parameters .= '-H \'X-Privoxy-Control: ' . $test{'tag'} . '\' ';
1146     # The header to filter
1147     $curl_parameters .= '-H \'X-Gimme-Head-With: ' . $test{'data'} . '\' ';
1148     $curl_parameters .= '--head ';
1149
1150     $curl_parameters .= ' ';
1151     $curl_parameters .= $fellatio_url;
1152
1153     return get_page_with_curl($curl_parameters);
1154 }
1155
1156 sub get_page_with_curl ($) {
1157
1158     our $proxy;
1159
1160     my $parameters = shift;
1161     my @buffer;
1162     my $curl_line = CURL;
1163     my $retries_left = get_cli_option('retries') + 1;
1164     my $failure_reason;
1165
1166     $curl_line .= ' --proxy ' . $proxy if (defined $proxy);
1167
1168     # We want to see the HTTP status code
1169     $curl_line .= " --include ";
1170     # Let Privoxy emit two log messages less.
1171     $curl_line .= ' -H \'Proxy-Connection:\' ' unless $parameters =~ /Proxy-Connection:/;
1172     $curl_line .= ' -H \'Connection: close\' ' unless $parameters =~ /Connection:/;
1173     # We don't care about fetch statistic.
1174     $curl_line .= " -s ";
1175     # We do care about the failure reason if any.
1176     $curl_line .= " -S ";
1177     # We want to advertise ourselves
1178     $curl_line .= " --user-agent '" . PRT_VERSION . "' ";
1179     # We aren't too patient
1180     $curl_line .= " --max-time '" . get_cli_option('max-time') . "' ";
1181
1182     $curl_line .= $parameters;
1183     # XXX: still necessary?
1184     $curl_line .= ' 2>&1';
1185
1186     l(LL_PAGE_FETCHING, "Executing: " . $curl_line);
1187
1188     do {
1189         @buffer = `$curl_line`;
1190
1191         if ($?) {
1192             $failure_reason = array_as_string(\@buffer);
1193             chomp $failure_reason;
1194             l(LL_SOFT_ERROR, "Fetch failure: '" . $failure_reason . $! ."'");
1195         }
1196     } while ($? && --$retries_left);
1197
1198     unless ($retries_left) {
1199         l(LL_ERROR,
1200           "Running curl failed " . get_cli_option('retries') .
1201           " times in a row. Last error: '" . $failure_reason . "'.");
1202     }
1203
1204     return \@buffer;
1205 }
1206
1207
1208 ############################################################################
1209 #
1210 # Log functions
1211 #
1212 ############################################################################
1213
1214 sub array_as_string ($) {
1215     my $array_ref = shift;
1216     my $string = '';
1217
1218     foreach (@{$array_ref}) {
1219         $string .= $_;
1220     }
1221
1222     return $string;
1223 }
1224
1225 sub show_test ($) {
1226     my $test_ref = shift;
1227     log_message('Test is:' . test_content_as_string($test_ref));
1228 }
1229
1230 # Conditional log
1231 sub l ($$) {
1232     our $log_level;
1233     my $this_level = shift;
1234     my $message = shift;
1235
1236     return unless ($log_level & $this_level);
1237
1238     if (LL_ERROR & $this_level) {
1239         $message = 'Oh noes. ' . $message . ' Fatal error. Exiting.';
1240     }
1241
1242     log_message($message);
1243
1244     if (LL_ERROR & $this_level) {
1245         exit;
1246     }
1247 }
1248
1249 sub log_message ($) {
1250
1251     my $message = shift;
1252
1253     our $logfile;
1254     our $no_logging;
1255     our $leading_log_date;
1256     our $leading_log_time;
1257
1258     my $time_stamp = '';
1259     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime time;
1260
1261     if ($leading_log_date || $leading_log_time) {
1262
1263         if ($leading_log_date) {
1264             $year += 1900;
1265             $mon  += 1;
1266             $time_stamp = sprintf("%i/%.2i/%.2i", $year, $mon, $mday);
1267         }
1268
1269         if ($leading_log_time) {
1270             $time_stamp .= ' ' if $leading_log_date;
1271             $time_stamp.= sprintf("%.2i:%.2i:%.2i", $hour, $min, $sec);
1272         }
1273
1274         $message = $time_stamp . ": " . $message;
1275     }
1276
1277
1278     printf(STDERR "%s\n", $message);
1279
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-2008 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