ext/Sys/Syslog/t/syslog.t

   1 #!/usr/bin/perl -T
   2
   3 BEGIN {
   4     if( $ENV{PERL_CORE} ) {
   5         chdir 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10 use strict;
  11 use Config;
  12 use File::Spec;
  13 use Test::More;
  14
  15 # we enable all Perl warnings, but we don't "use warnings 'all'" because
  16 # we want to disable the warnings generated by Sys::Syslog
  17 no warnings;
  18 use warnings qw(closure deprecated exiting glob io misc numeric once overflow
  19                 pack portable recursion redefine regexp severe signal substr
  20                 syntax taint uninitialized unpack untie utf8 void);
  21
  22 # check that the module is at least available
  23 plan skip_all => "Sys::Syslog was not build"
  24   unless $Config{'extensions'} =~ /\bSyslog\b/;
  25
  26 # we also need Socket
  27 plan skip_all => "Socket was not build"
  28   unless $Config{'extensions'} =~ /\bSocket\b/;
  29
  30 my $tests;
  31 plan tests => $tests;
  32
  33 BEGIN { $tests = 1 }
  34 # ok, now loads them
  35 eval 'use Socket';
  36 use_ok('Sys::Syslog', ':standard', ':extended', ':macros');
  37
  38 BEGIN { $tests += 1 }
  39 # check that the documented functions are correctly provided
  40 can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) );
  41
  42
  43 BEGIN { $tests += 1 }
  44 # check the diagnostics
  45 # setlogsock()
  46 eval { setlogsock() };
  47 like( $@, qr/^Invalid argument passed to setlogsock/,
  48     "calling setlogsock() with no argument" );
  49
  50 BEGIN { $tests += 3 }
  51 # syslog()
  52 eval { syslog() };
  53 like( $@, qr/^syslog: expecting argument \$priority/,
  54     "calling syslog() with no argument" );
  55
  56 eval { syslog(undef) };
  57 like( $@, qr/^syslog: expecting argument \$priority/,
  58     "calling syslog() with one undef argument" );
  59
  60 eval { syslog('') };
  61 like( $@, qr/^syslog: expecting argument \$format/,
  62     "calling syslog() with one empty argument" );
  63
  64
  65 my $test_string = "uid $< is testing Perl $] syslog(3) capabilities";
  66 my $r = 0;
  67
  68 BEGIN { $tests += 8 }
  69 # try to open a syslog using a Unix or stream socket
  70 SKIP: {
  71     skip "can't connect to Unix socket: _PATH_LOG unavailable", 8
  72       unless -e Sys::Syslog::_PATH_LOG();
  73
  74     # The only known $^O eq 'svr4' that needs this is NCR MP-RAS,
  75     # but assuming 'stream' in SVR4 is probably not that bad.
  76     my $sock_type = $^O =~ /^(solaris|irix|svr4|powerux)$/ ? 'stream' : 'unix';
  77
  78     eval { setlogsock($sock_type) };
  79     is( $@, '', "setlogsock() called with '$sock_type'" );
  80     TODO: {
  81         local $TODO = "minor bug";
  82         ok( $r, "setlogsock() should return true: '$r'" );
  83     }
  84
  85     # open syslog with a "local0" facility
  86     SKIP: {
  87         # openlog()
  88         $r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
  89         skip "can't connect to syslog", 6 if $@ =~ /^no connection to syslog available/;
  90         is( $@, '', "openlog() called with facility 'local0'" );
  91         ok( $r, "openlog() should return true: '$r'" );
  92
  93         # syslog()
  94         $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
  95         is( $@, '', "syslog() called with level 'info'" );
  96         ok( $r, "syslog() should return true: '$r'" );
  97
  98         # closelog()
  99         $r = eval { closelog() } || 0;
 100         is( $@, '', "closelog()" );
 101         ok( $r, "closelog() should return true: '$r'" );
 102     }
 103 }
 104
 105
 106 BEGIN { $tests += 20 * 6 }
 107 # try to open a syslog using all the available connection methods
 108 for my $sock_type (qw(native stream unix inet tcp udp)) {
 109     SKIP: {
 110         # setlogsock() called with an arrayref
 111         $r = eval { setlogsock([$sock_type]) } || 0;
 112         skip "can't use '$sock_type' socket", 20 unless $r;
 113         is( $@, '', "setlogsock() called with ['$sock_type']" );
 114         ok( $r, "setlogsock() should return true: '$r'" );
 115
 116         # setlogsock() called with a single argument
 117         $r = eval { setlogsock($sock_type) } || 0;
 118         skip "can't use '$sock_type' socket", 18 unless $r;
 119         is( $@, '', "setlogsock() called with '$sock_type'" );
 120         ok( $r, "setlogsock() should return true: '$r'" );
 121
 122         # openlog() without option NDELAY
 123         $r = eval { openlog('perl', '', 'local0') } || 0;
 124         skip "can't connect to syslog", 16 if $@ =~ /^no connection to syslog available/;
 125         is( $@, '', "openlog() called with facility 'local0' and without option 'ndelay'" );
 126         ok( $r, "openlog() should return true: '$r'" );
 127
 128         # openlog() with the option NDELAY
 129         $r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
 130         skip "can't connect to syslog", 14 if $@ =~ /^no connection to syslog available/;
 131         is( $@, '', "openlog() called with facility 'local0' with option 'ndelay'" );
 132         ok( $r, "openlog() should return true: '$r'" );
 133
 134         # syslog() with negative level, should fail
 135         $r = eval { syslog(-1, "$test_string by connecting to a $sock_type socket") } || 0;
 136         like( $@, '/^syslog: invalid level\/facility: /', "syslog() called with level -1" );
 137         ok( !$r, "syslog() should return false: '$r'" );
 138
 139         # syslog() with levels "info" and "notice" (as a strings), should fail
 140         $r = eval { syslog('info,notice', "$test_string by connecting to a $sock_type socket") } || 0;
 141         like( $@, '/^syslog: too many levels given: notice/', "syslog() called with level 'info,notice'" );
 142         ok( !$r, "syslog() should return false: '$r'" );
 143
 144         # syslog() with facilities "local0" and "local1" (as a strings), should fail
 145         $r = eval { syslog('local0,local1', "$test_string by connecting to a $sock_type socket") } || 0;
 146         like( $@, '/^syslog: too many facilities given: local1/', "syslog() called with level 'info,notice'" );
 147         ok( !$r, "syslog() should return false: '$r'" );
 148
 149         # syslog() with level "info" (as a string), should pass
 150         $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket (errno=%m)") } || 0;
 151         is( $@, '', "syslog() called with level 'info' (string)" );
 152         ok( $r, "syslog() should return true: '$r'" );
 153
 154         # syslog() with level "info" (as a macro), should pass
 155         $r = eval { syslog(LOG_INFO(), "$test_string by connecting to a $sock_type socket (errno=%m)") } || 0;
 156         is( $@, '', "syslog() called with level 'info' (macro)" );
 157         ok( $r, "syslog() should return true: '$r'" );
 158
 159         # syslog() with facility "kern" (as a string), should fail
 160         #$r = eval { syslog('kern', "$test_string by connecting to a $sock_type socket") } || 0;
 161         #like( $@, '/^syslog: invalid level/facility: kern/', "syslog() called with facility 'kern'" );
 162         #ok( !$r, "syslog() should return false: '$r'" );
 163
 164         # syslog() with facility "kern" (as a macro), should fail
 165         #$r = eval { syslog(LOG_KERN, "$test_string by connecting to a $sock_type socket") } || 0;
 166         #like( $@, '/^syslog: invalid level/facility: 0/', "syslog() called with facility 'kern'" );
 167         #ok( !$r, "syslog() should return false: '$r'" );
 168
 169         SKIP: {
 170             skip "skipping closelog() tests for 'console'", 2 if $sock_type eq 'console';
 171             # closelog()
 172             $r = eval { closelog() } || 0;
 173             is( $@, '', "closelog()" );
 174             ok( $r, "closelog() should return true: '$r'" );
 175         }
 176     }
 177 }
 178
 179
 180 BEGIN { $tests += 10 }
 181 # setlogsock() with "stream" and an undef path
 182 $r = eval { setlogsock("stream", undef ) } || '';
 183 is( $@, '', "setlogsock() called, with 'stream' and an undef path" );
 184 ok( $r, "setlogsock() should return true: '$r'" );
 185
 186 # setlogsock() with "stream" and an empty path
 187 $r = eval { setlogsock("stream", '' ) } || '';
 188 is( $@, '', "setlogsock() called, with 'stream' and an empty path" );
 189 ok( !$r, "setlogsock() should return false: '$r'" );
 190
 191 # setlogsock() with "stream" and /dev/null
 192 $r = eval { setlogsock("stream", '/dev/null' ) } || '';
 193 is( $@, '', "setlogsock() called, with 'stream' and '/dev/null'" );
 194 ok( $r, "setlogsock() should return true: '$r'" );
 195
 196 # setlogsock() with "stream" and a non-existing file
 197 $r = eval { setlogsock("stream", 'test.log' ) } || '';
 198 is( $@, '', "setlogsock() called, with 'stream' and 'test.log' (file does not exist)" );
 199 ok( !$r, "setlogsock() should return false: '$r'" );
 200
 201 # setlogsock() with "stream" and a local file
 202 SKIP: {
 203     my $logfile = "test.log";
 204     open(LOG, ">$logfile") or skip "can't create file '$logfile': $!", 2;
 205     close(LOG);
 206     $r = eval { setlogsock("stream", $logfile ) } || '';
 207     is( $@, '', "setlogsock() called, with 'stream' and '$logfile' (file exists)" );
 208     ok( $r, "setlogsock() should return true: '$r'" );
 209     unlink($logfile);
 210 }
 211
 212
 213 BEGIN { $tests += 3 + 4 * 3 }
 214 # setlogmask()
 215 {
 216     my $oldmask = 0;
 217
 218     $oldmask = eval { setlogmask(0) } || 0;
 219     is( $@, '', "setlogmask() called with a null mask" );
 220     $r = eval { setlogmask(0) } || 0;
 221     is( $@, '', "setlogmask() called with a null mask (second time)" );
 222     is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
 223
 224     my @masks = (
 225         LOG_MASK(LOG_ERR()),
 226         ~LOG_MASK(LOG_INFO()),
 227         LOG_MASK(LOG_CRIT()) | LOG_MASK(LOG_ERR()) | LOG_MASK(LOG_WARNING()),
 228     );
 229
 230     for my $newmask (@masks) {
 231         $r = eval { setlogmask($newmask) } || 0;
 232         is( $@, '', "setlogmask() called with a new mask" );
 233         is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
 234         $r = eval { setlogmask(0) } || 0;
 235         is( $@, '', "setlogmask() called with a null mask" );
 236         is( $r, $newmask, "setlogmask() must return the new mask");
 237         setlogmask($oldmask);
 238     }
 239 }