mirror of
https://github.com/moparisthebest/curl
synced 2024-12-21 23:58:49 -05:00
adjusted to the new test case formats
This commit is contained in:
Daniel Stenberg
parent
68af9a222e
commit
d3516810a7
@ -1,4 +1,5 @@
|
||||
EXTRA_DIST = ftpserver.pl httpserver.pl runtests.pl ftpsserver.pl stunnel.pm
|
||||
EXTRA_DIST = ftpserver.pl httpserver.pl runtests.pl ftpsserver.pl stunnel.pm \
|
||||
getpart.pm
|
||||
|
||||
SUBDIRS = data
|
||||
|
||||
|
||||
@ -16,6 +16,8 @@ use FileHandle;
|
||||
|
||||
use strict;
|
||||
|
||||
require "getpart.pm";
|
||||
|
||||
open(FTPLOG, ">log/ftpd.log") ||
|
||||
print STDERR "failed to open log file, runs without logging\n";
|
||||
|
||||
@ -190,27 +192,27 @@ sub RETR_command {
|
||||
return 0;
|
||||
}
|
||||
|
||||
my $filename = "data/reply$testno.txt";
|
||||
loadtest("data/test$testno");
|
||||
|
||||
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
|
||||
$atime,$mtime,$ctime,$blksize,$blocks)
|
||||
= stat($filename);
|
||||
my @data = getpart("reply", "data");
|
||||
|
||||
my $size=0;
|
||||
for(@data) {
|
||||
$size =+ length($_);
|
||||
}
|
||||
|
||||
if($size) {
|
||||
|
||||
open(FILE, "<$filename");
|
||||
if($rest) {
|
||||
# move read pointer forward
|
||||
seek(FILE, $rest, 1);
|
||||
$size -= $rest;
|
||||
}
|
||||
print "150 Binary data connection for $testno () ($size bytes).\r\n";
|
||||
$rest=0; # reset rest again
|
||||
|
||||
while(<FILE>) {
|
||||
for(@data) {
|
||||
print SOCK $_;
|
||||
}
|
||||
close(FILE);
|
||||
close(SOCK);
|
||||
|
||||
print "226 File transfer complete\r\n";
|
||||
|
||||
146
tests/getpart.pm
Normal file
146
tests/getpart.pm
Normal file
@ -0,0 +1,146 @@
|
||||
|
||||
use strict;
|
||||
|
||||
my @xml;
|
||||
|
||||
sub getpart {
|
||||
my ($section, $part)=@_;
|
||||
|
||||
my @this;
|
||||
my $inside=0;
|
||||
|
||||
# print "Section: $section, part: $part\n";
|
||||
|
||||
for(@xml) {
|
||||
# print "$inside: $_";
|
||||
if(!$inside && ($_ =~ /^ *\<$section/)) {
|
||||
$inside++;
|
||||
}
|
||||
elsif((1 ==$inside) && ($_ =~ /^ *\<$part/)) {
|
||||
$inside++;
|
||||
}
|
||||
elsif((2 ==$inside) && ($_ =~ /^ *\<\/$part/)) {
|
||||
$inside--;
|
||||
}
|
||||
elsif((1==$inside) && ($_ =~ /^ *\<\/$section/)) {
|
||||
return @this;
|
||||
}
|
||||
elsif(2==$inside) {
|
||||
push @this, $_;
|
||||
}
|
||||
}
|
||||
return @this; #empty!
|
||||
}
|
||||
|
||||
sub loadtest {
|
||||
my ($file)=@_;
|
||||
|
||||
undef @xml;
|
||||
open(XML, "<$file") ||
|
||||
return 1; # failure!
|
||||
while(<XML>) {
|
||||
push @xml, $_;
|
||||
}
|
||||
close(XML);
|
||||
return 0;
|
||||
}
|
||||
|
||||
#
|
||||
# Strip off all lines that match the specified pattern and return
|
||||
# the new array.
|
||||
#
|
||||
|
||||
sub striparray {
|
||||
my ($pattern, $arrayref) = @_;
|
||||
|
||||
my @array;
|
||||
|
||||
for(@$arrayref) {
|
||||
if($_ !~ /$pattern/) {
|
||||
push @array, $_;
|
||||
}
|
||||
}
|
||||
return @array;
|
||||
}
|
||||
|
||||
#
|
||||
# pass array *REFERENCES* !
|
||||
#
|
||||
sub compareparts {
|
||||
my ($firstref, $secondref)=@_;
|
||||
|
||||
my $sizefirst=scalar(@$firstref);
|
||||
my $sizesecond=scalar(@$secondref);
|
||||
|
||||
if($sizefirst != $sizesecond) {
|
||||
return -1;
|
||||
}
|
||||
|
||||
for(1 .. $sizefirst) {
|
||||
my $index = $_ - 1;
|
||||
if($firstref->[$index] ne $secondref->[$index]) {
|
||||
return 1+$index;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
#
|
||||
# Write a given array to the specified file
|
||||
#
|
||||
sub writearray {
|
||||
my ($filename, $arrayref)=@_;
|
||||
|
||||
open(TEMP, ">$filename");
|
||||
for(@$arrayref) {
|
||||
print TEMP $_;
|
||||
}
|
||||
close(TEMP);
|
||||
}
|
||||
|
||||
#
|
||||
# Load a specified file an return it as an array
|
||||
#
|
||||
sub loadarray {
|
||||
my ($filename)=@_;
|
||||
my @array;
|
||||
|
||||
open(TEMP, "<$filename");
|
||||
while(<TEMP>) {
|
||||
push @array, $_;
|
||||
}
|
||||
close(TEMP);
|
||||
return @array;
|
||||
}
|
||||
|
||||
#
|
||||
# Given two array references, this function will store them in two
|
||||
# temporary files, run 'diff' on them, store the result, remove the
|
||||
# temp files and return the diff output!
|
||||
#
|
||||
sub showdiff {
|
||||
my ($firstref, $secondref)=@_;
|
||||
|
||||
my $file1=".array1";
|
||||
my $file2=".array2";
|
||||
|
||||
open(TEMP, ">$file1");
|
||||
for(@$firstref) {
|
||||
print TEMP $_;
|
||||
}
|
||||
close(TEMP);
|
||||
|
||||
open(TEMP, ">$file2");
|
||||
for(@$secondref) {
|
||||
print TEMP $_;
|
||||
}
|
||||
close(TEMP);
|
||||
|
||||
my @out = `diff $file1 $file2`;
|
||||
|
||||
unlink $file1, $file2;
|
||||
return @out;
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
@ -5,6 +5,8 @@ use FileHandle;
|
||||
|
||||
use strict;
|
||||
|
||||
require "getpart.pm";
|
||||
|
||||
sub spawn; # forward declaration
|
||||
sub logmsg { #print "$0 $$: @_ at ", scalar localtime, "\n"
|
||||
}
|
||||
@ -140,15 +142,15 @@ for ( $waitedpid = 0;
|
||||
"You must enter a test number to get good data back\r\n";
|
||||
}
|
||||
else {
|
||||
loadtest("data/test$testnum");
|
||||
# send a custom reply to the client
|
||||
open(DATA, "<data/reply$testnum.txt");
|
||||
while(<DATA>) {
|
||||
my @data = getpart("reply", "data");
|
||||
for(@data) {
|
||||
print $_;
|
||||
if($verbose) {
|
||||
print STDERR "OUT: $_";
|
||||
}
|
||||
}
|
||||
close(DATA);
|
||||
}
|
||||
}
|
||||
# print "Hello there, $name, it's now ", scalar localtime, "\r\n";
|
||||
|
||||
@ -10,7 +10,8 @@ use strict;
|
||||
|
||||
@INC=(@INC, $ENV{'srcdir'}, ".");
|
||||
|
||||
require "stunnel.pm";
|
||||
require "stunnel.pm"; # stunnel functions
|
||||
require "getpart.pm"; # array functions
|
||||
|
||||
my $srcdir = $ENV{'srcdir'} || '.';
|
||||
my $HOSTIP="127.0.0.1";
|
||||
@ -261,40 +262,6 @@ sub runftpsserver {
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#######################################################################
|
||||
# This function compares two binary files and return non-zero if they
|
||||
# differ
|
||||
#
|
||||
sub comparefiles {
|
||||
my $source=$_[0];
|
||||
my $dest=$_[1];
|
||||
my $res=0;
|
||||
|
||||
open(S, "<$source") ||
|
||||
return 1;
|
||||
open(D, "<$dest") ||
|
||||
return 1;
|
||||
|
||||
# silly win-crap
|
||||
binmode S;
|
||||
binmode D;
|
||||
|
||||
my $m = 20;
|
||||
my ($snum, $dnum, $s, $d);
|
||||
do {
|
||||
$snum = read(S, $s, $m);
|
||||
$dnum = read(D, $d, $m);
|
||||
if(($snum != $dnum) ||
|
||||
($s ne $d)) {
|
||||
return 1;
|
||||
}
|
||||
} while($snum);
|
||||
close(S);
|
||||
close(D);
|
||||
return $res;
|
||||
}
|
||||
|
||||
#######################################################################
|
||||
# Remove all files in the specified directory
|
||||
#
|
||||
@ -350,32 +317,14 @@ sub filteroff {
|
||||
sub compare {
|
||||
# filter off the 4 pattern before compare!
|
||||
|
||||
my $first=$_[0];
|
||||
my $sec=$_[1];
|
||||
my $text=$_[2];
|
||||
my $strip=$_[3];
|
||||
my $res;
|
||||
my ($firstref, $secondref)=@_;
|
||||
|
||||
if ($strip ne "") {
|
||||
filteroff($first, $strip, "$LOGDIR/generated.tmp");
|
||||
filteroff($sec, $strip, "$LOGDIR/stored.tmp");
|
||||
my $result = compareparts($firstref, $secondref);
|
||||
|
||||
$first="$LOGDIR/generated.tmp";
|
||||
$sec="$LOGDIR/stored.tmp";
|
||||
if(!$short && $result) {
|
||||
print showdiff($firstref, $secondref);
|
||||
}
|
||||
|
||||
$res = comparefiles($first, $sec);
|
||||
if ($res != 0) {
|
||||
print " $text FAILED\n";
|
||||
print "=> diff $first $sec' looks like (\">\" added by runtime):\n";
|
||||
print `diff $sec $first`;
|
||||
return 1;
|
||||
}
|
||||
|
||||
if(!$short) {
|
||||
print " $text OK";
|
||||
}
|
||||
return 0;
|
||||
return $result;
|
||||
}
|
||||
|
||||
#######################################################################
|
||||
@ -424,71 +373,70 @@ sub displaydata {
|
||||
#
|
||||
|
||||
sub singletest {
|
||||
my $NUMBER=$_[0];
|
||||
my $REPLY="${TESTDIR}/reply${NUMBER}.txt";
|
||||
my $testnum=$_[0];
|
||||
|
||||
if ( -f "$TESTDIR/reply${NUMBER}0001.txt" ) {
|
||||
# load the test case file definition
|
||||
if(loadtest("${TESTDIR}/test${testnum}")) {
|
||||
if($verbose) {
|
||||
# this is not a test
|
||||
print "$testnum doesn't look like a test case!\n";
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
# extract the reply data
|
||||
my @reply = getpart("reply", "data");
|
||||
my @replycheck = getpart("reply", "datacheck");
|
||||
|
||||
if (@replycheck) {
|
||||
# we use this file instead to check the final output against
|
||||
$REPLY="$TESTDIR/reply${NUMBER}0001.txt";
|
||||
@reply=@replycheck;
|
||||
}
|
||||
|
||||
# curl command to run
|
||||
my $CURLCMD="$TESTDIR/command$NUMBER.txt";
|
||||
my @curlcmd= getpart("client", "command");
|
||||
|
||||
# this is the valid protocol file we should generate
|
||||
my $PROT="$TESTDIR/prot$NUMBER.txt";
|
||||
# this is the valid protocol blurb curl should generate
|
||||
my @protocol= getpart("verify", "protocol");
|
||||
|
||||
# redirected stdout/stderr here
|
||||
$STDOUT="$LOGDIR/stdout$NUMBER";
|
||||
$STDERR="$LOGDIR/stderr$NUMBER";
|
||||
# redirected stdout/stderr to these files
|
||||
$STDOUT="$LOGDIR/stdout$testnum";
|
||||
$STDERR="$LOGDIR/stderr$testnum";
|
||||
|
||||
# if this file exists, we verify that the stdout contained this:
|
||||
my $VALIDOUT="$TESTDIR/stdout$NUMBER.txt";
|
||||
# if this section exists, we verify that the stdout contained this:
|
||||
my @validstdout = getpart("verify", "stdout");
|
||||
|
||||
# if this file exists, we verify upload
|
||||
my $UPLOAD="$TESTDIR/upload$NUMBER.txt";
|
||||
# if this section exists, we verify upload
|
||||
my @upload = getpart("verify", "upload");
|
||||
|
||||
# if this file exists, it is FTP server instructions:
|
||||
my $ftpservercmd="$TESTDIR/ftpd$NUMBER.txt";
|
||||
# if this section exists, it is FTP server instructions:
|
||||
my @ftpservercmd = getpart("server", "instruction");
|
||||
|
||||
my $CURLOUT="$LOGDIR/curl$NUMBER.out"; # curl output if not stdout
|
||||
|
||||
if(! -r $CURLCMD) {
|
||||
if($verbose) {
|
||||
# this is not a test
|
||||
print "$NUMBER doesn't look like a test case!\n";
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
|
||||
|
||||
# remove previous server output logfile
|
||||
unlink($SERVERIN);
|
||||
|
||||
if(-r $ftpservercmd) {
|
||||
# copy the instruction file
|
||||
system("cp $ftpservercmd $FTPDCMD");
|
||||
if(@ftpservercmd) {
|
||||
# write the instructions to file
|
||||
writearray($FTPDCMD, \@ftpservercmd);
|
||||
}
|
||||
|
||||
# name of the test
|
||||
open(N, "<$TESTDIR/name$NUMBER.txt") ||
|
||||
return -1; # not a test
|
||||
my $DESC=<N>;
|
||||
close(N);
|
||||
$DESC =~ s/[\r\n]//g;
|
||||
my @testname= getpart("client", "name");
|
||||
|
||||
print "test $NUMBER...";
|
||||
print "test $testnum...";
|
||||
if(!$short) {
|
||||
print "[$DESC]\n";
|
||||
my $name = $testname[0];
|
||||
$name =~ s/\n//g;
|
||||
print "[$name]\n";
|
||||
}
|
||||
|
||||
# get the command line options to use
|
||||
|
||||
open(COMMAND, "<$CURLCMD");
|
||||
my $cmd=<COMMAND>;
|
||||
chomp $cmd;
|
||||
close(COMMAND);
|
||||
my ($cmd, @blaha)= getpart("client", "command");
|
||||
|
||||
# make some nice replace operations
|
||||
$cmd =~ s/\n//g; # no newlines please
|
||||
$cmd =~ s/%HOSTIP/$HOSTIP/g;
|
||||
$cmd =~ s/%HOSTPORT/$HOSTPORT/g;
|
||||
$cmd =~ s/%HTTPSPORT/$HTTPSPORT/g;
|
||||
@ -502,16 +450,20 @@ sub singletest {
|
||||
}
|
||||
|
||||
my $out="";
|
||||
if ( ! -r "$VALIDOUT" ) {
|
||||
if (!@validstdout) {
|
||||
$out="--output $CURLOUT ";
|
||||
}
|
||||
|
||||
# run curl, add -v for debug information output
|
||||
my $cmdargs="$out--include -v --silent $cmd";
|
||||
|
||||
my $STDINFILE="$TESTDIR/stdin$NUMBER.txt";
|
||||
if(-f $STDINFILE) {
|
||||
$cmdargs .= " < $STDINFILE";
|
||||
my @stdintest = getpart("verify", "stdin");
|
||||
|
||||
if(@stdintest) {
|
||||
my $stdinfile="$LOGDIR/stdin-for-$testnum";
|
||||
writearray($stdinfile, \@stdintest);
|
||||
|
||||
$cmdargs .= " <$stdinfile";
|
||||
}
|
||||
my $CMDLINE="$CURL $cmdargs >$STDOUT 2>$STDERR";
|
||||
|
||||
@ -536,93 +488,80 @@ sub singletest {
|
||||
$res /= 256;
|
||||
}
|
||||
|
||||
my $ERRORCODE = "$TESTDIR/error$NUMBER.txt";
|
||||
my @err = getpart("verify", "errorcode");
|
||||
my $errorcode = $err[0];
|
||||
|
||||
if ($res != 0) {
|
||||
# the invoked command return an error code
|
||||
|
||||
my $expectederror=0;
|
||||
|
||||
if(-f $ERRORCODE) {
|
||||
open(ERRO, "<$ERRORCODE");
|
||||
$expectederror = <ERRO>;
|
||||
close(ERRO);
|
||||
# strip non-digits
|
||||
$expectederror =~ s/[^0-9]//g;
|
||||
}
|
||||
|
||||
if($expectederror != $res) {
|
||||
|
||||
print "*** Failed to invoke curl for test $NUMBER ***\n",
|
||||
"*** [$DESC] ***\n",
|
||||
"*** The command returned $res for: ***\n $CMDLINE\n";
|
||||
return 1;
|
||||
}
|
||||
elsif(!$short) {
|
||||
if($errorcode || $res) {
|
||||
if($errorcode == $res) {
|
||||
if(!$short) {
|
||||
print " error OK";
|
||||
}
|
||||
}
|
||||
else {
|
||||
if(-f $ERRORCODE) {
|
||||
# this command was meant to fail, it didn't and thats WRONG
|
||||
if(!$short) {
|
||||
print "curl returned $res\n";
|
||||
}
|
||||
print " error FAILED";
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
if ( -r "$VALIDOUT" ) {
|
||||
if (@validstdout) {
|
||||
# verify redirected stdout
|
||||
$res = compare($STDOUT, $VALIDOUT, "data");
|
||||
my @actual = loadarray($STDOUT);
|
||||
|
||||
$res = compare(\@actual, \@validstdout);
|
||||
if($res) {
|
||||
print " stdout FAILED";
|
||||
return 1;
|
||||
}
|
||||
if(!$short) {
|
||||
print " stdout OK";
|
||||
}
|
||||
else {
|
||||
if (! -r $REPLY && -r $CURLOUT) {
|
||||
print "** Missing reply data file for test $NUMBER",
|
||||
", should be similar to $CURLOUT\n";
|
||||
return 1;
|
||||
}
|
||||
|
||||
if( -r $CURLOUT ) {
|
||||
if(@reply) {
|
||||
# verify the received data
|
||||
$res = compare($CURLOUT, $REPLY, "data");
|
||||
my @out = loadarray($CURLOUT);
|
||||
$res = compare(\@out, \@reply);
|
||||
if ($res) {
|
||||
print " data FAILED";
|
||||
return 1;
|
||||
}
|
||||
if(!$short) {
|
||||
print " data OK";
|
||||
}
|
||||
}
|
||||
|
||||
if(-r $UPLOAD) {
|
||||
if(@upload) {
|
||||
# verify uploaded data
|
||||
$res = compare("$LOGDIR/upload.$NUMBER", $UPLOAD, "upload");
|
||||
my @out = loadarray("$LOGDIR/upload.$testnum");
|
||||
$res = compare(\@out, \@upload);
|
||||
if ($res) {
|
||||
print " upload FAILED";
|
||||
return 1;
|
||||
}
|
||||
if(!$short) {
|
||||
print " upload OK";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
if(-r $SERVERIN) {
|
||||
if(! -r $PROT) {
|
||||
print "** Missing protocol file for test $NUMBER",
|
||||
", should be similar to $SERVERIN\n";
|
||||
return 1;
|
||||
}
|
||||
|
||||
# The strip pattern below is for stripping off User-Agent: since
|
||||
# that'll be different in all versions, and the lines in a
|
||||
# RFC1876-post that are randomly generated and therefore are
|
||||
# doomed to always differ!
|
||||
|
||||
if(@protocol) {
|
||||
# verify the sent request
|
||||
$res = compare($SERVERIN, $PROT, "protocol",
|
||||
"^(User-Agent:|--curl|Content-Type: multipart/form-data; boundary=|PORT ).*\r\n");
|
||||
my @out = loadarray($SERVERIN);
|
||||
|
||||
# what to cut off from the live protocol sent by curl
|
||||
my @strip = getpart("verify", "strip");
|
||||
@out = striparray( $strip[0], \@out);
|
||||
|
||||
$res = compare(\@out, \@protocol);
|
||||
if($res) {
|
||||
print " protocol FAILED";
|
||||
return 1;
|
||||
}
|
||||
if(!$short) {
|
||||
print " protocol OK";
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
if(!$keepoutfiles) {
|
||||
@ -631,7 +570,7 @@ sub singletest {
|
||||
unlink($STDERR);
|
||||
unlink($CURLOUT); # remove the downloaded results
|
||||
|
||||
unlink("$LOGDIR/upload.$NUMBER"); # remove upload leftovers
|
||||
unlink("$LOGDIR/upload.$testnum"); # remove upload leftovers
|
||||
}
|
||||
|
||||
unlink($FTPDCMD); # remove the instructions for this test
|
||||
@ -672,6 +611,11 @@ sub singletest {
|
||||
|
||||
my %run;
|
||||
|
||||
##############################################################################
|
||||
# This function makes sure the right set of server is running for the
|
||||
# specified test case. This is a useful design when we run single tests as not
|
||||
# all servers need to run then!
|
||||
|
||||
sub serverfortest {
|
||||
my ($testnum)=@_;
|
||||
|
||||
@ -818,16 +762,6 @@ displaydata();
|
||||
cleardir($LOGDIR);
|
||||
mkdir($LOGDIR, 0777);
|
||||
|
||||
#######################################################################
|
||||
# First, start our test servers
|
||||
#
|
||||
|
||||
#runhttpserver($verbose);
|
||||
#runftpserver($verbose);
|
||||
#runhttpsserver($verbose);
|
||||
|
||||
#sleep 1; # start-up time
|
||||
|
||||
#######################################################################
|
||||
# If 'all' tests are requested, find out all test numbers
|
||||
#
|
||||
@ -835,7 +769,7 @@ mkdir($LOGDIR, 0777);
|
||||
if ( $TESTCASES eq "all") {
|
||||
# Get all commands and find out their test numbers
|
||||
opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
|
||||
my @cmds = grep { /^command([0-9]+).txt/ && -f "$TESTDIR/$_" } readdir(DIR);
|
||||
my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
|
||||
closedir DIR;
|
||||
|
||||
$TESTCASES=""; # start with no test cases
|
||||
@ -883,12 +817,12 @@ foreach $testnum (split(" ", $TESTCASES)) {
|
||||
$total++;
|
||||
}
|
||||
if($error>0) {
|
||||
$failed.= "$testnum ";
|
||||
if(!$anyway) {
|
||||
# a test failed, abort
|
||||
print "\n - abort tests\n";
|
||||
last;
|
||||
}
|
||||
$failed.= "$testnum ";
|
||||
}
|
||||
elsif(!$error) {
|
||||
$ok++;
|
||||
@ -909,9 +843,6 @@ close(CMDLOG);
|
||||
for(keys %run) {
|
||||
stopserver($run{$_}); # the pid file is in the hash table
|
||||
}
|
||||
#stopserver($FTPPIDFILE);
|
||||
#stopserver($PIDFILE);
|
||||
#stopserver($HTTPSPIDFILE);
|
||||
|
||||
if($total) {
|
||||
print "$ok tests out of $total reported OK\n";
|
||||
|
||||
Loading…
Reference in New Issue
Block a user