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