Browse Source

runtests: refactor into more packages

testutil.pm now contains a few miscellaneous functions that are used in
several places but have no better place to live.  subvariables moves to
servers.pm since most variables that it substitutes relate to servers,
so this is the most appropriate place. Rename a few functions for better
naming consistency.

Ref: #10818
Closes #10995
Dan Fandrich 1 year ago
parent
commit
707f74c04a
6 changed files with 332 additions and 303 deletions
  1. 2 1
      tests/Makefile.am
  2. 21 16
      tests/globalconfig.pm
  3. 59 15
      tests/runner.pm
  4. 7 257
      tests/runtests.pl
  5. 100 14
      tests/servers.pm
  6. 143 0
      tests/testutil.pm

+ 2 - 1
tests/Makefile.am

@@ -33,7 +33,8 @@ EXTRA_DIST = appveyor.pm azure.pm badsymbols.pl check-deprecated.pl CMakeLists.t
  memanalyze.pl negtelnetserver.py nroff-scan.pl option-check.pl options-scan.pl \
  pathhelp.pm README.md rtspserver.pl runner.pm runtests.1 runtests.pl secureserver.pl \
  serverhelp.pm servers.pm smbserver.py sshhelp.pm sshserver.pl stunnel.pem symbol-scan.pl \
- testcurl.1 testcurl.pl tftpserver.pl util.py valgrind.pm valgrind.supp version-scan.pl 
+ testcurl.1 testcurl.pl testutil.pm tftpserver.pl util.py valgrind.pm \
+ valgrind.supp version-scan.pl
 
 DISTCLEANFILES = configurehelp.pm
 

+ 21 - 16
tests/globalconfig.pm

@@ -34,41 +34,44 @@ BEGIN {
     use base qw(Exporter);
 
     our @EXPORT = qw(
+        $anyway
+        $automakestyle
         $CURL
+        $CURLVERSION
         $FTPDCMD
+        $has_shared
         $LIBDIR
+        $listonly
         $LOGDIR
+        $memanalyze
+        $memdump
         $perl
         $PIDDIR
-        $SERVERIN
-        $SERVER2IN
-        $PROXYIN
-        $TESTDIR
-        $memdump
         $proxy_address
-        $listonly
+        $PROXYIN
+        $pwd
         $run_event_based
+        $SERVER2IN
+        $SERVERIN
         $srcdir
+        $TESTDIR
         $torture
+        $valgrind
         $VCURL
         $verbose
-        $memanalyze
-        @protocols
-        $anyway
         %feature
-        $has_shared
-        %timesrvrini
+        %keywords
+        @protocols
         %timesrvrend
-        %timetoolini
-        %timetoolend
+        %timesrvrini
         %timesrvrlog
+        %timetoolend
+        %timetoolini
         %timevrfyend
-        $valgrind
-        %keywords
-        $automakestyle
     );
 }
 use pathhelp qw(exe_ext);
+use Cwd qw(getcwd);
 
 
 #######################################################################
@@ -83,8 +86,10 @@ our $listonly;        # only list the tests
 our $run_event_based; # run curl with --test-event to test the event API
 our $automakestyle;   # use automake-like test status output format
 our $anyway;          # continue anyway, even if a test fail
+our $CURLVERSION="";  # curl's reported version number
 
 # paths
+our $pwd = getcwd();  # current working directory
 our $srcdir = $ENV{'srcdir'} || '.';  # root of the test source code
 our $perl="perl -I$srcdir"; # invoke perl like this
 our $LOGDIR="log";  # root of the log directory

+ 59 - 15
tests/runner.pm

@@ -33,6 +33,7 @@ BEGIN {
     use base qw(Exporter);
 
     our @EXPORT = qw(
+        prepro
         restore_test_env
         runner_test_preprocess
         runner_test_run
@@ -47,6 +48,11 @@ BEGIN {
         $valgrind_tool
         $gdb
     );
+
+    # these are for debugging only
+    our @EXPORT_OK = qw(
+        singletest_preprocess
+    );
 }
 
 use pathhelp qw(
@@ -59,6 +65,7 @@ use processhelp qw(
 use servers;
 use getpart;
 use globalconfig;
+use testutil;
 
 
 #######################################################################
@@ -97,21 +104,6 @@ sub displaylogs{
     return main::displaylogs(@_);
 }
 
-#######################################################################
-# Call main's prepro
-# TODO: figure out where this should live; since it needs to know
-# things in main:: only, maybe the test file should be preprocessed there
-sub prepro {
-    return main::prepro(@_);
-}
-
-#######################################################################
-# Call main's runclient
-# TODO: move this into a helper package
-sub runclient {
-    return main::runclient(@_);
-}
-
 #######################################################################
 # Check for a command in the PATH of the machine running curl.
 #
@@ -148,6 +140,58 @@ sub normalize_cmdres {
     return ($cmdres, $dumped_core);
 }
 
+# 'prepro' processes the input array and replaces %-variables in the array
+# etc. Returns the processed version of the array
+sub prepro {
+    my $testnum = shift;
+    my (@entiretest) = @_;
+    my $show = 1;
+    my @out;
+    my $data_crlf;
+    for my $s (@entiretest) {
+        my $f = $s;
+        if($s =~ /^ *%if (.*)/) {
+            my $cond = $1;
+            my $rev = 0;
+
+            if($cond =~ /^!(.*)/) {
+                $cond = $1;
+                $rev = 1;
+            }
+            $rev ^= $feature{$cond} ? 1 : 0;
+            $show = $rev;
+            next;
+        }
+        elsif($s =~ /^ *%else/) {
+            $show ^= 1;
+            next;
+        }
+        elsif($s =~ /^ *%endif/) {
+            $show = 1;
+            next;
+        }
+        if($show) {
+            # The processor does CRLF replacements in the <data*> sections if
+            # necessary since those parts might be read by separate servers.
+            if($s =~ /^ *<data(.*)\>/) {
+                if($1 =~ /crlf="yes"/ ||
+                   ($feature{"hyper"} && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) {
+                    $data_crlf = 1;
+                }
+            }
+            elsif(($s =~ /^ *<\/data/) && $data_crlf) {
+                $data_crlf = 0;
+            }
+            subvariables(\$s, $testnum, "%");
+            subbase64(\$s);
+            subnewlines(0, \$s) if($data_crlf);
+            push @out, $s;
+        }
+    }
+    return @out;
+}
+
+
 #######################################################################
 # Memory allocation test and failure torture testing.
 #

+ 7 - 257
tests/runtests.pl

@@ -78,9 +78,7 @@ BEGIN {
     }
 }
 
-use Cwd;
 use Digest::MD5 qw(md5);
-use MIME::Base64;
 use List::Util 'sum';
 
 use pathhelp qw(
@@ -98,14 +96,10 @@ use servers;
 use valgrind;  # valgrind report parser
 use globalconfig;
 use runner;
-
-my $CLIENTIP="127.0.0.1"; # address which curl uses for incoming connections
-my $CLIENT6IP="[::1]";    # address which curl uses for incoming connections
+use testutil;
 
 my %custom_skip_reasons;
 
-my $CURLVERSION="";          # curl's reported version number
-
 my $ACURL=$VCURL;  # what curl binary to use to talk to APIs (relevant for CI)
                    # ACURL is handy to set to the system one for reliability
 my $CURLCONFIG="../curl-config"; # curl-config from current build
@@ -124,9 +118,6 @@ my $TESTCASES="all";
 my $libtool;
 my $repeat = 0;
 
-my $pwd = getcwd();          # current working directory
-my $posix_pwd = $pwd;
-
 my $start;          # time at which testing started
 
 my $uname_release = `uname -r`;
@@ -136,9 +127,6 @@ my $http_ipv6;      # set if HTTP server has IPv6 support
 my $http_unix;      # set if HTTP server has Unix sockets support
 my $ftp_ipv6;       # set if FTP server has IPv6 support
 
-# this version is decided by the particular nghttp2 library that is being used
-my $h2cver = "h2c";
-
 my $resolver;       # name of the resolver backend (for human presentation)
 
 my $has_textaware;  # set if running on a system that has a text mode concept
@@ -267,35 +255,6 @@ sub get_disttests {
     close($dh);
 }
 
-#######################################################################
-# Run the application under test and return its return code
-#
-sub runclient {
-    my ($cmd)=@_;
-    my $ret = system($cmd);
-    print "CMD ($ret): $cmd\n" if($verbose && !$torture);
-    return $ret;
-
-# This is one way to test curl on a remote machine
-#    my $out = system("ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'");
-#    sleep 2;    # time to allow the NFS server to be updated
-#    return $out;
-}
-
-#######################################################################
-# Run the application under test and return its stdout
-#
-sub runclientoutput {
-    my ($cmd)=@_;
-    return `$cmd 2>/dev/null`;
-
-# This is one way to test curl on a remote machine
-#    my @out = `ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'`;
-#    sleep 2;    # time to allow the NFS server to be updated
-#    return @out;
-}
-
-
 
 #######################################################################
 # Remove all files in the specified directory
@@ -774,163 +733,6 @@ sub displayserverfeatures {
     logmsg "***************************************** \n";
 }
 
-#######################################################################
-# substitute the variable stuff into either a joined up file or
-# a command, in either case passed by reference
-#
-sub subVariables {
-    my ($thing, $testnum, $prefix) = @_;
-    my $port;
-
-    if(!$prefix) {
-        $prefix = "%";
-    }
-
-    # test server ports
-    # Substitutes variables like %HTTPPORT and %SMTP6PORT with the server ports
-    foreach my $proto ('DICT',
-                       'FTP', 'FTP6', 'FTPS',
-                       'GOPHER', 'GOPHER6', 'GOPHERS',
-                       'HTTP', 'HTTP6', 'HTTPS',
-                       'HTTPSPROXY', 'HTTPTLS', 'HTTPTLS6',
-                       'HTTP2', 'HTTP2TLS',
-                       'HTTP3',
-                       'IMAP', 'IMAP6', 'IMAPS',
-                       'MQTT',
-                       'NOLISTEN',
-                       'POP3', 'POP36', 'POP3S',
-                       'RTSP', 'RTSP6',
-                       'SMB', 'SMBS',
-                       'SMTP', 'SMTP6', 'SMTPS',
-                       'SOCKS',
-                       'SSH',
-                       'TELNET',
-                       'TFTP', 'TFTP6') {
-        $port = protoport(lc $proto);
-        $$thing =~ s/${prefix}(?:$proto)PORT/$port/g;
-    }
-    # Special case: for PROXYPORT substitution, use httpproxy.
-    $port = protoport('httpproxy');
-    $$thing =~ s/${prefix}PROXYPORT/$port/g;
-
-    # server Unix domain socket paths
-    $$thing =~ s/${prefix}HTTPUNIXPATH/$HTTPUNIXPATH/g;
-    $$thing =~ s/${prefix}SOCKSUNIXPATH/$SOCKSUNIXPATH/g;
-
-    # client IP addresses
-    $$thing =~ s/${prefix}CLIENT6IP/$CLIENT6IP/g;
-    $$thing =~ s/${prefix}CLIENTIP/$CLIENTIP/g;
-
-    # server IP addresses
-    $$thing =~ s/${prefix}HOST6IP/$HOST6IP/g;
-    $$thing =~ s/${prefix}HOSTIP/$HOSTIP/g;
-
-    # misc
-    $$thing =~ s/${prefix}CURL/$CURL/g;
-    $$thing =~ s/${prefix}LOGDIR/$LOGDIR/g;
-    $$thing =~ s/${prefix}PWD/$pwd/g;
-    $$thing =~ s/${prefix}POSIX_PWD/$posix_pwd/g;
-    $$thing =~ s/${prefix}VERSION/$CURLVERSION/g;
-    $$thing =~ s/${prefix}TESTNUMBER/$testnum/g;
-
-    my $file_pwd = $pwd;
-    if($file_pwd !~ /^\//) {
-        $file_pwd = "/$file_pwd";
-    }
-    my $ssh_pwd = $posix_pwd;
-    # this only works after the SSH server has been started
-    # TODO: call sshversioninfo early and store $sshdid so this substitution
-    # always works
-    if ($sshdid && $sshdid =~ /OpenSSH-Windows/) {
-        $ssh_pwd = $file_pwd;
-    }
-
-    $$thing =~ s/${prefix}FILE_PWD/$file_pwd/g;
-    $$thing =~ s/${prefix}SSH_PWD/$ssh_pwd/g;
-    $$thing =~ s/${prefix}SRCDIR/$srcdir/g;
-    $$thing =~ s/${prefix}USER/$USER/g;
-
-    $$thing =~ s/${prefix}SSHSRVMD5/$SSHSRVMD5/g;
-    $$thing =~ s/${prefix}SSHSRVSHA256/$SSHSRVSHA256/g;
-
-    # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
-    # used for time-out tests and that would work on most hosts as these
-    # adjust for the startup/check time for this particular host. We needed to
-    # do this to make the test suite run better on very slow hosts.
-    my $ftp2 = $ftpchecktime * 2;
-    my $ftp3 = $ftpchecktime * 3;
-
-    $$thing =~ s/${prefix}FTPTIME2/$ftp2/g;
-    $$thing =~ s/${prefix}FTPTIME3/$ftp3/g;
-
-    # HTTP2
-    $$thing =~ s/${prefix}H2CVER/$h2cver/g;
-}
-
-sub subBase64 {
-    my ($thing) = @_;
-
-    # cut out the base64 piece
-    if($$thing =~ s/%b64\[(.*)\]b64%/%%B64%%/i) {
-        my $d = $1;
-        # encode %NN characters
-        $d =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
-        my $enc = encode_base64($d, "");
-        # put the result into there
-        $$thing =~ s/%%B64%%/$enc/;
-    }
-    # hex decode
-    if($$thing =~ s/%hex\[(.*)\]hex%/%%HEX%%/i) {
-        # decode %NN characters
-        my $d = $1;
-        $d =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
-        $$thing =~ s/%%HEX%%/$d/;
-    }
-    if($$thing =~ s/%repeat\[(\d+) x (.*)\]%/%%REPEAT%%/i) {
-        # decode %NN characters
-        my ($d, $n) = ($2, $1);
-        $d =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
-        my $all = $d x $n;
-        $$thing =~ s/%%REPEAT%%/$all/;
-    }
-}
-
-my $prevupdate;
-sub subNewlines {
-    my ($force, $thing) = @_;
-
-    if($force) {
-        # enforce CRLF newline
-        $$thing =~ s/\x0d*\x0a/\x0d\x0a/;
-        return;
-    }
-
-    # When curl is built with Hyper, it gets all response headers delivered as
-    # name/value pairs and curl "invents" the newlines when it saves the
-    # headers. Therefore, curl will always save headers with CRLF newlines
-    # when built to use Hyper. By making sure we deliver all tests using CRLF
-    # as well, all test comparisons will survive without knowing about this
-    # little quirk.
-
-    if(($$thing =~ /^HTTP\/(1.1|1.0|2|3) [1-5][^\x0d]*\z/) ||
-       ($$thing =~ /^(GET|POST|PUT|DELETE) \S+ HTTP\/\d+(\.\d+)?/) ||
-       (($$thing =~ /^[a-z0-9_-]+: [^\x0d]*\z/i) &&
-        # skip curl error messages
-        ($$thing !~ /^curl: \(\d+\) /))) {
-        # enforce CRLF newline
-        $$thing =~ s/\x0d*\x0a/\x0d\x0a/;
-        $prevupdate = 1;
-    }
-    else {
-        if(($$thing =~ /^\n\z/) && $prevupdate) {
-            # if there's a blank link after a line we update, we hope it is
-            # the empty line following headers
-            $$thing =~ s/\x0a/\x0d\x0a/;
-        }
-        $prevupdate = 0;
-    }
-}
-
 #######################################################################
 # Provide time stamps for single test skipped events
 #
@@ -981,58 +783,6 @@ sub timestampskippedevents {
     }
 }
 
-#
-# 'prepro' processes the input array and replaces %-variables in the array
-# etc. Returns the processed version of the array
-
-sub prepro {
-    my $testnum = shift;
-    my (@entiretest) = @_;
-    my $show = 1;
-    my @out;
-    my $data_crlf;
-    for my $s (@entiretest) {
-        my $f = $s;
-        if($s =~ /^ *%if (.*)/) {
-            my $cond = $1;
-            my $rev = 0;
-
-            if($cond =~ /^!(.*)/) {
-                $cond = $1;
-                $rev = 1;
-            }
-            $rev ^= $feature{$cond} ? 1 : 0;
-            $show = $rev;
-            next;
-        }
-        elsif($s =~ /^ *%else/) {
-            $show ^= 1;
-            next;
-        }
-        elsif($s =~ /^ *%endif/) {
-            $show = 1;
-            next;
-        }
-        if($show) {
-            # The processor does CRLF replacements in the <data*> sections if
-            # necessary since those parts might be read by separate servers.
-            if($s =~ /^ *<data(.*)\>/) {
-                if($1 =~ /crlf="yes"/ ||
-                   ($feature{"hyper"} && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) {
-                    $data_crlf = 1;
-                }
-            }
-            elsif(($s =~ /^ *<\/data/) && $data_crlf) {
-                $data_crlf = 0;
-            }
-            subVariables(\$s, $testnum, "%");
-            subBase64(\$s);
-            subNewlines(0, \$s) if($data_crlf);
-            push @out, $s;
-        }
-    }
-    return @out;
-}
 
 # Setup CI Test Run
 sub citest_starttestrun {
@@ -1322,7 +1072,7 @@ sub singletest_check {
         if($hash{'crlf'} ||
            ($feature{"hyper"} && ($keywords{"HTTP"}
                            || $keywords{"HTTPS"}))) {
-            subNewlines(0, \$_) for @validstdout;
+            subnewlines(0, \$_) for @validstdout;
         }
 
         $res = compare($testnum, $testname, "stdout", \@actual, \@validstdout);
@@ -1423,7 +1173,7 @@ sub singletest_check {
         }
 
         if($hash{'crlf'}) {
-            subNewlines(1, \$_) for @protocol;
+            subnewlines(1, \$_) for @protocol;
         }
 
         if((!$out[0] || ($out[0] eq "")) && $protocol[0]) {
@@ -1469,7 +1219,7 @@ sub singletest_check {
                 if($replycheckpartattr{'crlf'} ||
                    ($feature{"hyper"} && ($keywords{"HTTP"}
                                    || $keywords{"HTTPS"}))) {
-                    subNewlines(0, \$_) for @replycheckpart;
+                    subnewlines(0, \$_) for @replycheckpart;
                 }
                 push(@reply, @replycheckpart);
             }
@@ -1494,7 +1244,7 @@ sub singletest_check {
         if($replyattr{'crlf'} ||
            ($feature{"hyper"} && ($keywords{"HTTP"}
                            || $keywords{"HTTPS"}))) {
-            subNewlines(0, \$_) for @reply;
+            subnewlines(0, \$_) for @reply;
         }
     }
 
@@ -1569,7 +1319,7 @@ sub singletest_check {
 
         if($hash{'crlf'} ||
            ($feature{"hyper"} && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) {
-            subNewlines(0, \$_) for @proxyprot;
+            subnewlines(0, \$_) for @proxyprot;
         }
 
         $res = compare($testnum, $testname, "proxy", \@out, \@proxyprot);
@@ -1614,7 +1364,7 @@ sub singletest_check {
             if($hash{'crlf'} ||
                ($feature{"hyper"} && ($keywords{"HTTP"}
                                || $keywords{"HTTPS"}))) {
-                subNewlines(0, \$_) for @outfile;
+                subnewlines(0, \$_) for @outfile;
             }
 
             for my $strip (@stripfilepar) {

+ 100 - 14
tests/servers.pm

@@ -61,6 +61,7 @@ BEGIN {
             serverfortest
             stopserver
             stopservers
+            subvariables
         )
     );
 }
@@ -103,6 +104,7 @@ use pathhelp qw(
 
 use processhelp;
 use globalconfig;
+use testutil;
 
 
 my %serverpidfile; # all server pid file names, identified by server id
@@ -117,6 +119,10 @@ my $httptlssrv = find_httptlssrv();
 my %run;          # running server
 my %runcert;      # cert file currently in use by an ssl running server
 my $serverstartretries=10; # number of times to attempt to start server
+my $CLIENTIP="127.0.0.1";  # address which curl uses for incoming connections
+my $CLIENT6IP="[::1]";     # address which curl uses for incoming connections
+my $posix_pwd=$pwd;        # current working directory
+my $h2cver = "h2c"; # this version is decided by the nghttp2 lib being used
 
 # Variables shared with runtests.pl
 our $HOSTIP="127.0.0.1";   # address on which the test server listens
@@ -141,20 +147,6 @@ sub logmsg {
     return main::logmsg(@_);
 }
 
-#######################################################################
-# Call main's runclient
-# TODO: move this into a helper package
-sub runclient {
-    return main::runclient(@_);
-}
-
-#######################################################################
-# Call main's runclientoutput
-# TODO: move this into a helper package
-sub runclientoutput {
-    return main::runclientoutput(@_);
-}
-
 #######################################################################
 # Check for a command in the PATH of the test server.
 #
@@ -2943,4 +2935,98 @@ sub stopservers {
 }
 
 
+#######################################################################
+# substitute the variable stuff into either a joined up file or
+# a command, in either case passed by reference
+#
+sub subvariables {
+    my ($thing, $testnum, $prefix) = @_;
+    my $port;
+
+    if(!$prefix) {
+        $prefix = "%";
+    }
+
+    # test server ports
+    # Substitutes variables like %HTTPPORT and %SMTP6PORT with the server ports
+    foreach my $proto ('DICT',
+                       'FTP', 'FTP6', 'FTPS',
+                       'GOPHER', 'GOPHER6', 'GOPHERS',
+                       'HTTP', 'HTTP6', 'HTTPS',
+                       'HTTPSPROXY', 'HTTPTLS', 'HTTPTLS6',
+                       'HTTP2', 'HTTP2TLS',
+                       'HTTP3',
+                       'IMAP', 'IMAP6', 'IMAPS',
+                       'MQTT',
+                       'NOLISTEN',
+                       'POP3', 'POP36', 'POP3S',
+                       'RTSP', 'RTSP6',
+                       'SMB', 'SMBS',
+                       'SMTP', 'SMTP6', 'SMTPS',
+                       'SOCKS',
+                       'SSH',
+                       'TELNET',
+                       'TFTP', 'TFTP6') {
+        $port = protoport(lc $proto);
+        $$thing =~ s/${prefix}(?:$proto)PORT/$port/g;
+    }
+    # Special case: for PROXYPORT substitution, use httpproxy.
+    $port = protoport('httpproxy');
+    $$thing =~ s/${prefix}PROXYPORT/$port/g;
+
+    # server Unix domain socket paths
+    $$thing =~ s/${prefix}HTTPUNIXPATH/$HTTPUNIXPATH/g;
+    $$thing =~ s/${prefix}SOCKSUNIXPATH/$SOCKSUNIXPATH/g;
+
+    # client IP addresses
+    $$thing =~ s/${prefix}CLIENT6IP/$CLIENT6IP/g;
+    $$thing =~ s/${prefix}CLIENTIP/$CLIENTIP/g;
+
+    # server IP addresses
+    $$thing =~ s/${prefix}HOST6IP/$HOST6IP/g;
+    $$thing =~ s/${prefix}HOSTIP/$HOSTIP/g;
+
+    # misc
+    $$thing =~ s/${prefix}CURL/$CURL/g;
+    $$thing =~ s/${prefix}LOGDIR/$LOGDIR/g;
+    $$thing =~ s/${prefix}PWD/$pwd/g;
+    $$thing =~ s/${prefix}POSIX_PWD/$posix_pwd/g;
+    $$thing =~ s/${prefix}VERSION/$CURLVERSION/g;
+    $$thing =~ s/${prefix}TESTNUMBER/$testnum/g;
+
+    my $file_pwd = $pwd;
+    if($file_pwd !~ /^\//) {
+        $file_pwd = "/$file_pwd";
+    }
+    my $ssh_pwd = $posix_pwd;
+    # this only works after the SSH server has been started
+    # TODO: call sshversioninfo early and store $sshdid so this substitution
+    # always works
+    if ($sshdid && $sshdid =~ /OpenSSH-Windows/) {
+        $ssh_pwd = $file_pwd;
+    }
+
+    $$thing =~ s/${prefix}FILE_PWD/$file_pwd/g;
+    $$thing =~ s/${prefix}SSH_PWD/$ssh_pwd/g;
+    $$thing =~ s/${prefix}SRCDIR/$srcdir/g;
+    $$thing =~ s/${prefix}USER/$USER/g;
+
+    $$thing =~ s/${prefix}SSHSRVMD5/$SSHSRVMD5/g;
+    $$thing =~ s/${prefix}SSHSRVSHA256/$SSHSRVSHA256/g;
+
+    # The purpose of FTPTIME2 and FTPTIME3 is to provide times that can be
+    # used for time-out tests and that would work on most hosts as these
+    # adjust for the startup/check time for this particular host. We needed to
+    # do this to make the test suite run better on very slow hosts.
+    my $ftp2 = $ftpchecktime * 2;
+    my $ftp3 = $ftpchecktime * 3;
+
+    $$thing =~ s/${prefix}FTPTIME2/$ftp2/g;
+    $$thing =~ s/${prefix}FTPTIME3/$ftp3/g;
+
+    # HTTP2
+    $$thing =~ s/${prefix}H2CVER/$h2cver/g;
+}
+
+
 1;

+ 143 - 0
tests/testutil.pm

@@ -0,0 +1,143 @@
+#***************************************************************************
+#                                  _   _ ____  _
+#  Project                     ___| | | |  _ \| |
+#                             / __| | | | |_) | |
+#                            | (__| |_| |  _ <| |___
+#                             \___|\___/|_| \_\_____|
+#
+# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al.
+#
+# This software is licensed as described in the file COPYING, which
+# you should have received as part of this distribution. The terms
+# are also available at https://curl.se/docs/copyright.html.
+#
+# You may opt to use, copy, modify, merge, publish, distribute and/or sell
+# copies of the Software, and permit persons to whom the Software is
+# furnished to do so, under the terms of the COPYING file.
+#
+# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
+# KIND, either express or implied.
+#
+# SPDX-License-Identifier: curl
+#
+###########################################################################
+
+# This module contains miscellanous functions needed in several parts of
+# the test suite.
+
+package testutil;
+
+use strict;
+use warnings;
+
+BEGIN {
+    use base qw(Exporter);
+
+    our @EXPORT = qw(
+        runclient
+        runclientoutput
+        subbase64
+        subnewlines
+    );
+}
+
+use MIME::Base64;
+
+use globalconfig qw(
+    $torture
+    $verbose
+);
+
+sub subbase64 {
+    my ($thing) = @_;
+
+    # cut out the base64 piece
+    if($$thing =~ s/%b64\[(.*)\]b64%/%%B64%%/i) {
+        my $d = $1;
+        # encode %NN characters
+        $d =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+        my $enc = encode_base64($d, "");
+        # put the result into there
+        $$thing =~ s/%%B64%%/$enc/;
+    }
+    # hex decode
+    if($$thing =~ s/%hex\[(.*)\]hex%/%%HEX%%/i) {
+        # decode %NN characters
+        my $d = $1;
+        $d =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+        $$thing =~ s/%%HEX%%/$d/;
+    }
+    if($$thing =~ s/%repeat\[(\d+) x (.*)\]%/%%REPEAT%%/i) {
+        # decode %NN characters
+        my ($d, $n) = ($2, $1);
+        $d =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+        my $all = $d x $n;
+        $$thing =~ s/%%REPEAT%%/$all/;
+    }
+}
+
+my $prevupdate;  # module scope so it remembers the last value
+sub subnewlines {
+    my ($force, $thing) = @_;
+
+    if($force) {
+        # enforce CRLF newline
+        $$thing =~ s/\x0d*\x0a/\x0d\x0a/;
+        return;
+    }
+
+    # When curl is built with Hyper, it gets all response headers delivered as
+    # name/value pairs and curl "invents" the newlines when it saves the
+    # headers. Therefore, curl will always save headers with CRLF newlines
+    # when built to use Hyper. By making sure we deliver all tests using CRLF
+    # as well, all test comparisons will survive without knowing about this
+    # little quirk.
+
+    if(($$thing =~ /^HTTP\/(1.1|1.0|2|3) [1-5][^\x0d]*\z/) ||
+       ($$thing =~ /^(GET|POST|PUT|DELETE) \S+ HTTP\/\d+(\.\d+)?/) ||
+       (($$thing =~ /^[a-z0-9_-]+: [^\x0d]*\z/i) &&
+        # skip curl error messages
+        ($$thing !~ /^curl: \(\d+\) /))) {
+        # enforce CRLF newline
+        $$thing =~ s/\x0d*\x0a/\x0d\x0a/;
+        $prevupdate = 1;
+    }
+    else {
+        if(($$thing =~ /^\n\z/) && $prevupdate) {
+            # if there's a blank link after a line we update, we hope it is
+            # the empty line following headers
+            $$thing =~ s/\x0a/\x0d\x0a/;
+        }
+        $prevupdate = 0;
+    }
+}
+
+#######################################################################
+# Run the application under test and return its return code
+#
+sub runclient {
+    my ($cmd)=@_;
+    my $ret = system($cmd);
+    print "CMD ($ret): $cmd\n" if($verbose && !$torture);
+    return $ret;
+
+# This is one way to test curl on a remote machine
+#    my $out = system("ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'");
+#    sleep 2;    # time to allow the NFS server to be updated
+#    return $out;
+}
+
+#######################################################################
+# Run the application under test and return its stdout
+#
+sub runclientoutput {
+    my ($cmd)=@_;
+    return `$cmd 2>/dev/null`;
+
+# This is one way to test curl on a remote machine
+#    my @out = `ssh $CLIENTIP cd \'$pwd\' \\; \'$cmd\'`;
+#    sleep 2;    # time to allow the NFS server to be updated
+#    return @out;
+}
+
+1;