adjusted to the new test case formats (d3516810) · Commits · CYBER - Cyber Security / TS 103 523 MSP / TLMSP / TLMSP curl

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

Admin message