This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: (perl-current of 5.9.5) patch for ext/Sys/Syslog/Makefile.PL for
[perl5.git] / ext / Sys / Syslog / Syslog.pm
CommitLineData
a0d0e21e 1package Sys::Syslog;
8168e71f 2use strict;
89c3c464 3use warnings::register;
8168e71f 4use Carp;
a650b841 5use Fcntl qw(O_WRONLY);
07b7e4bc 6use File::Basename;
6e4ef777
SP
7use POSIX qw(strftime setlocale LC_TIME);
8use Socket ':all';
d329efa2 9require 5.005;
a0d0e21e 10require Exporter;
a0d0e21e 11
89c3c464 12{ no strict 'vars';
d329efa2 13 $VERSION = '0.21';
89c3c464 14 @ISA = qw(Exporter);
942974c1 15
89c3c464 16 %EXPORT_TAGS = (
4b035b3d
SP
17 standard => [qw(openlog syslog closelog setlogmask)],
18 extended => [qw(setlogsock)],
19 macros => [
20 # levels
21 qw(
22 LOG_ALERT LOG_CRIT LOG_DEBUG LOG_EMERG LOG_ERR
23 LOG_INFO LOG_NOTICE LOG_WARNING
24 ),
25
a650b841 26 # standard facilities
4b035b3d 27 qw(
a650b841
AT
28 LOG_AUTH LOG_AUTHPRIV LOG_CRON LOG_DAEMON LOG_FTP LOG_KERN
29 LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3 LOG_LOCAL4
30 LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR LOG_MAIL LOG_NEWS
31 LOG_SYSLOG LOG_USER LOG_UUCP
32 ),
33 # Mac OS X specific facilities
34 qw( LOG_INSTALL LOG_LAUNCHD LOG_NETINFO LOG_RAS LOG_REMOTEAUTH ),
35 # modern BSD specific facilities
36 qw( LOG_CONSOLE LOG_NTP LOG_SECURITY ),
37 # IRIX specific facilities
38 qw( LOG_AUDIT LOG_LFMT ),
4b035b3d
SP
39
40 # options
41 qw(
42 LOG_CONS LOG_PID LOG_NDELAY LOG_NOWAIT LOG_ODELAY LOG_PERROR
43 ),
44
45 # others macros
46 qw(
47 LOG_FACMASK LOG_NFACILITIES LOG_PRIMASK
48 LOG_MASK LOG_UPTO
49 ),
50 ],
89c3c464 51 );
942974c1 52
89c3c464 53 @EXPORT = (
07b7e4bc 54 @{$EXPORT_TAGS{standard}},
89c3c464 55 );
942974c1 56
89c3c464 57 @EXPORT_OK = (
07b7e4bc
RGS
58 @{$EXPORT_TAGS{extended}},
59 @{$EXPORT_TAGS{macros}},
89c3c464
AT
60 );
61
62 eval {
63 require XSLoader;
64 XSLoader::load('Sys::Syslog', $VERSION);
65 1
66 } or do {
67 require DynaLoader;
68 push @ISA, 'DynaLoader';
69 bootstrap Sys::Syslog $VERSION;
70 };
71}
72
73
74#
75# Public variables
76#
a650b841 77use vars qw($host); # host to send syslog messages to (see notes at end)
89c3c464
AT
78
79#
80# Global variables
81#
a650b841 82use vars qw($facility);
89c3c464
AT
83my $connected = 0; # flag to indicate if we're connected or not
84my $syslog_send; # coderef of the function used to send messages
85my $syslog_path = undef; # syslog path for "stream" and "unix" mechanisms
a650b841 86my $syslog_xobj = undef; # if defined, holds the external object used to send messages
89c3c464
AT
87my $transmit_ok = 0; # flag to indicate if the last message was transmited
88my $current_proto = undef; # current mechanism used to transmit messages
89my $ident = ''; # identifiant prepended to each message
a650b841 90$facility = ''; # current facility
89c3c464
AT
91my $maskpri = LOG_UPTO(&LOG_DEBUG); # current log mask
92
93my %options = (
94 ndelay => 0,
95 nofatal => 0,
96 nowait => 0,
35a209d1 97 perror => 0,
89c3c464 98 pid => 0,
942974c1 99);
a0d0e21e 100
a650b841 101# Default is now to first use the native mechanism, so Perl programs
d329efa2
AT
102# behave like other normal Unix programs, then try other mechanisms.
103my @connectMethods = qw(native tcp udp unix pipe stream console);
dbfdd438
SR
104if ($^O =~ /^(freebsd|linux)$/) {
105 @connectMethods = grep { $_ ne 'udp' } @connectMethods;
106}
a650b841
AT
107
108# use EventLog on Win32
109my $is_Win32 = $^O =~ /Win32/i;
a650b841 110
35a209d1 111if (eval "use Sys::Syslog::Win32; 1") {
a650b841
AT
112 unshift @connectMethods, 'eventlog';
113} elsif ($is_Win32) {
114 warn $@;
115}
116
35a209d1
AT
117$@ = "";
118
23642f4b 119my @defaultMethods = @connectMethods;
89c3c464 120my @fallbackMethods = ();
8168e71f 121
89c3c464
AT
122# coderef for a nicer handling of errors
123my $err_sub = $options{nofatal} ? \&warnings::warnif : \&croak;
5be1dfc7 124
5be1dfc7 125
89c3c464
AT
126sub AUTOLOAD {
127 # This AUTOLOAD is used to 'autoload' constants from the constant()
128 # XS function.
129 no strict 'vars';
130 my $constname;
131 ($constname = $AUTOLOAD) =~ s/.*:://;
132 croak "Sys::Syslog::constant() not defined" if $constname eq 'constant';
133 my ($error, $val) = constant($constname);
a650b841 134 croak $error if $error;
89c3c464
AT
135 no strict 'refs';
136 *$AUTOLOAD = sub { $val };
137 goto &$AUTOLOAD;
138}
5be1dfc7 139
5be1dfc7 140
89c3c464
AT
141sub openlog {
142 ($ident, my $logopt, $facility) = @_;
8168e71f 143
a650b841
AT
144 # default values
145 $ident ||= basename($0) || getlogin() || getpwuid($<) || 'syslog';
146 $logopt ||= '';
147 $facility ||= LOG_USER();
148
89c3c464
AT
149 for my $opt (split /\b/, $logopt) {
150 $options{$opt} = 1 if exists $options{$opt}
151 }
5be1dfc7 152
89c3c464
AT
153 $err_sub = $options{nofatal} ? \&warnings::warnif : \&croak;
154 return 1 unless $options{ndelay};
155 connect_log();
156}
5be1dfc7 157
89c3c464
AT
158sub closelog {
159 $facility = $ident = '';
160 disconnect_log();
161}
8168e71f 162
89c3c464
AT
163sub setlogmask {
164 my $oldmask = $maskpri;
165 $maskpri = shift unless $_[0] == 0;
166 $oldmask;
167}
07b7e4bc 168
89c3c464
AT
169sub setlogsock {
170 my $setsock = shift;
171 $syslog_path = shift;
172 disconnect_log() if $connected;
173 $transmit_ok = 0;
174 @fallbackMethods = ();
175 @connectMethods = @defaultMethods;
942974c1 176
89c3c464
AT
177 if (ref $setsock eq 'ARRAY') {
178 @connectMethods = @$setsock;
942974c1 179
89c3c464 180 } elsif (lc $setsock eq 'stream') {
a650b841 181 if (not defined $syslog_path) {
89c3c464 182 my @try = qw(/dev/log /dev/conslog);
a650b841
AT
183
184 if (length &_PATH_LOG) { # Undefined _PATH_LOG is "".
89c3c464
AT
185 unshift @try, &_PATH_LOG;
186 }
a650b841 187
89c3c464
AT
188 for my $try (@try) {
189 if (-w $try) {
190 $syslog_path = $try;
191 last;
192 }
193 }
a650b841
AT
194
195 if (not defined $syslog_path) {
196 warnings::warnif "stream passed to setlogsock, but could not find any device";
197 return undef
198 }
89c3c464 199 }
a650b841
AT
200
201 if (not -w $syslog_path) {
07b7e4bc 202 warnings::warnif "stream passed to setlogsock, but $syslog_path is not writable";
89c3c464
AT
203 return undef;
204 } else {
a650b841 205 @connectMethods = qw(stream);
89c3c464 206 }
942974c1 207
89c3c464 208 } elsif (lc $setsock eq 'unix') {
8edeb3ad
RGS
209 if (length _PATH_LOG() || (defined $syslog_path && -w $syslog_path)) {
210 $syslog_path = _PATH_LOG() unless defined $syslog_path;
a650b841 211 @connectMethods = qw(unix);
89c3c464
AT
212 } else {
213 warnings::warnif 'unix passed to setlogsock, but path not available';
214 return undef;
215 }
8168e71f 216
d329efa2
AT
217 } elsif (lc $setsock eq 'pipe') {
218 for my $path ($syslog_path, &_PATH_LOG, "/dev/log") {
219 next unless defined $path and length $path and -w $path;
220 $syslog_path = $path;
221 last
222 }
223
224 if (not $syslog_path) {
225 warnings::warnif "pipe passed to setlogsock, but path not available";
226 return undef
227 }
228
229 @connectMethods = qw(pipe);
230
89c3c464 231 } elsif (lc $setsock eq 'native') {
a650b841
AT
232 @connectMethods = qw(native);
233
234 } elsif (lc $setsock eq 'eventlog') {
235 if (eval "use Win32::EventLog; 1") {
236 @connectMethods = qw(eventlog);
237 } else {
35a209d1
AT
238 warnings::warnif "eventlog passed to setlogsock, but no Win32 API available";
239 $@ = "";
d329efa2 240 return undef;
a650b841 241 }
8168e71f 242
89c3c464
AT
243 } elsif (lc $setsock eq 'tcp') {
244 if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) {
a650b841 245 @connectMethods = qw(tcp);
89c3c464
AT
246 } else {
247 warnings::warnif "tcp passed to setlogsock, but tcp service unavailable";
248 return undef;
249 }
942974c1 250
89c3c464
AT
251 } elsif (lc $setsock eq 'udp') {
252 if (getservbyname('syslog', 'udp')) {
a650b841 253 @connectMethods = qw(udp);
89c3c464
AT
254 } else {
255 warnings::warnif "udp passed to setlogsock, but udp service unavailable";
256 return undef;
257 }
942974c1 258
89c3c464
AT
259 } elsif (lc $setsock eq 'inet') {
260 @connectMethods = ( 'tcp', 'udp' );
942974c1 261
89c3c464 262 } elsif (lc $setsock eq 'console') {
a650b841 263 @connectMethods = qw(console);
942974c1 264
89c3c464 265 } else {
d329efa2
AT
266 croak "Invalid argument passed to setlogsock; must be 'stream', 'pipe', ",
267 "'unix', 'native', 'eventlog', 'tcp', 'udp' or 'inet'"
89c3c464 268 }
942974c1 269
89c3c464
AT
270 return 1;
271}
942974c1 272
89c3c464
AT
273sub syslog {
274 my $priority = shift;
275 my $mask = shift;
276 my ($message, $buf);
277 my (@words, $num, $numpri, $numfac, $sum);
278 my $failed = undef;
279 my $fail_time = undef;
8edeb3ad 280 my $error = $!;
8168e71f 281
a650b841
AT
282 # if $ident is undefined, it means openlog() wasn't previously called
283 # so do it now in order to have sensible defaults
284 openlog() unless $ident;
285
286 local $facility = $facility; # may need to change temporarily.
8168e71f 287
89c3c464
AT
288 croak "syslog: expecting argument \$priority" unless defined $priority;
289 croak "syslog: expecting argument \$format" unless defined $mask;
5be1dfc7 290
8edeb3ad 291 @words = split(/\W+/, $priority, 2); # Allow "level" or "level|facility".
89c3c464
AT
292 undef $numpri;
293 undef $numfac;
5be1dfc7 294
89c3c464 295 foreach (@words) {
8edeb3ad 296 $num = xlate($_); # Translate word to number.
89c3c464
AT
297 if ($num < 0) {
298 croak "syslog: invalid level/facility: $_"
299 }
300 elsif ($num <= &LOG_PRIMASK) {
301 croak "syslog: too many levels given: $_" if defined $numpri;
302 $numpri = $num;
303 return 0 unless LOG_MASK($numpri) & $maskpri;
304 }
305 else {
306 croak "syslog: too many facilities given: $_" if defined $numfac;
307 $facility = $_;
308 $numfac = $num;
309 }
310 }
5be1dfc7 311
89c3c464 312 croak "syslog: level must be given" unless defined $numpri;
942974c1 313
89c3c464
AT
314 if (not defined $numfac) { # Facility not specified in this call.
315 $facility = 'user' unless $facility;
316 $numfac = xlate($facility);
317 }
3d256c0f 318
89c3c464 319 connect_log() unless $connected;
8168e71f 320
89c3c464 321 if ($mask =~ /%m/) {
07b7e4bc 322 # escape percent signs for sprintf()
8edeb3ad 323 $error =~ s/%/%%/g if @_;
a650b841 324 # replace %m with $error, if preceded by an even number of percent signs
8edeb3ad 325 $mask =~ s/(?<!%)((?:%%)*)%m/$1$error/g;
89c3c464 326 }
5be1dfc7 327
89c3c464
AT
328 $mask .= "\n" unless $mask =~ /\n$/;
329 $message = @_ ? sprintf($mask, @_) : $mask;
942974c1 330
d329efa2 331 # See CPAN-RT#24431. Opened on Apple Radar as bug #4944407 on 2007.01.21
35a209d1 332 # Supposedly resolved on Leopard.
d329efa2
AT
333 chomp $message if $^O =~ /darwin/;
334
335 if ($current_proto eq 'native') {
89c3c464 336 $buf = $message;
a650b841
AT
337 }
338 elsif ($current_proto eq 'eventlog') {
339 $buf = $message;
340 }
341 else {
89c3c464 342 my $whoami = $ident;
89c3c464 343 $whoami .= "[$$]" if $options{pid};
942974c1 344
89c3c464
AT
345 $sum = $numpri + $numfac;
346 my $oldlocale = setlocale(LC_TIME);
347 setlocale(LC_TIME, 'C');
348 my $timestamp = strftime "%b %e %T", localtime;
349 setlocale(LC_TIME, $oldlocale);
350 $buf = "<$sum>$timestamp $whoami: $message\0";
351 }
942974c1 352
35a209d1
AT
353 # handle PERROR option
354 # "native" mechanism already handles it by itself
355 if ($options{perror} and $current_proto ne 'native') {
356 chomp $message;
357 my $whoami = $ident;
358 $whoami .= "[$$]" if $options{pid};
359 print STDERR "$whoami: $message\n";
360 }
361
89c3c464
AT
362 # it's possible that we'll get an error from sending
363 # (e.g. if method is UDP and there is no UDP listener,
364 # then we'll get ECONNREFUSED on the send). So what we
365 # want to do at this point is to fallback onto a different
366 # connection method.
367 while (scalar @fallbackMethods || $syslog_send) {
368 if ($failed && (time - $fail_time) > 60) {
369 # it's been a while... maybe things have been fixed
370 @fallbackMethods = ();
371 disconnect_log();
372 $transmit_ok = 0; # make it look like a fresh attempt
373 connect_log();
374 }
942974c1 375
89c3c464
AT
376 if ($connected && !connection_ok()) {
377 # Something was OK, but has now broken. Remember coz we'll
378 # want to go back to what used to be OK.
379 $failed = $current_proto unless $failed;
380 $fail_time = time;
381 disconnect_log();
382 }
942974c1 383
89c3c464
AT
384 connect_log() unless $connected;
385 $failed = undef if ($current_proto && $failed && $current_proto eq $failed);
942974c1 386
89c3c464 387 if ($syslog_send) {
a650b841 388 if ($syslog_send->($buf, $numpri, $numfac)) {
89c3c464
AT
389 $transmit_ok++;
390 return 1;
391 }
392 # typically doesn't happen, since errors are rare from write().
393 disconnect_log();
394 }
395 }
396 # could not send, could not fallback onto a working
397 # connection method. Lose.
398 return 0;
399}
942974c1 400
89c3c464
AT
401sub _syslog_send_console {
402 my ($buf) = @_;
403 chop($buf); # delete the NUL from the end
404 # The console print is a method which could block
405 # so we do it in a child process and always return success
406 # to the caller.
407 if (my $pid = fork) {
942974c1 408
89c3c464
AT
409 if ($options{nowait}) {
410 return 1;
411 } else {
412 if (waitpid($pid, 0) >= 0) {
413 return ($? >> 8);
414 } else {
415 # it's possible that the caller has other
416 # plans for SIGCHLD, so let's not interfere
417 return 1;
418 }
419 }
420 } else {
421 if (open(CONS, ">/dev/console")) {
422 my $ret = print CONS $buf . "\r"; # XXX: should this be \x0A ?
423 exit $ret if defined $pid;
424 close CONS;
425 }
426 exit if defined $pid;
427 }
428}
942974c1 429
89c3c464
AT
430sub _syslog_send_stream {
431 my ($buf) = @_;
432 # XXX: this only works if the OS stream implementation makes a write
433 # look like a putmsg() with simple header. For instance it works on
434 # Solaris 8 but not Solaris 7.
435 # To be correct, it should use a STREAMS API, but perl doesn't have one.
436 return syswrite(SYSLOG, $buf, length($buf));
437}
942974c1 438
d329efa2
AT
439sub _syslog_send_pipe {
440 my ($buf) = @_;
441 return print SYSLOG $buf;
442}
443
89c3c464
AT
444sub _syslog_send_socket {
445 my ($buf) = @_;
446 return syswrite(SYSLOG, $buf, length($buf));
447 #return send(SYSLOG, $buf, 0);
448}
942974c1 449
89c3c464
AT
450sub _syslog_send_native {
451 my ($buf, $numpri) = @_;
a650b841
AT
452 syslog_xs($numpri, $buf);
453 return 1;
89c3c464 454}
ce43db9b 455
5be1dfc7 456
89c3c464
AT
457# xlate()
458# -----
459# private function to translate names to numeric values
460#
461sub xlate {
462 my($name) = @_;
463 return $name+0 if $name =~ /^\s*\d+\s*$/;
464 $name = uc $name;
465 $name = "LOG_$name" unless $name =~ /^LOG_/;
466 $name = "Sys::Syslog::$name";
467 # Can't have just eval { &$name } || -1 because some LOG_XXX may be zero.
468 my $value = eval { no strict 'refs'; &$name };
35a209d1
AT
469 $@ = "";
470 return defined $value ? $value : -1;
89c3c464 471}
5be1dfc7 472
942974c1 473
89c3c464
AT
474# connect_log()
475# -----------
476# This function acts as a kind of front-end: it tries to connect to
477# a syslog service using the selected methods, trying each one in the
478# selected order.
479#
480sub connect_log {
481 @fallbackMethods = @connectMethods unless scalar @fallbackMethods;
07b7e4bc 482
89c3c464
AT
483 if ($transmit_ok && $current_proto) {
484 # Retry what we were on, because it has worked in the past.
485 unshift(@fallbackMethods, $current_proto);
486 }
07b7e4bc 487
89c3c464
AT
488 $connected = 0;
489 my @errs = ();
490 my $proto = undef;
07b7e4bc 491
89c3c464
AT
492 while ($proto = shift @fallbackMethods) {
493 no strict 'refs';
494 my $fn = "connect_$proto";
495 $connected = &$fn(\@errs) if defined &$fn;
496 last if $connected;
497 }
3d256c0f 498
89c3c464
AT
499 $transmit_ok = 0;
500 if ($connected) {
501 $current_proto = $proto;
a650b841 502 my ($old) = select(SYSLOG); $| = 1; select($old);
89c3c464
AT
503 } else {
504 @fallbackMethods = ();
505 $err_sub->(join "\n\t- ", "no connection to syslog available", @errs);
506 return undef;
507 }
508}
942974c1 509
89c3c464
AT
510sub connect_tcp {
511 my ($errs) = @_;
4b035b3d 512
89c3c464
AT
513 my $tcp = getprotobyname('tcp');
514 if (!defined $tcp) {
515 push @$errs, "getprotobyname failed for tcp";
516 return 0;
517 }
4b035b3d
SP
518
519 my $syslog = getservbyname('syslog', 'tcp');
520 $syslog = getservbyname('syslogng', 'tcp') unless defined $syslog;
89c3c464
AT
521 if (!defined $syslog) {
522 push @$errs, "getservbyname failed for syslog/tcp and syslogng/tcp";
523 return 0;
524 }
942974c1 525
4b035b3d 526 my $addr;
89c3c464 527 if (defined $host) {
4b035b3d
SP
528 $addr = inet_aton($host);
529 if (!$addr) {
89c3c464
AT
530 push @$errs, "can't lookup $host";
531 return 0;
532 }
533 } else {
4b035b3d 534 $addr = INADDR_LOOPBACK;
89c3c464 535 }
4b035b3d 536 $addr = sockaddr_in($syslog, $addr);
942974c1 537
89c3c464
AT
538 if (!socket(SYSLOG, AF_INET, SOCK_STREAM, $tcp)) {
539 push @$errs, "tcp socket: $!";
540 return 0;
541 }
a650b841 542
89c3c464 543 setsockopt(SYSLOG, SOL_SOCKET, SO_KEEPALIVE, 1);
d329efa2
AT
544 if (eval { IPPROTO_TCP() }) {
545 # These constants don't exist in 5.005. They were added in 1999
546 setsockopt(SYSLOG, IPPROTO_TCP(), TCP_NODELAY(), 1);
547 }
35a209d1 548 $@ = "";
4b035b3d 549 if (!connect(SYSLOG, $addr)) {
89c3c464
AT
550 push @$errs, "tcp connect: $!";
551 return 0;
552 }
4b035b3d 553
89c3c464 554 $syslog_send = \&_syslog_send_socket;
4b035b3d 555
89c3c464
AT
556 return 1;
557}
942974c1 558
89c3c464
AT
559sub connect_udp {
560 my ($errs) = @_;
4b035b3d 561
89c3c464
AT
562 my $udp = getprotobyname('udp');
563 if (!defined $udp) {
564 push @$errs, "getprotobyname failed for udp";
565 return 0;
566 }
4b035b3d
SP
567
568 my $syslog = getservbyname('syslog', 'udp');
89c3c464
AT
569 if (!defined $syslog) {
570 push @$errs, "getservbyname failed for syslog/udp";
571 return 0;
572 }
4b035b3d
SP
573
574 my $addr;
89c3c464 575 if (defined $host) {
4b035b3d
SP
576 $addr = inet_aton($host);
577 if (!$addr) {
89c3c464
AT
578 push @$errs, "can't lookup $host";
579 return 0;
580 }
581 } else {
4b035b3d 582 $addr = INADDR_LOOPBACK;
89c3c464 583 }
4b035b3d 584 $addr = sockaddr_in($syslog, $addr);
942974c1 585
89c3c464
AT
586 if (!socket(SYSLOG, AF_INET, SOCK_DGRAM, $udp)) {
587 push @$errs, "udp socket: $!";
588 return 0;
589 }
4b035b3d 590 if (!connect(SYSLOG, $addr)) {
89c3c464
AT
591 push @$errs, "udp connect: $!";
592 return 0;
593 }
4b035b3d 594
89c3c464
AT
595 # We want to check that the UDP connect worked. However the only
596 # way to do that is to send a message and see if an ICMP is returned
597 _syslog_send_socket("");
598 if (!connection_ok()) {
599 push @$errs, "udp connect: nobody listening";
600 return 0;
601 }
4b035b3d 602
89c3c464 603 $syslog_send = \&_syslog_send_socket;
4b035b3d 604
89c3c464
AT
605 return 1;
606}
9903e4c8 607
89c3c464
AT
608sub connect_stream {
609 my ($errs) = @_;
610 # might want syslog_path to be variable based on syslog.h (if only
611 # it were in there!)
8edeb3ad 612 $syslog_path = '/dev/conslog' unless defined $syslog_path;
89c3c464
AT
613 if (!-w $syslog_path) {
614 push @$errs, "stream $syslog_path is not writable";
615 return 0;
616 }
a650b841 617 if (!sysopen(SYSLOG, $syslog_path, 0400, O_WRONLY)) {
89c3c464
AT
618 push @$errs, "stream can't open $syslog_path: $!";
619 return 0;
620 }
621 $syslog_send = \&_syslog_send_stream;
622 return 1;
623}
942974c1 624
d329efa2
AT
625sub connect_pipe {
626 my ($errs) = @_;
627
628 $syslog_path ||= &_PATH_LOG || "/dev/log";
629
630 if (not -w $syslog_path) {
631 push @$errs, "$syslog_path is not writable";
632 return 0;
633 }
634
635 if (not open(SYSLOG, ">$syslog_path")) {
636 push @$errs, "can't write to $syslog_path: $!";
637 return 0;
638 }
639
640 $syslog_send = \&_syslog_send_pipe;
641
642 return 1;
643}
644
89c3c464
AT
645sub connect_unix {
646 my ($errs) = @_;
4b035b3d
SP
647
648 $syslog_path ||= _PATH_LOG() if length _PATH_LOG();
649
650 if (not defined $syslog_path) {
651 push @$errs, "_PATH_LOG not available in syslog.h and no user-supplied socket path";
89c3c464
AT
652 return 0;
653 }
4b035b3d 654
35a209d1 655 if (not (-S $syslog_path or -c _)) {
89c3c464
AT
656 push @$errs, "$syslog_path is not a socket";
657 return 0;
658 }
4b035b3d
SP
659
660 my $addr = sockaddr_un($syslog_path);
661 if (!$addr) {
89c3c464
AT
662 push @$errs, "can't locate $syslog_path";
663 return 0;
664 }
4b035b3d 665 if (!socket(SYSLOG, AF_UNIX, SOCK_STREAM, 0)) {
89c3c464
AT
666 push @$errs, "unix stream socket: $!";
667 return 0;
668 }
a650b841 669
4b035b3d
SP
670 if (!connect(SYSLOG, $addr)) {
671 if (!socket(SYSLOG, AF_UNIX, SOCK_DGRAM, 0)) {
89c3c464
AT
672 push @$errs, "unix dgram socket: $!";
673 return 0;
674 }
4b035b3d 675 if (!connect(SYSLOG, $addr)) {
89c3c464
AT
676 push @$errs, "unix dgram connect: $!";
677 return 0;
678 }
679 }
4b035b3d 680
89c3c464 681 $syslog_send = \&_syslog_send_socket;
4b035b3d 682
89c3c464
AT
683 return 1;
684}
942974c1 685
89c3c464
AT
686sub connect_native {
687 my ($errs) = @_;
688 my $logopt = 0;
5be1dfc7 689
89c3c464
AT
690 # reconstruct the numeric equivalent of the options
691 for my $opt (keys %options) {
692 $logopt += xlate($opt) if $options{$opt}
693 }
942974c1 694
89c3c464
AT
695 eval { openlog_xs($ident, $logopt, xlate($facility)) };
696 if ($@) {
697 push @$errs, $@;
698 return 0;
699 }
942974c1 700
89c3c464 701 $syslog_send = \&_syslog_send_native;
942974c1 702
89c3c464
AT
703 return 1;
704}
6e4ef777 705
a650b841
AT
706sub connect_eventlog {
707 my ($errs) = @_;
708
709 $syslog_xobj = Sys::Syslog::Win32::_install();
710 $syslog_send = \&Sys::Syslog::Win32::_syslog_send;
711
712 return 1;
713}
714
89c3c464
AT
715sub connect_console {
716 my ($errs) = @_;
717 if (!-w '/dev/console') {
718 push @$errs, "console is not writable";
719 return 0;
720 }
721 $syslog_send = \&_syslog_send_console;
722 return 1;
723}
6e4ef777 724
a650b841 725# To test if the connection is still good, we need to check if any
89c3c464
AT
726# errors are present on the connection. The errors will not be raised
727# by a write. Instead, sockets are made readable and the next read
728# would cause the error to be returned. Unfortunately the syslog
729# 'protocol' never provides anything for us to read. But with
730# judicious use of select(), we can see if it would be readable...
731sub connection_ok {
732 return 1 if defined $current_proto and (
733 $current_proto eq 'native' or $current_proto eq 'console'
a650b841 734 or $current_proto eq 'eventlog'
89c3c464 735 );
a650b841 736
89c3c464
AT
737 my $rin = '';
738 vec($rin, fileno(SYSLOG), 1) = 1;
a650b841 739 my $ret = select $rin, undef, $rin, 0.25;
89c3c464
AT
740 return ($ret ? 0 : 1);
741}
942974c1 742
89c3c464
AT
743sub disconnect_log {
744 $connected = 0;
745 $syslog_send = undef;
942974c1 746
a650b841
AT
747 if (defined $current_proto and $current_proto eq 'native') {
748 closelog_xs();
749 return 1;
750 }
751 elsif (defined $current_proto and $current_proto eq 'eventlog') {
752 $syslog_xobj->Close();
89c3c464
AT
753 return 1;
754 }
6e4ef777 755
89c3c464
AT
756 return close SYSLOG;
757}
6e4ef777 758
89c3c464 7591;
942974c1 760
89c3c464 761__END__
5be1dfc7 762
89c3c464 763=head1 NAME
8168e71f 764
89c3c464 765Sys::Syslog - Perl interface to the UNIX syslog(3) calls
3ffabb8c 766
89c3c464 767=head1 VERSION
3ffabb8c 768
d329efa2 769Version 0.21
23642f4b 770
89c3c464 771=head1 SYNOPSIS
cb63fe9d 772
89c3c464
AT
773 use Sys::Syslog; # all except setlogsock(), or:
774 use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock()
775 use Sys::Syslog qw(:standard :macros); # standard functions, plus macros
23642f4b 776
89c3c464
AT
777 openlog $ident, $logopt, $facility; # don't forget this
778 syslog $priority, $format, @args;
779 $oldmask = setlogmask $mask_priority;
780 closelog;
cb63fe9d 781
942974c1 782
89c3c464 783=head1 DESCRIPTION
5be1dfc7 784
89c3c464
AT
785C<Sys::Syslog> is an interface to the UNIX C<syslog(3)> program.
786Call C<syslog()> with a string priority and a list of C<printf()> args
787just like C<syslog(3)>.
5be1dfc7 788
a650b841
AT
789You can find a kind of FAQ in L<"THE RULES OF SYS::SYSLOG">. Please read
790it before coding, and again before asking questions.
791
5be1dfc7 792
89c3c464 793=head1 EXPORTS
5be1dfc7 794
89c3c464 795C<Sys::Syslog> exports the following C<Exporter> tags:
5be1dfc7 796
89c3c464
AT
797=over 4
798
799=item *
800
801C<:standard> exports the standard C<syslog(3)> functions:
802
803 openlog closelog setlogmask syslog
804
805=item *
806
807C<:extended> exports the Perl specific functions for C<syslog(3)>:
808
809 setlogsock
810
811=item *
812
813C<:macros> exports the symbols corresponding to most of your C<syslog(3)>
814macros and the C<LOG_UPTO()> and C<LOG_MASK()> functions.
815See L<"CONSTANTS"> for the supported constants and their meaning.
816
817=back
818
819By default, C<Sys::Syslog> exports the symbols from the C<:standard> tag.
820
821
822=head1 FUNCTIONS
823
824=over 4
825
826=item B<openlog($ident, $logopt, $facility)>
827
828Opens the syslog.
829C<$ident> is prepended to every message. C<$logopt> contains zero or
830more of the options detailed below. C<$facility> specifies the part
831of the system to report about, for example C<LOG_USER> or C<LOG_LOCAL0>:
832see L<"Facilities"> for a list of well-known facilities, and your
833C<syslog(3)> documentation for the facilities available in your system.
834Check L<"SEE ALSO"> for useful links. Facility can be given as a string
835or a numeric macro.
836
837This function will croak if it can't connect to the syslog daemon.
838
839Note that C<openlog()> now takes three arguments, just like C<openlog(3)>.
840
841B<You should use C<openlog()> before calling C<syslog()>.>
842
843B<Options>
844
845=over 4
846
847=item *
848
849C<cons> - This option is ignored, since the failover mechanism will drop
850down to the console automatically if all other media fail.
851
852=item *
853
854C<ndelay> - Open the connection immediately (normally, the connection is
855opened when the first message is logged).
856
857=item *
858
859C<nofatal> - When set to true, C<openlog()> and C<syslog()> will only
860emit warnings instead of dying if the connection to the syslog can't
861be established.
862
863=item *
864
865C<nowait> - Don't wait for child processes that may have been created
866while logging the message. (The GNU C library does not create a child
867process, so this option has no effect on Linux.)
868
869=item *
870
35a209d1
AT
871C<perror> - Write the message to standard error output as well to the
872system log.
873
874=item *
875
89c3c464
AT
876C<pid> - Include PID with each message.
877
878=back
879
880B<Examples>
881
882Open the syslog with options C<ndelay> and C<pid>, and with facility C<LOCAL0>:
883
884 openlog($name, "ndelay,pid", "local0");
885
886Same thing, but this time using the macro corresponding to C<LOCAL0>:
887
888 openlog($name, "ndelay,pid", LOG_LOCAL0);
889
890
891=item B<syslog($priority, $message)>
892
893=item B<syslog($priority, $format, @args)>
894
895If C<$priority> permits, logs C<$message> or C<sprintf($format, @args)>
896with the addition that C<%m> in $message or C<$format> is replaced with
897C<"$!"> (the latest error message).
898
899C<$priority> can specify a level, or a level and a facility. Levels and
a650b841
AT
900facilities can be given as strings or as macros. When using the C<eventlog>
901mechanism, priorities C<DEBUG> and C<INFO> are mapped to event type
902C<informational>, C<NOTICE> and C<WARNIN> to C<warning> and C<ERR> to
903C<EMERG> to C<error>.
89c3c464
AT
904
905If you didn't use C<openlog()> before using C<syslog()>, C<syslog()> will
906try to guess the C<$ident> by extracting the shortest prefix of
907C<$format> that ends in a C<":">.
908
909B<Examples>
910
911 syslog("info", $message); # informational level
912 syslog(LOG_INFO, $message); # informational level
913
914 syslog("info|local0", $message); # information level, Local0 facility
915 syslog(LOG_INFO|LOG_LOCAL0, $message); # information level, Local0 facility
916
917=over 4
918
919=item B<Note>
920
921C<Sys::Syslog> version v0.07 and older passed the C<$message> as the
922formatting string to C<sprintf()> even when no formatting arguments
923were provided. If the code calling C<syslog()> might execute with
924older versions of this module, make sure to call the function as
925C<syslog($priority, "%s", $message)> instead of C<syslog($priority,
926$message)>. This protects against hostile formatting sequences that
927might show up if $message contains tainted data.
928
929=back
930
931
932=item B<setlogmask($mask_priority)>
933
934Sets the log mask for the current process to C<$mask_priority> and
935returns the old mask. If the mask argument is 0, the current log mask
936is not modified. See L<"Levels"> for the list of available levels.
937You can use the C<LOG_UPTO()> function to allow all levels up to a
938given priority (but it only accept the numeric macros as arguments).
939
940B<Examples>
941
942Only log errors:
943
944 setlogmask( LOG_MASK(LOG_ERR) );
945
946Log everything except informational messages:
947
948 setlogmask( ~(LOG_MASK(LOG_INFO)) );
949
950Log critical messages, errors and warnings:
951
952 setlogmask( LOG_MASK(LOG_CRIT) | LOG_MASK(LOG_ERR) | LOG_MASK(LOG_WARNING) );
953
954Log all messages up to debug:
955
956 setlogmask( LOG_UPTO(LOG_DEBUG) );
957
958
959=item B<setlogsock($sock_type)>
960
07b7e4bc 961=item B<setlogsock($sock_type, $stream_location)> (added in Perl 5.004_02)
89c3c464
AT
962
963Sets the socket type to be used for the next call to
964C<openlog()> or C<syslog()> and returns true on success,
4b035b3d
SP
965C<undef> on failure. The available mechanisms are:
966
967=over
968
969=item *
970
07b7e4bc
RGS
971C<"native"> - use the native C functions from your C<syslog(3)> library
972(added in C<Sys::Syslog> 0.15).
4b035b3d
SP
973
974=item *
975
d329efa2
AT
976C<"eventlog"> - send messages to the Win32 events logger (Win32 only;
977added in C<Sys::Syslog> 0.19).
978
979=item *
980
4b035b3d
SP
981C<"tcp"> - connect to a TCP socket, on the C<syslog/tcp> or C<syslogng/tcp>
982service.
983
984=item *
985
986C<"udp"> - connect to a UDP socket, on the C<syslog/udp> service.
987
988=item *
989
990C<"inet"> - connect to an INET socket, either TCP or UDP, tried in that order.
991
992=item *
993
994C<"unix"> - connect to a UNIX domain socket (in some systems a character
995special device). The name of that socket is the second parameter or, if
996you omit the second parameter, the value returned by the C<_PATH_LOG> macro
997(if your system defines it), or F</dev/log> or F</dev/conslog>, whatever is
998writable.
999
1000=item *
1001
1002C<"stream"> - connect to the stream indicated by the pathname provided as
1003the optional second parameter, or, if omitted, to F</dev/conslog>.
1004For example Solaris and IRIX system may prefer C<"stream"> instead of C<"unix">.
1005
1006=item *
1007
d329efa2
AT
1008C<"pipe"> - connect to the named pipe indicated by the pathname provided as
1009the optional second parameter, or, if omitted, to the value returned by
1010the C<_PATH_LOG> macro (if your system defines it), or F</dev/log>
1011(added in C<Sys::Syslog> 0.21).
4b035b3d 1012
a650b841
AT
1013=item *
1014
d329efa2
AT
1015C<"console"> - send messages directly to the console, as for the C<"cons">
1016option of C<openlog()>.
a650b841 1017
4b035b3d 1018=back
89c3c464
AT
1019
1020A reference to an array can also be passed as the first parameter.
1021When this calling method is used, the array should contain a list of
4b035b3d 1022mechanisms which are attempted in order.
89c3c464 1023
4b035b3d 1024The default is to try C<native>, C<tcp>, C<udp>, C<unix>, C<stream>, C<console>.
35a209d1
AT
1025Under systems with the Win32 API, C<eventlog> will be added as the first
1026mechanism to try if C<Win32::EventLog> is available.
89c3c464 1027
07b7e4bc 1028Giving an invalid value for C<$sock_type> will C<croak>.
89c3c464 1029
4b035b3d
SP
1030B<Examples>
1031
1032Select the UDP socket mechanism:
1033
1034 setlogsock("udp");
1035
1036Select the native, UDP socket then UNIX domain socket mechanisms:
1037
1038 setlogsock(["native", "udp", "unix"]);
1039
07b7e4bc
RGS
1040=over
1041
1042=item B<Note>
1043
1044Now that the "native" mechanism is supported by C<Sys::Syslog> and selected
1045by default, the use of the C<setlogsock()> function is discouraged because
1046other mechanisms are less portable across operating systems. Authors of
1047modules and programs that use this function, especially its cargo-cult form
1048C<setlogsock("unix")>, are advised to remove any occurence of it unless they
1049specifically want to use a given mechanism (like TCP or UDP to connect to
1050a remote host).
1051
1052=back
89c3c464
AT
1053
1054=item B<closelog()>
1055
4b035b3d 1056Closes the log file and returns true on success.
89c3c464
AT
1057
1058=back
1059
1060
a650b841
AT
1061=head1 THE RULES OF SYS::SYSLOG
1062
1063I<The First Rule of Sys::Syslog is:>
1064You do not call C<setlogsock>.
1065
1066I<The Second Rule of Sys::Syslog is:>
1067You B<do not> call C<setlogsock>.
1068
1069I<The Third Rule of Sys::Syslog is:>
1070The program crashes, C<die>s, calls C<closelog>, the log is over.
1071
1072I<The Fourth Rule of Sys::Syslog is:>
1073One facility, one priority.
1074
1075I<The Fifth Rule of Sys::Syslog is:>
1076One log at a time.
1077
1078I<The Sixth Rule of Sys::Syslog is:>
1079No C<syslog> before C<openlog>.
1080
1081I<The Seventh Rule of Sys::Syslog is:>
1082Logs will go on as long as they have to.
1083
1084I<The Eighth, and Final Rule of Sys::Syslog is:>
1085If this is your first use of Sys::Syslog, you must read the doc.
1086
1087
89c3c464
AT
1088=head1 EXAMPLES
1089
a650b841
AT
1090An example:
1091
89c3c464
AT
1092 openlog($program, 'cons,pid', 'user');
1093 syslog('info', '%s', 'this is another test');
1094 syslog('mail|warning', 'this is a better test: %d', time);
1095 closelog();
5be1dfc7
HF
1096
1097 syslog('debug', 'this is the last test');
cb63fe9d 1098
a650b841
AT
1099Another example:
1100
5be1dfc7
HF
1101 openlog("$program $$", 'ndelay', 'user');
1102 syslog('notice', 'fooprogram: this is really done');
1103
a650b841
AT
1104Example of use of C<%m>:
1105
5be1dfc7 1106 $! = 55;
6e4ef777
SP
1107 syslog('info', 'problem was %m'); # %m == $! in syslog(3)
1108
1109Log to UDP port on C<$remotehost> instead of logging locally:
5be1dfc7 1110
476b65d9
JH
1111 setlogsock('udp');
1112 $Sys::Syslog::host = $remotehost;
1113 openlog($program, 'ndelay', 'user');
1114 syslog('info', 'something happened over here');
1115
8168e71f
SP
1116
1117=head1 CONSTANTS
1118
1119=head2 Facilities
1120
1121=over 4
1122
1123=item *
1124
a650b841
AT
1125C<LOG_AUDIT> - audit daemon (IRIX); falls back to C<LOG_AUTH>
1126
1127=item *
1128
8168e71f
SP
1129C<LOG_AUTH> - security/authorization messages
1130
1131=item *
1132
1133C<LOG_AUTHPRIV> - security/authorization messages (private)
1134
1135=item *
1136
a650b841
AT
1137C<LOG_CONSOLE> - C</dev/console> output (FreeBSD); falls back to C<LOG_USER>
1138
1139=item *
1140
4b035b3d 1141C<LOG_CRON> - clock daemons (B<cron> and B<at>)
8168e71f
SP
1142
1143=item *
1144
1145C<LOG_DAEMON> - system daemons without separate facility value
1146
1147=item *
1148
4b035b3d 1149C<LOG_FTP> - FTP daemon
8168e71f
SP
1150
1151=item *
1152
1153C<LOG_KERN> - kernel messages
1154
1155=item *
1156
a650b841 1157C<LOG_INSTALL> - installer subsystem (Mac OS X); falls back to C<LOG_USER>
4b035b3d
SP
1158
1159=item *
1160
a650b841
AT
1161C<LOG_LAUNCHD> - launchd - general bootstrap daemon (Mac OS X);
1162falls back to C<LOG_DAEMON>
1163
1164=item *
1165
1166C<LOG_LFMT> - logalert facility; falls back to C<LOG_USER>
4b035b3d
SP
1167
1168=item *
1169
8168e71f
SP
1170C<LOG_LOCAL0> through C<LOG_LOCAL7> - reserved for local use
1171
1172=item *
1173
1174C<LOG_LPR> - line printer subsystem
1175
1176=item *
1177
1178C<LOG_MAIL> - mail subsystem
1179
1180=item *
1181
a650b841 1182C<LOG_NETINFO> - NetInfo subsystem (Mac OS X); falls back to C<LOG_DAEMON>
4b035b3d
SP
1183
1184=item *
1185
8168e71f
SP
1186C<LOG_NEWS> - USENET news subsystem
1187
1188=item *
1189
a650b841
AT
1190C<LOG_NTP> - NTP subsystem (FreeBSD, NetBSD); falls back to C<LOG_DAEMON>
1191
1192=item *
1193
1194C<LOG_RAS> - Remote Access Service (VPN / PPP) (Mac OS X);
1195falls back to C<LOG_AUTH>
4b035b3d
SP
1196
1197=item *
1198
a650b841
AT
1199C<LOG_REMOTEAUTH> - remote authentication/authorization (Mac OS X);
1200falls back to C<LOG_AUTH>
1201
1202=item *
1203
1204C<LOG_SECURITY> - security subsystems (firewalling, etc.) (FreeBSD);
1205falls back to C<LOG_AUTH>
4b035b3d
SP
1206
1207=item *
1208
8168e71f
SP
1209C<LOG_SYSLOG> - messages generated internally by B<syslogd>
1210
1211=item *
1212
1213C<LOG_USER> (default) - generic user-level messages
1214
1215=item *
1216
1217C<LOG_UUCP> - UUCP subsystem
1218
1219=back
1220
1221
1222=head2 Levels
1223
1224=over 4
1225
1226=item *
1227
1228C<LOG_EMERG> - system is unusable
1229
1230=item *
1231
1232C<LOG_ALERT> - action must be taken immediately
1233
1234=item *
1235
1236C<LOG_CRIT> - critical conditions
1237
1238=item *
1239
942974c1 1240C<LOG_ERR> - error conditions
8168e71f
SP
1241
1242=item *
1243
1244C<LOG_WARNING> - warning conditions
1245
1246=item *
1247
1248C<LOG_NOTICE> - normal, but significant, condition
1249
1250=item *
1251
1252C<LOG_INFO> - informational message
1253
1254=item *
1255
1256C<LOG_DEBUG> - debug-level message
1257
1258=back
1259
1260
1261=head1 DIAGNOSTICS
1262
a650b841 1263=over
8168e71f 1264
a650b841 1265=item C<Invalid argument passed to setlogsock>
8168e71f
SP
1266
1267B<(F)> You gave C<setlogsock()> an invalid value for C<$sock_type>.
1268
35a209d1 1269=item C<eventlog passed to setlogsock, but no Win32 API available>
a650b841
AT
1270
1271B<(W)> You asked C<setlogsock()> to use the Win32 event logger but the
1272operating system running the program isn't Win32 or does not provides Win32
35a209d1 1273compatible facilities.
a650b841
AT
1274
1275=item C<no connection to syslog available>
8168e71f
SP
1276
1277B<(F)> C<syslog()> failed to connect to the specified socket.
1278
a650b841 1279=item C<stream passed to setlogsock, but %s is not writable>
8168e71f 1280
942974c1 1281B<(W)> You asked C<setlogsock()> to use a stream socket, but the given
8168e71f
SP
1282path is not writable.
1283
a650b841 1284=item C<stream passed to setlogsock, but could not find any device>
8168e71f 1285
942974c1 1286B<(W)> You asked C<setlogsock()> to use a stream socket, but didn't
8168e71f
SP
1287provide a path, and C<Sys::Syslog> was unable to find an appropriate one.
1288
a650b841 1289=item C<tcp passed to setlogsock, but tcp service unavailable>
8168e71f 1290
942974c1 1291B<(W)> You asked C<setlogsock()> to use a TCP socket, but the service
8168e71f
SP
1292is not available on the system.
1293
a650b841 1294=item C<syslog: expecting argument %s>
8168e71f
SP
1295
1296B<(F)> You forgot to give C<syslog()> the indicated argument.
1297
a650b841 1298=item C<syslog: invalid level/facility: %s>
8168e71f 1299
6e4ef777 1300B<(F)> You specified an invalid level or facility.
8168e71f 1301
a650b841 1302=item C<syslog: too many levels given: %s>
8168e71f
SP
1303
1304B<(F)> You specified too many levels.
1305
a650b841 1306=item C<syslog: too many facilities given: %s>
8168e71f
SP
1307
1308B<(F)> You specified too many facilities.
1309
a650b841 1310=item C<syslog: level must be given>
8168e71f
SP
1311
1312B<(F)> You forgot to specify a level.
1313
a650b841 1314=item C<udp passed to setlogsock, but udp service unavailable>
8168e71f 1315
942974c1 1316B<(W)> You asked C<setlogsock()> to use a UDP socket, but the service
8168e71f
SP
1317is not available on the system.
1318
a650b841 1319=item C<unix passed to setlogsock, but path not available>
8168e71f 1320
942974c1 1321B<(W)> You asked C<setlogsock()> to use a UNIX socket, but C<Sys::Syslog>
8168e71f
SP
1322was unable to find an appropriate an appropriate device.
1323
1324=back
1325
1326
5be1dfc7
HF
1327=head1 SEE ALSO
1328
a650b841
AT
1329=head2 Manual Pages
1330
5be1dfc7
HF
1331L<syslog(3)>
1332
6e4ef777
SP
1333SUSv3 issue 6, IEEE Std 1003.1, 2004 edition,
1334L<http://www.opengroup.org/onlinepubs/000095399/basedefs/syslog.h.html>
1335
1336GNU C Library documentation on syslog,
1337L<http://www.gnu.org/software/libc/manual/html_node/Syslog.html>
1338
1339Solaris 10 documentation on syslog,
1340L<http://docs.sun.com/app/docs/doc/816-5168/6mbb3hruo?a=view>
1341
a650b841
AT
1342IRIX 6.4 documentation on syslog,
1343L<http://techpubs.sgi.com/library/tpl/cgi-bin/getdoc.cgi?coll=0640&db=man&fname=3c+syslog>
1344
6e4ef777 1345AIX 5L 5.3 documentation on syslog,
d329efa2 1346L<http://publib.boulder.ibm.com/infocenter/pseries/v5r3/index.jsp?topic=/com.ibm.aix.basetechref/doc/basetrf2/syslog.htm>
6e4ef777
SP
1347
1348HP-UX 11i documentation on syslog,
1349L<http://docs.hp.com/en/B9106-90010/syslog.3C.html>
1350
1351Tru64 5.1 documentation on syslog,
1352L<http://h30097.www3.hp.com/docs/base_doc/DOCUMENTATION/V51_HTML/MAN/MAN3/0193____.HTM>
1353
1354Stratus VOS 15.1,
1355L<http://stratadoc.stratus.com/vos/15.1.1/r502-01/wwhelp/wwhimpl/js/html/wwhelp.htm?context=r502-01&file=ch5r502-01bi.html>
1356
a650b841
AT
1357=head2 RFCs
1358
6e4ef777
SP
1359I<RFC 3164 - The BSD syslog Protocol>, L<http://www.faqs.org/rfcs/rfc3164.html>
1360-- Please note that this is an informational RFC, and therefore does not
1361specify a standard of any kind.
1362
1363I<RFC 3195 - Reliable Delivery for syslog>, L<http://www.faqs.org/rfcs/rfc3195.html>
1364
a650b841
AT
1365=head2 Articles
1366
04f98b29
RGS
1367I<Syslogging with Perl>, L<http://lexington.pm.org/meetings/022001.html>
1368
a650b841 1369=head2 Event Log
8168e71f 1370
a650b841
AT
1371Windows Event Log,
1372L<http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wes/wes/windows_event_log.asp>
5be1dfc7 1373
a650b841
AT
1374
1375=head1 AUTHORS & ACKNOWLEDGEMENTS
1376
1377Tom Christiansen E<lt>F<tchrist (at) perl.com>E<gt> and Larry Wall
1378E<lt>F<larry (at) wall.org>E<gt>.
150b260b
GS
1379
1380UNIX domain sockets added by Sean Robinson
a650b841
AT
1381E<lt>F<robinson_s (at) sc.maricopa.edu>E<gt> with support from Tim Bunce
1382E<lt>F<Tim.Bunce (at) ig.co.uk>E<gt> and the C<perl5-porters> mailing list.
150b260b
GS
1383
1384Dependency on F<syslog.ph> replaced with XS code by Tom Hughes
a650b841 1385E<lt>F<tom (at) compton.nu>E<gt>.
5be1dfc7 1386
a650b841 1387Code for C<constant()>s regenerated by Nicholas Clark E<lt>F<nick (at) ccl4.org>E<gt>.
23642f4b
NW
1388
1389Failover to different communication modes by Nick Williams
a650b841
AT
1390E<lt>F<Nick.Williams (at) morganstanley.com>E<gt>.
1391
1392Extracted from core distribution for publishing on the CPAN by
1393SE<eacute>bastien Aperghis-Tramoni E<lt>sebastien (at) aperghis.netE<gt>.
b903fcff 1394
89c3c464 1395XS code for using native C functions borrowed from C<L<Unix::Syslog>>,
a650b841 1396written by Marcus Harnisch E<lt>F<marcus.harnisch (at) gmx.net>E<gt>.
89c3c464 1397
a650b841
AT
1398Yves Orton suggested and helped for making C<Sys::Syslog> use the native
1399event logger under Win32 systems.
1400
1401Jerry D. Hedden and Reini Urban provided greatly appreciated help to
1402debug and polish C<Sys::Syslog> under Cygwin.
8168e71f
SP
1403
1404
1405=head1 BUGS
1406
1407Please report any bugs or feature requests to
a650b841 1408C<bug-sys-syslog (at) rt.cpan.org>, or through the web interface at
35a209d1 1409L<http://rt.cpan.org/Public/Dist/Display.html?Name=Sys-Syslog>.
8168e71f
SP
1410I will be notified, and then you'll automatically be notified of progress on
1411your bug as I make changes.
1412
1413
1414=head1 SUPPORT
1415
1416You can find documentation for this module with the perldoc command.
1417
1418 perldoc Sys::Syslog
1419
1420You can also look for information at:
1421
1422=over 4
1423
1424=item * AnnoCPAN: Annotated CPAN documentation
1425
1426L<http://annocpan.org/dist/Sys-Syslog>
1427
1428=item * CPAN Ratings
1429
1430L<http://cpanratings.perl.org/d/Sys-Syslog>
1431
1432=item * RT: CPAN's request tracker
1433
1434L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Sys-Syslog>
1435
1436=item * Search CPAN
1437
6e4ef777
SP
1438L<http://search.cpan.org/dist/Sys-Syslog/>
1439
1440=item * Kobes' CPAN Search
1441
1442L<http://cpan.uwinnipeg.ca/dist/Sys-Syslog>
1443
1444=item * Perl Documentation
1445
1446L<http://perldoc.perl.org/Sys/Syslog.html>
8168e71f
SP
1447
1448=back
1449
1450
35a209d1
AT
1451=head1 COPYRIGHT
1452
1453Copyright (C) 1990-2007 by Larry Wall and others.
1454
1455
8168e71f
SP
1456=head1 LICENSE
1457
1458This program is free software; you can redistribute it and/or modify it
1459under the same terms as Perl itself.
1460
5be1dfc7 1461=cut
a650b841
AT
1462
1463=begin comment
1464
1465Notes for the future maintainer (even if it's still me..)
1466- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1467
1468Using Google Code Search, I search who on Earth was relying on $host being
1469public. It found 5 hits:
1470
1471* First was inside Indigo Star Perl2exe documentation. Just an old version
1472of Sys::Syslog.
1473
1474
1475* One real hit was inside DalWeathDB, a weather related program. It simply
1476does a
1477
1478 $Sys::Syslog::host = '127.0.0.1';
1479
1480- L<http://www.gallistel.net/nparker/weather/code/>
1481
1482
1483* Two hits were in TPC, a fax server thingy. It does a
1484
1485 $Sys::Syslog::host = $TPC::LOGHOST;
1486
1487but also has this strange piece of code:
1488
1489 # work around perl5.003 bug
1490 sub Sys::Syslog::hostname {}
1491
1492I don't know what bug the author referred to.
1493
1494- L<http://www.tpc.int/>
1495- L<ftp://ftp.tpc.int/tpc/server/UNIX/>
1496- L<ftp://ftp-usa.tpc.int/pub/tpc/server/UNIX/>
1497
1498
1499* Last hit was in Filefix, which seems to be a FIDOnet mail program (!).
1500This one does not use $host, but has the following piece of code:
1501
1502 sub Sys::Syslog::hostname
1503 {
1504 use Sys::Hostname;
1505 return hostname;
1506 }
1507
1508I guess this was a more elaborate form of the previous bit, maybe because
1509of a bug in Sys::Syslog back then?
1510
1511- L<ftp://ftp.kiae.su/pub/unix/fido/>
1512
d329efa2
AT
1513
1514Links
1515-----
1516II12021: SYSLOGD HOWTO TCPIPINFO (z/OS, OS/390, MVS)
1517- L<http://www-1.ibm.com/support/docview.wss?uid=isg1II12021>
1518
1519Getting the most out of the Event Viewer
1520- L<http://www.codeproject.com/dotnet/evtvwr.asp?print=true>
1521
1522Log events to the Windows NT Event Log with JNI
1523- L<http://www.javaworld.com/javaworld/jw-09-2001/jw-0928-ntmessages.html>
1524
a650b841 1525=end comment
d329efa2 1526