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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
|
#!/usr/bin/perl -T
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
@INC = '../lib';
}
}
use strict;
use Config;
use File::Spec;
use Test::More;
# we enable all Perl warnings, but we don't "use warnings 'all'" because
# we want to disable the warnings generated by Sys::Syslog
no warnings;
use warnings qw(closure deprecated exiting glob io misc numeric once overflow
pack portable recursion redefine regexp severe signal substr
syntax taint uninitialized unpack untie utf8 void);
# 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/;
my $tests;
plan tests => $tests;
BEGIN { $tests = 1 }
# ok, now loads them
eval 'use Socket';
use_ok('Sys::Syslog', ':standard', ':extended', ':macros');
BEGIN { $tests += 1 }
# check that the documented functions are correctly provided
can_ok( 'Sys::Syslog' => qw(openlog syslog syslog setlogmask setlogsock closelog) );
BEGIN { $tests += 1 }
# check the diagnostics
# setlogsock()
eval { setlogsock() };
like( $@, qr/^Invalid argument passed to setlogsock/,
"calling setlogsock() with no argument" );
BEGIN { $tests += 3 }
# syslog()
eval { syslog() };
like( $@, qr/^syslog: expecting argument \$priority/,
"calling syslog() with no argument" );
eval { syslog(undef) };
like( $@, qr/^syslog: expecting argument \$priority/,
"calling syslog() with one undef argument" );
eval { syslog('') };
like( $@, qr/^syslog: expecting argument \$format/,
"calling syslog() with one empty argument" );
my $test_string = "uid $< is testing Perl $] syslog(3) capabilities";
my $r = 0;
BEGIN { $tests += 8 }
# 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'" );
}
}
BEGIN { $tests += 20 * 7 }
# try to open a syslog using all the available connection methods
for my $sock_type (qw(stream unix native inet tcp udp console)) {
SKIP: {
# setlogsock() called with an arrayref
$r = eval { setlogsock([$sock_type]) } || 0;
skip "can't use '$sock_type' socket", 20 unless $r;
is( $@, '', "setlogsock() called with ['$sock_type']" );
ok( $r, "setlogsock() should return true: '$r'" );
# setlogsock() called with a single argument
$r = eval { setlogsock($sock_type) } || 0;
skip "can't use '$sock_type' socket", 18 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", 16 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", 14 if $@ =~ /^no connection to syslog available/;
is( $@, '', "openlog() called with facility 'local0' with option 'ndelay'" );
ok( $r, "openlog() should return true: '$r'" );
# syslog() with negative level, should fail
$r = eval { syslog(-1, "$test_string by connecting to a $sock_type socket") } || 0;
like( $@, '/^syslog: invalid level\/facility: /', "syslog() called with level -1" );
ok( !$r, "syslog() should return false: '$r'" );
# syslog() with levels "info" and "notice" (as a strings), should fail
$r = eval { syslog('info,notice', "$test_string by connecting to a $sock_type socket") } || 0;
like( $@, '/^syslog: too many levels given: notice/', "syslog() called with level 'info,notice'" );
ok( !$r, "syslog() should return false: '$r'" );
# syslog() with facilities "local0" and "local1" (as a strings), should fail
$r = eval { syslog('local0,local1', "$test_string by connecting to a $sock_type socket") } || 0;
like( $@, '/^syslog: too many facilities given: local1/', "syslog() called with level 'info,notice'" );
ok( !$r, "syslog() should return false: '$r'" );
# syslog() with level "info" (as a string), should pass
$r = eval { syslog('info', "$test_string by connecting to a $sock_type socket (errno=%m)") } || 0;
is( $@, '', "syslog() called with level 'info' (string)" );
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 (errno=%m)") } || 0;
is( $@, '', "syslog() called with level 'info' (macro)" );
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'" );
}
}
}
BEGIN { $tests += 10 }
# setlogsock() with "stream" and an undef path
$r = eval { setlogsock("stream", undef ) } || '';
is( $@, '', "setlogsock() called, with 'stream' and an undef path" );
ok( $r, "setlogsock() should return true: '$r'" );
# setlogsock() with "stream" and an empty path
$r = eval { setlogsock("stream", '' ) } || '';
is( $@, '', "setlogsock() called, with 'stream' and an empty path" );
ok( !$r, "setlogsock() should return false: '$r'" );
# setlogsock() with "stream" and /dev/null
$r = eval { setlogsock("stream", '/dev/null' ) } || '';
is( $@, '', "setlogsock() called, with 'stream' and '/dev/null'" );
ok( $r, "setlogsock() should return true: '$r'" );
# setlogsock() with "stream" and a non-existing file
$r = eval { setlogsock("stream", 'test.log' ) } || '';
is( $@, '', "setlogsock() called, with 'stream' and 'test.log' (file does not exist)" );
ok( !$r, "setlogsock() should return false: '$r'" );
# setlogsock() with "stream" and a local file
SKIP: {
my $logfile = "test.log";
open(LOG, ">$logfile") or skip "can't create file '$logfile': $!", 2;
close(LOG);
$r = eval { setlogsock("stream", $logfile ) } || '';
is( $@, '', "setlogsock() called, with 'stream' and '$logfile' (file exists)" );
ok( $r, "setlogsock() should return true: '$r'" );
unlink($logfile);
}
BEGIN { $tests += 3 + 4 * 3 }
# 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");
my @masks = (
LOG_MASK(LOG_ERR()),
~LOG_MASK(LOG_INFO()),
LOG_MASK(LOG_CRIT()) | LOG_MASK(LOG_ERR()) | LOG_MASK(LOG_WARNING()),
);
for my $newmask (@masks) {
$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);
}
}
|
