Daniel Black's test suite fixes and initial test cases for SOCKS4/5 using

openssh

1 files changed, 151 insertions, 60 deletions

diff --git a/tests/runtests.pl b/tests/runtests.pl
index 98c71d5e1..7d1bd1df3 100755
--- a/tests/runtests.pl
+++ b/tests/runtests.pl
@@ -49,6 +49,7 @@ my $FTP6PORT; # FTP IPv6 server port
 my $TFTPPORT; # TFTP
 my $TFTP6PORT; # TFTP
 my $SSHPORT; # SCP/SFTP
+my $SOCKSPORT; # SOCKS4/5 port
 
 my $CURL="../src/curl"; # what curl executable to run on the tests
 my $DBGCURL=$CURL; #"../src/.libs/curl";  # alternative for debugging
@@ -81,6 +82,7 @@ my $FTPSPIDFILE=".ftps.pid";
 my $TFTPPIDFILE=".tftpd.pid";
 my $TFTP6PIDFILE=".tftp6.pid";
 my $SSHPIDFILE=".ssh.pid";
+my $SOCKSPIDFILE=".socks.pid";
 
 # invoke perl like this:
 my $perl="perl -I$srcdir";
@@ -111,15 +113,15 @@ if($valgrind) {
     if (($? >> 8)==0) {
         $valgrind_tool="--tool=memcheck ";
     }
-    open(C, "<$CURL");
-    my $l = <C>;
+    open( my $C, "<", $CURL);
+    my $l = <$C>;
     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`;
@@ -181,6 +183,8 @@ 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
@@ -256,7 +260,7 @@ sub checkdied {
 # Return the pids (yes plural) of the new child process to the parent.
 #
 sub startnew {
-    my ($cmd, $pidfile)=@_;
+    my ($cmd, $pidfile,$fake)=@_;
 
     logmsg "startnew: $cmd\n" if ($verbose);
 
@@ -285,12 +289,22 @@ sub startnew {
         die "error: exec() has returned";
     }
 
+
+    # Ugly hack but ssh doesn't support pid files
+    if ($fake) {
+        logmsg "$pidfile faked with pid=$child\n";
+        open(my $OUT, ">", $pidfile);
+        print $OUT $child;
+        close $OUT;
+	# could/should do a while connect fails sleep a bit and loop
+	sleep 1;
+    }
     my $count=12;
     while($count--) {
         if(-f $pidfile) {
-            open(PID, "<$pidfile");
-            $pid2 = 0 + <PID>;
-            close(PID);
+            open(my $PID, "<", $pidfile);
+            $pid2 = 0 + <$PID>;
+            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
@@ -505,9 +519,9 @@ sub verifyhttp {
             }
         }
     }
-    open(FILE, "<log/verifiedserver");
-    my @file=<FILE>;
-    close(FILE);
+    open(my $FILE, "<", "log/verifiedserver");
+    my @file=<$FILE>;
+    close($FILE);
     $data=$file[0]; # first line
 
     if ( $data =~ /WE ROOLZ: (\d+)/ ) {
@@ -574,9 +588,20 @@ sub verifyftp {
 
 sub verifyssh {
     my ($proto, $ip, $port) = @_;
-    open(FILE, "<" . $SSHPIDFILE);
-    my $pid=0+<FILE>;
-    close(FILE);
+    open(my $FILE, "<" . $SSHPIDFILE);
+    my $pid=0+<$FILE>;
+    close($FILE);
+    return $pid;
+}
+
+#######################################################################
+# STUB for verifying socks
+
+sub verifysocks {
+    my ($proto, $ip, $port) = @_;
+    open(my $FILE, "<" . $SOCKSPIDFILE);
+    my $pid=0+<$FILE>;
+    close($FILE);
     return $pid;
 }
 
@@ -590,7 +615,8 @@ my %protofunc = ('http' => \&verifyhttp,
                  'ftp' => \&verifyftp,
                  'ftps' => \&verifyftp,
                  'tftp' => \&verifyftp,
-                 'ssh' => \&verifyssh);
+                 'ssh' => \&verifyssh,
+                 'socks' => \&verifysocks);
 
 sub verifyserver {
     my ($proto, $ip, $port) = @_;
@@ -648,7 +674,7 @@ sub runhttpserver {
 
     my $cmd="$perl $srcdir/httpserver.pl -p $pidfile $fork$flag $port $ipv6";
     my ($httppid, $pid2) =
-        startnew($cmd, $pidfile); # start the server in a new process
+        startnew($cmd, $pidfile,0); # start the server in a new process
 
     if(!kill(0, $httppid)) {
         # it is NOT alive
@@ -702,7 +728,7 @@ sub runhttpsserver {
     my $flag=$debugprotocol?"-v ":"";
     my $cmd="$perl $srcdir/httpsserver.pl $flag -p https -s \"$stunnel\" -d $srcdir -r $HTTPPORT $HTTPSPORT";
 
-    my ($httpspid, $pid2) = startnew($cmd, $HTTPSPIDFILE);
+    my ($httpspid, $pid2) = startnew($cmd, $HTTPSPIDFILE,0);
 
     if(!kill(0, $httpspid)) {
         # it is NOT alive
@@ -768,7 +794,7 @@ sub runftpserver {
 
     unlink($pidfile);
 
-    my ($ftppid, $pid2) = startnew($cmd, $pidfile);
+    my ($ftppid, $pid2) = startnew($cmd, $pidfile,0);
 
     if(!$ftppid || !kill(0, $ftppid)) {
         # it is NOT alive
@@ -821,7 +847,7 @@ sub runftpsserver {
     my $flag=$debugprotocol?"-v ":"";
     my $cmd="$perl $srcdir/httpsserver.pl $flag -p ftps -s \"$stunnel\" -d $srcdir -r $FTPPORT $FTPSPORT";
 
-    my ($ftpspid, $pid2) = startnew($cmd, $FTPSPIDFILE);
+    my ($ftpspid, $pid2) = startnew($cmd, $FTPSPIDFILE,0);
 
     if(!kill(0, $ftpspid)) {
         # it is NOT alive
@@ -887,7 +913,7 @@ sub runtftpserver {
 
     unlink($pidfile);
 
-    my ($tftppid, $pid2) = startnew($cmd, $pidfile);
+    my ($tftppid, $pid2) = startnew($cmd, $pidfile,0);
 
     if(!$tftppid || !kill(0, $tftppid)) {
         # it is NOT alive
@@ -930,7 +956,7 @@ sub runsshserver {
     my $flag=$debugprotocol?"-v ":"";
     my $cmd="$perl $srcdir/sshserver.pl $flag-u $USER -d $srcdir $port";
     my ($sshpid, $pid2) =
-        startnew($cmd, $pidfile); # start the server in a new process
+        startnew($cmd, $pidfile,0); # start the server in a new process
 
     if(!$sshpid || !kill(0, $sshpid)) {
         # it is NOT alive
@@ -952,6 +978,40 @@ sub runsshserver {
 }
 
 #######################################################################
+# Start the socks server
+#
+sub runsocksserver {
+    my ($id, $verbose, $ipv6) = @_;
+    my $ip=$HOSTIP;
+    my $port = $SOCKSPORT;
+    my $pidfile = $SOCKSPIDFILE;
+
+    my $flag=$debugprotocol?"-v ":"";
+    my $cmd="ssh -D ${HOSTIP}:$SOCKSPORT -N -F curl_ssh_config ${USER}\@${HOSTIP} -p ${SSHPORT}";
+    my ($sshpid, $pid2) =
+        startnew($cmd, $pidfile,1); # start the server in a new process
+
+    if(!$sshpid || !kill(0, $sshpid)) {
+        # it is NOT alive
+        logmsg "RUN: failed to start the SOCKS server\n";
+        # failed to talk to it properly. Kill the server and return failure
+        stopserver("$sshpid $pid2");
+        return (0,0);
+    }
+
+    # Ugly hack but ssh doesn't support pid files
+    if (!verifyserver('socks',$ip,$port)) {
+        logmsg "RUN: SOCKS server failed verification\n";
+        return (0,0);
+    }
+    if($verbose) {
+        logmsg "RUN: SOCKS server is now running PID $sshpid\n";
+    }
+
+    return ($pid2, $sshpid);
+}
+
+#######################################################################
 # Remove all files in the specified directory
 #
 sub cleardir {
@@ -981,20 +1041,20 @@ sub filteroff {
     my $filter=$_[1];
     my $ofile=$_[2];
 
-    open(IN, "<$infile")
+    open(my $IN, "<", $infile)
         || return 1;
 
-    open(OUT, ">$ofile")
+    open(my $OUT, ">", $ofile)
         || return 1;
 
     # logmsg "FILTER: off $filter from $infile to $ofile\n";
 
-    while(<IN>) {
+    while(<$IN>) {
         $_ =~ s/$filter//;
-        print OUT $_;
+        print $OUT $_;
     }
-    close(IN);
-    close(OUT);
+    close($IN);
+    close($OUT);
     return 0;
 }
 
@@ -1045,9 +1105,9 @@ sub checksystem {
     $versretval = system($versioncmd);
     $versnoexec = $!;
 
-    open(VERSOUT, $curlverout);
-    @version = <VERSOUT>;
-    close(VERSOUT);
+    open(my $VERSOUT, "<", $curlverout);
+    @version = <$VERSOUT>;
+    close($VERSOUT);
 
     for(@version) {
         chomp;
@@ -1197,13 +1257,13 @@ sub checksystem {
     }
 
     if(-r "../lib/config.h") {
-        open(CONF, "<../lib/config.h");
-        while(<CONF>) {
+        open(my $CONF, "<", "../lib/config.h");
+        while(<$CONF>) {
             if($_ =~ /^\#define HAVE_GETRLIMIT/) {
                 $has_getrlimit = 1;
             }
         }
-        close(CONF);
+        close($CONF);
     }
 
     if($has_ipv6) {
@@ -1267,6 +1327,7 @@ sub checksystem {
         logmsg sprintf("* TFTP IPv6 port: %d\n", $TFTP6PORT);
     }
     logmsg sprintf("* SCP/SFTP port:  %d\n", $SSHPORT);
+    logmsg sprintf("* SOCKS port:     %d\n", $SOCKSPORT);
 
     if($ssl_version) {
         logmsg sprintf("* SSL library:    %s\n", $ssllib);
@@ -1298,6 +1359,7 @@ sub subVariables {
   $$thing =~ s/%TFTPPORT/$TFTPPORT/g;
   $$thing =~ s/%TFTP6PORT/$TFTP6PORT/g;
   $$thing =~ s/%SSHPORT/$SSHPORT/g;
+  $$thing =~ s/%SOCKSPORT/$SOCKSPORT/g;
   $$thing =~ s/%CURL/$CURL/g;
   $$thing =~ s/%USER/$USER/g;
 
@@ -1412,6 +1474,9 @@ sub singletest {
                 next;
             }
         }
+        elsif($f eq "socks") {
+            next;
+        }
         # See if this "feature" is in the list of supported protocols
         elsif (grep /^$f$/, @protocols) {
             next;
@@ -1567,10 +1632,10 @@ sub singletest {
         my $fileContent = join('', @inputfile);
         subVariables \$fileContent;
 #        logmsg "DEBUG: writing file " . $filename . "\n";
-        open OUTFILE, ">$filename";
-        binmode OUTFILE; # for crapage systems, use binary
-        print OUTFILE $fileContent;
-        close OUTFILE;
+        open my $OUTFILE, ">", $filename;
+        binmode $OUTFILE; # for crapage systems, use binary
+        print $OUTFILE $fileContent;
+        close $OUTFILE;
     }
 
     my %cmdhash = getpartattr("client", "command");
@@ -1626,7 +1691,7 @@ sub singletest {
         logmsg "$CMDLINE\n";
     }
 
-    print CMDLOG "$CMDLINE\n";
+    print $CMDLOG "$CMDLINE\n";
 
     unlink("core");
 
@@ -1648,10 +1713,10 @@ sub singletest {
     }
 
     if($gdbthis) {
-        open(GDBCMD, ">log/gdbcmd");
-        print GDBCMD "set args $cmdargs\n";
-        print GDBCMD "show args\n";
-        close(GDBCMD);
+        open( my $GDBCMD, ">", "log/gdbcmd");
+        print $GDBCMD "set args $cmdargs\n";
+        print $GDBCMD "show args\n";
+        close($GDBCMD);
     }
     # run the command line we built
     if ($torture) {
@@ -1685,9 +1750,9 @@ sub singletest {
         logmsg "core dumped\n";
         if(0 && $gdb) {
             logmsg "running gdb for post-mortem analysis:\n";
-            open(GDBCMD, ">log/gdbcmd2");
-            print GDBCMD "bt\n";
-            close(GDBCMD);
+            open( my $GDBCMD, ">", "log/gdbcmd2");
+            print $GDBCMD "bt\n";
+            close($GDBCMD);
             system("$gdb --directory libtest -x log/gdbcmd2 -batch $DBGCURL core ");
      #       unlink("log/gdbcmd2");
         }
@@ -1963,10 +2028,10 @@ sub singletest {
 
         if($disable[0] !~ /disable/) {
 
-            opendir(DIR, "log") ||
+            opendir( my $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) {
@@ -2183,7 +2248,7 @@ sub startservers {
                 $run{'tftp-ipv6'}="$pid $pid2";
             }
         }
-        elsif($what eq "sftp" || $what eq "scp") {
+        elsif($what eq "sftp" || $what eq "scp" || $what eq "socks4" || $what eq "socks5" ) {
             if(!$run{'ssh'}) {
                 ($pid, $pid2) = runsshserver("", $verbose);
                 if($pid <= 0) {
@@ -2192,6 +2257,29 @@ sub startservers {
                 printf ("* pid ssh => %d %d\n", $pid, $pid2) if($verbose);
                 $run{'ssh'}="$pid $pid2";
             }
+	    if ($what eq "socks4" || $what eq "socks5") {
+                if (!checkcmd("ssh")) {
+                   return "failed to find SSH client for socks support";
+		}
+                if ($what eq "socks5") {
+		   my $sshversion=`ssh -V 2>&1`;
+                   if ($sshversion =~ /SSH_(\d+)\.(\d+)/i) {
+                       if ($1*10+$2 < 37) {
+		       # need 3.7 for socks5 - http://www.openssh.com/txt/release-3.7
+                           return "ssh version ($1.$2) $sshversion insufficient need at least 3.7\n" if ($verbose);
+		       }
+                   }
+                   
+		}
+            	if(!$run{'socks'}) {
+                    ($pid, $pid2) = runsocksserver("", $verbose);
+                    if($pid <= 0) {
+                        return "failed starting socks server";
+                    }
+                    printf ("* pid socks => %d %d\n", $pid, $pid2) if($verbose);
+                    $run{'socks'}="$pid $pid2";
+		}
+	    }
         }
         elsif($what eq "none") {
             logmsg "* starts no server\n" if ($verbose);
@@ -2234,7 +2322,9 @@ sub serverfortest {
     my $proto = lc($what[0]);
     chomp $proto;
     if (! grep /^$proto$/, @protocols) {
-        return "curl lacks $proto support";
+        if (substr($proto,0,5) ne "socks") {
+		return "curl lacks any $proto support";
+        }
     }
 
     return &startservers(@what);
@@ -2373,10 +2463,10 @@ if($valgrind) {
 }
 
 # open the executable curl and read the first 4 bytes of it
-open(CHECK, "<$CURL");
+open(my $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;
@@ -2394,6 +2484,7 @@ $FTP6PORT =  $base + 6; # FTP IPv6 port
 $TFTPPORT =  $base + 7; # TFTP (UDP) port
 $TFTP6PORT =  $base + 8; # TFTP IPv6 (UDP) port
 $SSHPORT =   $base + 9; # SSH (SCP/SFTP) port
+$SOCKSPORT =   $base + 10; # SOCKS port
 
 #######################################################################
 # clear and create logging directory:
@@ -2416,12 +2507,12 @@ if(!$listonly) {
 
 if ( $TESTCASES eq "all") {
     # Get all commands and find out their test numbers
-    opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
-    my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
-    closedir DIR;
+    opendir(my $DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
+    my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir($DIR);
+    closedir $DIR;
 
-    open(D, "$TESTDIR/DISABLED");
-    while(<D>) {
+    open(my $D, "$TESTDIR/DISABLED");
+    while(<$D>) {
         if(/^ *\#/) {
             # allow comments
             next;
@@ -2430,7 +2521,7 @@ if ( $TESTCASES eq "all") {
             $disabled{$1}=$1; # disable this test number
         }
     }
-    close(D);
+    close($D);
 
     $TESTCASES=""; # start with no test cases
 
@@ -2455,7 +2546,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";
 
 #######################################################################
@@ -2600,7 +2691,7 @@ foreach $testnum (@at) {
 #######################################################################
 # Close command log
 #
-close(CMDLOG);
+close($CMDLOG);
 
 # Tests done, stop the servers
 stopservers($verbose);