ext/Sys-Syslog/t/syslog.t

   1 #!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 # if someone is using warnings::compat, the previous trick won't work, so we
  23 # must manually disable warnings
  24 $^W = 0 if $] < 5.006;
  25
  26 my $is_Win32  = $^O =~ /win32/i;
  27 my $is_Cygwin = $^O =~ /cygwin/i;
  28
  29 # if testing in core, check that the module is at least available
  30 if ($ENV{PERL_CORE}) {
  31     plan skip_all => "Sys::Syslog was not build"
  32         unless $Config{'extensions'} =~ /\bSyslog\b/;
  33 }
  34
  35 # we also need Socket
  36 plan skip_all => "Socket was not build"
  37     unless $Config{'extensions'} =~ /\bSocket\b/;
  38
  39 my $tests;
  40 plan tests => $tests;
  41
  42 # any remaining warning should be severly punished
  43 BEGIN { eval "use Test::NoWarnings"; $tests = $@ ? 0 : 1; }
  44
  45 BEGIN { $tests += 1 }
  46 # ok, now loads them
  47 eval 'use Socket';
  48 use_ok('Sys::Syslog', ':standard', ':extended', ':macros');
  49
  50 BEGIN { $tests += 1 }
  51 # check that the documented functions are correctly provided
  52 can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) );
  53
  54
  55 BEGIN { $tests += 1 }
  56 # check the diagnostics
  57 # setlogsock()
  58 eval { setlogsock() };
  59 like( $@, qr/^Invalid argument passed to setlogsock/,
  60     "calling setlogsock() with no argument" );
  61
  62 BEGIN { $tests += 3 }
  63 # syslog()
  64 eval { syslog() };
  65 like( $@, qr/^syslog: expecting argument \$priority/,
  66     "calling syslog() with no argument" );
  67
  68 eval { syslog(undef) };
  69 like( $@, qr/^syslog: expecting argument \$priority/,
  70     "calling syslog() with one undef argument" );
  71
  72 eval { syslog('') };
  73 like( $@, qr/^syslog: expecting argument \$format/,
  74     "calling syslog() with one empty argument" );
  75
  76
  77 my $test_string = "uid $< is testing Perl $] syslog(3) capabilities";
  78 my $r = 0;
  79
  80 BEGIN { $tests += 8 }
  81 # try to open a syslog using a Unix or stream socket
  82 SKIP: {
  83     skip "can't connect to Unix socket: _PATH_LOG unavailable", 8
  84       unless -e Sys::Syslog::_PATH_LOG();
  85
  86     # The only known $^O eq 'svr4' that needs this is NCR MP-RAS,
  87     # but assuming 'stream' in SVR4 is probably not that bad.
  88     my $sock_type = $^O =~ /^(solaris|irix|svr4|powerux)$/ ? 'stream' : 'unix';
  89
  90     eval { setlogsock($sock_type) };
  91     is( $@, '', "setlogsock() called with '$sock_type'" );
  92     TODO: {
  93         local $TODO = "minor bug";
  94         ok( $r, "setlogsock() should return true: '$r'" );
  95     }
  96
  97     # open syslog with a "local0" facility
  98     SKIP: {
  99         # openlog()
 100         $r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
 101         skip "can't connect to syslog", 6 if $@ =~ /^no connection to syslog available/;
 102         is( $@, '', "openlog() called with facility 'local0'" );
 103         ok( $r, "openlog() should return true: '$r'" );
 104
 105         # syslog()
 106         $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
 107         is( $@, '', "syslog() called with level 'info'" );
 108         ok( $r, "syslog() should return true: '$r'" );
 109
 110         # closelog()
 111         $r = eval { closelog() } || 0;
 112         is( $@, '', "closelog()" );
 113         ok( $r, "closelog() should return true: '$r'" );
 114     }
 115 }
 116
 117
 118 BEGIN { $tests += 22 * 8 }
 119 # try to open a syslog using all the available connection methods
 120 my @passed = ();
 121 for my $sock_type (qw(native eventlog unix pipe stream inet tcp udp)) {
 122     SKIP: {
 123         skip "the 'stream' mechanism because a previous mechanism with similar interface succeeded", 22
 124             if $sock_type eq 'stream' and grep {/pipe|unix/} @passed;
 125
 126         # setlogsock() called with an arrayref
 127         $r = eval { setlogsock([$sock_type]) } || 0;
 128         skip "can't use '$sock_type' socket", 22 unless $r;
 129         is( $@, '', "[$sock_type] setlogsock() called with ['$sock_type']" );
 130         ok( $r, "[$sock_type] setlogsock() should return true: '$r'" );
 131
 132         # setlogsock() called with a single argument
 133         $r = eval { setlogsock($sock_type) } || 0;
 134         skip "can't use '$sock_type' socket", 20 unless $r;
 135         is( $@, '', "[$sock_type] setlogsock() called with '$sock_type'" );
 136         ok( $r, "[$sock_type] setlogsock() should return true: '$r'" );
 137
 138         # openlog() without option NDELAY
 139         $r = eval { openlog('perl', '', 'local0') } || 0;
 140         skip "can't connect to syslog", 18 if $@ =~ /^no connection to syslog available/;
 141         is( $@, '', "[$sock_type] openlog() called with facility 'local0' and without option 'ndelay'" );
 142         ok( $r, "[$sock_type] openlog() should return true: '$r'" );
 143
 144         # openlog() with the option NDELAY
 145         $r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
 146         skip "can't connect to syslog", 16 if $@ =~ /^no connection to syslog available/;
 147         is( $@, '', "[$sock_type] openlog() called with facility 'local0' with option 'ndelay'" );
 148         ok( $r, "[$sock_type] openlog() should return true: '$r'" );
 149
 150         # syslog() with negative level, should fail
 151         $r = eval { syslog(-1, "$test_string by connecting to a $sock_type socket") } || 0;
 152         like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level -1" );
 153         ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
 154
 155         # syslog() with invalid level, should fail
 156         $r = eval { syslog("plonk", "$test_string by connecting to a $sock_type socket") } || 0;
 157         like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level plonk" );
 158         ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
 159
 160         # syslog() with levels "info" and "notice" (as a strings), should fail
 161         $r = eval { syslog('info,notice', "$test_string by connecting to a $sock_type socket") } || 0;
 162         like( $@, '/^syslog: too many levels given: notice/', "[$sock_type] syslog() called with level 'info,notice'" );
 163         ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
 164
 165         # syslog() with facilities "local0" and "local1" (as a strings), should fail
 166         $r = eval { syslog('local0,local1', "$test_string by connecting to a $sock_type socket") } || 0;
 167         like( $@, '/^syslog: too many facilities given: local1/', "[$sock_type] syslog() called with level 'local0,local1'" );
 168         ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
 169
 170         # syslog() with level "info" (as a string), should pass
 171         $r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
 172         is( $@, '', "[$sock_type] syslog() called with level 'info' (string)" );
 173         ok( $r, "[$sock_type] syslog() should return true: '$r'" );
 174
 175         # syslog() with level "info" (as a macro), should pass
 176         { local $! = 1;
 177           $r = eval { syslog(LOG_INFO(), "$test_string by connecting to a $sock_type socket, setting a fake errno: %m") } || 0;
 178         }
 179         is( $@, '', "[$sock_type] syslog() called with level 'info' (macro)" );
 180         ok( $r, "[$sock_type] syslog() should return true: '$r'" );
 181
 182         push @passed, $sock_type;
 183
 184         SKIP: {
 185             skip "skipping closelog() tests for 'console'", 2 if $sock_type eq 'console';
 186             # closelog()
 187             $r = eval { closelog() } || 0;
 188             is( $@, '', "[$sock_type] closelog()" );
 189             ok( $r, "[$sock_type] closelog() should return true: '$r'" );
 190         }
 191     }
 192 }
 193
 194
 195 BEGIN { $tests += 10 }
 196 SKIP: {
 197     skip "not testing setlogsock('stream') on Win32", 10 if $is_Win32;
 198     skip "the 'unix' mechanism works, so the tests will likely fail with the 'stream' mechanism", 10
 199         if grep {/unix/} @passed;
 200
 201     skip "not testing setlogsock('stream'): _PATH_LOG unavailable", 10
 202         unless -e Sys::Syslog::_PATH_LOG();
 203
 204     # setlogsock() with "stream" and an undef path
 205     $r = eval { setlogsock("stream", undef ) } || '';
 206     is( $@, '', "setlogsock() called, with 'stream' and an undef path" );
 207     if ($is_Cygwin) {
 208         if (-x "/usr/sbin/syslog-ng") {
 209             ok( $r, "setlogsock() on Cygwin with syslog-ng should return true: '$r'" );
 210         }
 211         else {
 212             ok( !$r, "setlogsock() on Cygwin without syslog-ng should return false: '$r'" );
 213         }
 214     }
 215     else  {
 216         ok( $r, "setlogsock() should return true: '$r'" );
 217     }
 218
 219     # setlogsock() with "stream" and an empty path
 220     $r = eval { setlogsock("stream", '' ) } || '';
 221     is( $@, '', "setlogsock() called, with 'stream' and an empty path" );
 222     ok( !$r, "setlogsock() should return false: '$r'" );
 223
 224     # setlogsock() with "stream" and /dev/null
 225     $r = eval { setlogsock("stream", '/dev/null' ) } || '';
 226     is( $@, '', "setlogsock() called, with 'stream' and '/dev/null'" );
 227     ok( $r, "setlogsock() should return true: '$r'" );
 228
 229     # setlogsock() with "stream" and a non-existing file
 230     $r = eval { setlogsock("stream", 'test.log' ) } || '';
 231     is( $@, '', "setlogsock() called, with 'stream' and 'test.log' (file does not exist)" );
 232     ok( !$r, "setlogsock() should return false: '$r'" );
 233
 234     # setlogsock() with "stream" and a local file
 235     SKIP: {
 236         my $logfile = "test.log";
 237         open(LOG, ">$logfile") or skip "can't create file '$logfile': $!", 2;
 238         close(LOG);
 239         $r = eval { setlogsock("stream", $logfile ) } || '';
 240         is( $@, '', "setlogsock() called, with 'stream' and '$logfile' (file exists)" );
 241         ok( $r, "setlogsock() should return true: '$r'" );
 242         unlink($logfile);
 243     }
 244 }
 245
 246
 247 BEGIN { $tests += 3 + 4 * 3 }
 248 # setlogmask()
 249 {
 250     my $oldmask = 0;
 251
 252     $oldmask = eval { setlogmask(0) } || 0;
 253     is( $@, '', "setlogmask() called with a null mask" );
 254     $r = eval { setlogmask(0) } || 0;
 255     is( $@, '', "setlogmask() called with a null mask (second time)" );
 256     is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
 257
 258     my @masks = (
 259         LOG_MASK(LOG_ERR()),
 260         ~LOG_MASK(LOG_INFO()),
 261         LOG_MASK(LOG_CRIT()) | LOG_MASK(LOG_ERR()) | LOG_MASK(LOG_WARNING()),
 262     );
 263
 264     for my $newmask (@masks) {
 265         $r = eval { setlogmask($newmask) } || 0;
 266         is( $@, '', "setlogmask() called with a new mask" );
 267         is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
 268         $r = eval { setlogmask(0) } || 0;
 269         is( $@, '', "setlogmask() called with a null mask" );
 270         is( $r, $newmask, "setlogmask() must return the new mask");
 271         setlogmask($oldmask);
 272     }
 273 }