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
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);
#######################################################################
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
use base qw(Exporter);
our @EXPORT = qw(
+ prepro
restore_test_env
runner_test_preprocess
runner_test_run
$valgrind_tool
$gdb
);
+
+ # these are for debugging only
+ our @EXPORT_OK = qw(
+ singletest_preprocess
+ );
}
use pathhelp qw(
use servers;
use getpart;
use globalconfig;
+use testutil;
#######################################################################
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.
#
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.
#
}
}
-use Cwd;
use Digest::MD5 qw(md5);
-use MIME::Base64;
use List::Util 'sum';
use pathhelp qw(
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
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`;
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
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
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
#
}
}
-#
-# '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 {
if($hash{'crlf'} ||
($feature{"hyper"} && ($keywords{"HTTP"}
|| $keywords{"HTTPS"}))) {
- subNewlines(0, \$_) for @validstdout;
+ subnewlines(0, \$_) for @validstdout;
}
$res = compare($testnum, $testname, "stdout", \@actual, \@validstdout);
}
if($hash{'crlf'}) {
- subNewlines(1, \$_) for @protocol;
+ subnewlines(1, \$_) for @protocol;
}
if((!$out[0] || ($out[0] eq "")) && $protocol[0]) {
if($replycheckpartattr{'crlf'} ||
($feature{"hyper"} && ($keywords{"HTTP"}
|| $keywords{"HTTPS"}))) {
- subNewlines(0, \$_) for @replycheckpart;
+ subnewlines(0, \$_) for @replycheckpart;
}
push(@reply, @replycheckpart);
}
if($replyattr{'crlf'} ||
($feature{"hyper"} && ($keywords{"HTTP"}
|| $keywords{"HTTPS"}))) {
- subNewlines(0, \$_) for @reply;
+ subnewlines(0, \$_) for @reply;
}
}
if($hash{'crlf'} ||
($feature{"hyper"} && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) {
- subNewlines(0, \$_) for @proxyprot;
+ subnewlines(0, \$_) for @proxyprot;
}
$res = compare($testnum, $testname, "proxy", \@out, \@proxyprot);
if($hash{'crlf'} ||
($feature{"hyper"} && ($keywords{"HTTP"}
|| $keywords{"HTTPS"}))) {
- subNewlines(0, \$_) for @outfile;
+ subnewlines(0, \$_) for @outfile;
}
for my $strip (@stripfilepar) {
serverfortest
stopserver
stopservers
+ subvariables
)
);
}
use processhelp;
use globalconfig;
+use testutil;
my %serverpidfile; # all server pid file names, identified by server id
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
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.
#
}
+#######################################################################
+# 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;
--- /dev/null
+#***************************************************************************
+# _ _ ____ _
+# 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;
projects / thirdparty / curl.git / commitdiff
