1## Copyright (C) 2009-2020 by Carnegie Mellon University. 2## 3## @OPENSOURCE_LICENSE_START@ 4## See license information in ../LICENSE.txt 5## @OPENSOURCE_LICENSE_END@ 6## 7####################################################################### 8# SiLKTests.pm 9# 10# Mark Thomas 11# March 2009 12# 13####################################################################### 14# RCSIDENT("$SiLK: SiLKTests.pm ef14e54179be 2020-04-14 21:57:45Z mthomas $") 15####################################################################### 16# 17# Perl module used by the scripts that "make check" runs. 18# 19####################################################################### 20# 21# This module is also used by the various make-tests.pl scripts 22# that generate the tests that "make check" runs. 23# 24# In make-tests.pl, each test is defined by a tuple, which contains 25# two positional arguments and multiple keyed arguments. The first 26# two arguments must be (1)the test-name, (2)a variable denoting 27# the type of test: 28# 29# -- $SiLKTests::STATUS 30# 31# An exit-status-only test. The command is run and its exit 32# status is compared to see if it matches the expected value. 33# If the values match the test passes; otherwise it fails. 34# 35# -- $SiLKTests::MD5 36# 37# The command is run and its output is captured. If the command 38# fails to run or exit with a non-zero exit status, the test 39# fails. The md5 checksum of the output is computed and 40# compared with the expected value. If the values match the 41# test passes; otherwise it fails. 42# 43# -- $SiLKTests::ERR_MD5 44# 45# The same as $SiLKTests::MD5, except that the command MUST exit 46# with a non-zero exit status. One use of this is to determine 47# whether a command is failing with the correct error message. 48# 49# -- $SiLKTests::CMP_MD5 50# 51# Runs two different commands and determines whether the MD5 52# checksum of their outputs is identical. If they are 53# identical, the test passes. If either command exits with a 54# non-zero exit status, the test fails. 55# 56# The remaining members of the tuple are key/value pairs, where the 57# keys and their values are (note that keys include the single 58# leading hyphen): 59# 60# -file 61# 62# Array reference of data file keys the test uses. The test 63# should refer to them as $file{key}. These files must exist 64# in the $top_builddir/tests/. directory. If these files do 65# not exist when the test is run, the test will be skipped. 66# 67# -app 68# 69# Array reference of other SiLK applications required by the 70# test. The test should refer to them by name, e.g., $rwcat. 71# If these applications do not exist when the test is run, the 72# test will be skipped. 73# 74# -env 75# 76# Hash reference of environment variable names and values that 77# should be set. 78# 79# -lib 80# 81# Array reference of directories. The LD_LIBRARY_PATH, or 82# equivalent, will be set to include these directories. Used 83# to test plug-in support. 84# 85# -temp 86# 87# Array reference of name keys. These will be replaced by 88# temporary files, with the same name being mapped to the same 89# file. The test should refer to them as $temp{key}. The test 90# should not rely on the file name, since that will differ with 91# each run. 92# 93# -features 94# 95# Array reference of feature keys. This adds a call to the 96# check_features() function in the generated script, and uses 97# the elements in the array reference as the arguments to the 98# function. See the check_features() function for the 99# supported list of keys. 100# 101# -pretest 102# 103# Adds arbitrary code to the generated test. 104# 105# -exit77 106# 107# Text to add directly to the test file being created. When 108# the test is run, this text will be treated as the body of a 109# subroutine to be called with no arguments. If the sub 110# returns TRUE, the test will exit with exit code 77. This is 111# a way to skip tests for features that may not have been 112# compiled into SiLK. 113# 114# -testfile 115# 116# Use the specified value as the name of the test file instead 117# of the default, $APP-$test_name, where $APP is the name of 118# the application passed to make_test_scripts() and $test_name 119# is the name of the test. 120# 121# -cmd 122# 123# Either a single command string or an array reference 124# containing one or more command strings. 125# 126####################################################################### 127# 128# Environment variables affecting tests 129# 130# -- SK_TESTS_VERBOSE 131# 132# Print commands before they get executed. If this value is not 133# specified in the environment, it defaults to TRUE. 134# 135# -- SK_TESTS_SAVEOUTPUT 136# 137# Normally once the output of the command is used to compute the 138# MD5 checksum, the output is forgotten. When this variable is 139# set, the output used to compute the MD5 checksum is saved. 140# This variable also prevents the removal of any temporary files 141# that were used by the command 142# 143# -- SK_TESTS_VALGRIND 144# 145# If set, its value is expected to be the path to the valgrind 146# tool and any command line switches to pass to valgrind, for 147# example "SK_TESTS_VALGRIND='valgrind -v --leak-check=full'" 148# 149# Do not include the --log-file switch. The testing framework 150# will run the application under valgrind and write the results 151# to the tests directory with the name 152# "<TEST_NAME>.<APPLICATION>.<PID>.vg" where TEST_NAME is the 153# name of test, APPLICATION is the name of the application, and 154# PID is the process id. 155# 156# TODO: Currently this environment variable runs the application 157# under libtool if necessary; it would be nice to have a second 158# environment variable that points to the installed applications 159# to bypass the libtool mess. 160# 161# -- SK_TESTS_LOG_DEBUG 162# 163# Used by "make check" when running daemons. When this variable 164# is set, the test adds a --log-level=debug switch to the 165# daemon's command line. 166# 167# -- SK_TESTS_MAKEFILE 168# 169# Used by make-tests.pl. When this variable is set, the new 170# TESTS and XFAIL_TESTS variables are appended to the 171# Makefile.am file. The user should remove the previous values 172# before running automake. 173# 174# -- SK_TESTS_CHECK_MAKEFILE 175# 176# Similar to SK_TESTS_MAKEFILE, except the Makefile.am file is 177# not updated. Instead, a message is printed noting how the 178# TESTS and XFAIL_TESTS variables need to be modified. 179# 180# -- SK_TESTS_DEBUG_SCRIPTS 181# 182# Used by make-tests.pl. When this variable is set, the body of 183# the script that make-tests.pl runs to determine the correct 184# output is printed. 185# 186####################################################################### 187 188package SiLKTests; 189 190use strict; 191use warnings; 192use Carp; 193use IO::Socket::INET qw(); 194use File::Temp; 195 196 197END { 198} 199 200 201BEGIN { 202 our $NAME = $0; 203 $NAME =~ s,.*/,,; 204 205 # Set the required variables from the environment 206 our $srcdir = $ENV{srcdir}; 207 our $top_srcdir = $ENV{top_srcdir}; 208 our $top_builddir = $ENV{top_builddir}; 209 unless (defined $srcdir && defined $top_srcdir && defined $top_builddir) { 210 # do not use skip_test(), it is not defined yet 211 my @not_defined = 212 grep {!defined $ENV{$_}} qw(srcdir top_srcdir top_builddir); 213 warn("$NAME: Skipping test: The following environment", 214 " variable", ((@not_defined > 1) ? "s are" : " is"), 215 " not defined: @not_defined\n"); 216 exit 77; 217 } 218 219 # Make certain MD5 is available 220 eval { require Digest::MD5; Digest::MD5->import; }; 221 if ($@) { 222 # do not use skip_test(), it is not defined yet 223 warn "$NAME: Skipping test: Digest::MD5 module not available\n"; 224 exit 77; 225 } 226 227 our $testsdir = "$top_builddir/tests"; 228 require "$testsdir/config-vars.pm"; 229 230 # Set up the Exporter and export variables 231 use Exporter (); 232 our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); 233 234 # set the version for version checking 235 $VERSION = 1.00; 236 237 @ISA = qw(Exporter); 238 @EXPORT = qw(&add_plugin_dirs &check_app_switch 239 &check_daemon_init_program_name 240 &check_exit_status &check_features 241 &check_md5_file &check_md5_output 242 &check_python_bin &check_python_plugin 243 &check_silk_app &compute_md5 244 &get_data_or_exit77 &get_datafile 245 &get_ephemeral_port &make_config_file 246 &make_packer_sensor_conf 247 &make_tempdir &make_tempname &make_test_scripts 248 &print_tests_hash &run_command 249 &rwpollexec_use_alternate_shell &skip_test 250 &verify_archived_files &verify_directory_files 251 &verify_empty_dirs 252 $srcdir $top_srcdir 253 ); 254 %EXPORT_TAGS = ( ); 255 @EXPORT_OK = ( ); #qw($Var1 %Hashit &func3); 256 257 258 # These define the type of tests to run. 259 our $STATUS = 0; # Just check exit status of command 260 our $MD5 = 1; # Check MD5 checksum of output against known value 261 our $ERR_MD5 = 2; # Check MD5 checksum, expect cmd to exit non-zero 262 our $CMP_MD5 = 3; # Compare the MD5 checksums of two commands 263 264 our $PWD = `pwd`; 265 chomp $PWD; 266 267 # Default to being verbose 268 unless (defined $ENV{SK_TESTS_VERBOSE}) { 269 $ENV{SK_TESTS_VERBOSE} = 1; 270 } 271 272 # List of features used by check_features(). 273 our %feature_hash = ( 274 gnutls => sub { 275 skip_test("No GnuTLS support") 276 unless 1 == $SiLKTests::SK_ENABLE_GNUTLS; 277 }, 278 ipa => sub { 279 skip_test("No IPA support") 280 unless 1 == $SiLKTests::SK_ENABLE_IPA; 281 }, 282 ipfix => sub { 283 skip_test("No IPFIX support") 284 unless 1 == $SiLKTests::SK_ENABLE_IPFIX; 285 }, 286 inet6 => sub { 287 skip_test("No IPv6 networking support") 288 unless $SiLKTests::SK_ENABLE_INET6_NETWORKING; 289 }, 290 ipset_v6 => sub { 291 skip_test("No IPv6 IPset support") 292 unless ($SiLKTests::SK_ENABLE_IPV6); 293 }, 294 ipv6 => sub { 295 skip_test("No IPv6 Flow record support") 296 unless $SiLKTests::SK_ENABLE_IPV6; 297 }, 298 netflow9 => sub { 299 skip_test("No NetFlow V9 support") 300 unless ($SiLKTests::SK_ENABLE_IPFIX); 301 }, 302 stdin_tty => sub { 303 skip_test("stdin is not a tty") 304 unless (-t STDIN); 305 }, 306 ); 307 308} 309our @EXPORT_OK; 310 311our $top_builddir; 312our $top_srcdir; 313our $testsdir; 314our $srcdir; 315our $STATUS; 316our $MD5; 317our $ERR_MD5; 318our $CMP_MD5; 319our $NAME; 320 321# list of environment variables to print in dump_env(), which is 322# called when running a command. 323our @DUMP_ENVVARS = qw(top_srcdir top_builddir srcdir 324 TZ LANG LC_ALL SILK_HEADER_NOVERSION 325 SILK_DATA_ROOTDIR SILK_CONFIG_FILE 326 SILK_COUNTRY_CODES SILK_ADDRESS_TYPES 327 SILK_COMPRESSION_METHOD 328 SILK_IPSET_RECORD_VERSION SKIPSET_INCORE_FORMAT 329 PYTHONPATH 330 LD_LIBRARY_PATH DYLD_LIBRARY_PATH LIBPATH SHLIB_PATH 331 G_SLICE G_DEBUG); 332 333# whether to print contents of scripts that get run 334our $DEBUG_SCRIPTS = $ENV{SK_TESTS_DEBUG_SCRIPTS}; 335 336# how to indent each line of the output 337our $INDENT = " "; 338 339# ensure all commands are run in UTC timezone 340$ENV{TZ} = "0"; 341 342# specify silk.conf file to use for all tests 343$ENV{SILK_CONFIG_FILE} = "$top_builddir/tests/silk.conf"; 344 345# do not put the SiLK version number into binary SiLK files 346$ENV{SILK_HEADER_NOVERSION} = 1; 347 348# unset several environment variables 349for my $e (qw(SILK_IP_FORMAT SILK_IPV6_POLICY SILK_PYTHON_TRACEBACK 350 SILK_RWFILTER_THREADS SILK_TIMESTAMP_FORMAT 351 SILK_LOGSTATS_RWFILTER SILK_LOGSTATS SILK_LOGSTATS_DEBUG)) 352{ 353 delete $ENV{$e}; 354} 355 356# run the C locale 357$ENV{LANG} = 'C'; 358$ENV{LC_ALL} = 'C'; 359 360# disable creating of *.pyc files in Python 2.6+ 361$ENV{PYTHONDONTWRITEBYTECODE} = 1; 362 363my %test_files = ( 364 empty => "$testsdir/empty.rwf", 365 data => "$testsdir/data.rwf", 366 v6data => "$testsdir/data-v6.rwf", 367 scandata => "$testsdir/scandata.rwf", 368 sips004 => "$testsdir/sips-004-008.rw", 369 370 v4set1 => "$testsdir/set1-v4.set", 371 v4set2 => "$testsdir/set2-v4.set", 372 v4set3 => "$testsdir/set3-v4.set", 373 v4set4 => "$testsdir/set4-v4.set", 374 v6set1 => "$testsdir/set1-v6.set", 375 v6set2 => "$testsdir/set2-v6.set", 376 v6set3 => "$testsdir/set3-v6.set", 377 v6set4 => "$testsdir/set4-v6.set", 378 379 v4bag1 => "$testsdir/bag1-v4.bag", 380 v4bag2 => "$testsdir/bag2-v4.bag", 381 v4bag3 => "$testsdir/bag3-v4.bag", 382 v6bag1 => "$testsdir/bag1-v6.bag", 383 v6bag2 => "$testsdir/bag2-v6.bag", 384 v6bag3 => "$testsdir/bag3-v6.bag", 385 386 address_types => "$testsdir/address_types.pmap", 387 fake_cc => "$testsdir/fake-cc.pmap", 388 v6_fake_cc => "$testsdir/fake-cc-v6.pmap", 389 ip_map => "$testsdir/ip-map.pmap", 390 v6_ip_map => "$testsdir/ip-map-v6.pmap", 391 proto_port_map => "$testsdir/proto-port-map.pmap", 392 393 pysilk_plugin => "$top_srcdir/tests/pysilk-plugin.py", 394 395 pdu_small => "$testsdir/small.pdu", 396); 397 398 399# $path = get_datafile('key') 400# 401# Return the path to the data file named by 'key'. If $key is 402# invalid or if the file does not exist, return undef. 403# 404sub get_datafile 405{ 406 my ($arg) = @_; 407 408 my $file = $test_files{$arg}; 409 unless (defined $file) { 410 return undef; 411 } 412 unless (-f $file) { 413 return undef; 414 } 415 return $file; 416} 417 418 419# $path = get_data_or_exit77('key'); 420# 421# Like get_datafile(), but exits the program with code 77 if the 422# file does not exist. This would cause "make check" to skip the 423# test. 424# 425sub get_data_or_exit77 426{ 427 my ($arg) = @_; 428 429 my $file = get_datafile($arg); 430 if (!$file) { 431 skip_test("Did not find '$arg' file"); 432 } 433 return $file; 434} 435 436 437# $env = dump_env(); 438# 439# Return a string specifying any environment variables that may 440# affect this run 441# 442sub dump_env 443{ 444 join " ", ((map {"$_=$ENV{$_}"} 445 grep {defined $ENV{$_}} 446 @DUMP_ENVVARS), 447 ""); 448} 449 450 451# $string = print_command_with_env($cmd); 452# 453# For verbose debugging, print the bash command that would run 454# '$cmd' in a subshell with all the appropriate environment 455# variables set in the subshell. 456# 457sub print_command_with_env 458{ 459 my ($cmd) = @_; 460 461 return "( export ".dump_env()." ; ".$cmd." )"; 462} 463 464 465# skip_test($msg); 466# 467# Print a message indicating that the test is being skipped due to 468# '$msg' and then exit with status 77. 469# 470sub skip_test 471{ 472 my ($msg) = @_; 473 if ($ENV{SK_TESTS_VERBOSE}) { 474 if (!$msg) { 475 warn "$NAME: Skipping test\n"; 476 } 477 else { 478 warn "$NAME: Skipping test: $msg\n"; 479 } 480 } 481 exit 77; 482} 483 484 485# $dir = make_tempdir(); 486# 487# Make a temporary directory and return its location. This will 488# remove the directory on exit unless the appropriate environment 489# variable is set. 490# 491# If a temporary directory cannot be created, exit with status 77. 492# 493sub make_tempdir 494{ 495 my $tmpdir = File::Temp::tempdir(CLEANUP => !$ENV{SK_TESTS_SAVEOUTPUT}); 496 unless (-d $tmpdir) { 497 skip_test("Unable to create temporary directory"); 498 } 499 500 my $testing = "$tmpdir/-silktests-"; 501 open TESTING, '>', $testing 502 or die "$NAME: Cannot create '$testing': $!\n"; 503 print TESTING "\$0 = '$0';\n\$PWD = '$SiLKTests::PWD';\n"; 504 close TESTING 505 or die "$NAME: Cannot close '$testing': $!\n"; 506 507 return $tmpdir; 508} 509 510 511# $path = make_tempname($key); 512# 513# Return a path to a temporary file. Calls to this function with 514# the same $key return the same name. Calls to this function 515# within the same test return files in the same temporary 516# directory. 517# 518sub make_tempname 519{ 520 my ($key) = @_; 521 522 our $tmpdir; 523 our %TEMP_MAP; 524 525 unless (defined $tmpdir) { 526 $tmpdir = make_tempdir(); 527 } 528 529 # change anything other than -, _, ., and alpha-numerics to a 530 # single underscore 531 $key =~ tr/-_.0-9A-Za-z/_/cs; 532 533 unless (exists $TEMP_MAP{$key}) { 534 $TEMP_MAP{$key} = "$tmpdir/$key"; 535 } 536 return $TEMP_MAP{$key}; 537} 538 539 540# run_command($cmd, $callback); 541# 542# Run $cmd in a subshell. $callback should be a function that 543# takes two arguments. The first argument is a file handle from 544# which the standard output of the $cmd can be read. 545# 546# The second argument may be undefined. If it is defined, the 547# SK_TESTS_SAVEOUTPUT environment variable is set, and the argument 548# contains the name of the (unopened) file to which results should 549# be written. The individual test can determine which data to 550# write to this file. 551# 552# This function returns 0. 553# 554sub run_command 555{ 556 my ($cmd, $callback) = @_; 557 558 my $save_file; 559 if ($ENV{SK_TESTS_SAVEOUTPUT}) { 560 $save_file = "tests/$NAME.saveoutput"; 561 } 562 563 if ($ENV{SK_TESTS_VERBOSE}) { 564 print STDERR "RUNNING: ", print_command_with_env($cmd), "\n"; 565 } 566 my $io; 567 unless (open $io, "$cmd |") { 568 die "$NAME: cannot run '$cmd': $!\n"; 569 } 570 binmode($io); 571 $callback->($io, $save_file); 572 return 0; 573} 574 575 576# $ok = compute_md5(\$md5, $cmd, $expect_err); 577# 578# Run $cmd in a subshell, compute the MD5 of the output, and store 579# the hex-encoded MD5 in $md5. Dies if $cmd cannot be run. If 580# $expect_err is false, function dies if the command exits 581# abnormally. If $expect_err is true, function dies if command 582# exits normally. 583# 584sub compute_md5 585{ 586 my ($md5_out, $cmd, $expect_err) = @_; 587 588 # make certain $expect_err has a value 589 unless (defined $expect_err) { 590 $expect_err = 0; 591 } 592 593 if ($ENV{SK_TESTS_VERBOSE}) { 594 print STDERR "RUNNING: ", print_command_with_env($cmd), "\n"; 595 } 596 my $md5 = Digest::MD5->new; 597 my $io; 598 unless (open $io, "$cmd |") { 599 die "$NAME: cannot run '$cmd': $!\n"; 600 } 601 binmode($io); 602 if (!$ENV{SK_TESTS_SAVEOUTPUT}) { 603 $md5->addfile($io); 604 } else { 605 my $txt = "tests/$NAME.saveoutput"; 606 open TXT, ">$txt" 607 or die "$NAME: Cannot open output file '$txt': $!\n"; 608 binmode TXT; 609 while(<$io>) { 610 print TXT; 611 $md5->add($_); 612 } 613 close TXT 614 or die "$NAME: Cannot close file '$txt': $!\n"; 615 } 616 if (close($io)) { 617 # Close was successful 618 if ($expect_err) { 619 die "$NAME: Command exited cleanly when error was expected\n"; 620 } 621 } 622 elsif (!$expect_err) { 623 if ($!) { 624 die "$NAME: Error closing command pipe: $!\n"; 625 } 626 if ($? & 127) { 627 warn "$NAME: Command died by signal ", ($? & 127), "\n"; 628 } 629 elsif ($?) { 630 die ("$NAME: Command exited with non-zero exit status ", 631 ($? >> 8), "\n"); 632 } 633 } 634 else { 635 # Error was expected 636 if ($!) { 637 die "$NAME: Error closing command pipe: $!\n"; 638 } 639 if ($? & 127) { 640 warn "$NAME: Command died by signal ", ($? & 127), "\n"; 641 } 642 elsif ($ENV{SK_TESTS_VERBOSE}) { 643 print STDERR "$NAME: Command exited with status ", ($? >> 8), "\n"; 644 } 645 } 646 $$md5_out = $md5->hexdigest; 647 return 0; 648} 649 650 651# check_md5_output($expect_md5, $cmd, $expect_err); 652# 653# Die if the MD5 of the output from running $cmd does not equal 654# $expect_md5. $cmd and $expect_err are passed through to 655# compute_md5(). 656# 657sub check_md5_output 658{ 659 my ($expect, $cmd, $expect_err) = (@_); 660 661 my $md5; 662 my $err = compute_md5(\$md5, $cmd, $expect_err); 663 if ($expect ne $md5) { 664 unless ($ENV{SK_TESTS_VERBOSE}) { 665 print STDERR "RUNNING: ", print_command_with_env($cmd), "\n"; 666 } 667 die "$NAME: checksum mismatch [$md5] (expected $expect)\n"; 668 } 669} 670 671 672# $ok = check_md5_file($expect_md5, $file); 673# 674# Compute the MD5 checksum of $file and compare it to the value in 675# $expect_md5. Die if the values are not identical. 676# 677sub check_md5_file 678{ 679 my ($expect, $file) = @_; 680 681 my $md5 = Digest::MD5->new; 682 my $io; 683 unless (open $io, $file) { 684 die "$NAME: cannot open '$file': $!\n"; 685 } 686 binmode($io); 687 $md5->addfile($io); 688 close($io); 689 690 my $md5_hex = $md5->hexdigest; 691 if ($expect ne $md5_hex) { 692 die "$NAME: checksum mismatch [$md5_hex] ($file)\n"; 693 } 694 return 0; 695} 696 697 698# $app = check_silk_app($name) 699# 700# Find the SiLK application named $name and return a path to it. 701# 702# If an environment variable exists whose name is the uppercase 703# version of $name, that value is immediately returned. In all 704# other cases, assuming the application is found, the value 705# returned depends on whether the SK_TESTS_VALGRIND environment 706# variable is set. 707# 708# If the executable exists in the current directory, that 709# executable is used. Otherwise, the subroutine looks for the 710# executable $name in "../$name/$name", where the directory name 711# may be altered depending on $name. 712# 713# Exit with status 77 if the application does not exist. 714# 715# If SK_TESTS_VALGRIND is not set, return the application name. 716# 717# If SK_TESTS_VALGRIND is set, return a command that will run 718# valgrind on the application. Note that the valgrind program and 719# the arguments to valgrind (with the exception of --log-file) must 720# be set in the SK_TESTS_VALGRIND environment variable. The script 721# will instruct valgrind to write to a log file based on the name 722# of the script, the application being invoked, and the process ID. 723# 724# When SK_TESTS_VALGRIND is set, an environment variable 725# corresponding to the application name is set so that other 726# applications (e.g., rwscanquery, the python daemon wrappers) will 727# run the application under valgrind. 728# 729sub check_silk_app 730{ 731 my ($name) = @_; 732 733 # create name of environment variable by upcasing the application 734 # name and changing hyphens to underscores 735 my $envar = "\U$name"; 736 $envar =~ s/-/_/g; 737 if ($ENV{$envar}) { 738 return $ENV{$envar}; 739 } 740 741 my $path = "../$name/$name"; 742 if (-x $name) { 743 $path = "./$name"; 744 } 745 elsif ($name =~ /^rwuniq$/) { 746 $path = "../rwstats/$name"; 747 } 748 elsif ($name =~ /^(rwset|rwbag|rwids|rwipa|rwpmap|rwscan)/) { 749 $path = "../$1/$name"; 750 } 751 elsif ($name =~ /^rwfglob$/) { 752 $path = "../rwfilter/$name"; 753 } 754 elsif ($name =~ /^rwipfix2silk$/) { 755 $path = "../rwipfix/$name"; 756 } 757 elsif ($name =~ /^rwsilk2ipfix$/) { 758 $path = "../rwipfix/$name"; 759 } 760 elsif ($name =~ /^rwdedupe$/) { 761 $path = "../rwsort/$name"; 762 } 763 764 unless (-x $path) { 765 skip_test("Did not find application './$name' or '$path'"); 766 } 767 unless ($ENV{SK_TESTS_VALGRIND}) { 768 return $path; 769 } 770 771 # set environment variables to have glib work with valgrind 772 if (!$ENV{G_SLICE}) { 773 $ENV{G_SLICE} = 'always-malloc'; 774 } 775 if (!$ENV{G_DEBUG}) { 776 $ENV{G_DEBUG} = 'gc-friendly'; 777 } 778 779 # determine whether to run the application under libtool by 780 # looking for the application as ".libs/$app" or ".libs/lt-$app" 781 my $libtool = ""; 782 my $binary_path = $path; 783 $binary_path =~ s,(.*/),$1/.libs/,; 784 if (-x $binary_path) { 785 $libtool = "$top_builddir/libtool --mode=execute "; 786 } 787 else { 788 $binary_path =~ s,(\.libs)/,$1/lt-,; 789 if (-x $binary_path) { 790 $libtool = "$top_builddir/libtool --mode=execute "; 791 } 792 } 793 my $log_file = "$NAME.$name.\%p.vg"; 794 if (-d "tests") { 795 $log_file = "tests/$log_file"; 796 } 797 my $valgrind_cmd = ("$libtool$ENV{SK_TESTS_VALGRIND}" 798 ." --log-file=$log_file $path"); 799 $ENV{$envar} = $valgrind_cmd; 800 return $valgrind_cmd; 801} 802 803 804# check_features(@list) 805# 806# Check features of SiLK or of the current run-time environemnt. 807# 808# Check whether SiLK was compiled with support for each of the 809# features in '@list' and check whether the run-time environment 810# exhibits the specified features. If any feature in @list is not 811# present, exit with status 77. 812# 813# The acceptable names for '@list' w.r.t. SiLK are: 814# 815# gnutls -- verify that GnuTLS support is available 816# ipa -- verify that support for libipa is available 817# ipfix -- verify that IPFIX support is available 818# inet6 -- verify that IPv6 networking support is available 819# ipset_v6 -- verify that IPv6 IPsets is available 820# ipv6 -- verify that IPv6 Flow record support is available 821# netflow9 -- verify that support for NetFlow V9 is available 822# 823# The acceptable names for '@list' w.r.t. the environment are: 824# 825# stdin_tty -- verify that STDIN is a tty 826# 827# If any other name is provided, exit with an error. 828# 829# TODO: Idea for an extension, which we currently do not need: 830# Preceding a feature name with '!' causes the script to exit with 831# status 77 if the feature IS present. 832# 833sub check_features 834{ 835 my (@list) = @_; 836 837 our %feature_hash; 838 839 for my $feature (@list) { 840 my $check = $feature_hash{$feature}; 841 if (!$check) { 842 die "$NAME: No such feature as '$feature'\n"; 843 } 844 $check->(); 845 } 846} 847 848 849# check_app_switch($app, $switch, $re) 850# 851# Check the output of the --help switch. This function invokes 852# "$app --help" and captures the output. '$app' should be the 853# application name, and it may include switches. The function 854# searches the output for the switch '--$switch'. If '$re' is 855# undefined, the function returns true if the switch is found. 856# When '$re' is defined, the help text of the switch is regex 857# matched with '$re', and the result of the match is returned. 858# 859# The function returns false if the running the application fails. 860# 861sub check_app_switch 862{ 863 my ($app, $switch, $re) = @_; 864 865 my $cmd = $app.' --help 2>&1'; 866 if ($ENV{SK_TESTS_VERBOSE}) { 867 print STDERR "RUNNING: ", print_command_with_env($cmd), "\n"; 868 } 869 my $output = `$cmd`; 870 if ($?) { 871 if (-1 == $?) { 872 die "$NAME: Failed to execute command: $!\n"; 873 } 874 if ($? & 127) { 875 print STDERR "$NAME: Command died by signal ", ($? & 127), "\n"; 876 } 877 elsif ($ENV{SK_TESTS_VERBOSE}) { 878 print STDERR "$NAME: Command exited with status ", ($? >> 8), "\n"; 879 } 880 return 0; 881 } 882 my $text; 883 if ($output =~ m/^(--$switch[^-\w].*(\n[^-].+)*)/m) { 884 $text = $1; 885 unless (defined $re) { 886 return 1; 887 } 888 if ($text =~ $re) { 889 return 1; 890 } 891 } 892 return 0; 893} 894 895 896# check_daemon_init_program_name($init_script, $daemon_name); 897# 898# Verify that the daemon start-up script '$init_script' (for 899# example, rwflowpack.init.d) starts the daemon we expect it to, 900# namely '$daemon_name' ('rwflowpack' in our example). 901# 902# The purpose of this function is to skip these tests when the user 903# has used the --program-prefix/--program-suffix switches to 904# configure. The issue is that the $init_script contains the 905# modified daemon name, but the name only is modified at 906# installation time. 907# 908# This function ensures the 'MYNAME' and 'PROG' variables in shell 909# script $init_script are set to $daemon_name. If it does not, the 910# test is skipped. 911# 912sub check_daemon_init_program_name 913{ 914 my ($init_script, $daemon_name) = @_; 915 916 open INIT, $init_script 917 or die "$NAME: Unable to read start-up script '$init_script': $!\n"; 918 while (<INIT>) { 919 chomp; 920 if (/^(MYNAME|PROG)=(\S+)\s*$/) { 921 if ($2 ne $daemon_name) { 922 skip_test("Start-up script '$init_script' on line $." 923 ." does not use expected daemon name '$daemon_name';" 924 ." instead found '$_'"); 925 } 926 } 927 } 928 close INIT; 929} 930 931 932# check_exit_status($cmd, $no_redirect) 933# 934# Run $cmd. Return 1 if the command succeeded, or 0 if it failed. 935# 936# If $no_redirect is true, do not redirect the stdout or stderr of 937# $cmd in any way (meaning it should be written to the "make check" 938# log file. 939# 940# If $no_redirect is false (or not defined) and the SK_TESTS_SAVEOUTPUT 941# environment varialbe is not set, discard stdout and stderr. 942# 943# If $no_redirect is false (or not defined) and the 944# SK_TESTS_SAVEOUTPUT environment variable is set, write the output 945# to the file "tests/$NAME.saveoutput". 946# 947sub check_exit_status 948{ 949 my ($cmd, $no_redirect) = @_; 950 951 if ($ENV{SK_TESTS_VERBOSE}) { 952 print STDERR "RUNNING: ", print_command_with_env($cmd), "\n"; 953 } 954 955 unless ($no_redirect) { 956 # where to write the output 957 my $output = "/dev/null"; 958 959 if ($ENV{SK_TESTS_SAVEOUTPUT}) { 960 $output = "tests/$NAME.saveoutput"; 961 } 962 $cmd .= " >$output 2>&1"; 963 } 964 965 system $cmd; 966 if (0 == $?) { 967 return 1; 968 } 969 if (-1 == $?) { 970 die "$NAME: Failed to execute command: $!\n"; 971 } 972 if ($? & 127) { 973 print STDERR "$NAME: Command died by signal ", ($? & 127), "\n"; 974 } 975 elsif ($ENV{SK_TESTS_VERBOSE}) { 976 print STDERR "$NAME: Command exited with status ", ($? >> 8), "\n"; 977 } 978 return 0; 979} 980 981 982# check_python_bin() 983# 984# Check whether we found a python interpreter. If we did not, 985# exit 77. Otherwise, prefix any existing PYTHONPATH with the 986# proper directories and return 1. 987# 988# This check used by the code that tests daemons since the daemon 989# testing code requires a python interpreter. 990# 991sub check_python_bin 992{ 993 if ($SiLKTests::PYTHON eq "no" 994 || $SiLKTests::PYTHON_VERSION !~ /^[23]/ 995 || $SiLKTests::PYTHON_VERSION =~ /^2.[45]/) 996 { 997 skip_test("Python unset or not >= 2.6 < 4.0"); 998 } 999 $ENV{PYTHONPATH} = join ":", ($SiLKTests::top_builddir.'/tests', 1000 $SiLKTests::srcdir.'/tests', 1001 $SiLKTests::top_srcdir.'/tests', 1002 ($ENV{PYTHONPATH} ? $ENV{PYTHONPATH} : ())); 1003 return 1; 1004} 1005 1006 1007# check_python_plugin($app) 1008# 1009# Check whether the --python-file switch works for the application 1010# $app. The argument to --python-file is the pysilk_plugin defined 1011# in the %test_files hash. If the switch does not work, exit 77. 1012# 1013sub check_python_plugin 1014{ 1015 my ($app) = @_; 1016 1017 my $file = get_data_or_exit77('pysilk_plugin'); 1018 if (check_exit_status(qq|$app --python-file=$file --help|)) { 1019 return; 1020 } 1021 check_exit_status(qq|$app --python-file=$file --help|, 'no_redirect'); 1022 skip_test('Cannot use --python-file'); 1023} 1024 1025 1026# add_plugin_dirs(@libs) 1027# 1028# For each directory in @libs, prefix the directory name and the 1029# directory name with "/.libs" appended to it to the 1030# LD_LIBRARY_PATH (and platform variations of that environment 1031# variable). 1032# 1033# Each directory in @libs should relative to the top of the build 1034# tree. 1035# 1036sub add_plugin_dirs 1037{ 1038 my (@dirs) = (@_); 1039 1040 my $newlibs = join (":", 1041 map {"$_:$_/.libs"} 1042 map {"$SiLKTests::top_builddir$_"} 1043 @dirs); 1044 for my $L (qw(LD_LIBRARY_PATH DYLD_LIBRARY_PATH LIBPATH SHLIB_PATH)) { 1045 if ($ENV{$L}) { 1046 $ENV{$L} = $newlibs.":".$ENV{$L}; 1047 } 1048 else { 1049 $ENV{$L} = $newlibs; 1050 } 1051 } 1052} 1053 1054 1055# $port = get_ephemeral_port($host, $proto); 1056# 1057# Get an ephemeral port by creating a short-lived server listening 1058# on the specified $host and $protocol, and using the fact that 1059# binding to port 0 assigns an available ephemeral port. 1060# 1061# If the short-lived server cannot be created, the program exits 1062# with status 77. 1063# 1064sub get_ephemeral_port 1065{ 1066 use Socket (); 1067 1068 my ($host, $proto) = @_; 1069 my $type = Socket::SOCK_DGRAM; 1070 1071 unless ($host) { 1072 $host = '127.0.0.1'; 1073 } 1074 unless ($proto) { 1075 $proto = getprotobyname('tcp'); 1076 $type = Socket::SOCK_STREAM; 1077 } 1078 else { 1079 if ($proto =~ /\D/) { 1080 $proto = getprotobyname($proto); 1081 } 1082 if (getprotobyname('tcp') == $proto) { 1083 $type = Socket::SOCK_STREAM; 1084 } 1085 } 1086 1087 if ($host =~ /:/) { 1088 # IPv6; run in an eval, in case Socket6 is not available. 1089 my $have_socket6 = 0; 1090 1091 my $port = eval <<EOF; 1092 use Socket qw(SOL_SOCKET SO_REUSEADDR); 1093 use Socket6 qw(getaddrinfo getnameinfo AF_INET6 1094 NI_NUMERICHOST NI_NUMERICSERV); 1095 1096 \$have_socket6 = 1; 1097 1098 my (\$s, \$port); 1099 unless (socket(\$s, AF_INET6, $type, $proto)) { 1100 skip_test("Unable to open socket: \$!)"; 1101 } 1102 setsockopt(\$s, SOL_SOCKET, SO_REUSEADDR, 1); 1103 1104 my \@res = getaddrinfo('$host', 0, AF_INET6, $type, $proto); 1105 if (\$#res == 0) { 1106 skip_test("Unable to resolve '$host'"); 1107 } 1108 1109 my \$s_addr = \$res[3]; 1110 unless (bind(\$s, \$s_addr)) { 1111 skip_test("Unable to bind to socket: \$!"); 1112 } 1113 1114 (undef, \$port) = getnameinfo(getsockname(\$s), 1115 (NI_NUMERICHOST | NI_NUMERICSERV)); 1116 close(\$s); 1117 1118 return \$port; 1119EOF 1120 if (defined $port) { 1121 return $port; 1122 } 1123 if ($@ && $have_socket6) { 1124 skip_test("$@"); 1125 } 1126 # Assume failure was due to absence of Socket6 module, and use 1127 # IPv4 to get a port 1128 $host = '127.0.0.1'; 1129 } 1130 1131 # IPv4 1132 1133 my ($s, $port); 1134 unless (socket($s, Socket::PF_INET, $type, $proto)) { 1135 skip_test("Unable to open socket: $!"); 1136 } 1137 setsockopt($s, Socket::SOL_SOCKET, Socket::SO_REUSEADDR, 1); 1138 1139 my $h_addr = Socket::inet_aton($host); 1140 unless (defined $h_addr) { 1141 skip_test("Unable to resolve '$host'"); 1142 } 1143 my $s_addr = Socket::sockaddr_in(0, $h_addr); 1144 1145 unless (bind($s, $s_addr)) { 1146 skip_test("Unable to bind to socket: $!"); 1147 } 1148 1149 ($port, ) = Socket::sockaddr_in(getsockname($s)); 1150 close($s); 1151 1152 return $port; 1153 1154 # The following does the same as the above 1155 # 1156 # my $s = IO::Socket::INET->new(Proto => $proto, 1157 # LocalAddr => $host, 1158 # LocalPort=> 0, 1159 # Reuse => 1, 1160 # ); 1161 # unless ($s) { 1162 # if ($ENV{SK_TESTS_VERBOSE}) { 1163 # warn "$NAME: Cannot create $proto server on $host: $!\n"; 1164 # } 1165 # exit 77; 1166 # } 1167 # my $port = $s->sockport; 1168 # $s->close(); 1169 # 1170 # return $port; 1171} 1172 1173 1174# rwpollexec_use_alternate_shell($tmpdir) 1175# 1176# Work around an issue that occurs when running "make check" under 1177# OS X when System Integrity Protection is enabled. 1178# 1179# As part of finding a valid shell to use when spawning programs, 1180# rwpollexec attempts to exec itself in a subshell.(NOTE-1) This 1181# subprocess does not have access to the DYLD_LIBRARY_PATH 1182# environment variable since /bin/sh strips it from the 1183# environment, and therefore rwpollexec fails to run since it 1184# cannot locate libsilk. 1185# 1186# The work-around is to copy /bin/sh out of the /bin directory and 1187# set SILK_RWPOLLEXEC_SHELL to that location.(NOTE-2) This function 1188# copies it into the $tmpdir. 1189# 1190# NOTE-1: This is only a problem when running a non-installed 1191# version of rwpollexec. In this case, rwpollexec thinks its 1192# complete path is in the .libs subdirectory, but that version 1193# requires DYLD_LIBRARY_PATH settings from libtool to work 1194# correctly. 1195# 1196# NOTE-2: Copying /bin/sh to another directory works around the 1197# issue since stripping DYLD_LIBRARY_PATH from the environment 1198# occurs for all programs in /bin and is not inherent to /bin/sh 1199# itself. 1200# 1201sub rwpollexec_use_alternate_shell 1202{ 1203 my ($dir) = @_; 1204 1205 my $bin_sh = '/bin/sh'; 1206 my $copy_sh = "$dir/sh"; 1207 1208 for my $shell ($bin_sh, $copy_sh) { 1209 # Fork, set the DYLD_LIBRARY_PATH environment variable in the 1210 # child, and then exec $shell and echo the envvar's value. 1211 # Have the parent read the output from the child. Do not use 1212 # backticks, since that may run /bin/sh for us. 1213 my $pid = open ECHO, '-|'; 1214 if (!defined $pid) { 1215 die "$NAME: Cannot fork: $!\n"; 1216 } 1217 if (0 == $pid) { 1218 # Child 1219 $ENV{DYLD_LIBRARY_PATH} = "foo"; 1220 #print STDERR "\$i = $i; $shell -c 'echo \$DYLD_LIBRARY_PATH'\n"; 1221 exec $shell, '-c', 'echo $DYLD_LIBRARY_PATH' 1222 or die "$NAME: Cannot exec: $!\n"; 1223 } 1224 # Parent 1225 my $result = ''; 1226 while (<ECHO>) { 1227 $result .= $_; 1228 } 1229 close(ECHO); 1230 #print STDERR "\$i = $i; \$result = '$result'\n"; 1231 1232 if ($result =~ /^foo$/) { 1233 # Either System Integrity Protection is not enabled or we 1234 # worked around it 1235 return; 1236 } 1237 if ($shell eq $copy_sh) { 1238 # This is the second pass and we failed to work around it; 1239 # should skip this test. 1240 skip_test("Unable to work around OS X System Integrity Protection"); 1241 } 1242 1243 unless (-d $dir) { 1244 die "$NAME: Directory '$dir' does not exist\n"; 1245 } 1246 system '/bin/cp', $bin_sh, $copy_sh 1247 and die "$NAME: Unable to copy $bin_sh\n"; 1248 1249 $ENV{SILK_RWPOLLEXEC_SHELL} = $copy_sh; 1250 push @DUMP_ENVVARS, 'SILK_RWPOLLEXEC_SHELL'; 1251 } 1252 die "$NAME: Not reached!\n"; 1253} 1254 1255 1256# santize_cmd(\$cmd); 1257# 1258# Remove any references to the source path or to the temporary 1259# directory from '$cmd' prior to $cmd into the top of the source 1260# file 1261# 1262sub sanitize_cmd 1263{ 1264 my ($cmd) = @_; 1265 1266 # don't put source path into test file 1267 $$cmd =~ s,\Q$top_srcdir,$top_builddir,g; 1268 1269 # don't put TMPDIR into test file 1270 my $tmp = $ENV{TMPDIR} || '/tmp'; 1271 1272 # convert "$TMPDIR/foobar/file" to "/tmp/file" 1273 $$cmd =~ s,\Q$tmp\E/?(\S+/)*,/tmp/,g; 1274} 1275 1276 1277# verify_archived_files($archive_base, @file_list); 1278# 1279# Verify that the files in @file_list exist in subdirectories of 1280# '$archive_base', where the subdirectory is based on the current 1281# UTC time in the form YYYY/MM/DD/hh/. 1282# 1283# See also verify_directory_files(). 1284# 1285# Any directory components of the elements in @file_list will be 1286# removed. That is, only the basename of the files in @file_list 1287# are considered. 1288# 1289# Since it is possible for the hour to roll-over during a test, the 1290# function checks subdirectories based on the current time and on 1291# the time when the Perl script began running (given by the $^T 1292# variable). 1293# 1294# Exit with an error if the $archive_base does not exist. 1295# 1296# Exit with an error if any of the files do not exist. 1297# 1298sub verify_archived_files 1299{ 1300 my ($archive_base, @file_list) = @_; 1301 1302 unless (-d $archive_base) { 1303 die "$NAME: Directory '$archive_base' does not exist\n"; 1304 } 1305 1306 # remove trailing slash and any double slashes 1307 $archive_base =~ s,/+$,,g; 1308 $archive_base =~ s,//+,/,g; 1309 1310 # take basename of the expected files and create a hash 1311 my %expected_files; 1312 for my $f (@file_list) { 1313 $f =~ s,.*/,,; 1314 $expected_files{$f} = "'$archive_base/.../$f'"; 1315 } 1316 1317 # generate expected directories based on timestamps 1318 my %expected_dirs; 1319 $expected_dirs{$archive_base} = $archive_base; 1320 1321 for my $ts ($^T, time) { 1322 # generate components of potential archive directory 1323 my @t = gmtime($ts); 1324 my @parts = (sprintf("%4d", (1900 + $t[5])), 1325 sprintf("%02d", (1 + $t[4])), 1326 sprintf("%02d", $t[3]), 1327 sprintf("%02d", $t[2]), 1328 ); 1329 for (my $i = 0; $i < @parts; ++$i) { 1330 my $d = join "/", $archive_base, @parts[0..$i]; 1331 $expected_dirs{$d} = "'$d'"; 1332 } 1333 } 1334 1335 my @unexpected; 1336 1337 use File::Find qw//; 1338 File::Find::find( 1339 sub { 1340 lstat $_; 1341 if ((-d _) && $expected_dirs{$File::Find::name}) { 1342 return; 1343 } 1344 if ((-f _) 1345 && $expected_files{$_} && $expected_dirs{$File::Find::dir}) 1346 { 1347 delete $expected_files{$_}; 1348 return; 1349 } 1350 push @unexpected, "'$File::Find::name'"; 1351 }, 1352 $archive_base); 1353 1354 1355 if (keys %expected_files) { 1356 my @missing = values %expected_files; 1357 if (@unexpected) { 1358 die ("$NAME: Missing file", ((@missing > 1) ? "s " : " "), 1359 join(", ", @missing), " and found unexpected ", 1360 ((@unexpected > 1) ? "entries " : "entry "), 1361 join(", ", @unexpected), "\n"); 1362 } 1363 die ("$NAME: Missing file", ((@missing > 1) ? "s " : " "), 1364 join(", ", @missing), "\n"); 1365 } 1366 if (@unexpected) { 1367 die ("$NAME: Found unexpected ", 1368 ((@unexpected > 1) ? "entries " : "entry "), 1369 join(", ", @unexpected), "\n"); 1370 } 1371} 1372 1373 1374# verify_directory_files($dir, @file_list); 1375# 1376# Verify that the files in @file_list exist in the directory 1377# '$dir' and verify that no other files exist in the directory. 1378# 1379# Any directory components of the elements in @file_list will be 1380# removed. That is, only the basename of the files in @file_list 1381# are considered. 1382# 1383# Exit with an error if the $dir does not exist, if any of the 1384# files do not exist, or if any other files are found. 1385# 1386sub verify_directory_files 1387{ 1388 my ($dir, @file_list) = @_; 1389 1390 # table of expected files 1391 my %expected; 1392 for my $f (@file_list) { 1393 # take basename 1394 $f =~ s,.*/,,; 1395 $expected{$f} = "'$dir/$f'"; 1396 } 1397 1398 my @unexpected; 1399 1400 unless (opendir D, $dir) { 1401 die "$NAME: Cannot open directory '$dir': $!\n"; 1402 } 1403 while (defined(my $f = readdir(D))) { 1404 next if $f =~ /^\.\.?$/; 1405 if ($expected{$f}) { 1406 delete $expected{$f}; 1407 } 1408 else { 1409 push @unexpected, "'$dir/$f'"; 1410 } 1411 } 1412 closedir D; 1413 1414 if (keys %expected) { 1415 my @missing = values %expected; 1416 if (@unexpected) { 1417 die ("$NAME: Missing file", ((@missing > 1) ? "s " : " "), 1418 join(", ", @missing), 1419 " and found unexpected file",((@unexpected > 1) ? "s " : " "), 1420 join(", ", @unexpected), "\n"); 1421 } 1422 die ("$NAME: Missing file", ((@missing > 1) ? "s " : " "), 1423 join(", ", @missing), "\n"); 1424 } 1425 if (@unexpected) { 1426 die ("$NAME: Found unexpected file", ((@unexpected > 1) ? "s " : " "), 1427 join(", ", @unexpected), "\n"); 1428 } 1429} 1430 1431 1432# verify_empty_dirs($base_dir, @dir_list) 1433# 1434# For each string in @dir_list, if the string begins with a slash 1435# (/), use it as is. If the string does not begin with a slash and 1436# $base_dir is defined, prepend the string "$base_dir/" to the 1437# string. 1438# 1439# For each of the (possibly modified) strings, see if a directory 1440# exists with that name. If so, verify that no files exist that 1441# directory. 1442# 1443# Exit with an error if any directories are not empty. 1444# 1445sub verify_empty_dirs 1446{ 1447 my ($base_dir, @dir_list) = @_; 1448 1449 my @unexpected; 1450 1451 if (defined $base_dir) { 1452 for my $d (@dir_list) { 1453 unless ($d =~ m,^/,) { 1454 $d = $base_dir.'/'.$d; 1455 } 1456 } 1457 } 1458 for my $d (@dir_list) { 1459 unless (-d $d) { 1460 warn "$NAME: Entry '$d' exists but is not a directory\n" 1461 if -e $d; 1462 next; 1463 } 1464 unless (opendir D, $d) { 1465 warn "$NAME: Cannot open directory '$d': $!\n"; 1466 next; 1467 } 1468 while (my $f = readdir(D)) { 1469 next if $f =~ /^\.\.?$/; 1470 push @unexpected, "'$d/$f'"; 1471 } 1472 closedir D; 1473 } 1474 1475 if (@unexpected) { 1476 die "$NAME: Found unexpected file", ((@unexpected > 1) ? "s " : " "), 1477 join(", ", @unexpected), "\n"; 1478 } 1479} 1480 1481 1482sub make_test_scripts 1483{ 1484 my ($APP, $test_tuples, $tests_list_hash) = @_; 1485 1486 my @temp_param = ('make-tests-XXXXXXXX', 1487 UNLINK => 1, 1488 DIR => File::Spec->tmpdir); 1489 1490 if ($ENV{SK_TESTS_SAVEOUTPUT}) { 1491 $File::Temp::KEEP_ALL = 1; 1492 } 1493 1494 # get the path to the application 1495 my $APP_PATH; 1496 if ($APP =~ m,/,) { 1497 $APP_PATH = $APP; 1498 $APP =~ s,.*/,,; 1499 } 1500 else { 1501 $APP_PATH = "./$APP"; 1502 } 1503 1504 # variable that holds the name of the application for use in the 1505 # script; this variable includes the leading "$". 1506 my $APP_VARNAME = '$'.$APP; 1507 $APP_VARNAME =~ s/-/_/g; 1508 1509 my @test_list; 1510 my @xfail_list; 1511 1512 our (%global_tests); 1513 1514 TUPLE: 1515 while (defined(my $tuple = shift @$test_tuples)) { 1516 # first two arguments in tuple are positional 1517 my $test_name = shift @$tuple; 1518 my $test_type = shift @$tuple; 1519 1520 # print the name of the file to create; this can be 1521 # over-ridden if the test-tuple contains a -testfile value 1522 my $outfile = "$APP-$test_name.pl"; 1523 print "Creating $outfile\n"; 1524 1525 # others are in tuple are by keyword 1526 my ($file_keys, $app_keys, $env_hash, $lib_list, $temp_keys, 1527 $feature_list, $exit77, $pretest, @cmd_list); 1528 while (defined (my $k = shift @$tuple)) { 1529 if ($k =~ /^-files?/) { 1530 $file_keys = shift @$tuple; 1531 } 1532 elsif ($k =~ /^-apps?/) { 1533 $app_keys = shift @$tuple; 1534 } 1535 elsif ($k =~ /^-env/) { 1536 $env_hash = shift @$tuple; 1537 } 1538 elsif ($k =~ /^-libs?/) { 1539 $lib_list = shift @$tuple; 1540 } 1541 elsif ($k =~ /^-temps?/) { 1542 $temp_keys = shift @$tuple; 1543 } 1544 elsif ($k =~ /^-cmds?/) { 1545 my $tmp = shift @$tuple; 1546 if ('ARRAY' eq ref($tmp)) { 1547 @cmd_list = @$tmp; 1548 } else { 1549 @cmd_list = ($tmp); 1550 } 1551 } 1552 elsif ($k =~ /^-features?/) { 1553 $feature_list = shift @$tuple; 1554 } 1555 elsif ($k =~ /^-exit77/) { 1556 $exit77 = shift @$tuple; 1557 } 1558 elsif ($k =~ /^-pretest/) { 1559 $pretest = shift @$tuple; 1560 } 1561 elsif ($k =~ /^-testfile$/) { 1562 $outfile = shift @$tuple; 1563 } 1564 elsif ($k =~ /^-/) { 1565 croak "$NAME: Unknown tuple key '$k'"; 1566 } 1567 else { 1568 croak "$NAME: Expected to find key in tuple"; 1569 } 1570 } 1571 1572 # add file to create to our output list 1573 $outfile = "tests/$outfile"; 1574 push @test_list, $outfile; 1575 $outfile = "$srcdir/$outfile"; 1576 1577 if ($global_tests{$outfile}) { 1578 carp "\nWARNING!! Duplicate test '$outfile'\n"; 1579 } 1580 $global_tests{$outfile} = 1; 1581 1582 # the body of the test file we are writing 1583 my $test_body = <<EOF; 1584#! /usr/bin/perl -w 1585#HEADER 1586use strict; 1587use SiLKTests; 1588 1589my $APP_VARNAME = check_silk_app('$APP'); 1590EOF 1591 1592 # the body of the string we eval to get the test command 1593 my $run_body = "my $APP_VARNAME = '$APP_PATH';\n"; 1594 1595 # handle any required applications 1596 if ($app_keys && @$app_keys) { 1597 for my $key (@$app_keys) { 1598 my $app = check_silk_app($key); 1599 if (!$app) { 1600 die "$NAME: No app '$app'"; 1601 } 1602 $run_body .= "my \$$key = '$app';\n"; 1603 $test_body .= "my \$$key = check_silk_app('$key');\n"; 1604 } 1605 } 1606 1607 # handle any required data files 1608 if ($file_keys && @$file_keys) { 1609 $run_body .= "my \%file;\n"; 1610 $test_body .= "my \%file;\n"; 1611 for my $key (@$file_keys) { 1612 my $file = get_datafile($key); 1613 if (!$file) { 1614 # Skip V6 when built without V6 1615 if ($key eq 'v6data' && $SiLKTests::SK_ENABLE_IPV6 == 0) { 1616 warn $INDENT, "Skipping V6 test\n"; 1617 next TUPLE; 1618 } 1619 die "$NAME: No file '$key'"; 1620 } 1621 $run_body .= "\$file{$key} = '$file';\n"; 1622 $test_body .= "\$file{$key} = get_data_or_exit77('$key');\n"; 1623 } 1624 } 1625 1626 # handle any necessary temporary files 1627 if ($temp_keys && @$temp_keys) { 1628 $run_body .= "my \%temp;\n"; 1629 $test_body .= "my \%temp;\n"; 1630 for my $key (@$temp_keys) { 1631 my $temp = make_tempname("$APP-$test_name-$key"); 1632 if (!$temp) { 1633 die "$NAME: No temp '$APP-$test_name-$key'"; 1634 } 1635 # make certain to start with a clean slate 1636 unlink $temp; 1637 $run_body .= "\$temp{$key} = '$temp';\n"; 1638 $test_body .= "\$temp{$key} = make_tempname('$key');\n"; 1639 } 1640 } 1641 1642 # Set any environment variables 1643 if ($env_hash) { 1644 for my $var (sort keys %$env_hash) { 1645 my $val = $env_hash->{$var}; 1646 $test_body .= "\$ENV{$var} = $val;\n"; 1647 $run_body .= "\$ENV{$var} = $val;\n"; 1648 } 1649 } 1650 1651 # Set the LD_LIBRARY_PATH 1652 if ($lib_list) { 1653 my $new_libs = join ", ", map {"'/$_'"} @$lib_list; 1654 my $libs_expr .= <<EOF; 1655add_plugin_dirs($new_libs); 1656EOF 1657 1658 $test_body .= $libs_expr; 1659 $run_body .= $libs_expr; 1660 } 1661 1662 # Add feature checks 1663 if ($feature_list && @$feature_list) { 1664 $test_body .= <<EOF; 1665check_features(qw(@$feature_list)); 1666EOF 1667 } 1668 if ($exit77) { 1669 $test_body .= <<EOF; 1670 1671exit 77 if sub { $exit77 }->(); 1672 1673EOF 1674 } 1675 1676 # add any extra code 1677 if ($pretest) { 1678 $run_body .= "\n$pretest\n"; 1679 $test_body .= "\n$pretest\n"; 1680 } 1681 1682 # This gets filled in by the various test types 1683 my $header = "\n"; 1684 1685 # run the test, which depends on its type 1686 if ($test_type == $STATUS) { 1687 if (@cmd_list > 1) { 1688 croak "$NAME: Too many commands\n"; 1689 } 1690 my $cmd = shift @cmd_list; 1691 1692 my ($fh, $tmp_cmd) = File::Temp::tempfile(@temp_param); 1693 1694 # make $fh unbuffered 1695 select((select($fh), $| = 1)[0]); 1696 print $fh <<EOF; 1697use strict; 1698do "$INC{'SiLKTests.pm'}"; 1699import SiLKTests; 1700$run_body 1701exec "$cmd" 1702EOF 1703 1704 if ($DEBUG_SCRIPTS) { 1705 print $INDENT, "****\n"; 1706 seek $fh, 0, 0; 1707 while (defined (my $line = <$fh>)) { 1708 print $INDENT, $line; 1709 } 1710 print $INDENT, "****\n"; 1711 } 1712 1713 # the run_body returns the string containing the test to run 1714 my %OLD_ENV = (%ENV); 1715 $run_body .= qq/"$cmd"/; 1716 my $run_cmd = eval "$run_body" 1717 or croak "ERROR! '$cmd'\n$@"; 1718 %ENV = (%OLD_ENV); 1719 1720 print $INDENT, "Invoking $run_cmd\n"; 1721 my $status = check_exit_status("perl $tmp_cmd"); 1722 my ($status_str, $exit_conditions); 1723 if (!$status) { 1724 $status_str = 'ERR'; 1725 $exit_conditions = '? 1 : 0'; 1726 } 1727 else { 1728 $status_str = 'OK'; 1729 $exit_conditions = '? 0 : 1'; 1730 } 1731 print $INDENT, "[$status_str]\n"; 1732 1733 sanitize_cmd(\$run_cmd); 1734 1735 # store the test string in the test itself 1736 $header = <<EOF; 1737# STATUS: $status_str 1738# TEST: $run_cmd 1739EOF 1740 1741 $test_body .= <<EOF; 1742my \$cmd = "$cmd"; 1743 1744exit (check_exit_status(\$cmd) $exit_conditions); 1745EOF 1746 } 1747 1748 elsif ($test_type == $MD5 || $test_type == $ERR_MD5) { 1749 if (@cmd_list > 1) { 1750 croak "$NAME: Too many commands\n"; 1751 } 1752 my $cmd = shift @cmd_list; 1753 1754 my ($fh, $tmp_cmd) = File::Temp::tempfile(@temp_param); 1755 1756 # make $fh unbuffered 1757 select((select($fh), $| = 1)[0]); 1758 print $fh <<EOF; 1759use strict; 1760do "$INC{'SiLKTests.pm'}"; 1761import SiLKTests; 1762$run_body 1763exec "$cmd" 1764EOF 1765 1766 if ($DEBUG_SCRIPTS) { 1767 print $INDENT, "****\n"; 1768 seek $fh, 0, 0; 1769 while (defined (my $line = <$fh>)) { 1770 print $INDENT, $line; 1771 } 1772 print $INDENT, "****\n"; 1773 } 1774 1775 # the run_body returns the string containing the test to run 1776 my %OLD_ENV = (%ENV); 1777 $run_body .= qq/"$cmd"/; 1778 my $run_cmd = eval "$run_body" 1779 or croak "ERROR! '$cmd'\n$@"; 1780 %ENV = (%OLD_ENV); 1781 1782 my $expect_err = ""; 1783 if ($test_type == $ERR_MD5) { 1784 $expect_err = ", 1"; 1785 } 1786 1787 my $test_type_str = (($test_type == $MD5) ? "MD5" : "ERR_MD5"); 1788 1789 print $INDENT, "Invoking $run_cmd\n"; 1790 my $md5; 1791 compute_md5(\$md5, "perl $tmp_cmd", !!$expect_err); 1792 print $INDENT, "[$md5]\n"; 1793 1794 sanitize_cmd(\$run_cmd); 1795 1796 # store the test string in the test itself 1797 $header = <<EOF; 1798# $test_type_str: $md5 1799# TEST: $run_cmd 1800EOF 1801 1802 $test_body .= <<EOF; 1803my \$cmd = "$cmd"; 1804my \$md5 = "$md5"; 1805 1806check_md5_output(\$md5, \$cmd$expect_err); 1807EOF 1808 } 1809 1810 elsif ($test_type == $CMP_MD5) { 1811 my @expanded_cmd = (); 1812 1813 my $run_body_orig = $run_body; 1814 for my $cmd (@cmd_list) { 1815 1816 my ($fh, $tmp_cmd) = File::Temp::tempfile(@temp_param); 1817 1818 # make $fh unbuffered 1819 select((select($fh), $| = 1)[0]); 1820 print $fh <<EOF; 1821use strict; 1822do "$INC{'SiLKTests.pm'}"; 1823import SiLKTests; 1824$run_body_orig 1825exec "$cmd" 1826EOF 1827 1828 if ($DEBUG_SCRIPTS) { 1829 print $INDENT, "****\n"; 1830 seek $fh, 0, 0; 1831 while (defined (my $line = <$fh>)) { 1832 print $INDENT, $line; 1833 } 1834 print $INDENT, "****\n"; 1835 } 1836 1837 my %OLD_ENV = (%ENV); 1838 $run_body = $run_body_orig . qq/"$cmd"/; 1839 my $run_cmd = eval "$run_body" 1840 or croak "ERROR! '$cmd'\n$@"; 1841 %ENV = (%OLD_ENV); 1842 1843 print $INDENT, "Invoking $run_cmd\n"; 1844 my $md5; 1845 compute_md5(\$md5, "perl $tmp_cmd"); 1846 print $INDENT, "[$md5]\n"; 1847 1848 sanitize_cmd(\$run_cmd); 1849 1850 push @expanded_cmd, $run_cmd; 1851 } 1852 1853 $header = join("\n# TEST: ", '# CMP_MD5', @expanded_cmd)."\n"; 1854 1855 my $cmds_string = '"'.join(qq|",\n|.(' 'x12).'"', @cmd_list).'"'; 1856 1857 $test_body .= <<EOF; 1858my \@cmds = ($cmds_string); 1859my \$md5_old; 1860 1861for my \$cmd (\@cmds) { 1862 my \$md5; 1863 compute_md5(\\\$md5, \$cmd); 1864 if (!defined \$md5_old) { 1865 \$md5_old = \$md5; 1866 } 1867 elsif (\$md5_old ne \$md5) { 1868 die "$APP-$test_name.pl: checksum mismatch [\$md5] (\$cmd)\\n"; 1869 } 1870} 1871EOF 1872 } 1873 1874 # fill in the header 1875 $test_body =~ s/^#HEADER/$header/m; 1876 1877 open OUTFILE, "> $outfile" 1878 or die "$NAME: open $outfile: $!"; 1879 print OUTFILE $test_body; 1880 close(OUTFILE) 1881 or die "$NAME: close $outfile: $!"; 1882 } 1883 1884 1885 # Tests are complete. Either put the values into the hash 1886 # reference that was passed in, or print the values ourselves 1887 1888 if ('HASH' ne ref($tests_list_hash)) { 1889 print_tests_hash({TESTS => \@test_list, XFAIL_TESTS => \@xfail_list}); 1890 } 1891 else { 1892 if (@test_list) { 1893 unless (exists $tests_list_hash->{TESTS}) { 1894 $tests_list_hash->{TESTS} = []; 1895 } 1896 push @{$tests_list_hash->{TESTS}}, @test_list; 1897 } 1898 if (@xfail_list) { 1899 unless (exists $tests_list_hash->{XFAIL_TESTS}) { 1900 $tests_list_hash->{XFAIL_TESTS} = []; 1901 } 1902 push @{$tests_list_hash->{XFAIL_TESTS}}, @xfail_list; 1903 } 1904 } 1905} 1906 1907 1908sub print_tests_hash 1909{ 1910 my ($tests_list) = @_; 1911 1912 for my $t (qw(TESTS XFAIL_TESTS)) { 1913 if (exists($tests_list->{$t}) && @{$tests_list->{$t}}) { 1914 print "$t = @{$tests_list->{$t}}\n"; 1915 } 1916 } 1917 1918 if ($ENV{SK_TESTS_MAKEFILE}) { 1919 my $makefile = "$srcdir/Makefile.am"; 1920 if (-f $makefile) { 1921 print "Modifying $makefile\n"; 1922 1923 open MF, ">> $makefile" 1924 or croak "$NAME: Opening '$makefile' failed: $!"; 1925 print MF "\n# Added by $NAME on ".localtime()."\n"; 1926 for my $t (qw(TESTS XFAIL_TESTS)) { 1927 if (exists($tests_list->{$t}) && @{$tests_list->{$t}}) { 1928 print MF join(" \\\n\t", "$t =", @{$tests_list->{$t}}),"\n"; 1929 } 1930 } 1931 close MF 1932 or croak "$NAME: Closing '$makefile' failed: $!"; 1933 } 1934 } 1935 1936 if ($ENV{SK_TESTS_CHECK_MAKEFILE}) { 1937 my $makefile = "$srcdir/Makefile.am"; 1938 if (-f $makefile) { 1939 print "Checking $makefile\n"; 1940 1941 my %make_lists = (TESTS => {}, XFAIL_TESTS => {}); 1942 1943 open MF, "$makefile" 1944 or croak "$NAME: Opening '$makefile' failed: $!"; 1945 my $t; 1946 while (defined(my $line = <MF>)) { 1947 if ($line =~ /^(TESTS|XFAIL_TESTS) *= *\\/) { 1948 $t = $1; 1949 next; 1950 } 1951 next unless $t; 1952 if ($line =~ /^[ \t]*(\S+)(| \\)$/) { 1953 $make_lists{$t}{$1} = 1; 1954 if (!$2) { 1955 $t = undef; 1956 } 1957 } 1958 } 1959 close MF; 1960 1961 for my $t (qw(TESTS XFAIL_TESTS)) { 1962 my @missing; 1963 if (exists($tests_list->{$t})) { 1964 for my $i (@{$tests_list->{$t}}) { 1965 if (!$make_lists{$t}{$i}) { 1966 push @missing, $i; 1967 } 1968 else { 1969 delete $make_lists{$t}{$i}; 1970 } 1971 } 1972 } 1973 my @extra = keys %{$make_lists{$t}}; 1974 if (@missing) { 1975 print "MISSING $t = @missing\n"; 1976 } 1977 if (@extra) { 1978 print "EXTRA $t = @extra\n"; 1979 } 1980 } 1981 } 1982 } 1983} 1984 1985 1986# make_config_file($file, $text_reference) 1987# 1988# Writes the text in the scalar reference '$text_reference' to the 1989# file named by '$file'. In addition, when $ENV{SK_TESTS_VERBOSE} 1990# is set, prints the text to the standard error for capture by the 1991# Automake test harness. 1992# 1993# Exits the test if the file cannot be opened or written. 1994# 1995sub make_config_file 1996{ 1997 my ($out, $text_ref) = @_; 1998 1999 open CONFIG, ">", $out 2000 or die "$NAME: Cannot open file '$out': $!\n"; 2001 print CONFIG $$text_ref; 2002 close CONFIG 2003 or die "$NAME: Cannot close file '$out': $!\n"; 2004 2005 if ($ENV{SK_TESTS_VERBOSE}) { 2006 print STDERR ">> START OF FILE '$out' >>>>>>>>>>\n"; 2007 print STDERR $$text_ref; 2008 print STDERR "<< END OF FILE '$out' <<<<<<<<<<<<\n"; 2009 } 2010} 2011 2012 2013sub make_packer_sensor_conf 2014{ 2015 my ($sensor_conf, $probe_type, $port, @rest) = @_; 2016 2017 my $sensor_template = "$srcdir/tests/sensors.conf"; 2018 2019 my %features; 2020 2021 for my $f (@rest) { 2022 my $re = "\\#\U$f\\#"; 2023 $features{$f} = qr/$re/; 2024 } 2025 2026 my $text = ""; 2027 2028 open SENSOR_IN, $sensor_template 2029 or die "$NAME: Cannot open file '$sensor_template': $!\n"; 2030 while (defined (my $line = <SENSOR_IN>)) { 2031 $line =~ s/PROBETYPE/$probe_type/g; 2032 $line =~ s/RANDOMPORT/$port/g; 2033 for my $re (values %features) { 2034 $line =~ s/$re//g; 2035 } 2036 $text .= $line; 2037 } 2038 close SENSOR_IN; 2039 make_config_file($sensor_conf, \$text); 2040} 2041 2042 20431; 2044__END__ 2045