diff options
Diffstat (limited to 'tests/TESTrun')
| -rwxr-xr-x | tests/TESTrun | 502 |
1 files changed, 502 insertions, 0 deletions
diff --git a/tests/TESTrun b/tests/TESTrun new file mode 100755 index 0000000..1843bc5 --- /dev/null +++ b/tests/TESTrun @@ -0,0 +1,502 @@ +#!/usr/bin/env perl + +# +# Were we told where to find tcpdump? +# +if (!($TCPDUMP = $ENV{TCPDUMP_BIN})) { + # + # No. Use the appropriate path. + # + if ($^O eq 'MSWin32') { + # + # XXX - assume, for now, a Visual Studio debug build, so that + # tcpdump is in the Debug subdirectory. + # + $TCPDUMP = "Debug\\tcpdump" + } else { + $TCPDUMP = "./tcpdump" + } +} + +# +# Make true and false work as Booleans. +# +use constant true => 1; +use constant false => 0; + +use File::Basename; +use POSIX qw( WEXITSTATUS WIFEXITED); +use Cwd qw(abs_path getcwd); +use File::Path qw(mkpath); # mkpath works with ancient perl, as well as newer perl +use File::Spec; +use Data::Dumper; # for debugging. + +# these are created in the directory where we are run, which might be +# a build directory. +my $newdir = "tests/NEW"; +my $diffdir= "tests/DIFF"; +mkpath($newdir); +mkpath($diffdir); +my $origdir = getcwd(); +my $srcdir = $ENV{'srcdir'} || "."; +# Default to unified diff and allow to fall back to basic diff if necessary. +my $diff_flags = defined $ENV{'DIFF_FLAGS'} ? $ENV{'DIFF_FLAGS'} : '-u'; + +# +# Force UTC, so time stamps are printed in a standard time zone, and +# tests don't have to be run in the time zone in which the output +# file was generated. +# +$ENV{'TZ'}='GMT0'; + +# +# Get the tests directory from $0. +# +my $testsdir = dirname($0); + +# +# Convert it to an absolute path, so it works even after we do a cd. +# +$testsdir = abs_path($testsdir); +print "Running tests from ${testsdir}\n"; +print "with ${TCPDUMP}, version:\n"; +system "${TCPDUMP} --version"; + +unshift(@INC, $testsdir); + +$passedcount = 0; +$failedcount = 0; +# +my $failureoutput=$origdir . "/tests/failure-outputs.txt"; + +# truncate the output file +open(FAILUREOUTPUT, ">" . $failureoutput); +close(FAILUREOUTPUT); + +$confighhash = undef; + +sub showfile { + local($path) = @_; + + # + # XXX - just do this directly in Perl? + # + if ($^O eq 'MSWin32') { + my $winpath = File::Spec->canonpath($path); + system "type $winpath"; + } else { + system "cat $path"; + } +} + +sub runtest { + local($name, $input, $output, $options) = @_; + my $r; + + $outputbase = basename($output); + my $coredump = false; + my $status = 0; + my $linecount = 0; + my $rawstderrlog = "tests/NEW/${outputbase}.raw.stderr"; + my $stderrlog = "tests/NEW/${outputbase}.stderr"; + my $diffstat = 0; + my $errdiffstat = 0; + + # we used to do this as a nice pipeline, but the problem is that $r fails to + # to be set properly if the tcpdump core dumps. + # + # Furthermore, on Windows, fc can't read the standard input, so we + # can't do it as a pipeline in any case. + $r = system "$TCPDUMP -# -n -r $input $options >tests/NEW/${outputbase} 2>${rawstderrlog}"; + if($r != 0) { + # + # Something other than "tcpdump opened the file, read it, and + # dissected all the packets". What happened? + # + # We write out an exit status after whatever the subprocess + # wrote out, so it shows up when we diff the expected output + # with it. + # + open(OUTPUT, ">>"."tests/NEW/$outputbase") || die "fail to open $outputbase\n"; + if($r == -1) { + # failed to start due to error. + $status = $!; + printf OUTPUT "FAILED TO RUN: status: %d\n", $status; + } else { + if ($^O eq 'MSWin32' or $^O eq 'msys') { + # + # On Windows, the return value of system is the lower 8 + # bits of the exit status of the process, shifted left + # 8 bits. + # + # If the process crashed, rather than exiting, the + # exit status will be one of the EXCEPTION_ values + # listed in the documentation for the GetExceptionCode() + # macro. + # + # Those are defined as STATUS_ values, which should have + # 0xC in the topmost 4 bits (being fatal error + # statuses); some of them have a value that fits in + # the lower 8 bits. We could, I guess, assume that + # any value that 1) isn't returned by tcpdump and 2) + # corresponds to the lower 8 bits of a STATUS_ value + # used as an EXCEPTION_ value indicates that tcpdump + # exited with that exception. + # + # However, as we're running tcpdump with system, which + # runs the command through cmd.exe, and as cmd.exe + # doesn't map the command's exit code to its own exit + # code in any straightforward manner, we can't get + # that information in any case, so there's no point + # in trying to interpret it in that fashion. + # + $status = $r >> 8; + } else { + # + # On UN*Xes, the return status is a POSIX as filled in + # by wait() or waitpid(). + # + # POSIX offers some calls for analyzing it, such as + # WIFSIGNALED() to test whether it indicates that the + # process was terminated by a signal, WTERMSIG() to + # get the signal number from it, WIFEXITED() to test + # whether it indicates that the process exited normally, + # and WEXITSTATUS() to get the exit status from it. + # + # POSIX doesn't standardize core dumps, so the POSIX + # calls can't test whether a core dump occurred. + # However, all the UN*Xes we are likely to encounter + # follow Research UNIX in this regard, with the exit + # status containing either 0 or a signal number in + # the lower 7 bits, with 0 meaning "exited rather + # than being terminated by a signal", the "core dumped" + # flag in the 0x80 bit, and, if the signal number is + # 0, the exit status in the next 8 bits up. + # + # This should be cleaned up to use the POSIX calls + # from the Perl library - and to define an additional + # WCOREDUMP() call to test the "core dumped" bit and + # use that. + # + # But note also that, as we're running tcpdump with + # system, which runs the command through a shell, if + # tcpdump crashes, we'll only know that if the shell + # maps the signal indication and uses that as its + # exit status. + # + # The good news is that the Bourne shell, and compatible + # shells, have traditionally done that. If the process + # for which the shell reports the exit status terminates + # with a signal, it adds 128 to the signal number and + # returns that as its exit status. (This is why the + # "this is now working right" behavior described in a + # comment below is occurring.) + # + # As tcpdump itself never returns with an exit status + # >= 128, we can try checking for an exit status with + # the 0x80 bit set and, if we have one, get the signal + # number from the lower 7 bits of the exit status. We + # can't get the "core dumped" indication from the + # shell's exit status; all we can do is check whether + # there's a core file. + # + if( $r & 128 ) { + $coredump = $r & 127; + } + if( WIFEXITED($r)) { + $status = WEXITSTATUS($r); + } + } + + if($coredump || $status) { + printf OUTPUT "EXIT CODE %08x: dump:%d code: %d\n", $r, $coredump, $status; + } else { + printf OUTPUT "EXIT CODE %08x\n", $r; + } + $r = 0; + } + close(OUTPUT); + } + if($r == 0) { + # + # Compare tcpdump's output with what we think it should be. + # If tcpdump failed to produce output, we've produced our own + # "output" above, with the exit status. + # + if ($^O eq 'MSWin32') { + my $winoutput = File::Spec->canonpath($output); + $r = system "fc /lb1000 /t /1 $winoutput tests\\NEW\\$outputbase >tests\\DIFF\\$outputbase.diff"; + $diffstat = $r >> 8; + } else { + $r = system "diff $diff_flags $output tests/NEW/$outputbase >tests/DIFF/$outputbase.diff"; + $diffstat = WEXITSTATUS($r); + } + } + + # process the standard error file, sanitize "reading from" line, + # and count lines + $linecount = 0; + open(ERRORRAW, "<" . $rawstderrlog); + open(ERROROUT, ">" . $stderrlog); + while(<ERRORRAW>) { + next if /^$/; # blank lines are boring + if(/^(reading from file )(.*)(,.*)$/) { + my $filename = basename($2); + print ERROROUT "${1}${filename}${3}\n"; + next; + } + print ERROROUT; + $linecount++; + } + close(ERROROUT); + close(ERRORRAW); + + if ( -f "$output.stderr" ) { + # + # Compare the standard error with what we think it should be. + # + if ($^O eq 'MSWin32') { + my $winoutput = File::Spec->canonpath($output); + my $canonstderrlog = File::Spec->canonpath($stderrlog); + $nr = system "fc /lb1000 /t /1 $winoutput.stderr $canonstderrlog >tests\DIFF\$outputbase.stderr.diff"; + $errdiffstat = $nr >> 8; + } else { + $nr = system "diff $output.stderr $stderrlog >tests/DIFF/$outputbase.stderr.diff"; + $errdiffstat = WEXITSTATUS($nr); + } + if($r == 0) { + $r = $nr; + } + } + + if($r == 0) { + if($linecount == 0 && $status == 0) { + unlink($stderrlog); + } else { + $errdiffstat = 1; + } + } + + #print sprintf("END: %08x\n", $r); + + if($r == 0) { + if($linecount == 0) { + printf " %-40s: passed\n", $name; + } else { + printf " %-40s: passed with error messages:\n", $name; + showfile($stderrlog); + } + unlink "tests/DIFF/$outputbase.diff"; + return 0; + } + # must have failed! + printf " %-40s: TEST FAILED(exit core=%d/diffstat=%d,%d/r=%d)", $name, $coredump, $diffstat, $errdiffstat, $r; + open FOUT, '>>tests/failure-outputs.txt'; + printf FOUT "\nFailed test: $name\n\n"; + close FOUT; + if(-f "tests/DIFF/$outputbase.diff") { + # + # XXX - just do this directly in Perl? + # + if ($^O eq 'MSWin32') { + system "type tests\\DIFF\\$outputbase.diff >> tests\\failure-outputs.txt"; + } else { + system "cat tests/DIFF/$outputbase.diff >> tests/failure-outputs.txt"; + } + } + + if($r == -1) { + print " (failed to execute: $!)\n"; + return(30); + } + + # this is not working right, $r == 0x8b00 when there is a core dump. + # clearly, we need some platform specific perl magic to take this apart, so look for "core" + # too. + # In particular, on Solaris 10 SPARC an alignment problem results in SIGILL, + # a core dump and $r set to 0x00008a00 ($? == 138 in the shell). + if($r & 127 || -f "core") { + my $with = ($r & 128) ? 'with' : 'without'; + if(-f "core") { + $with = "with"; + } + printf " (terminated with signal %u, %s coredump)", ($r & 127), $with; + if($linecount == 0) { + print "\n"; + } else { + print " with error messages:\n"; + showfile($stderrlog); + } + return(($r & 128) ? 10 : 20); + } + if($linecount == 0) { + print "\n"; + } else { + print " with error messages:\n"; + showfile($stderrlog); + } + return(5); +} + +sub loadconfighash { + if(defined($confighhash)) { + return $confighhash; + } + + $main::confighhash = {}; + + # this could be loaded once perhaps. + open(CONFIG_H, "config.h") || die "Can not open config.h: $!\n"; + while(<CONFIG_H>) { + chomp; + if(/^\#define (.*) 1/) { + #print "Setting $1\n"; + $main::confighhash->{$1} = 1; + } + } + close(CONFIG_H); + #print Dumper($main::confighhash); + + # also run tcpdump --fp-type to get the type of floating-point + # arithmetic we're doing, setting a HAVE_{fptype} key based + # on the value it prints + open(FPTYPE_PIPE, "$TCPDUMP --fp-type |") or die("piping tcpdump --fp-type failed\n"); + my $fptype_val = <FPTYPE_PIPE>; + close(FPTYPE_PIPE); + my $have_fptype; + if($fptype_val == "9877.895") { + $have_fptype = "HAVE_FPTYPE1"; + } else { + $have_fptype = "HAVE_FPTYPE2"; + } + $main::confighhash->{$have_fptype} = 1; + + # and check whether this is OpenBSD, as one test fails in OpenBSD + # due to the sad hellscape of low-numbered DLT_ values, due to + # 12 meaning "OpenBSD loopback" rather than "raw IP" on OpenBSD + if($^O eq "openbsd") { + $main::confighhash->{"IS_OPENBSD"} = 1; + } + + return $main::confighhash; +} + + +sub runOneComplexTest { + local($testconfig) = @_; + + my $output = $testconfig->{output}; + my $input = $testconfig->{input}; + my $name = $testconfig->{name}; + my $options= $testconfig->{args}; + my $foundit = 1; + my $unfoundit=1; + + my $configset = $testconfig->{config_set}; + my $configunset = $testconfig->{config_unset}; + my $ch = loadconfighash(); + #print Dumper($ch); + + if(defined($configset)) { + $foundit = ($ch->{$configset} == 1); + } + if(defined($configunset)) { + $unfoundit=($ch->{$configunset} != 1); + } + + if(!$foundit) { + printf " %-40s: skipped (%s not set)\n", $name, $configset; + return 0; + } + + if(!$unfoundit) { + printf " %-40s: skipped (%s set)\n", $name, $configunset; + return 0; + } + + #use Data::Dumper; + #print Dumper($testconfig); + + # EXPAND any occurrences of @TESTDIR@ to $testsdir + $options =~ s/\@TESTDIR\@/$testsdir/; + + my $result = runtest($name, + $testsdir . "/" . $input, + $testsdir . "/" . $output, + $options); + + if($result == 0) { + $passedcount++; + } else { + $failedcount++; + } +} + +# *.tests files are PERL hash definitions. They should create an array of hashes +# one per test, and place it into the variable @testlist. +sub runComplexTests { + my @files = glob( $testsdir . '/*.tests' ); + foreach $file (@files) { + my @testlist = undef; + my $definitions; + print "FILE: ${file}\n"; + open(FILE, "<".$file) || die "can not open $file: $!"; + { + local $/ = undef; + $definitions = <FILE>; + } + close(FILE); + #print "STUFF: ${definitions}\n"; + eval $definitions; + if(defined($testlist)) { + #use Data::Dumper; + #print Dumper($testlist); + foreach $test (@$testlist) { + runOneComplexTest($test); + } + } else { + warn "File: ${file} could not be loaded as PERL: $!"; + } + } +} + +sub runSimpleTests { + + local($only)=@_; + + open(TESTLIST, "<" . "${testsdir}/TESTLIST") || die "no ${testsdir}/TESTFILE: $!\n"; + while(<TESTLIST>) { + next if /^\#/; + next if /^$/; + + unlink("core"); + ($name, $input, $output, @options) = split; + #print "processing ${only} vs ${name}\n"; + next if(defined($only) && $only ne $name); + + my $options = join(" ", @options); + #print "@{options} becomes ${options}\n"; + + my $hash = { name => $name, + input=> $input, + output=>$output, + args => $options }; + + runOneComplexTest($hash); + } +} + +if(scalar(@ARGV) == 0) { + runSimpleTests(); + runComplexTests(); +} else { + runSimpleTests($ARGV[0]); +} + +# exit with number of failing tests. +print "------------------------------------------------\n"; +printf("%4u tests failed\n",$failedcount); +printf("%4u tests passed\n",$passedcount); + +showfile(${failureoutput}); +exit $failedcount; |