From ad80490711998830855da0d9488b18a6540fac81 Mon Sep 17 00:00:00 2001 From: Dan Fandrich Date: Thu, 7 Jun 2007 22:42:26 +0000 Subject: Changed the opens to work on older versions of perl. Redirect ssh output to ssh.log --- tests/runtests.pl | 128 +++++++++++++++++++++++++++--------------------------- 1 file changed, 63 insertions(+), 65 deletions(-) diff --git a/tests/runtests.pl b/tests/runtests.pl index 36ed610fd..e570c1fc0 100755 --- a/tests/runtests.pl +++ b/tests/runtests.pl @@ -113,15 +113,15 @@ if($valgrind) { if (($? >> 8)==0) { $valgrind_tool="--tool=memcheck "; } - open( my $C, "<", $CURL); - my $l = <$C>; + open(C, "<", $CURL); + my $l = ; if($l =~ /^\#\!/) { # The first line starts with "#!" which implies a shell-script. # This means libcurl is built shared and curl is a wrapper-script # Disable valgrind in this setup $valgrind=0; } - close($C); + close(C); # valgrind 3 renamed the --logfile option to --log-file!!! my $ver=`valgrind --version`; @@ -183,8 +183,6 @@ my $torture; my $tortnum; my $tortalloc; -my $CMDLOG; #log filehandle - # open and close each time to allow removal at any time sub logmsg { # uncomment the Time::HiRes usage for this @@ -293,9 +291,9 @@ sub startnew { # Ugly hack but ssh doesn't support pid files if ($fake) { logmsg "$pidfile faked with pid=$child\n" if($verbose); - open(my $OUT, ">", $pidfile); - print $OUT $child; - close $OUT; + open(OUT, ">", $pidfile); + print OUT $child; + close(OUT); # could/should do a while connect fails sleep a bit and loop sleep 1; if (checkdied($child)) { @@ -306,9 +304,9 @@ sub startnew { my $count=12; while($count--) { if(-f $pidfile) { - open(my $PID, "<", $pidfile); - $pid2 = 0 + <$PID>; - close($PID); + open(PID, "<", $pidfile); + $pid2 = 0 + ; + close(PID); if($pid2 && kill(0, $pid2)) { # if $pid2 is valid, then make sure this pid is alive, as # otherwise it is just likely to be the _previous_ pidfile or @@ -523,9 +521,9 @@ sub verifyhttp { } } } - open(my $FILE, "<", "log/verifiedserver"); - my @file=<$FILE>; - close($FILE); + open(FILE, "<", "log/verifiedserver"); + my @file=; + close(FILE); $data=$file[0]; # first line if ( $data =~ /WE ROOLZ: (\d+)/ ) { @@ -592,9 +590,9 @@ sub verifyftp { sub verifyssh { my ($proto, $ip, $port) = @_; - open(my $FILE, "<" . $SSHPIDFILE); - my $pid=0+<$FILE>; - close($FILE); + open(FILE, "<" . $SSHPIDFILE); + my $pid=0+; + close(FILE); return $pid; } @@ -603,9 +601,9 @@ sub verifyssh { sub verifysocks { my ($proto, $ip, $port) = @_; - open(my $FILE, "<" . $SOCKSPIDFILE); - my $pid=0+<$FILE>; - close($FILE); + open(FILE, "<" . $SOCKSPIDFILE); + my $pid=0+; + close(FILE); return $pid; } @@ -991,7 +989,7 @@ sub runsocksserver { my $pidfile = $SOCKSPIDFILE; 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) = startnew($cmd, $pidfile,1); # start the server in a new process @@ -1045,20 +1043,20 @@ sub filteroff { my $filter=$_[1]; my $ofile=$_[2]; - open(my $IN, "<", $infile) + open(IN, "<", $infile) || return 1; - open(my $OUT, ">", $ofile) + open(OUT, ">", $ofile) || return 1; # logmsg "FILTER: off $filter from $infile to $ofile\n"; - while(<$IN>) { + while() { $_ =~ s/$filter//; - print $OUT $_; + print OUT $_; } - close($IN); - close($OUT); + close(IN); + close(OUT); return 0; } @@ -1109,9 +1107,9 @@ sub checksystem { $versretval = system($versioncmd); $versnoexec = $!; - open(my $VERSOUT, "<", $curlverout); - @version = <$VERSOUT>; - close($VERSOUT); + open(VERSOUT, "<", $curlverout); + @version = ; + close(VERSOUT); for(@version) { chomp; @@ -1261,13 +1259,13 @@ sub checksystem { } if(-r "../lib/config.h") { - open(my $CONF, "<", "../lib/config.h"); - while(<$CONF>) { + open(CONF, "<", "../lib/config.h"); + while() { if($_ =~ /^\#define HAVE_GETRLIMIT/) { $has_getrlimit = 1; } } - close($CONF); + close(CONF); } if($has_ipv6) { @@ -1636,10 +1634,10 @@ sub singletest { my $fileContent = join('', @inputfile); subVariables \$fileContent; # logmsg "DEBUG: writing file " . $filename . "\n"; - open my $OUTFILE, ">", $filename; - binmode $OUTFILE; # for crapage systems, use binary - print $OUTFILE $fileContent; - close $OUTFILE; + open(OUTFILE, ">", $filename); + binmode OUTFILE; # for crapage systems, use binary + print OUTFILE $fileContent; + close(OUTFILE); } my %cmdhash = getpartattr("client", "command"); @@ -1695,7 +1693,7 @@ sub singletest { logmsg "$CMDLINE\n"; } - print $CMDLOG "$CMDLINE\n"; + print CMDLOG "$CMDLINE\n"; unlink("core"); @@ -1717,10 +1715,10 @@ sub singletest { } if($gdbthis) { - open( my $GDBCMD, ">", "log/gdbcmd"); - print $GDBCMD "set args $cmdargs\n"; - print $GDBCMD "show args\n"; - close($GDBCMD); + open(GDBCMD, ">", "log/gdbcmd"); + print GDBCMD "set args $cmdargs\n"; + print GDBCMD "show args\n"; + close(GDBCMD); } # run the command line we built if ($torture) { @@ -1754,9 +1752,9 @@ sub singletest { logmsg "core dumped\n"; if(0 && $gdb) { logmsg "running gdb for post-mortem analysis:\n"; - open( my $GDBCMD, ">", "log/gdbcmd2"); - print $GDBCMD "bt\n"; - close($GDBCMD); + open(GDBCMD, ">", "log/gdbcmd2"); + print GDBCMD "bt\n"; + close(GDBCMD); system("$gdb --directory libtest -x log/gdbcmd2 -batch $DBGCURL core "); # unlink("log/gdbcmd2"); } @@ -2032,10 +2030,10 @@ sub singletest { if($disable[0] !~ /disable/) { - opendir( my $DIR, "log") || + opendir(DIR, "log") || return 0; # can't open log dir - my @files = readdir($DIR); - closedir $DIR; + my @files = readdir(DIR); + closedir(DIR); my $f; my $l; foreach $f (@files) { @@ -2468,10 +2466,10 @@ if($valgrind) { } # open the executable curl and read the first 4 bytes of it -open(my $CHECK, "<", $CURL); +open(CHECK, "<", $CURL); my $c; -sysread $CHECK, $c, 4; -close($CHECK); +sysread CHECK, $c, 4; +close(CHECK); if($c eq "#! /") { # A shell script. This is typically when built with libtool, $libtool = 1; @@ -2512,12 +2510,12 @@ if(!$listonly) { if ( $TESTCASES eq "all") { # Get all commands and find out their test numbers - opendir(my $DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!"; - my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir($DIR); - closedir $DIR; + opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!"; + my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR); + closedir(DIR); - open(my $D, "$TESTDIR/DISABLED"); - while(<$D>) { + open(D, "$TESTDIR/DISABLED"); + while() { if(/^ *\#/) { # allow comments next; @@ -2526,7 +2524,7 @@ if ( $TESTCASES eq "all") { $disabled{$1}=$1; # disable this test number } } - close($D); + close(D); $TESTCASES=""; # start with no test cases @@ -2551,7 +2549,7 @@ if ( $TESTCASES eq "all") { ####################################################################### # Start the command line log # -open($CMDLOG, ">", $CURLLOG) || +open(CMDLOG, ">", $CURLLOG) || logmsg "can't log command lines to $CURLLOG\n"; ####################################################################### @@ -2560,12 +2558,12 @@ open($CMDLOG, ">", $CURLLOG) || # and excessively long files are truncated sub displaylogcontent { my ($file)=@_; - if(open(my $SINGLE, "<$file")) { + if(open(SINGLE, "<$file")) { my $lfcount; my $linecount = 0; my $truncate; my @tail; - while(my $string = <$SINGLE>) { + while(my $string = ) { $string =~ s/\r\n/\n/g; $string =~ s/[\r\f\032]/\n/g; $string .= "\n" unless ($string =~ /\n$/); @@ -2598,16 +2596,16 @@ sub displaylogcontent { # This won't work properly if time stamps are enabled in logmsg logmsg join('',@tail[$#tail-200..$#tail]); } - close($SINGLE); + close(SINGLE); } } sub displaylogs { my ($testnum)=@_; - opendir(my $DIR, "$LOGDIR") || + opendir(DIR, "$LOGDIR") || die "can't open dir: $!"; - my @logs = readdir($DIR); - closedir($DIR); + my @logs = readdir(DIR); + closedir(DIR); logmsg "== Contents of files in the log/ dir after test $testnum\n"; foreach my $log (sort @logs) { @@ -2696,7 +2694,7 @@ foreach $testnum (@at) { ####################################################################### # Close command log # -close($CMDLOG); +close(CMDLOG); # Tests done, stop the servers stopservers($verbose); -- cgit v1.2.3