diff --git a/tests/Makefile.am b/tests/Makefile.am index cf3e9f0ea1..676e5ccdac 100644 --- a/tests/Makefile.am +++ b/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 diff --git a/tests/globalconfig.pm b/tests/globalconfig.pm index f24f9c3fc9..420a71c24e 100644 --- a/tests/globalconfig.pm +++ b/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 - %timesrvrend - %timetoolini - %timetoolend - %timesrvrlog - %timevrfyend - $valgrind %keywords - $automakestyle + @protocols + %timesrvrend + %timesrvrini + %timesrvrlog + %timetoolend + %timetoolini + %timevrfyend ); } 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 diff --git a/tests/runner.pm b/tests/runner.pm index 8ada81d91e..ab5c1f8a09 100644 --- a/tests/runner.pm +++ b/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 sections if + # necessary since those parts might be read by separate servers. + if($s =~ /^ */) { + 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. # diff --git a/tests/runtests.pl b/tests/runtests.pl index 683f38c413..e652b968ef 100755 --- a/tests/runtests.pl +++ b/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 sections if - # necessary since those parts might be read by separate servers. - if($s =~ /^ */) { - 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) { diff --git a/tests/servers.pm b/tests/servers.pm index 6d3cefe595..c4cc35d6b5 100644 --- a/tests/servers.pm +++ b/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; diff --git a/tests/testutil.pm b/tests/testutil.pm new file mode 100644 index 0000000000..f80ae01769 --- /dev/null +++ b/tests/testutil.pm @@ -0,0 +1,143 @@ +#*************************************************************************** +# _ _ ____ _ +# Project ___| | | | _ \| | +# / __| | | | |_) | | +# | (__| |_| | _ <| |___ +# \___|\___/|_| \_\_____| +# +# Copyright (C) Daniel Stenberg, , 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;