NPTest.pm

   1 package NPTest;
   2
   3 #
   4 # Helper Functions for testing Nagios Plugins
   5 #
   6
   7 require Exporter;
   8 @ISA       = qw(Exporter);
   9 @EXPORT    = qw(getTestParameter checkCmd skipMissingCmd);
  10 @EXPORT_OK = qw(DetermineTestHarnessDirectory TestsFrom SetCacheFilename);
  11
  12 use strict;
  13 use warnings;
  14
  15 use Cwd;
  16 use File::Basename;
  17
  18 use IO::File;
  19 use Data::Dumper;
  20
  21 use Test;
  22
  23 use vars qw($VERSION);
  24 $VERSION = do { my @r = (q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
  25
  26 =head1 NAME
  27
  28 NPTest - Simplify the testing of Nagios Plugins
  29
  30 =head1 DESCRIPTION
  31
  32 This modules provides convenience functions to assist in the testing
  33 of Nagios Plugins, making the testing code easier to read and write;
  34 hopefully encouraging the development of a more complete test suite for
  35 the Nagios Plugins. It is based on the patterns of testing seen in the
  36 1.4.0 release, and continues to use the L<Test> module as the basis of
  37 testing.
  38
  39 =head1 FUNCTIONS
  40
  41 This module defines three public functions, C<getTestParameter(...)>,
  42 C<checkCmd(...)> and C<skipMissingCmd(...)>.  These are exported by
  43 default via the C<use NPTest;> statement.
  44
  45 =over
  46
  47 =item getTestParameter( "ENV_VARIABLE", $brief_description, $default )
  48
  49 $default is optional.
  50
  51 This function allows the test harness
  52 developer to interactively request test parameter information from the
  53 user. The user can accept the developer's default value or reply "none"
  54 which will then be returned as "" for the test to skip if appropriate.
  55
  56 If a parameter needs to be entered and the test is run without a tty
  57 attached (such as a cronjob), the parameter will be assigned as if it
  58 was "none". Tests can check for the parameter and skip if not set.
  59
  60 Responses are stored in an external, file-based cache so subsequent test
  61 runs will use these values. The user is able to change the values by
  62 amending the values in the file /var/tmp/NPTest.cache, or by setting
  63 the appropriate environment variable before running the test.
  64
  65 The option exists to store parameters in a scoped means, allowing a
  66 test harness to a localise a parameter should the need arise. This
  67 allows a parameter of the same name to exist in a test harness
  68 specific scope, while not affecting the globally scoped parameter. The
  69 scoping identifier is the name of the test harness sans the trailing
  70 ".t".  All cache searches first look to a scoped parameter before
  71 looking for the parameter at global scope. Thus for a test harness
  72 called "check_disk.t" requesting the parameter "mountpoint_valid", the
  73 cache is first searched for "check_disk"/"mountpoint_valid", if this
  74 fails, then a search is conducted for "mountpoint_valid".
  75
  76 To facilitate quick testing setup, it is possible to accept all the
  77 developer provided defaults by setting the environment variable
  78 "NPTEST_ACCEPTDEFAULT" to "1" (or any other perl truth value). Note
  79 that, such defaults are not stored in the cache, as there is currently
  80 no mechanism to edit existing cache entries, save the use of text
  81 editor or removing the cache file completely.
  82
  83 =item C<testCmd($command)>
  84
  85 Call with NPTest->testCmd("./check_disk ...."). This returns a NPTest object
  86 which you can then run $object->return_code or $object->output against.
  87
  88 Testing of results would be done in your test script, not in this module.
  89
  90 =item C<checkCmd(...)>
  91
  92 This function is obsolete. Use C<testCmd()> instead.
  93
  94 This function attempts to encompass the majority of test styles used
  95 in testing Nagios Plugins. As each plug-in is a separate command, the
  96 typical tests we wish to perform are against the exit status of the
  97 command and the output (if any) it generated. Simplifying these tests
  98 into a single function call, makes the test harness easier to read and
  99 maintain and allows additional functionality (such as debugging) to be
 100 provided without additional effort on the part of the test harness
 101 developer.
 102
 103 It is possible to enable debugging via the environment variable
 104 C<NPTEST_DEBUG>. If this environment variable exists and its value in PERL's
 105 boolean context evaluates to true, debugging is enabled.
 106
 107 The function prototype can be expressed as follows:
 108
 109   Parameter 1 : command => DEFINED SCALAR(string)
 110   Parameter 2 : desiredExitStatus => ONE OF
 111                   SCALAR(integer)
 112                   ARRAYREF(integer)
 113                   HASHREF(integer,string)
 114                   UNDEFINED
 115   Parameter 3 : desiredOutput => SCALAR(string) OR UNDEFINED
 116   Parameter 4 : exceptions => HASH(integer,string) OR UNDEFINED
 117   Returns     : SCALAR(integer) as defined by Test::ok(...)
 118
 119 The function treats the first parameter C<$command> as a command line
 120 to execute as part of the test, it is executed only once and its exit
 121 status (C<$?E<gt>E<gt>8>) and output are captured.
 122
 123 At this point if debugging is enabled the command, its exit status and
 124 output are displayed to the tester.
 125
 126 C<checkCmd(...)> allows the testing of either the exit status or the
 127 generated output or both, not testing either will result in neither
 128 the C<Test::ok(...)> or C<Test::skip(...)> functions being called,
 129 something you probably don't want. Note that each defined test
 130 (C<$desiredExitStatus> and C<$desiredOutput>) results in a invocation
 131 of either C<Test::ok(...)> or C<Test::skip(...)>, so remember this
 132 when counting the number of tests to place in the C<Test::plan(...)>
 133 call.
 134
 135 Many Nagios Plugins test network services, some of which may not be
 136 present on all systems. To cater for this, C<checkCmd(...)> allows the
 137 tester to define exceptions based on the command's exit status. These
 138 exceptions are provided to skip tests if the test case developer
 139 believes the service is not being provided. For example, if a site
 140 does not have a POP3 server, the test harness could map the
 141 appropriate exit status to a useful message the person running the
 142 tests, telling the reason the test is being skipped.
 143
 144 Example:
 145
 146 my %exceptions = ( 2 =E<gt> "No POP Server present?" );
 147
 148 $t += checkCmd( "./check_pop I<some args>", 0, undef, %exceptions );
 149
 150 Thus, in the above example, an exit status of 2 does not result in a
 151 failed test case (as the exit status is not the desired value of 0),
 152 but a skipped test case with the message "No POP Server present?"
 153 given as the reason.
 154
 155 Sometimes the exit status of a command should be tested against a set
 156 of possible values, rather than a single value, this could especially
 157 be the case in failure testing. C<checkCmd(...)> support two methods
 158 of testing against a set of desired exit status values.
 159
 160 =over
 161
 162 =item *
 163
 164 Firstly, if C<$desiredExitStatus> is a reference to an array of exit
 165 stati, if the actual exit status of the command is present in the
 166 array, it is used in the call to C<Test::ok(...)> when testing the
 167 exit status.
 168
 169 =item *
 170
 171 Alternatively, if C<$desiredExitStatus> is a reference to a hash of
 172 exit stati (mapped to the strings "continue" or "skip"), similar
 173 processing to the above occurs with the side affect of determining if
 174 any generated output testing should proceed. Note: only the string
 175 "skip" will result in generated output testing being skipped.
 176
 177 =back
 178
 179 =item C<skipMissingCmd(...)>
 180
 181 If a command is missing and the test harness must C<Test::skip()> some
 182 or all of the tests in a given test harness this function provides a
 183 simple iterator to issue an appropriate message the requested number
 184 of times.
 185
 186 =back
 187
 188 =head1 SEE ALSO
 189
 190 L<Test>
 191
 192 The rest of the code, as I have only commented on the major public
 193 functions that test harness writers will use, not all the code present
 194 in this helper module.
 195
 196 =head1 AUTHOR
 197
 198 Copyright (c) 2005 Peter Bray.  All rights reserved.
 199
 200 This package is free software and is provided "as is" without express
 201 or implied warranty.  It may be used, redistributed and/or modified
 202 under the same terms as the Nagios Plugins release.
 203
 204 =cut
 205
 206 #
 207 # Package Scope Variables
 208 #
 209
 210 my( %CACHE ) = ();
 211
 212 # I'm not really sure wether to house a site-specific cache inside
 213 # or outside of the extracted source / build tree - lets default to outside
 214 my( $CACHEFILENAME ) = ( exists( $ENV{'NPTEST_CACHE'} ) && $ENV{'NPTEST_CACHE'} )
 215                        ? $ENV{'NPTEST_CACHE'} : "/var/tmp/NPTest.cache"; # "../Cache.pdd";
 216
 217 #
 218 # Testing Functions
 219 #
 220
 221 sub checkCmd
 222 {
 223   my( $command, $desiredExitStatus, $desiredOutput, %exceptions ) = @_;
 224
 225   my $result = NPTest->testCmd($command);
 226
 227   my $output     = $result->output;
 228   my $exitStatus = $result->return_code;
 229
 230   $output = "" unless defined( $output );
 231   chomp( $output );
 232
 233   my $testStatus;
 234
 235   my $testOutput = "continue";
 236
 237   if ( defined( $desiredExitStatus ) )
 238   {
 239     if ( ref $desiredExitStatus eq "ARRAY" )
 240     {
 241       if ( scalar( grep { $_ == $exitStatus } @{$desiredExitStatus} ) )
 242       {
 243         $desiredExitStatus = $exitStatus;
 244       }
 245       else
 246       {
 247         $desiredExitStatus = -1;
 248       }
 249     }
 250     elsif ( ref $desiredExitStatus eq "HASH" )
 251     {
 252       if ( exists( ${$desiredExitStatus}{$exitStatus} ) )
 253       {
 254         if ( defined( ${$desiredExitStatus}{$exitStatus} ) )
 255         {
 256           $testOutput = ${$desiredExitStatus}{$exitStatus};
 257         }
 258         $desiredExitStatus = $exitStatus;
 259       }
 260       else
 261       {
 262         $desiredExitStatus = -1;
 263       }
 264     }
 265
 266     if ( %exceptions && exists( $exceptions{$exitStatus} ) )
 267     {
 268       $testStatus += skip( $exceptions{$exitStatus}, $exitStatus, $desiredExitStatus );
 269       $testOutput = "skip";
 270     }
 271     else
 272     {
 273       $testStatus += ok( $exitStatus, $desiredExitStatus );
 274     }
 275   }
 276
 277   if ( defined( $desiredOutput ) )
 278   {
 279     if ( $testOutput ne "skip" )
 280     {
 281       $testStatus += ok( $output, $desiredOutput );
 282     }
 283     else
 284     {
 285       $testStatus += skip( "Skipping output test as requested", $output, $desiredOutput );
 286     }
 287   }
 288
 289   return $testStatus;
 290 }
 291
 292
 293 sub skipMissingCmd
 294 {
 295   my( $command, $count ) = @_;
 296
 297   my $testStatus;
 298
 299   for ( 1 .. $count )
 300   {
 301     $testStatus += skip( "Missing ${command} - tests skipped", 1 );
 302   }
 303
 304   return $testStatus;
 305 }
 306
 307 sub getTestParameter
 308 {
 309   my( $param, $envvar, $default, $brief, $scoped );
 310   my $new_style;
 311   if (scalar @_ <= 3) {
 312         ($param, $brief, $default) = @_;
 313         $envvar = $param;
 314         $new_style = 1;
 315   } else {
 316         ( $param, $envvar, $default, $brief, $scoped ) = @_;
 317         $new_style = 0;
 318   }
 319
 320   # Apply default values for optional arguments
 321   $scoped = ( defined( $scoped ) && $scoped );
 322
 323   my $testharness = basename( (caller(0))[1], ".t" ); # used for scoping
 324
 325   if ( defined( $envvar ) &&  exists( $ENV{$envvar} ) && $ENV{$envvar} )
 326   {
 327     return $ENV{$envvar};
 328   }
 329
 330   my $cachedValue = SearchCache( $param, $testharness );
 331   if ( defined( $cachedValue ) )
 332   {
 333     # This save required to convert to new style because the key required is
 334     # changing to the environment variable
 335     if ($new_style == 0) {
 336       SetCacheParameter( $envvar, undef, $cachedValue );
 337     }
 338     return $cachedValue;
 339   }
 340
 341   my $defaultValid      = ( defined( $default ) && $default );
 342   my $autoAcceptDefault = ( exists( $ENV{'NPTEST_ACCEPTDEFAULT'} ) && $ENV{'NPTEST_ACCEPTDEFAULT'} );
 343
 344   if ( $autoAcceptDefault && $defaultValid )
 345   {
 346     return $default;
 347   }
 348
 349   # Set "none" if no terminal attached (eg, tinderbox build servers when new variables set)
 350   return "" unless (-t STDERR);
 351
 352   my $userResponse = "";
 353
 354   while ( $userResponse eq "" )
 355   {
 356     print STDERR "\n";
 357     print STDERR "Test Harness         : $testharness\n";
 358     print STDERR "Test Parameter       : $param\n";
 359     print STDERR "Environment Variable : $envvar\n" if ($param ne $envvar);
 360     print STDERR "Brief Description    : $brief\n";
 361     print STDERR "Enter value (or 'none') ", ($defaultValid ? "[${default}]" : "[]"), " => ";
 362     $userResponse = <STDIN>;
 363     $userResponse = "" if ! defined( $userResponse ); # Handle EOF
 364     chomp( $userResponse );
 365     if ( $defaultValid && $userResponse eq "" )
 366     {
 367       $userResponse = $default;
 368     }
 369   }
 370
 371   print STDERR "\n";
 372
 373   if ($userResponse =~ /^(na|none)$/) {
 374         $userResponse = "";
 375   }
 376
 377   # define all user responses at global scope
 378   SetCacheParameter( $param, ( $scoped ? $testharness : undef ), $userResponse );
 379
 380   return $userResponse;
 381 }
 382
 383 #
 384 # Internal Cache Management Functions
 385 #
 386
 387 sub SearchCache
 388 {
 389   my( $param, $scope ) = @_;
 390
 391   LoadCache();
 392
 393   if ( exists( $CACHE{$scope} ) && exists( $CACHE{$scope}{$param} ) )
 394   {
 395     return $CACHE{$scope}{$param};
 396   }
 397
 398   if ( exists( $CACHE{$param} ) )
 399   {
 400     return $CACHE{$param};
 401   }
 402   return undef; # Need this to say "nothing found"
 403 }
 404
 405 sub SetCacheParameter
 406 {
 407   my( $param, $scope, $value ) = @_;
 408
 409   if ( defined( $scope ) )
 410   {
 411     $CACHE{$scope}{$param} = $value;
 412   }
 413   else
 414   {
 415     $CACHE{$param} = $value;
 416   }
 417
 418   SaveCache();
 419 }
 420
 421 sub LoadCache
 422 {
 423   return if exists( $CACHE{'_cache_loaded_'} );
 424
 425   if ( -f $CACHEFILENAME )
 426   {
 427     my( $fileHandle ) = new IO::File;
 428
 429     if ( ! $fileHandle->open( "< ${CACHEFILENAME}" ) )
 430     {
 431       print STDERR "NPTest::LoadCache() : Problem opening ${CACHEFILENAME} : $!\n";
 432       return;
 433     }
 434
 435     my( $fileContents ) = join( "\n", <$fileHandle> );
 436
 437     $fileHandle->close();
 438
 439     my( $contentsRef ) = eval $fileContents;
 440     %CACHE = %{$contentsRef};
 441
 442   }
 443
 444   $CACHE{'_cache_loaded_'} = 1;
 445 }
 446
 447
 448 sub SaveCache
 449 {
 450   delete $CACHE{'_cache_loaded_'};
 451
 452   my( $fileHandle ) = new IO::File;
 453
 454   if ( ! $fileHandle->open( "> ${CACHEFILENAME}" ) )
 455   {
 456     print STDERR "NPTest::LoadCache() : Problem saving ${CACHEFILENAME} : $!\n";
 457     return;
 458   }
 459
 460   my( $dataDumper ) = new Data::Dumper( [ \%CACHE ] );
 461
 462   $dataDumper->Terse(1);
 463
 464   print $fileHandle $dataDumper->Dump();
 465
 466   $fileHandle->close();
 467
 468   $CACHE{'_cache_loaded_'} = 1;
 469 }
 470
 471 #
 472 # (Questionable) Public Cache Management Functions
 473 #
 474
 475 sub SetCacheFilename
 476 {
 477   my( $filename ) = @_;
 478
 479   # Unfortunately we can not validate the filename
 480   # in any meaningful way, as it may not yet exist
 481   $CACHEFILENAME = $filename;
 482 }
 483
 484
 485 #
 486 # Test Harness Wrapper Functions
 487 #
 488
 489 sub DetermineTestHarnessDirectory
 490 {
 491   my( $userSupplied ) = @_;
 492
 493   # User Supplied
 494   if ( defined( $userSupplied ) && $userSupplied )
 495   {
 496     if ( -d $userSupplied )
 497     {
 498       return $userSupplied;
 499     }
 500     else
 501     {
 502       return undef; # userSupplied is invalid -> FAIL
 503     }
 504   }
 505
 506   # Simple Case : "t" is a subdirectory of the current directory
 507   if ( -d "./t" )
 508   {
 509     return "./t";
 510   }
 511
 512   # To be honest I don't understand which case satisfies the
 513   # original code in test.pl : when $tstdir == `pwd` w.r.t.
 514   # $tstdir =~ s|^(.*)/([^/]+)/?$|$1/$2|; and if (-d "../../$2/t")
 515   # Assuming pwd is "/a/b/c/d/e" then we are testing for "/a/b/c/e/t"
 516   # if I understand the code correctly (a big assumption)
 517
 518   # Simple Case : the current directory is "t"
 519   my $pwd = cwd();
 520
 521   if ( $pwd =~ m|/t$| )
 522   {
 523     return $pwd;
 524
 525     # The alternate that might work better is
 526     # chdir( ".." );
 527     # return "./t";
 528     # As the current test harnesses assume the application
 529     # to be tested is in the current directory (ie "./check_disk ....")
 530   }
 531
 532   return undef;
 533 }
 534
 535 sub TestsFrom
 536 {
 537   my( $directory, $excludeIfAppMissing ) = @_;
 538
 539   $excludeIfAppMissing = 0 unless defined( $excludeIfAppMissing );
 540
 541   if ( ! opendir( DIR, $directory ) )
 542   {
 543     print STDERR "NPTest::TestsFrom() - Failed to open ${directory} : $!\n";
 544     return ();
 545   }
 546
 547   my( @tests ) = ();
 548
 549   my $filename;
 550   my $application;
 551
 552   while ( $filename = readdir( DIR ) )
 553   {
 554     if ( $filename =~ m/\.t$/ )
 555     {
 556       if ( $excludeIfAppMissing )
 557       {
 558         $application = basename( $filename, ".t" );
 559         if ( ! -e $application )
 560         {
 561           print STDERR "No application (${application}) found for test harness (${filename})\n";
 562           next;
 563         }
 564       }
 565       push @tests, "${directory}/${filename}";
 566     }
 567   }
 568
 569   closedir( DIR );
 570
 571   return sort @tests;
 572 }
 573
 574 # All the new object oriented stuff below
 575
 576 sub new {
 577         my $type = shift;
 578         my $self = {};
 579         return bless $self, $type;
 580 }
 581
 582 # Accessors
 583 sub return_code {
 584         my $self = shift;
 585         if (@_) {
 586                 return $self->{return_code} = shift;
 587         } else {
 588                 return $self->{return_code};
 589         }
 590 }
 591 sub output {
 592         my $self = shift;
 593         if (@_) {
 594                 return $self->{output} = shift;
 595         } else {
 596                 return $self->{output};
 597         }
 598 }
 599
 600 sub perf_output {
 601         my $self = shift;
 602         $_ = $self->{output};
 603         /\|(.*)$/;
 604         return $1 || "";
 605 }
 606
 607 sub only_output {
 608         my $self = shift;
 609         $_ = $self->{output};
 610         /(.*?)\|/;
 611         return $1 || "";
 612 }
 613
 614 sub testCmd {
 615         my $class = shift;
 616         my $command = shift or die "No command passed to testCmd";
 617         my $object = $class->new;
 618
 619         my $output = `$command`;
 620         $object->return_code($? >> 8);
 621         $_ = $? & 127;
 622         if ($_) {
 623                 die "Got signal $_ for command $command";
 624         }
 625         chomp $output;
 626         $object->output($output);
 627
 628         if ($ENV{'NPTEST_DEBUG'}) {
 629                 my ($pkg, $file, $line) = caller(0);
 630                 print "testCmd: Called from line $line in $file", $/;
 631                 print "Testing: $command", $/;
 632                 print "Output:  ", $object->output, $/;
 633                 print "Return code: ", $object->return_code, $/;
 634         }
 635
 636         return $object;
 637 }
 638
 639 1;
 640 #
 641 # End of File
 642 #