493 lines
16 KiB
Perl
Executable File
493 lines
16 KiB
Perl
Executable File
#!/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, 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'} || ".";
|
|
|
|
#
|
|
# 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') {
|
|
#
|
|
# 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 $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;
|
|
|
|
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;
|