|
Packit |
972a07 |
#!perl -T
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
use strict;
|
|
Packit |
972a07 |
use Config;
|
|
Packit |
972a07 |
use FileHandle;
|
|
Packit |
972a07 |
use File::Spec;
|
|
Packit |
972a07 |
use Test::More;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# we enable all Perl warnings, but we don't "use warnings 'all'" because
|
|
Packit |
972a07 |
# we want to disable the warnings generated by Sys::Syslog
|
|
Packit |
972a07 |
no warnings;
|
|
Packit |
972a07 |
use warnings qw(closure deprecated exiting glob io misc numeric once overflow
|
|
Packit |
972a07 |
pack portable recursion redefine regexp severe signal substr
|
|
Packit |
972a07 |
syntax taint uninitialized unpack untie utf8 void);
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# if someone is using warnings::compat, the previous trick won't work, so we
|
|
Packit |
972a07 |
# must manually disable warnings
|
|
Packit |
972a07 |
$^W = 0 if $] < 5.006;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
my $is_Win32 = $^O =~ /win32/i;
|
|
Packit |
972a07 |
my $is_Cygwin = $^O =~ /cygwin/i;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# if testing in core, check that the module is at least available
|
|
Packit |
972a07 |
if ($ENV{PERL_CORE}) {
|
|
Packit |
972a07 |
plan skip_all => "Sys::Syslog was not build"
|
|
Packit |
972a07 |
unless $Config{'extensions'} =~ /\bSyslog\b/;
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# we also need Socket
|
|
Packit |
972a07 |
plan skip_all => "Socket was not build"
|
|
Packit |
972a07 |
unless $Config{'extensions'} =~ /\bSocket\b/;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
my $tests;
|
|
Packit |
972a07 |
plan tests => $tests;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# any remaining warning should be severly punished
|
|
Packit |
972a07 |
BEGIN { eval "use Test::NoWarnings"; $tests = $@ ? 0 : 1; }
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
BEGIN { $tests += 1 }
|
|
Packit |
972a07 |
# ok, now loads them
|
|
Packit |
972a07 |
eval 'use Socket';
|
|
Packit |
972a07 |
use_ok('Sys::Syslog', ':standard', ':extended', ':macros');
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
BEGIN { $tests += 1 }
|
|
Packit |
972a07 |
# check that the documented functions are correctly provided
|
|
Packit |
972a07 |
can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
BEGIN { $tests += 4 }
|
|
Packit |
972a07 |
# check the diagnostics
|
|
Packit |
972a07 |
# setlogsock()
|
|
Packit |
972a07 |
eval { setlogsock() };
|
|
Packit |
972a07 |
like( $@, qr/^setlogsock\(\): Invalid number of arguments/,
|
|
Packit |
972a07 |
"calling setlogsock() with no argument" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
eval { setlogsock(undef) };
|
|
Packit |
972a07 |
like( $@, qr/^setlogsock\(\): Invalid type; must be one of /,
|
|
Packit |
972a07 |
"calling setlogsock() with undef" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
eval { setlogsock(\"") };
|
|
Packit |
972a07 |
like( $@, qr/^setlogsock\(\): Unexpected scalar reference/,
|
|
Packit |
972a07 |
"calling setlogsock() with a scalar reference" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
eval { setlogsock({}) };
|
|
Packit |
972a07 |
like( $@, qr/^setlogsock\(\): No argument given/,
|
|
Packit |
972a07 |
"calling setlogsock() with an empty hash reference" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
BEGIN { $tests += 3 }
|
|
Packit |
972a07 |
# syslog()
|
|
Packit |
972a07 |
eval { syslog() };
|
|
Packit |
972a07 |
like( $@, qr/^syslog: expecting argument \$priority/,
|
|
Packit |
972a07 |
"calling syslog() with no argument" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
eval { syslog(undef) };
|
|
Packit |
972a07 |
like( $@, qr/^syslog: expecting argument \$priority/,
|
|
Packit |
972a07 |
"calling syslog() with one undef argument" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
eval { syslog('') };
|
|
Packit |
972a07 |
like( $@, qr/^syslog: expecting argument \$format/,
|
|
Packit |
972a07 |
"calling syslog() with one empty argument" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
my $test_string = "uid $< is testing Perl $] syslog(3) capabilities";
|
|
Packit |
972a07 |
my $r = 0;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
BEGIN { $tests += 8 }
|
|
Packit |
972a07 |
# try to open a syslog using a Unix or stream socket
|
|
Packit |
972a07 |
SKIP: {
|
|
Packit |
972a07 |
skip "can't connect to Unix socket: _PATH_LOG unavailable", 8
|
|
Packit |
972a07 |
unless -e Sys::Syslog::_PATH_LOG();
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# The only known $^O eq 'svr4' that needs this is NCR MP-RAS,
|
|
Packit |
972a07 |
# but assuming 'stream' in SVR4 is probably not that bad.
|
|
Packit |
972a07 |
my $sock_type = $^O =~ /^(solaris|irix|svr4|powerux)$/ ? 'stream' : 'unix';
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
eval { setlogsock($sock_type) };
|
|
Packit |
972a07 |
is( $@, '', "setlogsock() called with '$sock_type'" );
|
|
Packit |
972a07 |
TODO: {
|
|
Packit |
972a07 |
local $TODO = "minor bug";
|
|
Packit |
972a07 |
SKIP: { skip "TODO $TODO", 1 if $] < 5.006002;
|
|
Packit |
972a07 |
ok( $r, "setlogsock() should return true: '$r'" );
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# open syslog with a "local0" facility
|
|
Packit |
972a07 |
SKIP: {
|
|
Packit |
972a07 |
# openlog()
|
|
Packit |
972a07 |
$r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
|
|
Packit |
972a07 |
skip "can't connect to syslog", 6 if $@ =~ /^no connection to syslog available/;
|
|
Packit |
972a07 |
is( $@, '', "openlog() called with facility 'local0'" );
|
|
Packit |
972a07 |
ok( $r, "openlog() should return true: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# syslog()
|
|
Packit |
972a07 |
$r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
|
|
Packit |
972a07 |
is( $@, '', "syslog() called with level 'info'" );
|
|
Packit |
972a07 |
ok( $r, "syslog() should return true: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# closelog()
|
|
Packit |
972a07 |
$r = eval { closelog() } || 0;
|
|
Packit |
972a07 |
is( $@, '', "closelog()" );
|
|
Packit |
972a07 |
ok( $r, "closelog() should return true: '$r'" );
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
BEGIN { $tests += 22 * 8 }
|
|
Packit |
972a07 |
# try to open a syslog using all the available connection methods
|
|
Packit |
972a07 |
my @passed = ();
|
|
Packit |
972a07 |
for my $sock_type (qw(native eventlog unix pipe stream inet tcp udp)) {
|
|
Packit |
972a07 |
SKIP: {
|
|
Packit |
972a07 |
skip "the 'stream' mechanism because a previous mechanism with similar interface succeeded", 22
|
|
Packit |
972a07 |
if $sock_type eq 'stream' and grep {/pipe|unix/} @passed;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# setlogsock() called with an arrayref
|
|
Packit |
972a07 |
$r = eval { setlogsock([$sock_type]) } || 0;
|
|
Packit |
972a07 |
skip "can't use '$sock_type' socket", 22 unless $r;
|
|
Packit |
972a07 |
is( $@, '', "[$sock_type] setlogsock() called with ['$sock_type']" );
|
|
Packit |
972a07 |
ok( $r, "[$sock_type] setlogsock() should return true: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# setlogsock() called with a single argument
|
|
Packit |
972a07 |
$r = eval { setlogsock($sock_type) } || 0;
|
|
Packit |
972a07 |
skip "can't use '$sock_type' socket", 20 unless $r;
|
|
Packit |
972a07 |
is( $@, '', "[$sock_type] setlogsock() called with '$sock_type'" );
|
|
Packit |
972a07 |
ok( $r, "[$sock_type] setlogsock() should return true: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# openlog() without option NDELAY
|
|
Packit |
972a07 |
$r = eval { openlog('perl', '', 'local0') } || 0;
|
|
Packit |
972a07 |
skip "can't connect to syslog", 18 if $@ =~ /^no connection to syslog available/;
|
|
Packit |
972a07 |
is( $@, '', "[$sock_type] openlog() called with facility 'local0' and without option 'ndelay'" );
|
|
Packit |
972a07 |
ok( $r, "[$sock_type] openlog() should return true: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# openlog() with the option NDELAY
|
|
Packit |
972a07 |
$r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
|
|
Packit |
972a07 |
skip "can't connect to syslog", 16 if $@ =~ /^no connection to syslog available/;
|
|
Packit |
972a07 |
is( $@, '', "[$sock_type] openlog() called with facility 'local0' with option 'ndelay'" );
|
|
Packit |
972a07 |
ok( $r, "[$sock_type] openlog() should return true: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# syslog() with negative level, should fail
|
|
Packit |
972a07 |
$r = eval { syslog(-1, "$test_string by connecting to a $sock_type socket") } || 0;
|
|
Packit |
972a07 |
like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level -1" );
|
|
Packit |
972a07 |
ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# syslog() with invalid level, should fail
|
|
Packit |
972a07 |
$r = eval { syslog("plonk", "$test_string by connecting to a $sock_type socket") } || 0;
|
|
Packit |
972a07 |
like( $@, '/^syslog: invalid level\/facility: /', "[$sock_type] syslog() called with level plonk" );
|
|
Packit |
972a07 |
ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# syslog() with levels "info" and "notice" (as a strings), should fail
|
|
Packit |
972a07 |
$r = eval { syslog('info,notice', "$test_string by connecting to a $sock_type socket") } || 0;
|
|
Packit |
972a07 |
like( $@, '/^syslog: too many levels given: notice/', "[$sock_type] syslog() called with level 'info,notice'" );
|
|
Packit |
972a07 |
ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# syslog() with facilities "local0" and "local1" (as a strings), should fail
|
|
Packit |
972a07 |
$r = eval { syslog('local0,local1', "$test_string by connecting to a $sock_type socket") } || 0;
|
|
Packit |
972a07 |
like( $@, '/^syslog: too many facilities given: local1/', "[$sock_type] syslog() called with level 'local0,local1'" );
|
|
Packit |
972a07 |
ok( !$r, "[$sock_type] syslog() should return false: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# syslog() with level "info" (as a string), should pass
|
|
Packit |
972a07 |
$r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
|
|
Packit |
972a07 |
is( $@, '', "[$sock_type] syslog() called with level 'info' (string)" );
|
|
Packit |
972a07 |
ok( $r, "[$sock_type] syslog() should return true: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# syslog() with level "info" (as a macro), should pass
|
|
Packit |
972a07 |
{ local $! = 1;
|
|
Packit |
972a07 |
$r = eval { syslog(LOG_INFO(), "$test_string by connecting to a $sock_type socket, setting a fake errno: %m") } || 0;
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
is( $@, '', "[$sock_type] syslog() called with level 'info' (macro)" );
|
|
Packit |
972a07 |
ok( $r, "[$sock_type] syslog() should return true: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
push @passed, $sock_type;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
SKIP: {
|
|
Packit |
972a07 |
skip "skipping closelog() tests for 'console'", 2 if $sock_type eq 'console';
|
|
Packit |
972a07 |
# closelog()
|
|
Packit |
972a07 |
$r = eval { closelog() } || 0;
|
|
Packit |
972a07 |
is( $@, '', "[$sock_type] closelog()" );
|
|
Packit |
972a07 |
ok( $r, "[$sock_type] closelog() should return true: '$r'" );
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
BEGIN { $tests += 10 }
|
|
Packit |
972a07 |
SKIP: {
|
|
Packit |
972a07 |
skip "not testing setlogsock('stream') on Win32", 10 if $is_Win32;
|
|
Packit |
972a07 |
skip "the 'unix' mechanism works, so the tests will likely fail with the 'stream' mechanism", 10
|
|
Packit |
972a07 |
if grep {/unix/} @passed;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
skip "not testing setlogsock('stream'): _PATH_LOG unavailable", 10
|
|
Packit |
972a07 |
unless -e Sys::Syslog::_PATH_LOG();
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# setlogsock() with "stream" and an undef path
|
|
Packit |
972a07 |
$r = eval { setlogsock("stream", undef ) } || '';
|
|
Packit |
972a07 |
is( $@, '', "setlogsock() called, with 'stream' and an undef path" );
|
|
Packit |
972a07 |
if ($is_Cygwin) {
|
|
Packit |
972a07 |
if (-x "/usr/sbin/syslog-ng") {
|
|
Packit |
972a07 |
ok( $r, "setlogsock() on Cygwin with syslog-ng should return true: '$r'" );
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
else {
|
|
Packit |
972a07 |
ok( !$r, "setlogsock() on Cygwin without syslog-ng should return false: '$r'" );
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
else {
|
|
Packit |
972a07 |
ok( $r, "setlogsock() should return true: '$r'" );
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# setlogsock() with "stream" and an empty path
|
|
Packit |
972a07 |
$r = eval { setlogsock("stream", '' ) } || '';
|
|
Packit |
972a07 |
is( $@, '', "setlogsock() called, with 'stream' and an empty path" );
|
|
Packit |
972a07 |
ok( !$r, "setlogsock() should return false: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# setlogsock() with "stream" and /dev/null
|
|
Packit |
972a07 |
$r = eval { setlogsock("stream", '/dev/null' ) } || '';
|
|
Packit |
972a07 |
is( $@, '', "setlogsock() called, with 'stream' and '/dev/null'" );
|
|
Packit |
972a07 |
ok( $r, "setlogsock() should return true: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# setlogsock() with "stream" and a non-existing file
|
|
Packit |
972a07 |
$r = eval { setlogsock("stream", 'test.log' ) } || '';
|
|
Packit |
972a07 |
is( $@, '', "setlogsock() called, with 'stream' and 'test.log' (file does not exist)" );
|
|
Packit |
972a07 |
ok( !$r, "setlogsock() should return false: '$r'" );
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# setlogsock() with "stream" and a local file
|
|
Packit |
972a07 |
SKIP: {
|
|
Packit |
972a07 |
my $logfile = "test.log";
|
|
Packit |
972a07 |
my $fh = FileHandle->new;
|
|
Packit |
972a07 |
open $fh, ">$logfile" or skip "can't create file '$logfile': $!", 2;
|
|
Packit |
972a07 |
close $fh;
|
|
Packit |
972a07 |
$r = eval { setlogsock("stream", $logfile ) } || '';
|
|
Packit |
972a07 |
is( $@, '', "setlogsock() called, with 'stream' and '$logfile' (file exists)" );
|
|
Packit |
972a07 |
ok( $r, "setlogsock() should return true: '$r'" );
|
|
Packit |
972a07 |
unlink($logfile);
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
BEGIN { $tests += 3 + 4 * 3 }
|
|
Packit |
972a07 |
# setlogmask()
|
|
Packit |
972a07 |
{
|
|
Packit |
972a07 |
my $oldmask = 0;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
$oldmask = eval { setlogmask(0) } || 0;
|
|
Packit |
972a07 |
is( $@, '', "setlogmask() called with a null mask" );
|
|
Packit |
972a07 |
$r = eval { setlogmask(0) } || 0;
|
|
Packit |
972a07 |
is( $@, '', "setlogmask() called with a null mask (second time)" );
|
|
Packit |
972a07 |
is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
my @masks = (
|
|
Packit |
972a07 |
LOG_MASK(LOG_ERR()),
|
|
Packit |
972a07 |
~LOG_MASK(LOG_INFO()),
|
|
Packit |
972a07 |
LOG_MASK(LOG_CRIT()) | LOG_MASK(LOG_ERR()) | LOG_MASK(LOG_WARNING()),
|
|
Packit |
972a07 |
);
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
for my $newmask (@masks) {
|
|
Packit |
972a07 |
$r = eval { setlogmask($newmask) } || 0;
|
|
Packit |
972a07 |
is( $@, '', "setlogmask() called with a new mask" );
|
|
Packit |
972a07 |
is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
|
|
Packit |
972a07 |
$r = eval { setlogmask(0) } || 0;
|
|
Packit |
972a07 |
is( $@, '', "setlogmask() called with a null mask" );
|
|
Packit |
972a07 |
is( $r, $newmask, "setlogmask() must return the new mask");
|
|
Packit |
972a07 |
setlogmask($oldmask);
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
BEGIN { $tests += 4 }
|
|
Packit |
972a07 |
SKIP: {
|
|
Packit |
972a07 |
# case: test the return value of setlogsock()
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# setlogsock("stream") on a non-existent file must fail
|
|
Packit |
972a07 |
eval { $r = setlogsock("stream", "plonk/log") };
|
|
Packit |
972a07 |
is( $@, '', "setlogsock() didn't croak");
|
|
Packit |
972a07 |
ok( !$r, "setlogsock() correctly failed with a non-existent stream path");
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# setlogsock("tcp") must fail if the service is not declared
|
|
Packit |
972a07 |
my $service = getservbyname("syslog", "tcp") || getservbyname("syslogng", "tcp");
|
|
Packit |
972a07 |
skip "can't test setlogsock() tcp failure", 2 if $service;
|
|
Packit |
972a07 |
eval { $r = setlogsock("tcp") };
|
|
Packit |
972a07 |
is( $@, '', "setlogsock() didn't croak");
|
|
Packit |
972a07 |
ok( !$r, "setlogsock() correctly failed when tcp services can't be resolved");
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
BEGIN { $tests += 3 }
|
|
Packit |
972a07 |
SKIP: {
|
|
Packit |
972a07 |
# case: configure Sys::Syslog to use the stream mechanism on a
|
|
Packit |
972a07 |
# given file, but remove the file before openlog() is called,
|
|
Packit |
972a07 |
# so it fails.
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# create the log file
|
|
Packit |
972a07 |
my $log = "t/stream";
|
|
Packit |
972a07 |
my $fh = FileHandle->new;
|
|
Packit |
972a07 |
open $fh, ">$log" or skip "can't write file '$log': $!", 3;
|
|
Packit |
972a07 |
close $fh;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# configure Sys::Syslog to use it
|
|
Packit |
972a07 |
$r = eval { setlogsock("stream", $log) };
|
|
Packit |
972a07 |
is( $@, "", "setlogsock('stream', '$log') -> $r" );
|
|
Packit |
972a07 |
skip "can't test openlog() failure with a missing stream", 2 if !$r;
|
|
Packit |
972a07 |
|
|
Packit |
972a07 |
# remove the log and check that openlog() fails
|
|
Packit |
972a07 |
unlink $log;
|
|
Packit |
972a07 |
$r = eval { openlog('perl', 'ndelay', 'local0') };
|
|
Packit |
972a07 |
ok( !$r, "openlog() correctly failed with a non-existent stream" );
|
|
Packit |
972a07 |
like( $@, '/not writable/', "openlog() correctly croaked with a non-existent stream" );
|
|
Packit |
972a07 |
}
|
|
Packit |
972a07 |
|