tcpdump/tests/TESTonce

#!/usr/bin/env perl

$TCPDUMP = "../tcpdump" if (!($TCPDUMP = $ENV{TCPDUMP_BIN}));

use File::Basename;
use POSIX qw( WEXITSTATUS WIFEXITED);

system("mkdir -p NEW DIFF");

if(@ARGV != 4) {
  print "Usage: TESTonce name input output options\n";
  exit 20;
}

$name=$ARGV[0];
$input=$ARGV[1];
$output=$ARGV[2];
$options=$ARGV[3];

my $r;

$outputbase = basename($output);
my $coredump = false;
my $status = 0;
my $linecount = 0;
my $rawstderrlog = "NEW/${outputbase}.raw.stderr";
my $stderrlog = "NEW/${outputbase}.stderr";
my $diffstat = 0;
my $errdiffstat = 0;

if ($^O eq 'MSWin32') {
    $r = system "..\\windump -# -n -r $input $options 2>NUL | sed 's/\\r//' | tee NEW/$outputbase | diff $output - >DIFF/$outputbase.diff";
    # need to do same as below for Cygwin.
}
else {
    # 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.
    $r = system "$TCPDUMP 2>${rawstderrlog} -# -n -r $input $options >NEW/${outputbase}";
    if($r == -1) {
        # failed to start due to error.
        $status = $!;
    }
    if($r != 0) {
        $coredump = false;
        $status = 0;
        # this means tcpdump failed.
        open(OUTPUT, ">>"."NEW/$outputbase") || die "fail to open $outputbase\n";
        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;
        }
        close(OUTPUT);
        $r = 0;
    }
    if($r == 0) {
        $r = system "cat NEW/$outputbase | diff $output - >DIFF/$outputbase.diff";
        $diffstat = WEXITSTATUS($r);
    }

    # process the 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" ) {
        $nr = system "cat $stderrlog | diff $output.stderr - >DIFF/$outputbase.stderr.diff";
        if($r == 0) {
            $r = $nr;
        }
        $errdiffstat = WEXITSTATUS($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 "    %-35s: passed\n", $name;
    } else {
        printf "    %-35s: passed with error messages:\n", $name;
        system "cat $stderrlog";
    }
    unlink "DIFF/$outputbase.diff";
    exit 0;
}
# must have failed!
printf "    %-35s: TEST FAILED(exit core=%d/diffstat=%d,%d/r=%d)", $name, $coredump, $diffstat, $errdiffstat, $r;
open FOUT, '>>failure-outputs.txt';
printf FOUT "\nFailed test: $name\n\n";
close FOUT;
if(-f "DIFF/$outputbase.diff") {
    system "cat DIFF/$outputbase.diff >> failure-outputs.txt";
}

if($r == -1) {
  print " (failed to execute: $!)\n";
  exit 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";
        system "cat $stderrlog";
    }
    exit ($r & 128) ? 10 : 20;
}
if($linecount == 0) {
    print "\n";
} else {
    print " with error messages:\n";
    system "cat $stderrlog";
}
exit $r >> 8;