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