1 ################################################################################
4 # Code that has to be loaded by curl's runtests.pl with the -L option
5 # to deal with modifications required when using the tests with Privoxy.
7 # Copyright (c) 2014-2022 Fabian Keil <fk@fabiankeil.de>
9 # Permission to use, copy, modify, and distribute this software for any
10 # purpose with or without fee is hereby granted, provided that the above
11 # copyright notice and this permission notice appear in all copies.
13 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
14 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
15 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
16 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
17 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
18 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
19 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
20 ################################################################################
24 no warnings "redefine";
27 my $use_external_proxy = 0;
30 # Keep a couple of functions from getpart.pm accessible so
31 # our redefinitions don't have to reimplement them.
32 our $real_showdiff = \&showdiff;
33 our $real_getpart = \&getpart;
34 our $real_getpartattr = \&getpartattr;
35 our $real_compareparts = \&compareparts;
36 our $real_startnew = \&startnew;
39 sub print_skipped_header($) {
40 my $skipped_header = shift;
41 $skipped_header =~ s@\r?\n$@@;
42 print "Skipping '$skipped_header'\n";
45 # Process headers to ignore differences that are to be expected
46 # when Privoxy is being used.
48 # - Filter out "Proxy-Connection:" headers when checking for
50 # - Filter out a header that is specified with a "X-Ignore-Header" header.
51 # - Deal with tests that don't expect CRLF header endings as
52 # long as the test uses it consistently.
53 # - Reduce spaces in server headers with a too-simplistic heuristic
54 # that happens to work for the existing tests.
55 sub process_headers($$) {
56 my ($head1_ref, $head2_ref) = @_;
59 my $crlf_expected = 0;
60 my $connection_header_expected = 0;
61 my $proxy_connection_header_expected = 0;
62 my $parsing_server_headers = 0;
66 foreach (@$head2_ref) {
68 # If it starts like a response line, assume we are
69 # looking at server headers.
70 $parsing_server_headers = 1;
73 $parsing_server_headers = 0;
76 $crlf_expected = 1; # XXX: assume the expectancy is consistent.
80 $connection_header_expected = 1;
82 if (/^Proxy-Connection:/) {
83 $proxy_connection_header_expected = 1;
85 if (/^X-Ignore-Header: (.*)/) {
87 print "Ignoring header '$ignore_header'\n" if $verbose;
89 if (defined $ignore_header and /^$ignore_header: .*/) {
93 if ($parsing_server_headers and not /"/) {
94 # Normalize spaces in server headers similar to the way Privoxy
95 # does. This is required for curl tests 29, 40, 42 and 54.
101 print "Expecting " . ($crlf_expected ? "" : "no ") . "crlf\n";
102 print "Expecting " . ($connection_header_expected ? "a" : "no") . " Connection: header\n";
103 print "Expecting " . ($proxy_connection_header_expected ? "a" : "no") . " Proxy-Connection: header\n";
106 foreach (@$head1_ref) {
108 s@\r\n$@\n@ unless ($crlf_expected);
110 if ((m/^Connection:/ and not $connection_header_expected) or
111 (m/^Proxy-Connection:/ and not $proxy_connection_header_expected)) {
112 print_skipped_header($_) if ($verbose);
115 if (defined $ignore_header) {
116 if (m/^$ignore_header:/) {
117 push @head1, "X-Ignore-Header: $ignore_header\n";
118 $_ = $ignored_header;
123 $head1_ref = \@head1;
125 return ($head1_ref, $head2_ref);
128 # Behaves like the real compareparts(), but if a proxy is being used,
129 # headers are run through process_headers() before checking them for
132 my ($head1_ref, $head2_ref) = @_;
133 our $real_compareparts;
135 if ($use_external_proxy) {
136 ($head1_ref, $head2_ref) = process_headers($head1_ref, $head2_ref);
139 return &$real_compareparts($head1_ref, $head2_ref);
142 # Behaves like the real getpart() but if a proxy is being used
143 # and a proxy-reply section exists, it is returned instead of
144 # a common reply section.
146 my ($section, $part) = @_;
149 if ($use_external_proxy and
150 $section eq 'reply' and
151 partexists("proxy-reply", $part)) {
152 $section = "proxy-reply";
155 return &$real_getpart($section, $part);
158 # Behaves like the real getpartattr() but if a proxy is being used
159 # and a proxy-reply section exists, it is being used instead of
160 # a common reply section.
162 my ($section, $part)=@_;
163 our $real_getpartattr;
165 if ($use_external_proxy and
166 $section eq 'reply' and
167 partexists("proxy-reply", $part)) {
168 $section = "proxy-reply";
171 return &$real_getpartattr($section, $part);
174 # Behaves like the real logmsg but suppresses warnings
175 # about unknown tests
178 next if /^Warning: test\d+ not present in/;
183 # Behaves like the real showdiff() but diffs twice,
184 # the second time after processing the headers.
186 my ($logdir, $head1_ref, $head2_ref) = @_;
189 print "Unprocessed headers:\n";
190 print &$real_showdiff($logdir, $head1_ref, $head2_ref);
192 print "Processed headers:\n";
193 ($head1_ref, $head2_ref) = process_headers($head1_ref, $head2_ref);
194 return &$real_showdiff($logdir, $head1_ref, $head2_ref);
197 # Behaves like the real startnew() but sets a static port if
198 # the started server is httpserver.pl.
200 my ($cmd, $pidfile, $timeout, $fake) = @_;
203 if ($cmd =~ /httpserver\.pl/) {
204 $cmd =~ s@--port 0@--port 20000@;
205 } elsif ($cmd =~ m@server/socksd@) {
206 $cmd =~ s@--port 0@--port 20001@;
209 return &$real_startnew($cmd, $pidfile, $timeout, $fake);
214 # Look but don't touch, @ARGV is still needed elsewhere
215 foreach my $arg (@ARGV) {
216 $use_external_proxy = 1 if ($arg eq "-P");
217 $verbose = 1 if ($arg eq "-v");