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