package Sys::Syslog; use strict; use warnings; use warnings::register; use Carp; use Exporter (); use Fcntl qw(O_WRONLY); use File::Basename; use POSIX qw(strftime setlocale LC_TIME); use Socket ':all'; require 5.005; { no strict 'vars'; $VERSION = '0.27'; @ISA = qw(Exporter); %EXPORT_TAGS = ( standard => [qw(openlog syslog closelog setlogmask)], extended => [qw(setlogsock)], macros => [ # levels qw( LOG_ALERT LOG_CRIT LOG_DEBUG LOG_EMERG LOG_ERR LOG_INFO LOG_NOTICE LOG_WARNING ), # standard facilities qw( LOG_AUTH LOG_AUTHPRIV LOG_CRON LOG_DAEMON LOG_FTP LOG_KERN LOG_LOCAL0 LOG_LOCAL1 LOG_LOCAL2 LOG_LOCAL3 LOG_LOCAL4 LOG_LOCAL5 LOG_LOCAL6 LOG_LOCAL7 LOG_LPR LOG_MAIL LOG_NEWS LOG_SYSLOG LOG_USER LOG_UUCP ), # Mac OS X specific facilities qw( LOG_INSTALL LOG_LAUNCHD LOG_NETINFO LOG_RAS LOG_REMOTEAUTH ), # modern BSD specific facilities qw( LOG_CONSOLE LOG_NTP LOG_SECURITY ), # IRIX specific facilities qw( LOG_AUDIT LOG_LFMT ), # options qw( LOG_CONS LOG_PID LOG_NDELAY LOG_NOWAIT LOG_ODELAY LOG_PERROR ), # others macros qw( LOG_FACMASK LOG_NFACILITIES LOG_PRIMASK LOG_MASK LOG_UPTO ), ], ); @EXPORT = ( @{$EXPORT_TAGS{standard}}, ); @EXPORT_OK = ( @{$EXPORT_TAGS{extended}}, @{$EXPORT_TAGS{macros}}, ); eval { require XSLoader; XSLoader::load('Sys::Syslog', $VERSION); 1 } or do { require DynaLoader; push @ISA, 'DynaLoader'; bootstrap Sys::Syslog $VERSION; }; } # # Public variables # use vars qw($host); # host to send syslog messages to (see notes at end) # # Prototypes # sub silent_eval (&); # # Global variables # use vars qw($facility); my $connected = 0; # flag to indicate if we're connected or not my $syslog_send; # coderef of the function used to send messages my $syslog_path = undef; # syslog path for "stream" and "unix" mechanisms my $syslog_xobj = undef; # if defined, holds the external object used to send messages my $transmit_ok = 0; # flag to indicate if the last message was transmited my $sock_timeout = 0; # socket timeout, see below my $current_proto = undef; # current mechanism used to transmit messages my $ident = ''; # identifiant prepended to each message $facility = ''; # current facility my $maskpri = LOG_UPTO(&LOG_DEBUG); # current log mask my %options = ( ndelay => 0, nofatal => 0, nowait => 0, perror => 0, pid => 0, ); # Default is now to first use the native mechanism, so Perl programs # behave like other normal Unix programs, then try other mechanisms. my @connectMethods = qw(native tcp udp unix pipe stream console); if ($^O =~ /^(freebsd|linux)$/) { @connectMethods = grep { $_ ne 'udp' } @connectMethods; } # And on Win32 systems, we try to use the native mechanism for this # platform, the events logger, available through Win32::EventLog. EVENTLOG: { my $is_Win32 = $^O =~ /Win32/i; if (can_load("Sys::Syslog::Win32")) { unshift @connectMethods, 'eventlog'; } elsif ($is_Win32) { warn $@; } } my @defaultMethods = @connectMethods; my @fallbackMethods = (); # The timeout in connection_ok() was pushed up to 0.25 sec in # Sys::Syslog v0.19 in order to address a heisenbug on MacOSX: # http://london.pm.org/pipermail/london.pm/Week-of-Mon-20061211/005961.html # # However, this also had the effect of slowing this test for # all other operating systems, which apparently impacted some # users (cf. CPAN-RT #34753). So, in order to make everybody # happy, the timeout is now zero by default on all systems # except on OSX where it is set to 250 msec, and can be set # with the infamous setlogsock() function. $sock_timeout = 0.25 if $^O =~ /darwin/; # coderef for a nicer handling of errors my $err_sub = $options{nofatal} ? \&warnings::warnif : \&croak; sub AUTOLOAD { # This AUTOLOAD is used to 'autoload' constants from the constant() # XS function. no strict 'vars'; my $constname; ($constname = $AUTOLOAD) =~ s/.*:://; croak "Sys::Syslog::constant() not defined" if $constname eq 'constant'; my ($error, $val) = constant($constname); croak $error if $error; no strict 'refs'; *$AUTOLOAD = sub { $val }; goto &$AUTOLOAD; } sub openlog { ($ident, my $logopt, $facility) = @_; # default values $ident ||= basename($0) || getlogin() || getpwuid($<) || 'syslog'; $logopt ||= ''; $facility ||= LOG_USER(); for my $opt (split /\b/, $logopt) { $options{$opt} = 1 if exists $options{$opt} } $err_sub = delete $options{nofatal} ? \&warnings::warnif : \&croak; return 1 unless $options{ndelay}; connect_log(); } sub closelog { $facility = $ident = ''; disconnect_log(); } sub setlogmask { my $oldmask = $maskpri; $maskpri = shift unless $_[0] == 0; $oldmask; } sub setlogsock { my ($setsock, $setpath, $settime) = @_; # check arguments my $diag_invalid_arg = "Invalid argument passed to setlogsock; must be 'stream', 'pipe', " . "'unix', 'native', 'eventlog', 'tcp', 'udp' or 'inet'"; croak $diag_invalid_arg unless defined $setsock; croak "Invalid number of arguments" unless @_ >= 1 and @_ <= 3; $syslog_path = $setpath if defined $setpath; $sock_timeout = $settime if defined $settime; disconnect_log() if $connected; $transmit_ok = 0; @fallbackMethods = (); @connectMethods = @defaultMethods; if (ref $setsock eq 'ARRAY') { @connectMethods = @$setsock; } elsif (lc $setsock eq 'stream') { if (not defined $syslog_path) { my @try = qw(/dev/log /dev/conslog); if (length &_PATH_LOG) { # Undefined _PATH_LOG is "". unshift @try, &_PATH_LOG; } for my $try (@try) { if (-w $try) { $syslog_path = $try; last; } } if (not defined $syslog_path) { warnings::warnif "stream passed to setlogsock, but could not find any device"; return undef } } if (not -w $syslog_path) { warnings::warnif "stream passed to setlogsock, but $syslog_path is not writable"; return undef; } else { @connectMethods = qw(stream); } } elsif (lc $setsock eq 'unix') { if (length _PATH_LOG() || (defined $syslog_path && -w $syslog_path)) { $syslog_path = _PATH_LOG() unless defined $syslog_path; @connectMethods = qw(unix); } else { warnings::warnif 'unix passed to setlogsock, but path not available'; return undef; } } elsif (lc $setsock eq 'pipe') { for my $path ($syslog_path, &_PATH_LOG, "/dev/log") { next unless defined $path and length $path and -p $path and -w _; $syslog_path = $path; last } if (not $syslog_path) { warnings::warnif "pipe passed to setlogsock, but path not available"; return undef } @connectMethods = qw(pipe); } elsif (lc $setsock eq 'native') { @connectMethods = qw(native); } elsif (lc $setsock eq 'eventlog') { if (can_load("Win32::EventLog")) { @connectMethods = qw(eventlog); } else { warnings::warnif "eventlog passed to setlogsock, but no Win32 API available"; $@ = ""; return undef; } } elsif (lc $setsock eq 'tcp') { if (getservbyname('syslog', 'tcp') || getservbyname('syslogng', 'tcp')) { @connectMethods = qw(tcp); $host = $syslog_path; } else { warnings::warnif "tcp passed to setlogsock, but tcp service unavailable"; return undef; } } elsif (lc $setsock eq 'udp') { if (getservbyname('syslog', 'udp')) { @connectMethods = qw(udp); $host = $syslog_path; } else { warnings::warnif "udp passed to setlogsock, but udp service unavailable"; return undef; } } elsif (lc $setsock eq 'inet') { @connectMethods = ( 'tcp', 'udp' ); } elsif (lc $setsock eq 'console') { @connectMethods = qw(console); } else { croak $diag_invalid_arg } return 1; } sub syslog { my $priority = shift; my $mask = shift; my ($message, $buf); my (@words, $num, $numpri, $numfac, $sum); my $failed = undef; my $fail_time = undef; my $error = $!; # if $ident is undefined, it means openlog() wasn't previously called # so do it now in order to have sensible defaults openlog() unless $ident; local $facility = $facility; # may need to change temporarily. croak "syslog: expecting argument \$priority" unless defined $priority; croak "syslog: expecting argument \$format" unless defined $mask; croak "syslog: invalid level/facility: $priority" if $priority =~ /^-\d+$/; @words = split(/\W+/, $priority, 2); # Allow "level" or "level|facility". undef $numpri; undef $numfac; for my $word (@words) { next if length $word == 0; $num = xlate($word); # Translate word to number. if ($num < 0) { croak "syslog: invalid level/facility: $word" } elsif ($num <= &LOG_PRIMASK) { croak "syslog: too many levels given: $word" if defined $numpri; $numpri = $num; return 0 unless LOG_MASK($numpri) & $maskpri; } else { croak "syslog: too many facilities given: $word" if defined $numfac; $facility = $word; $numfac = $num; } } croak "syslog: level must be given" unless defined $numpri; if (not defined $numfac) { # Facility not specified in this call. $facility = 'user' unless $facility; $numfac = xlate($facility); } connect_log() unless $connected; if ($mask =~ /%m/) { # escape percent signs for sprintf() $error =~ s/%/%%/g if @_; # replace %m with $error, if preceded by an even number of percent signs $mask =~ s/(?$timestamp $whoami: $message\0"; } # handle PERROR option # "native" mechanism already handles it by itself if ($options{perror} and $current_proto ne 'native') { chomp $message; my $whoami = $ident; $whoami .= "[$$]" if $options{pid}; print STDERR "$whoami: $message\n"; } # it's possible that we'll get an error from sending # (e.g. if method is UDP and there is no UDP listener, # then we'll get ECONNREFUSED on the send). So what we # want to do at this point is to fallback onto a different # connection method. while (scalar @fallbackMethods || $syslog_send) { if ($failed && (time - $fail_time) > 60) { # it's been a while... maybe things have been fixed @fallbackMethods = (); disconnect_log(); $transmit_ok = 0; # make it look like a fresh attempt connect_log(); } if ($connected && !connection_ok()) { # Something was OK, but has now broken. Remember coz we'll # want to go back to what used to be OK. $failed = $current_proto unless $failed; $fail_time = time; disconnect_log(); } connect_log() unless $connected; $failed = undef if ($current_proto && $failed && $current_proto eq $failed); if ($syslog_send) { if ($syslog_send->($buf, $numpri, $numfac)) { $transmit_ok++; return 1; } # typically doesn't happen, since errors are rare from write(). disconnect_log(); } } # could not send, could not fallback onto a working # connection method. Lose. return 0; } sub _syslog_send_console { my ($buf) = @_; chop($buf); # delete the NUL from the end # The console print is a method which could block # so we do it in a child process and always return success # to the caller. if (my $pid = fork) { if ($options{nowait}) { return 1; } else { if (waitpid($pid, 0) >= 0) { return ($? >> 8); } else { # it's possible that the caller has other # plans for SIGCHLD, so let's not interfere return 1; } } } else { if (open(CONS, ">/dev/console")) { my $ret = print CONS $buf . "\r"; # XXX: should this be \x0A ? exit $ret if defined $pid; close CONS; } exit if defined $pid; } } sub _syslog_send_stream { my ($buf) = @_; # XXX: this only works if the OS stream implementation makes a write # look like a putmsg() with simple header. For instance it works on # Solaris 8 but not Solaris 7. # To be correct, it should use a STREAMS API, but perl doesn't have one. return syswrite(SYSLOG, $buf, length($buf)); } sub _syslog_send_pipe { my ($buf) = @_; return print SYSLOG $buf; } sub _syslog_send_socket { my ($buf) = @_; return syswrite(SYSLOG, $buf, length($buf)); #return send(SYSLOG, $buf, 0); } sub _syslog_send_native { my ($buf, $numpri) = @_; syslog_xs($numpri, $buf); return 1; } # xlate() # ----- # private function to translate names to numeric values # sub xlate { my ($name) = @_; return $name+0 if $name =~ /^\s*\d+\s*$/; $name = uc $name; $name = "LOG_$name" unless $name =~ /^LOG_/; # ExtUtils::Constant 0.20 introduced a new way to implement # constants, called ProxySubs. When it was used to generate # the C code, the constant() function no longer returns the # correct value. Therefore, we first try a direct call to # constant(), and if the value is an error we try to call the # constant by its full name. my $value = constant($name); if (index($value, "not a valid") >= 0) { $name = "Sys::Syslog::$name"; $value = eval { no strict "refs"; &$name }; $value = $@ unless defined $value; } $value = -1 if index($value, "not a valid") >= 0; return defined $value ? $value : -1; } # connect_log() # ----------- # This function acts as a kind of front-end: it tries to connect to # a syslog service using the selected methods, trying each one in the # selected order. # sub connect_log { @fallbackMethods = @connectMethods unless scalar @fallbackMethods; if ($transmit_ok && $current_proto) { # Retry what we were on, because it has worked in the past. unshift(@fallbackMethods, $current_proto); } $connected = 0; my @errs = (); my $proto = undef; while ($proto = shift @fallbackMethods) { no strict 'refs'; my $fn = "connect_$proto"; $connected = &$fn(\@errs) if defined &$fn; last if $connected; } $transmit_ok = 0; if ($connected) { $current_proto = $proto; my ($old) = select(SYSLOG); $| = 1; select($old); } else { @fallbackMethods = (); $err_sub->(join "\n\t- ", "no connection to syslog available", @errs); return undef; } } sub connect_tcp { my ($errs) = @_; my $tcp = getprotobyname('tcp'); if (!defined $tcp) { push @$errs, "getprotobyname failed for tcp"; return 0; } my $syslog = getservbyname('syslog', 'tcp'); $syslog = getservbyname('syslogng', 'tcp') unless defined $syslog; if (!defined $syslog) { push @$errs, "getservbyname failed for syslog/tcp and syslogng/tcp"; return 0; } my $addr; if (defined $host) { $addr = inet_aton($host); if (!$addr) { push @$errs, "can't lookup $host"; return 0; } } else { $addr = INADDR_LOOPBACK; } $addr = sockaddr_in($syslog, $addr); if (!socket(SYSLOG, AF_INET, SOCK_STREAM, $tcp)) { push @$errs, "tcp socket: $!"; return 0; } setsockopt(SYSLOG, SOL_SOCKET, SO_KEEPALIVE, 1); if (silent_eval { IPPROTO_TCP() }) { # These constants don't exist in 5.005. They were added in 1999 setsockopt(SYSLOG, IPPROTO_TCP(), TCP_NODELAY(), 1); } if (!connect(SYSLOG, $addr)) { push @$errs, "tcp connect: $!"; return 0; } $syslog_send = \&_syslog_send_socket; return 1; } sub connect_udp { my ($errs) = @_; my $udp = getprotobyname('udp'); if (!defined $udp) { push @$errs, "getprotobyname failed for udp"; return 0; } my $syslog = getservbyname('syslog', 'udp'); if (!defined $syslog) { push @$errs, "getservbyname failed for syslog/udp"; return 0; } my $addr; if (defined $host) { $addr = inet_aton($host); if (!$addr) { push @$errs, "can't lookup $host"; return 0; } } else { $addr = INADDR_LOOPBACK; } $addr = sockaddr_in($syslog, $addr); if (!socket(SYSLOG, AF_INET, SOCK_DGRAM, $udp)) { push @$errs, "udp socket: $!"; return 0; } if (!connect(SYSLOG, $addr)) { push @$errs, "udp connect: $!"; return 0; } # We want to check that the UDP connect worked. However the only # way to do that is to send a message and see if an ICMP is returned _syslog_send_socket(""); if (!connection_ok()) { push @$errs, "udp connect: nobody listening"; return 0; } $syslog_send = \&_syslog_send_socket; return 1; } sub connect_stream { my ($errs) = @_; # might want syslog_path to be variable based on syslog.h (if only # it were in there!) $syslog_path = '/dev/conslog' unless defined $syslog_path; if (!-w $syslog_path) { push @$errs, "stream $syslog_path is not writable"; return 0; } if (!sysopen(SYSLOG, $syslog_path, O_WRONLY, 0400)) { push @$errs, "stream can't open $syslog_path: $!"; return 0; } $syslog_send = \&_syslog_send_stream; return 1; } sub connect_pipe { my ($errs) = @_; $syslog_path ||= &_PATH_LOG || "/dev/log"; if (not -w $syslog_path) { push @$errs, "$syslog_path is not writable"; return 0; } if (not open(SYSLOG, ">$syslog_path")) { push @$errs, "can't write to $syslog_path: $!"; return 0; } $syslog_send = \&_syslog_send_pipe; return 1; } sub connect_unix { my ($errs) = @_; $syslog_path ||= _PATH_LOG() if length _PATH_LOG(); if (not defined $syslog_path) { push @$errs, "_PATH_LOG not available in syslog.h and no user-supplied socket path"; return 0; } if (not (-S $syslog_path or -c _)) { push @$errs, "$syslog_path is not a socket"; return 0; } my $addr = sockaddr_un($syslog_path); if (!$addr) { push @$errs, "can't locate $syslog_path"; return 0; } if (!socket(SYSLOG, AF_UNIX, SOCK_STREAM, 0)) { push @$errs, "unix stream socket: $!"; return 0; } if (!connect(SYSLOG, $addr)) { if (!socket(SYSLOG, AF_UNIX, SOCK_DGRAM, 0)) { push @$errs, "unix dgram socket: $!"; return 0; } if (!connect(SYSLOG, $addr)) { push @$errs, "unix dgram connect: $!"; return 0; } } $syslog_send = \&_syslog_send_socket; return 1; } sub connect_native { my ($errs) = @_; my $logopt = 0; # reconstruct the numeric equivalent of the options for my $opt (keys %options) { $logopt += xlate($opt) if $options{$opt} } openlog_xs($ident, $logopt, xlate($facility)); $syslog_send = \&_syslog_send_native; return 1; } sub connect_eventlog { my ($errs) = @_; $syslog_xobj = Sys::Syslog::Win32::_install(); $syslog_send = \&Sys::Syslog::Win32::_syslog_send; return 1; } sub connect_console { my ($errs) = @_; if (!-w '/dev/console') { push @$errs, "console is not writable"; return 0; } $syslog_send = \&_syslog_send_console; return 1; } # To test if the connection is still good, we need to check if any # errors are present on the connection. The errors will not be raised # by a write. Instead, sockets are made readable and the next read # would cause the error to be returned. Unfortunately the syslog # 'protocol' never provides anything for us to read. But with # judicious use of select(), we can see if it would be readable... sub connection_ok { return 1 if defined $current_proto and ( $current_proto eq 'native' or $current_proto eq 'console' or $current_proto eq 'eventlog' ); my $rin = ''; vec($rin, fileno(SYSLOG), 1) = 1; my $ret = select $rin, undef, $rin, $sock_timeout; return ($ret ? 0 : 1); } sub disconnect_log { $connected = 0; $syslog_send = undef; if (defined $current_proto and $current_proto eq 'native') { closelog_xs(); return 1; } elsif (defined $current_proto and $current_proto eq 'eventlog') { $syslog_xobj->Close(); return 1; } return close SYSLOG; } # # Wrappers around eval() that makes sure that nobody, and I say NOBODY, # ever knows that I wanted to test if something was here or not. # It is needed because some applications are trying to be too smart, # do it wrong, and it ends up in EPIC FAIL. # Yes I'm speaking of YOU, SpamAssassin. # sub silent_eval (&) { local($SIG{__DIE__}, $SIG{__WARN__}, $@); return eval { $_[0]->() } } sub can_load { local($SIG{__DIE__}, $SIG{__WARN__}, $@); return eval "use $_[0]; 1" } "Eighth Rule: read the documentation." __END__ =head1 NAME Sys::Syslog - Perl interface to the UNIX syslog(3) calls =head1 VERSION Version 0.27 =head1 SYNOPSIS use Sys::Syslog; # all except setlogsock(), or: use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock() use Sys::Syslog qw(:standard :macros); # standard functions, plus macros openlog $ident, $logopt, $facility; # don't forget this syslog $priority, $format, @args; $oldmask = setlogmask $mask_priority; closelog; =head1 DESCRIPTION C is an interface to the UNIX C program. Call C with a string priority and a list of C args just like C. You can find a kind of FAQ in L<"THE RULES OF SYS::SYSLOG">. Please read it before coding, and again before asking questions. =head1 EXPORTS C exports the following C tags: =over 4 =item * C<:standard> exports the standard C functions: openlog closelog setlogmask syslog =item * C<:extended> exports the Perl specific functions for C: setlogsock =item * C<:macros> exports the symbols corresponding to most of your C macros and the C and C functions. See L<"CONSTANTS"> for the supported constants and their meaning. =back By default, C exports the symbols from the C<:standard> tag. =head1 FUNCTIONS =over 4 =item B Opens the syslog. C<$ident> is prepended to every message. C<$logopt> contains zero or more of the options detailed below. C<$facility> specifies the part of the system to report about, for example C or C: see L<"Facilities"> for a list of well-known facilities, and your C documentation for the facilities available in your system. Check L<"SEE ALSO"> for useful links. Facility can be given as a string or a numeric macro. This function will croak if it can't connect to the syslog daemon. Note that C now takes three arguments, just like C. B before calling C.> B =over 4 =item * C - This option is ignored, since the failover mechanism will drop down to the console automatically if all other media fail. =item * C - Open the connection immediately (normally, the connection is opened when the first message is logged). =item * C - When set to true, C and C will only emit warnings instead of dying if the connection to the syslog can't be established. =item * C - Don't wait for child processes that may have been created while logging the message. (The GNU C library does not create a child process, so this option has no effect on Linux.) =item * C - Write the message to standard error output as well to the system log. =item * C - Include PID with each message. =back B Open the syslog with options C and C, and with facility C: openlog($name, "ndelay,pid", "local0"); Same thing, but this time using the macro corresponding to C: openlog($name, "ndelay,pid", LOG_LOCAL0); =item B =item B If C<$priority> permits, logs C<$message> or C with the addition that C<%m> in $message or C<$format> is replaced with C<"$!"> (the latest error message). C<$priority> can specify a level, or a level and a facility. Levels and facilities can be given as strings or as macros. When using the C mechanism, priorities C and C are mapped to event type C, C and C to C and C to C to C. If you didn't use C before using C, C will try to guess the C<$ident> by extracting the shortest prefix of C<$format> that ends in a C<":">. B syslog("info", $message); # informational level syslog(LOG_INFO, $message); # informational level syslog("info|local0", $message); # information level, Local0 facility syslog(LOG_INFO|LOG_LOCAL0, $message); # information level, Local0 facility =over 4 =item B C version v0.07 and older passed the C<$message> as the formatting string to C even when no formatting arguments were provided. If the code calling C might execute with older versions of this module, make sure to call the function as C instead of C. This protects against hostile formatting sequences that might show up if $message contains tainted data. =back =item B Sets the log mask for the current process to C<$mask_priority> and returns the old mask. If the mask argument is 0, the current log mask is not modified. See L<"Levels"> for the list of available levels. You can use the C function to allow all levels up to a given priority (but it only accept the numeric macros as arguments). B Only log errors: setlogmask( LOG_MASK(LOG_ERR) ); Log everything except informational messages: setlogmask( ~(LOG_MASK(LOG_INFO)) ); Log critical messages, errors and warnings: setlogmask( LOG_MASK(LOG_CRIT) | LOG_MASK(LOG_ERR) | LOG_MASK(LOG_WARNING) ); Log all messages up to debug: setlogmask( LOG_UPTO(LOG_DEBUG) ); =item B =item B (added in Perl 5.004_02) =item B (added in 0.25) Sets the socket type to be used for the next call to C or C and returns true on success, C on failure. The available mechanisms are: =over =item * C<"native"> - use the native C functions from your C library (added in C 0.15). =item * C<"eventlog"> - send messages to the Win32 events logger (Win32 only; added in C 0.19). =item * C<"tcp"> - connect to a TCP socket, on the C or C service. If defined, the second parameter is used as a hostname to connect to. =item * C<"udp"> - connect to a UDP socket, on the C service. If defined, the second parameter is used as a hostname to connect to, and the third parameter as the timeout used to check for UDP response. =item * C<"inet"> - connect to an INET socket, either TCP or UDP, tried in that order. If defined, the second parameter is used as a hostname to connect to. =item * C<"unix"> - connect to a UNIX domain socket (in some systems a character special device). The name of that socket is the second parameter or, if you omit the second parameter, the value returned by the C<_PATH_LOG> macro (if your system defines it), or F or F, whatever is writable. =item * C<"stream"> - connect to the stream indicated by the pathname provided as the optional second parameter, or, if omitted, to F. For example Solaris and IRIX system may prefer C<"stream"> instead of C<"unix">. =item * C<"pipe"> - connect to the named pipe indicated by the pathname provided as the optional second parameter, or, if omitted, to the value returned by the C<_PATH_LOG> macro (if your system defines it), or F (added in C 0.21). =item * C<"console"> - send messages directly to the console, as for the C<"cons"> option of C. =back A reference to an array can also be passed as the first parameter. When this calling method is used, the array should contain a list of mechanisms which are attempted in order. The default is to try C, C, C, C, C, C, C. Under systems with the Win32 API, C will be added as the first mechanism to try if C is available. Giving an invalid value for C<$sock_type> will C. B Select the UDP socket mechanism: setlogsock("udp"); Select the native, UDP socket then UNIX domain socket mechanisms: setlogsock(["native", "udp", "unix"]); =over =item B Now that the "native" mechanism is supported by C and selected by default, the use of the C function is discouraged because other mechanisms are less portable across operating systems. Authors of modules and programs that use this function, especially its cargo-cult form C, are advised to remove any occurence of it unless they specifically want to use a given mechanism (like TCP or UDP to connect to a remote host). =back =item B Closes the log file and returns true on success. =back =head1 THE RULES OF SYS::SYSLOG I You do not call C. I You B call C. I The program crashes, Cs, calls C, the log is over. I One facility, one priority. I One log at a time. I No C before C. I Logs will go on as long as they have to. I If this is your first use of Sys::Syslog, you must read the doc. =head1 EXAMPLES An example: openlog($program, 'cons,pid', 'user'); syslog('info', '%s', 'this is another test'); syslog('mail|warning', 'this is a better test: %d', time); closelog(); syslog('debug', 'this is the last test'); Another example: openlog("$program $$", 'ndelay', 'user'); syslog('notice', 'fooprogram: this is really done'); Example of use of C<%m>: $! = 55; syslog('info', 'problem was %m'); # %m == $! in syslog(3) Log to UDP port on C<$remotehost> instead of logging locally: setlogsock("udp", $remotehost); openlog($program, 'ndelay', 'user'); syslog('info', 'something happened over here'); =head1 CONSTANTS =head2 Facilities =over 4 =item * C - audit daemon (IRIX); falls back to C =item * C - security/authorization messages =item * C - security/authorization messages (private) =item * C - C output (FreeBSD); falls back to C =item * C - clock daemons (B and B) =item * C - system daemons without separate facility value =item * C - FTP daemon =item * C - kernel messages =item * C - installer subsystem (Mac OS X); falls back to C =item * C - launchd - general bootstrap daemon (Mac OS X); falls back to C =item * C - logalert facility; falls back to C =item * C through C - reserved for local use =item * C - line printer subsystem =item * C - mail subsystem =item * C - NetInfo subsystem (Mac OS X); falls back to C =item * C - USENET news subsystem =item * C - NTP subsystem (FreeBSD, NetBSD); falls back to C =item * C - Remote Access Service (VPN / PPP) (Mac OS X); falls back to C =item * C - remote authentication/authorization (Mac OS X); falls back to C =item * C - security subsystems (firewalling, etc.) (FreeBSD); falls back to C =item * C - messages generated internally by B =item * C (default) - generic user-level messages =item * C - UUCP subsystem =back =head2 Levels =over 4 =item * C - system is unusable =item * C - action must be taken immediately =item * C - critical conditions =item * C - error conditions =item * C - warning conditions =item * C - normal, but significant, condition =item * C - informational message =item * C - debug-level message =back =head1 DIAGNOSTICS =over =item C B<(F)> You gave C an invalid value for C<$sock_type>. =item C B<(W)> You asked C to use the Win32 event logger but the operating system running the program isn't Win32 or does not provides Win32 compatible facilities. =item C B<(F)> C failed to connect to the specified socket. =item C B<(W)> You asked C to use a stream socket, but the given path is not writable. =item C B<(W)> You asked C to use a stream socket, but didn't provide a path, and C was unable to find an appropriate one. =item C B<(W)> You asked C to use a TCP socket, but the service is not available on the system. =item C B<(F)> You forgot to give C the indicated argument. =item C B<(F)> You specified an invalid level or facility. =item C B<(F)> You specified too many levels. =item C B<(F)> You specified too many facilities. =item C B<(F)> You forgot to specify a level. =item C B<(W)> You asked C to use a UDP socket, but the service is not available on the system. =item C B<(W)> You asked C to use a UNIX socket, but C was unable to find an appropriate an appropriate device. =back =head1 SEE ALSO =head2 Manual Pages L SUSv3 issue 6, IEEE Std 1003.1, 2004 edition, L GNU C Library documentation on syslog, L Solaris 10 documentation on syslog, L Mac OS X documentation on syslog, L IRIX 6.5 documentation on syslog, L AIX 5L 5.3 documentation on syslog, L HP-UX 11i documentation on syslog, L Tru64 5.1 documentation on syslog, L Stratus VOS 15.1, L =head2 RFCs I, L -- Please note that this is an informational RFC, and therefore does not specify a standard of any kind. I, L =head2 Articles I, L =head2 Event Log Windows Event Log, L =head1 AUTHORS & ACKNOWLEDGEMENTS Tom Christiansen EFE and Larry Wall EFE. UNIX domain sockets added by Sean Robinson EFE with support from Tim Bunce EFE and the C mailing list. Dependency on F replaced with XS code by Tom Hughes EFE. Code for Cs regenerated by Nicholas Clark EFE. Failover to different communication modes by Nick Williams EFE. Extracted from core distribution for publishing on the CPAN by SEbastien Aperghis-Tramoni Esebastien (at) aperghis.netE. XS code for using native C functions borrowed from C>, written by Marcus Harnisch EFE. Yves Orton suggested and helped for making C use the native event logger under Win32 systems. Jerry D. Hedden and Reini Urban provided greatly appreciated help to debug and polish C under Cygwin. =head1 BUGS Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. =head1 SUPPORT You can find documentation for this module with the perldoc command. perldoc Sys::Syslog You can also look for information at: =over 4 =item * AnnoCPAN: Annotated CPAN documentation L =item * CPAN Ratings L =item * RT: CPAN's request tracker L =item * Search CPAN L =item * Kobes' CPAN Search L =item * Perl Documentation L =back =head1 COPYRIGHT Copyright (C) 1990-2008 by Larry Wall and others. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut =begin comment Notes for the future maintainer (even if it's still me..) - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Using Google Code Search, I search who on Earth was relying on $host being public. It found 5 hits: * First was inside Indigo Star Perl2exe documentation. Just an old version of Sys::Syslog. * One real hit was inside DalWeathDB, a weather related program. It simply does a $Sys::Syslog::host = '127.0.0.1'; - L * Two hits were in TPC, a fax server thingy. It does a $Sys::Syslog::host = $TPC::LOGHOST; but also has this strange piece of code: # work around perl5.003 bug sub Sys::Syslog::hostname {} I don't know what bug the author referred to. - L - L - L * Last hit was in Filefix, which seems to be a FIDOnet mail program (!). This one does not use $host, but has the following piece of code: sub Sys::Syslog::hostname { use Sys::Hostname; return hostname; } I guess this was a more elaborate form of the previous bit, maybe because of a bug in Sys::Syslog back then? - L Links ----- Linux Fast-STREAMS - L II12021: SYSLOGD HOWTO TCPIPINFO (z/OS, OS/390, MVS) - L Getting the most out of the Event Viewer - L Log events to the Windows NT Event Log with JNI - L =end comment