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