Changed the opens to work on older versions of perl. (ad804907) · Commits · CYBER - Cyber Security / TS 103 523 MSP / TLMSP / TLMSP curl

tests/runtests.pl

+63 −65

Original line number	Original line	Diff line number	Diff line
	@@ -113,15 +113,15 @@ if($valgrind) {
	if (($? >> 8)==0) {		if (($? >> 8)==0) {
	$valgrind_tool="--tool=memcheck ";		$valgrind_tool="--tool=memcheck ";
	}		}
	open( my $C, "<", $CURL);		open(C, "<", $CURL);
	my $l = <$C>;		my $l = <C>;
	if($l =~ /^\#\!/) {		if($l =~ /^\#\!/) {
	# The first line starts with "#!" which implies a shell-script.		# The first line starts with "#!" which implies a shell-script.
	# This means libcurl is built shared and curl is a wrapper-script		# This means libcurl is built shared and curl is a wrapper-script
	# Disable valgrind in this setup		# Disable valgrind in this setup
	$valgrind=0;		$valgrind=0;
	}		}
	close($C);		close(C);

	# valgrind 3 renamed the --logfile option to --log-file!!!		# valgrind 3 renamed the --logfile option to --log-file!!!
	my $ver=`valgrind --version`;		my $ver=`valgrind --version`;
	@@ -183,8 +183,6 @@ my $torture;
	my $tortnum;		my $tortnum;
	my $tortalloc;		my $tortalloc;

	my $CMDLOG; #log filehandle

	# open and close each time to allow removal at any time		# open and close each time to allow removal at any time
	sub logmsg {		sub logmsg {
	# uncomment the Time::HiRes usage for this		# uncomment the Time::HiRes usage for this
	@@ -293,9 +291,9 @@ sub startnew {
	# Ugly hack but ssh doesn't support pid files		# Ugly hack but ssh doesn't support pid files
	if ($fake) {		if ($fake) {
	logmsg "$pidfile faked with pid=$child\n" if($verbose);		logmsg "$pidfile faked with pid=$child\n" if($verbose);
	open(my $OUT, ">", $pidfile);		open(OUT, ">", $pidfile);
	print $OUT $child;		print OUT $child;
	close $OUT;		close(OUT);
	# could/should do a while connect fails sleep a bit and loop		# could/should do a while connect fails sleep a bit and loop
	sleep 1;		sleep 1;
	if (checkdied($child)) {		if (checkdied($child)) {
	@@ -306,9 +304,9 @@ sub startnew {
	my $count=12;		my $count=12;
	while($count--) {		while($count--) {
	if(-f $pidfile) {		if(-f $pidfile) {
	open(my $PID, "<", $pidfile);		open(PID, "<", $pidfile);
	$pid2 = 0 + <$PID>;		$pid2 = 0 + <PID>;
	close($PID);		close(PID);
	if($pid2 && kill(0, $pid2)) {		if($pid2 && kill(0, $pid2)) {
	# if $pid2 is valid, then make sure this pid is alive, as		# if $pid2 is valid, then make sure this pid is alive, as
	# otherwise it is just likely to be the _previous_ pidfile or		# otherwise it is just likely to be the _previous_ pidfile or
	@@ -523,9 +521,9 @@ sub verifyhttp {
	}		}
	}		}
	}		}
	open(my $FILE, "<", "log/verifiedserver");		open(FILE, "<", "log/verifiedserver");
	my @file=<$FILE>;		my @file=<FILE>;
	close($FILE);		close(FILE);
	$data=$file[0]; # first line		$data=$file[0]; # first line

	if ( $data =~ /WE ROOLZ: (\d+)/ ) {		if ( $data =~ /WE ROOLZ: (\d+)/ ) {
	@@ -592,9 +590,9 @@ sub verifyftp {

	sub verifyssh {		sub verifyssh {
	my ($proto, $ip, $port) = @_;		my ($proto, $ip, $port) = @_;
	open(my $FILE, "<" . $SSHPIDFILE);		open(FILE, "<" . $SSHPIDFILE);
	my $pid=0+<$FILE>;		my $pid=0+<FILE>;
	close($FILE);		close(FILE);
	return $pid;		return $pid;
	}		}

	@@ -603,9 +601,9 @@ sub verifyssh {

	sub verifysocks {		sub verifysocks {
	my ($proto, $ip, $port) = @_;		my ($proto, $ip, $port) = @_;
	open(my $FILE, "<" . $SOCKSPIDFILE);		open(FILE, "<" . $SOCKSPIDFILE);
	my $pid=0+<$FILE>;		my $pid=0+<FILE>;
	close($FILE);		close(FILE);
	return $pid;		return $pid;
	}		}

	@@ -991,7 +989,7 @@ sub runsocksserver {
	my $pidfile = $SOCKSPIDFILE;		my $pidfile = $SOCKSPIDFILE;

	my $flag=$debugprotocol?"-v ":"";		my $flag=$debugprotocol?"-v ":"";
	my $cmd="ssh -D ${HOSTIP}:$SOCKSPORT -N -F curl_ssh_config ${USER}\@${HOSTIP} -p ${SSHPORT}";		my $cmd="ssh -D ${HOSTIP}:$SOCKSPORT -N -F curl_ssh_config ${USER}\@${HOSTIP} -p ${SSHPORT} >log/ssh.log 2>&1";
	my ($sshpid, $pid2) =		my ($sshpid, $pid2) =
	startnew($cmd, $pidfile,1); # start the server in a new process		startnew($cmd, $pidfile,1); # start the server in a new process

	@@ -1045,20 +1043,20 @@ sub filteroff {
	my $filter=$_[1];		my $filter=$_[1];
	my $ofile=$_[2];		my $ofile=$_[2];

	open(my $IN, "<", $infile)		open(IN, "<", $infile)
	\|\| return 1;		\|\| return 1;

	open(my $OUT, ">", $ofile)		open(OUT, ">", $ofile)
	\|\| return 1;		\|\| return 1;

	# logmsg "FILTER: off $filter from $infile to $ofile\n";		# logmsg "FILTER: off $filter from $infile to $ofile\n";

	while(<$IN>) {		while(<IN>) {
	$_ =~ s/$filter//;		$_ =~ s/$filter//;
	print $OUT $_;		print OUT $_;
	}		}
	close($IN);		close(IN);
	close($OUT);		close(OUT);
	return 0;		return 0;
	}		}

	@@ -1109,9 +1107,9 @@ sub checksystem {
	$versretval = system($versioncmd);		$versretval = system($versioncmd);
	$versnoexec = $!;		$versnoexec = $!;

	open(my $VERSOUT, "<", $curlverout);		open(VERSOUT, "<", $curlverout);
	@version = <$VERSOUT>;		@version = <VERSOUT>;
	close($VERSOUT);		close(VERSOUT);

	for(@version) {		for(@version) {
	chomp;		chomp;
	@@ -1261,13 +1259,13 @@ sub checksystem {
	}		}

	if(-r "../lib/config.h") {		if(-r "../lib/config.h") {
	open(my $CONF, "<", "../lib/config.h");		open(CONF, "<", "../lib/config.h");
	while(<$CONF>) {		while(<CONF>) {
	if($_ =~ /^\#define HAVE_GETRLIMIT/) {		if($_ =~ /^\#define HAVE_GETRLIMIT/) {
	$has_getrlimit = 1;		$has_getrlimit = 1;
	}		}
	}		}
	close($CONF);		close(CONF);
	}		}

	if($has_ipv6) {		if($has_ipv6) {
	@@ -1636,10 +1634,10 @@ sub singletest {
	my $fileContent = join('', @inputfile);		my $fileContent = join('', @inputfile);
	subVariables \$fileContent;		subVariables \$fileContent;
	# logmsg "DEBUG: writing file " . $filename . "\n";		# logmsg "DEBUG: writing file " . $filename . "\n";
	open my $OUTFILE, ">", $filename;		open(OUTFILE, ">", $filename);
	binmode $OUTFILE; # for crapage systems, use binary		binmode OUTFILE; # for crapage systems, use binary
	print $OUTFILE $fileContent;		print OUTFILE $fileContent;
	close $OUTFILE;		close(OUTFILE);
	}		}

	my %cmdhash = getpartattr("client", "command");		my %cmdhash = getpartattr("client", "command");
	@@ -1695,7 +1693,7 @@ sub singletest {
	logmsg "$CMDLINE\n";		logmsg "$CMDLINE\n";
	}		}

	print $CMDLOG "$CMDLINE\n";		print CMDLOG "$CMDLINE\n";

	unlink("core");		unlink("core");

	@@ -1717,10 +1715,10 @@ sub singletest {
	}		}

	if($gdbthis) {		if($gdbthis) {
	open( my $GDBCMD, ">", "log/gdbcmd");		open(GDBCMD, ">", "log/gdbcmd");
	print $GDBCMD "set args $cmdargs\n";		print GDBCMD "set args $cmdargs\n";
	print $GDBCMD "show args\n";		print GDBCMD "show args\n";
	close($GDBCMD);		close(GDBCMD);
	}		}
	# run the command line we built		# run the command line we built
	if ($torture) {		if ($torture) {
	@@ -1754,9 +1752,9 @@ sub singletest {
	logmsg "core dumped\n";		logmsg "core dumped\n";
	if(0 && $gdb) {		if(0 && $gdb) {
	logmsg "running gdb for post-mortem analysis:\n";		logmsg "running gdb for post-mortem analysis:\n";
	open( my $GDBCMD, ">", "log/gdbcmd2");		open(GDBCMD, ">", "log/gdbcmd2");
	print $GDBCMD "bt\n";		print GDBCMD "bt\n";
	close($GDBCMD);		close(GDBCMD);
	system("$gdb --directory libtest -x log/gdbcmd2 -batch $DBGCURL core ");		system("$gdb --directory libtest -x log/gdbcmd2 -batch $DBGCURL core ");
	# unlink("log/gdbcmd2");		# unlink("log/gdbcmd2");
	}		}
	@@ -2032,10 +2030,10 @@ sub singletest {

	if($disable[0] !~ /disable/) {		if($disable[0] !~ /disable/) {

	opendir( my $DIR, "log") \|\|		opendir(DIR, "log") \|\|
	return 0; # can't open log dir		return 0; # can't open log dir
	my @files = readdir($DIR);		my @files = readdir(DIR);
	closedir $DIR;		closedir(DIR);
	my $f;		my $f;
	my $l;		my $l;
	foreach $f (@files) {		foreach $f (@files) {
	@@ -2468,10 +2466,10 @@ if($valgrind) {
	}		}

	# open the executable curl and read the first 4 bytes of it		# open the executable curl and read the first 4 bytes of it
	open(my $CHECK, "<", $CURL);		open(CHECK, "<", $CURL);
	my $c;		my $c;
	sysread $CHECK, $c, 4;		sysread CHECK, $c, 4;
	close($CHECK);		close(CHECK);
	if($c eq "#! /") {		if($c eq "#! /") {
	# A shell script. This is typically when built with libtool,		# A shell script. This is typically when built with libtool,
	$libtool = 1;		$libtool = 1;
	@@ -2512,12 +2510,12 @@ if(!$listonly) {

	if ( $TESTCASES eq "all") {		if ( $TESTCASES eq "all") {
	# Get all commands and find out their test numbers		# Get all commands and find out their test numbers
	opendir(my $DIR, $TESTDIR) \|\| die "can't opendir $TESTDIR: $!";		opendir(DIR, $TESTDIR) \|\| die "can't opendir $TESTDIR: $!";
	my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir($DIR);		my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
	closedir $DIR;		closedir(DIR);

	open(my $D, "$TESTDIR/DISABLED");		open(D, "$TESTDIR/DISABLED");
	while(<$D>) {		while(<D>) {
	if(/^ *\#/) {		if(/^ *\#/) {
	# allow comments		# allow comments
	next;		next;
	@@ -2526,7 +2524,7 @@ if ( $TESTCASES eq "all") {
	$disabled{$1}=$1; # disable this test number		$disabled{$1}=$1; # disable this test number
	}		}
	}		}
	close($D);		close(D);

	$TESTCASES=""; # start with no test cases		$TESTCASES=""; # start with no test cases

	@@ -2551,7 +2549,7 @@ if ( $TESTCASES eq "all") {
	#######################################################################		#######################################################################
	# Start the command line log		# Start the command line log
	#		#
	open($CMDLOG, ">", $CURLLOG) \|\|		open(CMDLOG, ">", $CURLLOG) \|\|
	logmsg "can't log command lines to $CURLLOG\n";		logmsg "can't log command lines to $CURLLOG\n";

	#######################################################################		#######################################################################
	@@ -2560,12 +2558,12 @@ open($CMDLOG, ">", $CURLLOG) \|\|
	# and excessively long files are truncated		# and excessively long files are truncated
	sub displaylogcontent {		sub displaylogcontent {
	my ($file)=@_;		my ($file)=@_;
	if(open(my $SINGLE, "<$file")) {		if(open(SINGLE, "<$file")) {
	my $lfcount;		my $lfcount;
	my $linecount = 0;		my $linecount = 0;
	my $truncate;		my $truncate;
	my @tail;		my @tail;
	while(my $string = <$SINGLE>) {		while(my $string = <SINGLE>) {
	$string =~ s/\r\n/\n/g;		$string =~ s/\r\n/\n/g;
	$string =~ s/[\r\f\032]/\n/g;		$string =~ s/[\r\f\032]/\n/g;
	$string .= "\n" unless ($string =~ /\n$/);		$string .= "\n" unless ($string =~ /\n$/);
	@@ -2598,16 +2596,16 @@ sub displaylogcontent {
	# This won't work properly if time stamps are enabled in logmsg		# This won't work properly if time stamps are enabled in logmsg
	logmsg join('',@tail[$#tail-200..$#tail]);		logmsg join('',@tail[$#tail-200..$#tail]);
	}		}
	close($SINGLE);		close(SINGLE);
	}		}
	}		}

	sub displaylogs {		sub displaylogs {
	my ($testnum)=@_;		my ($testnum)=@_;
	opendir(my $DIR, "$LOGDIR") \|\|		opendir(DIR, "$LOGDIR") \|\|
	die "can't open dir: $!";		die "can't open dir: $!";
	my @logs = readdir($DIR);		my @logs = readdir(DIR);
	closedir($DIR);		closedir(DIR);

	logmsg "== Contents of files in the log/ dir after test $testnum\n";		logmsg "== Contents of files in the log/ dir after test $testnum\n";
	foreach my $log (sort @logs) {		foreach my $log (sort @logs) {
	@@ -2696,7 +2694,7 @@ foreach $testnum (@at) {
	#######################################################################		#######################################################################
	# Close command log		# Close command log
	#		#
	close($CMDLOG);		close(CMDLOG);

	# Tests done, stop the servers		# Tests done, stop the servers
	stopservers($verbose);		stopservers($verbose);