Add privoxy-runtests.pm

Overwrites some of the functions used by curl's runtests.pl
to let it properly deal with Privoxy being used as proxy.

Sponsored by: Privoxy project funds collected at SPI

diff --git a/tests/cts/privoxy-runtests.pm b/tests/cts/privoxy-runtests.pm
new file mode 100644 (file)
index 0000000..b04b027
--- /dev/null
+++ b/tests/cts/privoxy-runtests.pm
@@ -0,0 +1,223 @@
+################################################################################
+# privoxy-runtests.pm
+#
+# Code that has to be loaded by curl's runtests.pl with the -L option
+# to deal with modifications required when using the tests with Privoxy.
+#
+# Copyright (c) 2014-2022 Fabian Keil <fk@fabiankeil.de>
+#
+# Permission to use, copy, modify, and distribute this software for any
+# purpose with or without fee is hereby granted, provided that the above
+# copyright notice and this permission notice appear in all copies.
+#
+# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+################################################################################
+
+use strict;
+use warnings;
+no warnings "redefine";
+
+my $verbose = 0;
+my $use_external_proxy = 0;
+
+BEGIN {
+    # Keep a couple of functions from getpart.pm accessible so
+    # our redefinitions don't have to reimplement them.
+    our $real_showdiff = \&showdiff;
+    our $real_getpart = \&getpart;
+    our $real_getpartattr = \&getpartattr;
+    our $real_compareparts = \&compareparts;
+    our $real_startnew = \&startnew;
+}
+
+sub print_skipped_header($) {
+    my $skipped_header = shift;
+    $skipped_header =~ s@\r?\n$@@;
+    print "Skipping '$skipped_header'\n";
+}
+
+# Process headers to ignore differences that are to be expected
+# when Privoxy is being used.
+#
+# - Filter out "Proxy-Connection:" headers when checking for
+#   test success.
+# - Filter out a header that is specified with a "X-Ignore-Header" header.
+# - Deal with tests that don't expect CRLF header endings as
+#   long as the test uses it consistently.
+# - Reduce spaces in server headers with a too-simplistic heuristic
+#   that happens to work for the existing tests.
+sub process_headers($$) {
+    my ($head1_ref, $head2_ref) = @_;
+    my @head1;
+    my @head2;
+    my $crlf_expected = 0;
+    my $connection_header_expected = 0;
+    my $proxy_connection_header_expected = 0;
+    my $parsing_server_headers = 0;
+    my $ignore_header;
+    my $ignored_header;
+
+    foreach (@$head2_ref) {
+        if (/^HTTP/) {
+            # If it starts like a response line, assume we are
+            # looking at server headers.
+            $parsing_server_headers = 1;
+        }
+        if (/^\r?\n$/) {
+            $parsing_server_headers = 0;
+        }
+        if (/\r\n$/) {
+            $crlf_expected = 1; # XXX: assume the expectancy is consistent.
+        }
+
+        if (/^Connection:/) {
+            $connection_header_expected = 1;
+        }
+        if (/^Proxy-Connection:/) {
+            $proxy_connection_header_expected = 1;
+        }
+        if (/^X-Ignore-Header: (.*)/) {
+            $ignore_header = $1;
+            print "Ignoring header '$ignore_header'\n" if $verbose;
+        }
+        if (defined $ignore_header and /^$ignore_header: .*/) {
+            $ignored_header = $_;
+        }
+
+        if ($parsing_server_headers and not /"/) {
+            # Normalize spaces in server headers similar to the way Privoxy
+            # does. This is required for curl tests 29, 40, 42 and 54.
+            s@  +@ @g;
+        }
+    }
+
+    if ($verbose) {
+        print "Expecting " . ($crlf_expected ? "" : "no ") . "crlf\n";
+        print "Expecting " . ($connection_header_expected ? "a" : "no") . " Connection: header\n";
+        print "Expecting " . ($proxy_connection_header_expected ? "a" : "no") . " Proxy-Connection: header\n";
+    }
+
+    foreach (@$head1_ref) {
+
+        s@\r\n$@\n@ unless ($crlf_expected);
+
+        if ((m/^Connection:/ and not $connection_header_expected) or
+            (m/^Proxy-Connection:/ and not $proxy_connection_header_expected)) {
+            print_skipped_header($_) if ($verbose);
+            next;
+        }
+        if (defined $ignore_header) {
+            if (m/^$ignore_header:/) {
+                push @head1, "X-Ignore-Header: $ignore_header\n";
+                $_ = $ignored_header;
+            }
+        }
+        push @head1, $_;
+    }
+    $head1_ref = \@head1;
+
+    return ($head1_ref, $head2_ref);
+}
+
+# Behaves like the real compareparts(), but if a proxy is being used,
+# headers are run through process_headers() before checking them for
+# differences.
+sub compareparts {
+    my ($head1_ref, $head2_ref) = @_;
+    our $real_compareparts;
+
+    if ($use_external_proxy) {
+        ($head1_ref, $head2_ref) = process_headers($head1_ref, $head2_ref);
+    }
+
+    return &$real_compareparts($head1_ref, $head2_ref);
+}
+
+# Behaves like the real getpart() but if a proxy is being used
+# and a proxy-reply section exists, it is returned instead of
+# a common reply section.
+sub getpart {
+    my ($section, $part) = @_;
+    our $real_getpart;
+
+    if ($use_external_proxy and
+        $section eq 'reply' and
+        partexists("proxy-reply", $part)) {
+        $section = "proxy-reply";
+    }
+
+    return &$real_getpart($section, $part);
+}
+
+# Behaves like the real getpartattr() but if a proxy is being used
+# and a proxy-reply section exists, it is being used instead of
+# a common reply section.
+sub getpartattr {
+    my ($section, $part)=@_;
+    our $real_getpartattr;
+
+    if ($use_external_proxy and
+        $section eq 'reply' and
+        partexists("proxy-reply", $part)) {
+        $section = "proxy-reply";
+    }
+
+    return &$real_getpartattr($section, $part);
+}
+
+# Behaves like the real logmsg but suppresses warnings
+# about unknown tests
+sub logmsg {
+    for (@_) {
+        next if /^Warning: test\d+ not present in/;
+        print "$_";
+    }
+}
+
+# Behaves like the real showdiff() but diffs twice,
+# the second time after processing the headers.
+sub showdiff {
+    my ($logdir, $head1_ref, $head2_ref) = @_;
+    our $real_showdiff;
+
+    print "Unprocessed headers:\n";
+    print &$real_showdiff($logdir, $head1_ref, $head2_ref);
+
+    print "Processed headers:\n";
+    ($head1_ref, $head2_ref) = process_headers($head1_ref, $head2_ref);
+    return &$real_showdiff($logdir, $head1_ref, $head2_ref);
+}
+
+# Behaves like the real startnew() but sets a static port if
+# the started server is httpserver.pl.
+sub startnew {
+    my ($cmd, $pidfile, $timeout, $fake) = @_;
+    our $real_startnew;
+
+    if ($cmd =~ /httpserver\.pl/) {
+        $cmd =~ s@--port 0@--port 20000@;
+    } elsif ($cmd =~ m@server/socksd@) {
+        $cmd =~ s@--port 0@--port 20001@;
+    }
+
+    return &$real_startnew($cmd, $pidfile, $timeout, $fake);
+}
+
+sub main() {
+
+    # Look but don't touch, @ARGV is still needed elsewhere
+    foreach my $arg (@ARGV) {
+        $use_external_proxy = 1 if ($arg eq "-P");
+        $verbose = 1 if ($arg eq "-v");
+    }
+
+    return 1;
+}
+
+main();