This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix typo spotted by Ronald J Kimball.
[perl5.git] / ext / Sys / Syslog / Syslog.pm
CommitLineData
a0d0e21e 1package Sys::Syslog;
3b355090 2require 5.006;
a0d0e21e
LW
3require Exporter;
4use Carp;
108be7fb 5use strict;
a0d0e21e 6
db9f82cf 7our @ISA = qw(Exporter);
108be7fb
RGS
8our @EXPORT = qw(openlog closelog setlogmask syslog);
9our @EXPORT_OK = qw(setlogsock);
ce43db9b 10our $VERSION = '0.08';
a0d0e21e 11
23642f4b
NW
12# it would be nice to try stream/unix first, since that will be
13# most efficient. However streams are dodgy - see _syslog_send_stream
23642f4b 14my @connectMethods = ( 'tcp', 'udp', 'unix', 'stream', 'console' );
dbfdd438
SR
15if ($^O =~ /^(freebsd|linux)$/) {
16 @connectMethods = grep { $_ ne 'udp' } @connectMethods;
17}
23642f4b
NW
18my @defaultMethods = @connectMethods;
19my $syslog_path = undef;
20my $transmit_ok = 0;
21my $current_proto = undef;
22my $failed = undef;
23my $fail_time = undef;
108be7fb 24our ($connected, @fallbackMethods, $syslog_send, $host);
23642f4b 25
108be7fb 26use Socket ':all';
55497cff 27use Sys::Hostname;
37120919 28
5be1dfc7
HF
29=head1 NAME
30
31Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls
32
33=head1 SYNOPSIS
34
3ffabb8c
GS
35 use Sys::Syslog; # all except setlogsock, or:
36 use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock
5be1dfc7 37
3ffabb8c 38 setlogsock $sock_type;
3d256c0f 39 openlog $ident, $logopt, $facility; # don't forget this
2eae817d 40 syslog $priority, $format, @args;
5be1dfc7
HF
41 $oldmask = setlogmask $mask_priority;
42 closelog;
43
44=head1 DESCRIPTION
45
46Sys::Syslog is an interface to the UNIX C<syslog(3)> program.
47Call C<syslog()> with a string priority and a list of C<printf()> args
48just like C<syslog(3)>.
49
50Syslog provides the functions:
51
bbc7dcd2 52=over 4
5be1dfc7
HF
53
54=item openlog $ident, $logopt, $facility
55
b91ed019 56Opens the syslog.
23642f4b
NW
57I<$ident> is prepended to every message. I<$logopt> contains zero or
58more of the words I<pid>, I<ndelay>, I<nowait>. The cons option is
59ignored, since the failover mechanism will drop down to the console
60automatically if all other media fail. I<$facility> specifies the
3d256c0f
JH
61part of the system to report about, for example LOG_USER or LOG_LOCAL0:
62see your C<syslog(3)> documentation for the facilities available in
b91ed019
RGS
63your system. This function will croak if it can't connect to the syslog
64daemon.
3d256c0f
JH
65
66B<You should use openlog() before calling syslog().>
5be1dfc7 67
ce43db9b
GA
68=item syslog $priority, $message
69
2eae817d 70=item syslog $priority, $format, @args
5be1dfc7 71
caccce6a
RGS
72If I<$priority> permits, logs I<$message> or I<sprintf($format, @args)>
73with the addition that I<%m> in $message or $format is replaced with
74C<"$!"> (the latest error message).
5be1dfc7 75
3d256c0f
JH
76If you didn't use openlog() before using syslog(), syslog will try to
77guess the I<$ident> by extracting the shortest prefix of I<$format>
78that ends in a ":".
79
9903e4c8
GA
80Note that Sys::Syslog version v0.07 and older passed the $message as
81the formatting string to sprintf() even when no formatting arguments
29d14c72 82were provided. If the code calling syslog() might execute with older
9903e4c8
GA
83versions of this module, make sure to call the function as
84syslog($priority, "%s", $message) instead of syslog($priority,
85$message). This protects against hostile formatting sequences that
86might show up if $message contains tainted data.
87
5be1dfc7
HF
88=item setlogmask $mask_priority
89
90Sets log mask I<$mask_priority> and returns the old mask.
91
23642f4b 92=item setlogsock $sock_type [$stream_location] (added in 5.004_02)
3ffabb8c 93
cb63fe9d 94Sets the socket type to be used for the next call to
3ffabb8c
GS
95C<openlog()> or C<syslog()> and returns TRUE on success,
96undef on failure.
97
f66a7beb
JB
98A value of 'unix' will connect to the UNIX domain socket (in some
99systems a character special device) returned by the C<_PATH_LOG> macro
100(if your system defines it), or F</dev/log> or F</dev/conslog>,
101whatever is writable. A value of 'stream' will connect to the stream
102indicated by the pathname provided as the optional second parameter.
e9aaaa2f 103(For example Solaris and IRIX require 'stream' instead of 'unix'.)
f66a7beb
JB
104A value of 'inet' will connect to an INET socket (either tcp or udp,
105tried in that order) returned by getservbyname(). 'tcp' and 'udp' can
106also be given as values. The value 'console' will send messages
107directly to the console, as for the 'cons' option in the logopts in
108openlog().
23642f4b
NW
109
110A reference to an array can also be passed as the first parameter.
111When this calling method is used, the array should contain a list of
112sock_types which are attempted in order.
cb63fe9d 113
23642f4b
NW
114The default is to try tcp, udp, unix, stream, console.
115
116Giving an invalid value for sock_type will croak.
cb63fe9d 117
5be1dfc7
HF
118=item closelog
119
120Closes the log file.
121
122=back
123
124Note that C<openlog> now takes three arguments, just like C<openlog(3)>.
125
126=head1 EXAMPLES
127
128 openlog($program, 'cons,pid', 'user');
e6c138cd 129 syslog('info', '%s', 'this is another test');
5be1dfc7
HF
130 syslog('mail|warning', 'this is a better test: %d', time);
131 closelog();
132
133 syslog('debug', 'this is the last test');
cb63fe9d
TB
134
135 setlogsock('unix');
5be1dfc7
HF
136 openlog("$program $$", 'ndelay', 'user');
137 syslog('notice', 'fooprogram: this is really done');
138
cb63fe9d 139 setlogsock('inet');
5be1dfc7
HF
140 $! = 55;
141 syslog('info', 'problem was %m'); # %m == $! in syslog(3)
142
476b65d9
JH
143 # Log to UDP port on $remotehost instead of logging locally
144 setlogsock('udp');
145 $Sys::Syslog::host = $remotehost;
146 openlog($program, 'ndelay', 'user');
147 syslog('info', 'something happened over here');
148
5be1dfc7
HF
149=head1 SEE ALSO
150
151L<syslog(3)>
152
153=head1 AUTHOR
154
150b260b
GS
155Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall
156E<lt>F<larry@wall.org>E<gt>.
157
158UNIX domain sockets added by Sean Robinson
23642f4b 159E<lt>F<robinson_s@sc.maricopa.edu>E<gt> with support from Tim Bunce
a88817a4 160E<lt>F<Tim.Bunce@ig.co.uk>E<gt> and the perl5-porters mailing list.
150b260b
GS
161
162Dependency on F<syslog.ph> replaced with XS code by Tom Hughes
163E<lt>F<tom@compton.nu>E<gt>.
5be1dfc7 164
23642f4b
NW
165Code for constant()s regenerated by Nicholas Clark E<lt>F<nick@ccl4.org>E<gt>.
166
167Failover to different communication modes by Nick Williams
168E<lt>F<Nick.Williams@morganstanley.com>E<gt>.
b903fcff 169
5be1dfc7 170=cut
a0d0e21e 171
8ce86de8
GS
172sub AUTOLOAD {
173 # This AUTOLOAD is used to 'autoload' constants from the constant()
174 # XS function.
23642f4b 175
8ce86de8
GS
176 my $constname;
177 our $AUTOLOAD;
178 ($constname = $AUTOLOAD) =~ s/.*:://;
b903fcff
JH
179 croak "&Sys::Syslog::constant not defined" if $constname eq 'constant';
180 my ($error, $val) = constant($constname);
181 if ($error) {
182 croak $error;
8ce86de8 183 }
108be7fb 184 no strict 'refs';
8ce86de8
GS
185 *$AUTOLOAD = sub { $val };
186 goto &$AUTOLOAD;
187}
188
db9f82cf
AT
189require XSLoader;
190XSLoader::load('Sys::Syslog', $VERSION);
a0d0e21e 191
108be7fb 192our $maskpri = &LOG_UPTO(&LOG_DEBUG);
a0d0e21e
LW
193
194sub openlog {
108be7fb
RGS
195 our ($ident, $logopt, $facility) = @_; # package vars
196 our $lo_pid = $logopt =~ /\bpid\b/;
197 our $lo_ndelay = $logopt =~ /\bndelay\b/;
198 our $lo_nowait = $logopt =~ /\bnowait\b/;
a8710ca1
GS
199 return 1 unless $lo_ndelay;
200 &connect;
a0d0e21e
LW
201}
202
203sub closelog {
108be7fb 204 our $facility = our $ident = '';
a0d0e21e
LW
205 &disconnect;
206}
207
208sub setlogmask {
108be7fb 209 my $oldmask = $maskpri;
a0d0e21e
LW
210 $maskpri = shift;
211 $oldmask;
212}
213
cb63fe9d 214sub setlogsock {
108be7fb 215 my $setsock = shift;
23642f4b 216 $syslog_path = shift;
3ffabb8c 217 &disconnect if $connected;
23642f4b
NW
218 $transmit_ok = 0;
219 @fallbackMethods = ();
220 @connectMethods = @defaultMethods;
221 if (ref $setsock eq 'ARRAY') {
222 @connectMethods = @$setsock;
223 } elsif (lc($setsock) eq 'stream') {
f66a7beb
JB
224 unless (defined $syslog_path) {
225 my @try = qw(/dev/log /dev/conslog);
e863979d 226 if (length &_PATH_LOG) { # Undefined _PATH_LOG is "".
f66a7beb
JB
227 unshift @try, &_PATH_LOG;
228 }
229 for my $try (@try) {
230 if (-w $try) {
231 $syslog_path = $try;
232 last;
233 }
234 }
e863979d
JH
235 carp "stream passed to setlogsock, but could not find any device"
236 unless defined $syslog_path;
f66a7beb 237 }
e863979d 238 unless (-w $syslog_path) {
23642f4b
NW
239 carp "stream passed to setlogsock, but $syslog_path is not writable";
240 return undef;
241 } else {
242 @connectMethods = ( 'stream' );
243 }
244 } elsif (lc($setsock) eq 'unix') {
245 if (length _PATH_LOG() && !defined $syslog_path) {
246 $syslog_path = _PATH_LOG();
247 @connectMethods = ( 'unix' );
3ffabb8c 248 } else {
23642f4b
NW
249 carp 'unix passed to setlogsock, but path not available';
250 return undef;
3ffabb8c 251 }
23642f4b
NW
252 } elsif (lc($setsock) eq 'tcp') {
253 if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) {
254 @connectMethods = ( 'tcp' );
255 } else {
256 carp "tcp passed to setlogsock, but tcp service unavailable";
257 return undef;
258 }
259 } elsif (lc($setsock) eq 'udp') {
260 if (getservbyname('syslog', 'udp')) {
261 @connectMethods = ( 'udp' );
262 } else {
263 carp "udp passed to setlogsock, but udp service unavailable";
264 return undef;
265 }
cb63fe9d 266 } elsif (lc($setsock) eq 'inet') {
23642f4b
NW
267 @connectMethods = ( 'tcp', 'udp' );
268 } elsif (lc($setsock) eq 'console') {
269 @connectMethods = ( 'console' );
cb63fe9d 270 } else {
23642f4b 271 carp "Invalid argument passed to setlogsock; must be 'stream', 'unix', 'tcp', 'udp' or 'inet'";
cb63fe9d 272 }
f8b75b0c 273 return 1;
cb63fe9d
TB
274}
275
a0d0e21e 276sub syslog {
108be7fb
RGS
277 my $priority = shift;
278 my $mask = shift;
279 my ($message, $whoami);
280 my (@words, $num, $numpri, $numfac, $sum);
281 our $facility;
a0d0e21e
LW
282 local($facility) = $facility; # may need to change temporarily.
283
78ac6fa8
JA
284 croak "syslog: expecting argument \$priority" unless $priority;
285 croak "syslog: expecting argument \$format" unless $mask;
a0d0e21e
LW
286
287 @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
288 undef $numpri;
289 undef $numfac;
290 foreach (@words) {
291 $num = &xlate($_); # Translate word to number.
292 if (/^kern$/ || $num < 0) {
293 croak "syslog: invalid level/facility: $_";
294 }
295 elsif ($num <= &LOG_PRIMASK) {
296 croak "syslog: too many levels given: $_" if defined($numpri);
297 $numpri = $num;
298 return 0 unless &LOG_MASK($numpri) & $maskpri;
299 }
300 else {
301 croak "syslog: too many facilities given: $_" if defined($numfac);
302 $facility = $_;
303 $numfac = $num;
304 }
305 }
306
307 croak "syslog: level must be given" unless defined($numpri);
308
309 if (!defined($numfac)) { # Facility not specified in this call.
310 $facility = 'user' unless $facility;
311 $numfac = &xlate($facility);
312 }
313
314 &connect unless $connected;
315
108be7fb 316 $whoami = our $ident;
a0d0e21e 317
5dad0344 318 if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) {
a0d0e21e
LW
319 $whoami = $1;
320 $mask = $2;
321 }
322
323 unless ($whoami) {
324 ($whoami = getlogin) ||
325 ($whoami = getpwuid($<)) ||
326 ($whoami = 'syslog');
327 }
328
108be7fb 329 $whoami .= "[$$]" if our $lo_pid;
a0d0e21e 330
5007285b
RK
331 if ($mask =~ /%m/) {
332 my $err = $!;
333 # escape percent signs if sprintf will be called
334 $err =~ s/%/%%/g if @_;
335 # replace %m with $err, if preceded by an even number of percent signs
336 $mask =~ s/(?<!%)((?:%%)*)%m/$1$err/g;
337 }
338
a0d0e21e 339 $mask .= "\n" unless $mask =~ /\n$/;
ce43db9b 340 $message = @_ ? sprintf($mask, @_) : $mask;
a0d0e21e
LW
341
342 $sum = $numpri + $numfac;
23642f4b
NW
343 my $buf = "<$sum>$whoami: $message\0";
344
345 # it's possible that we'll get an error from sending
346 # (e.g. if method is UDP and there is no UDP listener,
347 # then we'll get ECONNREFUSED on the send). So what we
348 # want to do at this point is to fallback onto a different
349 # connection method.
350 while (scalar @fallbackMethods || $syslog_send) {
351 if ($failed && (time - $fail_time) > 60) {
352 # it's been a while... maybe things have been fixed
353 @fallbackMethods = ();
354 disconnect();
355 $transmit_ok = 0; # make it look like a fresh attempt
356 &connect;
357 }
358 if ($connected && !connection_ok()) {
359 # Something was OK, but has now broken. Remember coz we'll
360 # want to go back to what used to be OK.
361 $failed = $current_proto unless $failed;
362 $fail_time = time;
363 disconnect();
364 }
365 &connect unless $connected;
60b8437d 366 $failed = undef if ($current_proto && $failed && $current_proto eq $failed);
23642f4b
NW
367 if ($syslog_send) {
368 if (&{$syslog_send}($buf)) {
369 $transmit_ok++;
370 return 1;
a0d0e21e 371 }
23642f4b
NW
372 # typically doesn't happen, since errors are rare from write().
373 disconnect();
374 }
375 }
376 # could not send, could not fallback onto a working
377 # connection method. Lose.
378 return 0;
379}
380
381sub _syslog_send_console {
382 my ($buf) = @_;
383 chop($buf); # delete the NUL from the end
384 # The console print is a method which could block
385 # so we do it in a child process and always return success
386 # to the caller.
387 if (my $pid = fork) {
108be7fb 388 our $lo_nowait;
23642f4b
NW
389 if ($lo_nowait) {
390 return 1;
391 } else {
392 if (waitpid($pid, 0) >= 0) {
393 return ($? >> 8);
394 } else {
395 # it's possible that the caller has other
396 # plans for SIGCHLD, so let's not interfere
397 return 1;
a0d0e21e
LW
398 }
399 }
23642f4b
NW
400 } else {
401 if (open(CONS, ">/dev/console")) {
402 my $ret = print CONS $buf . "\r";
403 exit ($ret) if defined $pid;
404 close CONS;
405 }
406 exit if defined $pid;
a0d0e21e
LW
407 }
408}
409
23642f4b
NW
410sub _syslog_send_stream {
411 my ($buf) = @_;
412 # XXX: this only works if the OS stream implementation makes a write
413 # look like a putmsg() with simple header. For instance it works on
414 # Solaris 8 but not Solaris 7.
415 # To be correct, it should use a STREAMS API, but perl doesn't have one.
416 return syswrite(SYSLOG, $buf, length($buf));
417}
418sub _syslog_send_socket {
419 my ($buf) = @_;
420 return syswrite(SYSLOG, $buf, length($buf));
421 #return send(SYSLOG, $buf, 0);
422}
423
a0d0e21e 424sub xlate {
108be7fb 425 my($name) = @_;
b9f13614 426 return $name+0 if $name =~ /^\s*\d+\s*$/;
55497cff 427 $name = uc $name;
a0d0e21e 428 $name = "LOG_$name" unless $name =~ /^LOG_/;
748a9306 429 $name = "Sys::Syslog::$name";
2c3b42a1 430 # Can't have just eval { &$name } || -1 because some LOG_XXX may be zero.
108be7fb 431 my $value = eval { no strict 'refs'; &$name };
2c3b42a1 432 defined $value ? $value : -1;
a0d0e21e
LW
433}
434
435sub connect {
23642f4b
NW
436 @fallbackMethods = @connectMethods unless (scalar @fallbackMethods);
437 if ($transmit_ok && $current_proto) {
438 # Retry what we were on, because it's worked in the past.
439 unshift(@fallbackMethods, $current_proto);
440 }
441 $connected = 0;
442 my @errs = ();
443 my $proto = undef;
444 while ($proto = shift(@fallbackMethods)) {
108be7fb 445 no strict 'refs';
23642f4b 446 my $fn = "connect_$proto";
108be7fb 447 $connected = &$fn(\@errs) if defined &$fn;
23642f4b
NW
448 last if ($connected);
449 }
450
451 $transmit_ok = 0;
452 if ($connected) {
60b8437d 453 $current_proto = $proto;
108be7fb 454 my($old) = select(SYSLOG); $| = 1; select($old);
23642f4b
NW
455 } else {
456 @fallbackMethods = ();
457 foreach my $err (@errs) {
458 carp $err;
459 }
460 croak "no connection to syslog available";
461 }
462}
463
464sub connect_tcp {
465 my ($errs) = @_;
466 unless ($host) {
467 require Sys::Hostname;
468 my($host_uniq) = Sys::Hostname::hostname();
469 ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
470 }
471 my $tcp = getprotobyname('tcp');
472 if (!defined $tcp) {
473 push(@{$errs}, "getprotobyname failed for tcp");
474 return 0;
475 }
476 my $syslog = getservbyname('syslog','tcp');
477 $syslog = getservbyname('syslogng','tcp') unless (defined $syslog);
478 if (!defined $syslog) {
479 push(@{$errs}, "getservbyname failed for tcp");
480 return 0;
481 }
482
483 my $this = sockaddr_in($syslog, INADDR_ANY);
484 my $that = sockaddr_in($syslog, inet_aton($host));
485 if (!$that) {
486 push(@{$errs}, "can't lookup $host");
487 return 0;
488 }
489 if (!socket(SYSLOG,AF_INET,SOCK_STREAM,$tcp)) {
490 push(@{$errs}, "tcp socket: $!");
491 return 0;
492 }
493 setsockopt(SYSLOG, SOL_SOCKET, SO_KEEPALIVE, 1);
494 setsockopt(SYSLOG, IPPROTO_TCP, TCP_NODELAY, 1);
60b8437d 495 if (!CORE::connect(SYSLOG,$that)) {
23642f4b
NW
496 push(@{$errs}, "tcp connect: $!");
497 return 0;
498 }
499 $syslog_send = \&_syslog_send_socket;
500 return 1;
501}
502
503sub connect_udp {
504 my ($errs) = @_;
4fc7577b
PP
505 unless ($host) {
506 require Sys::Hostname;
2eae817d 507 my($host_uniq) = Sys::Hostname::hostname();
3e3baf6d 508 ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
4fc7577b 509 }
23642f4b
NW
510 my $udp = getprotobyname('udp');
511 if (!defined $udp) {
512 push(@{$errs}, "getprotobyname failed for udp");
513 return 0;
514 }
515 my $syslog = getservbyname('syslog','udp');
516 if (!defined $syslog) {
517 push(@{$errs}, "getservbyname failed for udp");
518 return 0;
519 }
520 my $this = sockaddr_in($syslog, INADDR_ANY);
521 my $that = sockaddr_in($syslog, inet_aton($host));
522 if (!$that) {
523 push(@{$errs}, "can't lookup $host");
524 return 0;
525 }
526 if (!socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp)) {
527 push(@{$errs}, "udp socket: $!");
528 return 0;
529 }
60b8437d 530 if (!CORE::connect(SYSLOG,$that)) {
23642f4b
NW
531 push(@{$errs}, "udp connect: $!");
532 return 0;
533 }
534 # We want to check that the UDP connect worked. However the only
535 # way to do that is to send a message and see if an ICMP is returned
536 _syslog_send_socket("");
537 if (!connection_ok()) {
538 push(@{$errs}, "udp connect: nobody listening");
539 return 0;
540 }
541 $syslog_send = \&_syslog_send_socket;
542 return 1;
543}
544
545sub connect_stream {
546 my ($errs) = @_;
547 # might want syslog_path to be variable based on syslog.h (if only
548 # it were in there!)
549 $syslog_path = '/dev/conslog';
550 if (!-w $syslog_path) {
551 push(@{$errs}, "stream $syslog_path is not writable");
552 return 0;
553 }
554 if (!open(SYSLOG, ">" . $syslog_path)) {
555 push(@{$errs}, "stream can't open $syslog_path: $!");
556 return 0;
557 }
558 $syslog_send = \&_syslog_send_stream;
559 return 1;
560}
561
562sub connect_unix {
563 my ($errs) = @_;
564 if (length _PATH_LOG()) {
565 $syslog_path = _PATH_LOG();
cb63fe9d 566 } else {
23642f4b
NW
567 push(@{$errs}, "_PATH_LOG not available in syslog.h");
568 return 0;
569 }
570 my $that = sockaddr_un($syslog_path);
571 if (!$that) {
572 push(@{$errs}, "can't locate $syslog_path");
573 return 0;
574 }
575 if (!socket(SYSLOG,AF_UNIX,SOCK_STREAM,0)) {
576 push(@{$errs}, "unix stream socket: $!");
577 return 0;
578 }
60b8437d 579 if (!CORE::connect(SYSLOG,$that)) {
23642f4b
NW
580 if (!socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0)) {
581 push(@{$errs}, "unix dgram socket: $!");
582 return 0;
583 }
60b8437d 584 if (!CORE::connect(SYSLOG,$that)) {
23642f4b
NW
585 push(@{$errs}, "unix dgram connect: $!");
586 return 0;
587 }
cb63fe9d 588 }
23642f4b
NW
589 $syslog_send = \&_syslog_send_socket;
590 return 1;
591}
592
593sub connect_console {
594 my ($errs) = @_;
595 if (!-w '/dev/console') {
596 push(@{$errs}, "console is not writable");
597 return 0;
598 }
599 $syslog_send = \&_syslog_send_console;
600 return 1;
601}
602
603# to test if the connection is still good, we need to check if any
604# errors are present on the connection. The errors will not be raised
605# by a write. Instead, sockets are made readable and the next read
606# would cause the error to be returned. Unfortunately the syslog
607# 'protocol' never provides anything for us to read. But with
608# judicious use of select(), we can see if it would be readable...
609sub connection_ok {
dbfdd438 610 return 1 if (defined $current_proto && $current_proto eq 'console');
23642f4b
NW
611 my $rin = '';
612 vec($rin, fileno(SYSLOG), 1) = 1;
613 my $ret = select $rin, undef, $rin, 0;
614 return ($ret ? 0 : 1);
a0d0e21e
LW
615}
616
617sub disconnect {
618 close SYSLOG;
619 $connected = 0;
23642f4b 620 $syslog_send = undef;
a0d0e21e
LW
621}
622
6231;