xref: /netbsd-src/external/bsd/tcpdump/dist/tests/TESTrun (revision 4439cfd0acf9c7dc90625e5cd83b2317a9ab8967) 
1#!/usr/bin/env perl
2
3#
4# Were we told where to find tcpdump?
5#
6if (!($TCPDUMP = $ENV{TCPDUMP_BIN})) {
7    #
8    # No.  Use the appropriate path.
9    #
10    if ($^O eq 'MSWin32') {
11        #
12        # XXX - assume, for now, a Visual Studio debug build, so that
13        # tcpdump is in the Debug subdirectory.
14        #
15        $TCPDUMP = "Debug\\tcpdump.exe"
16    } else {
17        $TCPDUMP = "./tcpdump"
18    }
19}
20
21#
22# Make true and false work as Booleans.
23#
24use constant true => 1;
25use constant false => 0;
26
27use File::Basename;
28use POSIX qw( WEXITSTATUS WIFEXITED);
29use Cwd qw(abs_path getcwd);
30use File::Path qw(mkpath);   # mkpath works with ancient perl, as well as newer perl
31use File::Spec;
32use Data::Dumper;            # for debugging.
33
34# these are created in the directory where we are run, which might be
35# a build directory.
36my $newdir = "tests/NEW";
37my $diffdir= "tests/DIFF";
38mkpath($newdir);
39mkpath($diffdir);
40my $origdir = getcwd();
41my $srcdir  = $ENV{'srcdir'} || ".";
42# Default to unified diff and allow to fall back to basic diff if necessary.
43my $diff_flags = defined $ENV{'DIFF_FLAGS'} ? $ENV{'DIFF_FLAGS'} : '-u';
44
45#
46# Force UTC, so time stamps are printed in a standard time zone, and
47# tests don't have to be run in the time zone in which the output
48# file was generated.
49#
50$ENV{'TZ'}='GMT0';
51
52#
53# Get the tests directory from $0.
54#
55my $testsdir = dirname($0);
56
57#
58# Convert it to an absolute path, so it works even after we do a cd.
59#
60$testsdir = abs_path($testsdir);
61print "Running tests from ${testsdir}\n";
62print "with ${TCPDUMP}, version:\n";
63system "${TCPDUMP} --version";
64
65unshift(@INC, $testsdir);
66
67$passedcount = 0;
68$failedcount = 0;
69$skippedcount = 0;
70#
71my $failureoutput=$origdir . "/tests/failure-outputs.txt";
72
73# truncate the output file
74open(FAILUREOUTPUT, ">" . $failureoutput);
75close(FAILUREOUTPUT);
76
77$confighhash = undef;
78
79sub showfile {
80    local($path) = @_;
81
82    #
83    # XXX - just do this directly in Perl?
84    #
85    if ($^O eq 'MSWin32') {
86        my $winpath = File::Spec->canonpath($path);
87        system "type $winpath";
88    } else {
89        system "cat $path";
90    }
91}
92
93sub runtest {
94    local($name, $input, $output, $options) = @_;
95    my $r;
96
97    $outputbase = basename($output);
98    my $coredump = false;
99    my $status = 0;
100    my $linecount = 0;
101    my $rawstderrlog = "${newdir}/${outputbase}.raw.stderr";
102    my $stderrlog = "${newdir}/${outputbase}.stderr";
103    my $diffstat = 0;
104    my $errdiffstat = 0;
105
106    # we used to do this as a nice pipeline, but the problem is that $r fails to
107    # to be set properly if the tcpdump core dumps.
108    #
109    # Furthermore, on Windows, fc can't read the standard input, so we
110    # can't do it as a pipeline in any case.
111    if (index($options, "SPECIAL_t") != -1) {
112        # Hack to keep specific time options for tcp-handshake-micro-t, etc.
113        # -t, -tt, etc.
114        $options =~ s/ SPECIAL_t//;
115    } else {
116        # No specific time option, use -tttt
117        $options .= " -tttt";
118    }
119    $r = system "$TCPDUMP -# -n -r $input $options >${newdir}/${outputbase} 2>${rawstderrlog}";
120
121    if($r != 0) {
122        #
123        # Something other than "tcpdump opened the file, read it, and
124        # dissected all the packets".  What happened?
125        #
126        # We write out an exit status after whatever the subprocess
127        # wrote out, so it shows up when we diff the expected output
128        # with it.
129        #
130        open(OUTPUT, ">>"."${newdir}/$outputbase") || die "fail to open $outputbase\n";
131        if($r == -1) {
132            # failed to start due to error.
133            $status = $!;
134            printf OUTPUT "FAILED TO RUN: status: %d\n", $status;
135        } else {
136            if ($^O eq 'MSWin32' or $^O eq 'msys') {
137                #
138                # On Windows, the return value of system is the lower 8
139                # bits of the exit status of the process, shifted left
140                # 8 bits.
141                #
142                # If the process crashed, rather than exiting, the
143                # exit status will be one of the EXCEPTION_ values
144                # listed in the documentation for the GetExceptionCode()
145                # macro.
146                #
147                # Those are defined as STATUS_ values, which should have
148                # 0xC in the topmost 4 bits (being fatal error
149                # statuses); some of them have a value that fits in
150                # the lower 8 bits.  We could, I guess, assume that
151                # any value that 1) isn't returned by tcpdump and 2)
152                # corresponds to the lower 8 bits of a STATUS_ value
153                # used as an EXCEPTION_ value indicates that tcpdump
154                # exited with that exception.
155                #
156                # However, as we're running tcpdump with system, which
157                # runs the command through cmd.exe, and as cmd.exe
158                # doesn't map the command's exit code to its own exit
159                # code in any straightforward manner, we can't get
160                # that information in any case, so there's no point
161                # in trying to interpret it in that fashion.
162                #
163                $status = $r >> 8;
164            } else {
165                #
166                # On UN*Xes, the return status is a POSIX as filled in
167                # by wait() or waitpid().
168                #
169                # POSIX offers some calls for analyzing it, such as
170                # WIFSIGNALED() to test whether it indicates that the
171                # process was terminated by a signal, WTERMSIG() to
172                # get the signal number from it, WIFEXITED() to test
173                # whether it indicates that the process exited normally,
174                # and WEXITSTATUS() to get the exit status from it.
175                #
176                # POSIX doesn't standardize core dumps, so the POSIX
177                # calls can't test whether a core dump occurred.
178                # However, all the UN*Xes we are likely to encounter
179                # follow Research UNIX in this regard, with the exit
180                # status containing either 0 or a signal number in
181                # the lower 7 bits, with 0 meaning "exited rather
182                # than being terminated by a signal", the "core dumped"
183                # flag in the 0x80 bit, and, if the signal number is
184                # 0, the exit status in the next 8 bits up.
185                #
186                # This should be cleaned up to use the POSIX calls
187                # from the Perl library - and to define an additional
188                # WCOREDUMP() call to test the "core dumped" bit and
189                # use that.
190                #
191                # But note also that, as we're running tcpdump with
192                # system, which runs the command through a shell, if
193                # tcpdump crashes, we'll only know that if the shell
194                # maps the signal indication and uses that as its
195                # exit status.
196                #
197                # The good news is that the Bourne shell, and compatible
198                # shells, have traditionally done that.  If the process
199                # for which the shell reports the exit status terminates
200                # with a signal, it adds 128 to the signal number and
201                # returns that as its exit status.  (This is why the
202                # "this is now working right" behavior described in a
203                # comment below is occurring.)
204                #
205                # As tcpdump itself never returns with an exit status
206                # >= 128, we can try checking for an exit status with
207                # the 0x80 bit set and, if we have one, get the signal
208                # number from the lower 7 bits of the exit status.  We
209                # can't get the "core dumped" indication from the
210                # shell's exit status; all we can do is check whether
211                # there's a core file.
212                #
213                if( $r & 128 ) {
214                    $coredump = $r & 127;
215                }
216                if( WIFEXITED($r)) {
217                    $status = WEXITSTATUS($r);
218                }
219            }
220
221            if($coredump || $status) {
222                printf OUTPUT "EXIT CODE %08x: dump:%d code: %d\n", $r, $coredump, $status;
223            } else {
224                printf OUTPUT "EXIT CODE %08x\n", $r;
225            }
226            $r = 0;
227        }
228        close(OUTPUT);
229    }
230    if($r == 0) {
231        #
232        # Compare tcpdump's output with what we think it should be.
233        # If tcpdump failed to produce output, we've produced our own
234        # "output" above, with the exit status.
235        #
236        if ($^O eq 'MSWin32') {
237            my $winoutput = File::Spec->canonpath($output);
238            my $winnewdir = File::Spec->canonpath($newdir);
239            my $windiffdir = File::Spec->canonpath($diffdir);
240            $r = system "fc /lb1000 /t /1 $winoutput ${winnewdir}\\$outputbase >${windiffdir}\\$outputbase.diff";
241            $diffstat = $r >> 8;
242        } else {
243            $r = system "diff $diff_flags $output ${newdir}/$outputbase >${diffdir}/$outputbase.diff";
244            $diffstat = WEXITSTATUS($r);
245        }
246    }
247
248    # process the standard error file, sanitize "reading from" line,
249    # and count lines
250    $linecount = 0;
251    open(ERRORRAW, "<" . $rawstderrlog);
252    open(ERROROUT, ">" . $stderrlog);
253    while(<ERRORRAW>) {
254        next if /^$/;  # blank lines are boring
255        if(/^(reading from file )(.*)(,.*)$/) {
256            my $filename = basename($2);
257            print ERROROUT "${1}${filename}${3}\n";
258            next;
259        }
260        print ERROROUT;
261        $linecount++;
262    }
263    close(ERROROUT);
264    close(ERRORRAW);
265
266    if ( -f "$output.stderr" ) {
267        #
268        # Compare the standard error with what we think it should be.
269        #
270        if ($^O eq 'MSWin32') {
271            my $winoutput = File::Spec->canonpath($output);
272            my $windiffdir = File::Spec->canonpath($diffdir);
273            my $canonstderrlog = File::Spec->canonpath($stderrlog);
274            $nr = system "fc /lb1000 /t /1 $winoutput.stderr $canonstderrlog >${windiffdir}\\$outputbase.stderr.diff";
275            $errdiffstat = $nr >> 8;
276        } else {
277            $nr = system "diff $output.stderr $stderrlog >${diffdir}/$outputbase.stderr.diff";
278            $errdiffstat = WEXITSTATUS($nr);
279        }
280        if($r == 0) {
281            $r = $nr;
282        }
283    }
284
285    if($r == 0) {
286        if($linecount == 0 && $status == 0) {
287            unlink($stderrlog);
288        } else {
289            $errdiffstat = 1;
290        }
291    }
292
293    #print sprintf("END: %08x\n", $r);
294
295    if($r == 0) {
296        if($linecount == 0) {
297            printf "    %-40s: passed\n", $name;
298        } else {
299            printf "    %-40s: passed with error messages:\n", $name;
300            showfile($stderrlog);
301        }
302        unlink "${diffdir}/$outputbase.diff";
303        return 0;
304    }
305    # must have failed!
306    printf "    %-40s: TEST FAILED(exit core=%d/diffstat=%d,%d/r=%d)", $name, $coredump, $diffstat, $errdiffstat, $r;
307    open FOUT, '>>tests/failure-outputs.txt';
308    printf FOUT "\nFailed test: $name\n\n";
309    close FOUT;
310    if(-f "${diffdir}/$outputbase.diff") {
311        #
312        # XXX - just do this directly in Perl?
313        #
314        if ($^O eq 'MSWin32') {
315            my $windiffdir = File::Spec->canonpath($diffdir);
316            system "type ${windiffdir}\\$outputbase.diff >> tests\\failure-outputs.txt";
317        } else {
318            system "cat ${diffdir}/$outputbase.diff >> tests/failure-outputs.txt";
319        }
320    }
321
322    if($r == -1) {
323        print " (failed to execute: $!)\n";
324        return(30);
325    }
326
327    # this is not working right, $r == 0x8b00 when there is a core dump.
328    # clearly, we need some platform specific perl magic to take this apart, so look for "core"
329    # too.
330    # In particular, on Solaris 10 SPARC an alignment problem results in SIGILL,
331    # a core dump and $r set to 0x00008a00 ($? == 138 in the shell).
332    if($r & 127 || -f "core") {
333        my $with = ($r & 128) ? 'with' : 'without';
334        if(-f "core") {
335            $with = "with";
336        }
337        printf " (terminated with signal %u, %s coredump)", ($r & 127), $with;
338        if($linecount == 0) {
339            print "\n";
340        } else {
341            print " with error messages:\n";
342            showfile($stderrlog);
343        }
344        return(($r & 128) ? 10 : 20);
345    }
346    if($linecount == 0) {
347        print "\n";
348    } else {
349        print " with error messages:\n";
350        showfile($stderrlog);
351    }
352    return(5);
353}
354
355sub loadconfighash {
356    if(defined($confighhash)) {
357        return $confighhash;
358    }
359
360    $main::confighhash = {};
361
362    # this could be loaded once perhaps.
363    open(CONFIG_H, "config.h") || die "Can not open config.h: $!\n";
364    while(<CONFIG_H>) {
365        chomp;
366        if(/^\#define (.*) 1/) {
367            #print "Setting $1\n";
368            $main::confighhash->{$1} = 1;
369        }
370    }
371    close(CONFIG_H);
372    #print Dumper($main::confighhash);
373
374    # also run tcpdump --fp-type to get the type of floating-point
375    # arithmetic we're doing, setting a HAVE_{fptype} key based
376    # on the value it prints
377    open(FPTYPE_PIPE, "$TCPDUMP --fp-type |") or die("piping tcpdump --fp-type failed\n");
378    my $fptype_val = <FPTYPE_PIPE>;
379    close(FPTYPE_PIPE);
380    my $have_fptype;
381    if($fptype_val == "9877.895") {
382        $have_fptype = "HAVE_FPTYPE1";
383    } else {
384        $have_fptype = "HAVE_FPTYPE2";
385    }
386    printf "$TCPDUMP --fp-type => %s\n", $have_fptype;
387    $main::confighhash->{$have_fptype} = 1;
388
389    # and check whether this is OpenBSD, as one test fails in OpenBSD
390    # due to the sad hellscape of low-numbered DLT_ values, due to
391    # 12 meaning "OpenBSD loopback" rather than "raw IP" on OpenBSD
392    if($^O eq "openbsd") {
393        $main::confighhash->{"IS_OPENBSD"} = 1;
394    }
395
396    return $main::confighhash;
397}
398
399
400sub runOneComplexTest {
401    local($testconfig) = @_;
402
403    my $output = $testconfig->{output};
404    my $input  = $testconfig->{input};
405    my $name   = $testconfig->{name};
406    my $options= $testconfig->{args};
407    my $foundit = 1;
408    my $unfoundit=1;
409
410    my $configset = $testconfig->{config_set};
411    my $configunset = $testconfig->{config_unset};
412    my $ch = loadconfighash();
413    #print Dumper($ch);
414
415    if(defined($configset)) {
416        $foundit = ($ch->{$configset} == 1);
417    }
418    if(defined($configunset)) {
419        $unfoundit=($ch->{$configunset} != 1);
420    }
421
422    if(!$foundit) {
423        printf "    %-40s: skipped (%s not set)\n", $name, $configset;
424        $skippedcount++;
425        return 0;
426    }
427
428    if(!$unfoundit) {
429        printf "    %-40s: skipped (%s set)\n", $name, $configunset;
430        $skippedcount++;
431        return 0;
432    }
433
434    #use Data::Dumper;
435    #print Dumper($testconfig);
436
437    # EXPAND any occurrences of @TESTDIR@ to $testsdir
438    $options =~ s/\@TESTDIR\@/$testsdir/;
439
440    my $result = runtest($name,
441                         $testsdir . "/" . $input,
442                         $testsdir . "/" . $output,
443                         $options);
444
445    if($result == 0) {
446        $passedcount++;
447    } else {
448        $failedcount++;
449    }
450}
451
452# *.tests files are PERL hash definitions.  They should create an array of hashes
453# one per test, and place it into the variable @testlist.
454sub runComplexTests {
455    my @files = glob( $testsdir . '/*.tests' );
456    foreach $file (@files) {
457        my @testlist = undef;
458        my $definitions;
459        print "FILE: ${file}\n";
460        open(FILE, "<".$file) || die "can not open $file: $!";
461        {
462            local $/ = undef;
463            $definitions = <FILE>;
464        }
465        close(FILE);
466        #print "STUFF: ${definitions}\n";
467        eval $definitions;
468        if(defined($testlist)) {
469            #use Data::Dumper;
470            #print Dumper($testlist);
471            foreach $test (@$testlist) {
472                runOneComplexTest($test);
473            }
474        } else {
475            warn "File: ${file} could not be loaded as PERL: $!";
476        }
477    }
478}
479
480sub runSimpleTests {
481
482    local($only)=@_;
483
484    open(TESTLIST, "<" . "${testsdir}/TESTLIST") || die "no ${testsdir}/TESTFILE: $!\n";
485    while(<TESTLIST>) {
486        next if /^\#/;
487        next if /^$/;
488
489        unlink("core");
490        ($name, $input, $output, @options) = split;
491        #print "processing ${only} vs ${name}\n";
492        next if(defined($only) && $only ne $name);
493
494        my $options = join(" ", @options);
495        #print "@{options} becomes ${options}\n";
496
497        my $hash = { name => $name,
498                     input=> $input,
499                     output=>$output,
500                     args => $options };
501
502        runOneComplexTest($hash);
503    }
504}
505
506if(scalar(@ARGV) == 0) {
507    runSimpleTests();
508    runComplexTests();
509} else {
510    runSimpleTests($ARGV[0]);
511}
512
513# exit with number of failing tests.
514print "------------------------------------------------\n";
515printf("%4u tests skipped\n",$skippedcount);
516printf("%4u tests failed\n",$failedcount);
517printf("%4u tests passed\n",$passedcount);
518
519showfile(${failureoutput});
520exit $failedcount;
521