generic-library/curl
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

Browse Source 
openssh
This commit is contained in:
Daniel Stenberg
2007-06-05 13:50:59 +00:00
parent 48064f8dee
commit a466b31574
11 changed files with 437 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

211
tests/runtests.pl
View File

@@ -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
@@ -951,6 +977,40 @@ sub runsshserver {
return ($pid2, $sshpid);
}
#######################################################################
# 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
#
@@ -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);