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