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