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