1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
#!/usr/bin/perl -T
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use strict;
use Config;
use File::Spec;
use Test::More;
# check that the module is at least available
plan skip_all => "Sys::Syslog was not build"
unless $Config{'extensions'} =~ /\bSyslog\b/;
# we also need Socket
plan skip_all => "Socket was not build"
unless $Config{'extensions'} =~ /\bSocket\b/;
BEGIN {
plan tests => 119;
# ok, now loads them
eval 'use Socket';
use_ok('Sys::Syslog', ':standard', ':extended', ':macros');
}
# check that the documented functions are correctly provided
can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) );
# check the diagnostics
# setlogsock()
eval { setlogsock() };
like( $@, qr/^Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'/,
"calling setlogsock() with no argument" );
# syslog()
eval { syslog() };
like( $@, qr/^syslog: expecting argument \$priority/,
"calling syslog() with no argument" );
my $test_string = "uid $< is testing Perl $] syslog(3) capabilities";
my $r = 0;
# try to open a syslog using a Unix or stream socket
SKIP: {
skip "can't connect to Unix socket: _PATH_LOG unavailable", 8
unless -e Sys::Syslog::_PATH_LOG();
# The only known $^O eq 'svr4' that needs this is NCR MP-RAS,
# but assuming 'stream' in SVR4 is probably not that bad.
my $sock_type = $^O =~ /^(solaris|irix|svr4|powerux)$/ ? 'stream' : 'unix';
eval { setlogsock($sock_type) };
is( $@, '', "setlogsock() called with '$sock_type'" );
TODO: {
local $TODO = "minor bug";
ok( $r, "setlogsock() should return true: '$r'" );
}
# open syslog with a "local0" facility
SKIP: {
# openlog()
$r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
skip "can't connect to syslog", 6 if $@ =~ /^no connection to syslog available/;
is( $@, '', "openlog() called with facility 'local0'" );
ok( $r, "openlog() should return true: '$r'" );
# syslog()
$r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
is( $@, '', "syslog() called with level 'info'" );
ok( $r, "syslog() should return true: '$r'" );
# closelog()
$r = eval { closelog() } || 0;
is( $@, '', "closelog()" );
ok( $r, "closelog() should return true: '$r'" );
}
}
# try to open a syslog using all the available connection methods
for my $sock_type (qw(stream unix inet tcp udp console)) {
SKIP: {
# setlogsock()
$r = eval { setlogsock([$sock_type]) } || 0;
skip "can't use '$sock_type' socket", 16 unless $r;
is( $@, '', "setlogsock() called with '$sock_type'" );
ok( $r, "setlogsock() should return true: '$r'" );
# openlog() without option NDELAY
$r = eval { openlog('perl', '', 'local0') } || 0;
skip "can't connect to syslog", 14 if $@ =~ /^no connection to syslog available/;
is( $@, '', "openlog() called with facility 'local0' and without option 'ndelay'" );
ok( $r, "openlog() should return true: '$r'" );
# openlog() with the option NDELAY
$r = eval { openlog('perl', 'ndelay', 'local0') } || 0;
skip "can't connect to syslog", 12 if $@ =~ /^no connection to syslog available/;
is( $@, '', "openlog() called with facility 'local0' with option 'ndelay'" );
ok( $r, "openlog() should return true: '$r'" );
# syslog() with level "info" (as a string), should pass
$r = eval { syslog('info', "$test_string by connecting to a $sock_type socket") } || 0;
is( $@, '', "syslog() called with level 'info'" );
ok( $r, "syslog() should return true: '$r'" );
# syslog() with level "info" (as a macro), should pass
$r = eval { syslog(LOG_INFO, "$test_string by connecting to a $sock_type socket") } || 0;
is( $@, '', "syslog() called with level 'info'" );
ok( $r, "syslog() should return true: '$r'" );
# syslog() with facility "kern" (as a string), should fail
$r = eval { syslog('kern', "$test_string by connecting to a $sock_type socket") } || 0;
like( $@, '/^syslog: invalid level/facility: kern/', "syslog() called with facility 'kern'" );
ok( !$r, "syslog() should return false: '$r'" );
# syslog() with facility "kern" (as a macro), should fail
$r = eval { syslog(LOG_KERN, "$test_string by connecting to a $sock_type socket") } || 0;
like( $@, '/^syslog: invalid level/facility: 0/', "syslog() called with facility 'kern'" );
ok( !$r, "syslog() should return false: '$r'" );
SKIP: {
skip "skipping closelog() tests for 'console'", 2 if $sock_type eq 'console';
# closelog()
$r = eval { closelog() } || 0;
is( $@, '', "closelog()" );
ok( $r, "closelog() should return true: '$r'" );
}
}
}
# setlogmask()
{
my $oldmask = 0;
$oldmask = eval { setlogmask(0) } || 0;
is( $@, '', "setlogmask() called with a null mask" );
$r = eval { setlogmask(0) } || 0;
is( $@, '', "setlogmask() called with a null mask (second time)" );
is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
for my $newmask ( LOG_ERR , LOG_CRIT|LOG_ERR|LOG_WARNING ) {
$r = eval { setlogmask($newmask) } || 0;
is( $@, '', "setlogmask() called with a new mask" );
is( $r, $oldmask, "setlogmask() must return the same mask as previous call");
$r = eval { setlogmask(0) } || 0;
is( $@, '', "setlogmask() called with a null mask" );
is( $r, $newmask, "setlogmask() must return the new mask");
setlogmask($oldmask);
}
}
|
