tools/privoxy-regression-test.pl

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