Commit d3516810 authored by Daniel Stenberg's avatar Daniel Stenberg
Browse files

adjusted to the new test case formats

parent 68af9a22

tests/Makefile.am

+2 −1
Original line number Diff line number Diff line 
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

tests/ftpserver.pl

+10 −8
Original line number Diff line number Diff line
@@ -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";

tests/getpart.pm

0 → 100644
+146 −0
Original line number Diff line number Diff line 


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;

tests/httpserver.pl

+5 −3
Original line number Diff line number Diff line
@@ -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";

tests/runtests.pl

+118 −187
Original line number Diff line number Diff line
@@ -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];



    # 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;

    }



    if ( -f "$TESTDIR/reply${NUMBER}0001.txt" ) {

    # 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";



    # this is the valid protocol file we should generate

    my $PROT="$TESTDIR/prot$NUMBER.txt";

    my @curlcmd= getpart("client", "command");



    # redirected stdout/stderr here

    $STDOUT="$LOGDIR/stdout$NUMBER";

    $STDERR="$LOGDIR/stderr$NUMBER";

    # this is the valid protocol blurb curl should generate

    my @protocol= getpart("verify", "protocol");



    # if this file exists, we verify that the stdout contained this:

    my $VALIDOUT="$TESTDIR/stdout$NUMBER.txt";

    # redirected stdout/stderr to these files

    $STDOUT="$LOGDIR/stdout$testnum";

    $STDERR="$LOGDIR/stderr$testnum";



    # if this file exists, we verify upload

    my $UPLOAD="$TESTDIR/upload$NUMBER.txt";

    # if this section exists, we verify that the stdout contained this:

    my @validstdout = getpart("verify", "stdout");



    # if this file exists, it is FTP server instructions:

    my $ftpservercmd="$TESTDIR/ftpd$NUMBER.txt";

    # if this section exists, we verify upload

    my @upload = getpart("verify", "upload");



    my $CURLOUT="$LOGDIR/curl$NUMBER.out"; # curl output if not stdout

    # if this section exists, it is FTP server instructions:

    my @ftpservercmd = getpart("server", "instruction");



    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";



    if ($res != 0) {

        # the invoked command return an error code

    my @err = getpart("verify", "errorcode");

    my $errorcode = $err[0];



        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 " error FAILED";

                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";