Sys::Syslog patch to allow unix domain sockets

Thank you to Tim Bunce and Tom Phoenix for insights on making the
patched code faster and safer, and pointing out bugs.

  What follows is a "fresh patch over the 5.004_01 version".  So reverse
the previous patch before adding this one just to be safe.

 CHANGES (all recommended by Tim or Tom):

 - fixed bug where wrong variable was undef()ined causing attempts to
change back to INET socket to never occur
 - setlogsock() now croaks on any value other than 'unix' or 'inet'
 - setlogsock() no longer uses pattern matching, but is still
case-insensitive
 - updated documentation

p5p-msgid: 33B31342.7EB16A44@sc.maricopa.edu

diff --git a/lib/Sys/Syslog.pm b/lib/Sys/Syslog.pm
index 9efcfbf..9ba4ed5 100644 (file)
--- a/lib/Sys/Syslog.pm
+++ b/lib/Sys/Syslog.pm
@@ -4,7 +4,7 @@ require Exporter;
 use Carp;
 
 @ISA = qw(Exporter);
-@EXPORT = qw(openlog closelog setlogmask syslog);
+@EXPORT = qw(openlog closelog setlogmask setlogsock syslog);
 
 use Socket;
 use Sys::Hostname;
@@ -14,15 +14,18 @@ use Sys::Hostname;
 # Tom Christiansen <tchrist@convex.com>
 # modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
 # NOTE: openlog now takes three arguments, just like openlog(3)
+# Modified to add UNIX domain sockets by Sean Robinson <robinson_s@sc.maricopa.edu>
+#  with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list
 
 =head1 NAME
 
-Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls
+Sys::Syslog, openlog, closelog, setlogmask, setlogsock, syslog - Perl interface to the UNIX syslog(3) calls
 
 =head1 SYNOPSIS
 
     use Sys::Syslog;
 
+    setlogsock $sock_unix;
     openlog $ident, $logopt, $facility;
     syslog $priority, $format, @args;
     $oldmask = setlogmask $mask_priority;
@@ -54,6 +57,20 @@ is replaced with C<"$!"> (the latest error message).
 
 Sets log mask I<$mask_priority> and returns the old mask.
 
+=item setlogsock $sock_unix
+
+Defines or undefines the boolean I<$sock_unix>;
+a value equalling C<unix> defines I<$sock_unix>, a value
+equalling C<inet >undefines I<$sock_unix>, and any other 
+value croaks.
+The I<$sock_unix> boolean determines whether the next
+call to C<openlog()> or C<syslog()> will connect to the 
+UNIX domain socket returned by C<_PATH_LOG> in 
+I<syslog.ph> or to the INET socket returned by 
+getservbyname().
+
+The default is for the INET socket to be used.
+
 =item closelog
 
 Closes the log file.
@@ -70,9 +87,12 @@ Note that C<openlog> now takes three arguments, just like C<openlog(3)>.
     closelog();
 
     syslog('debug', 'this is the last test');
+
+    setlogsock('unix');
     openlog("$program $$", 'ndelay', 'user');
     syslog('notice', 'fooprogram: this is really done');
 
+    setlogsock('inet');
     $! = 55;
     syslog('info', 'problem was %m'); # %m == $! in syslog(3)
 
@@ -86,7 +106,9 @@ L<syslog(3)>
 
 =head1 AUTHOR
 
-Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt>
+Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt>.
+UNIX domain sockets added by Sean Robinson E<lt>F<robinson_s@sc.maricopa.edu>E<gt>
+with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list.
 
 =cut
 
@@ -114,6 +136,17 @@ sub setlogmask {
     $oldmask;
 }
  
+sub setlogsock {
+    local($setsock) = shift;
+    if (lc($setsock) eq 'unix') {
+        $sock_unix = 1;
+    } elsif (lc($setsock) eq 'inet') {
+        undef($sock_unix);
+    } else {
+        croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'";
+    }
+}
+
 sub syslog {
     local($priority) = shift;
     local($mask) = shift;
@@ -172,7 +205,7 @@ sub syslog {
     $message = sprintf ($mask, @_);
 
     $sum = $numpri + $numfac;
-    unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
+    unless (send(SYSLOG,"<$sum>$whoami: $message\0",0)) {
        if ($lo_cons) {
            if ($pid = fork) {
                unless ($lo_nowait) {
@@ -203,12 +236,19 @@ sub connect {
        my($host_uniq) = Sys::Hostname::hostname();
        ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
     }
-    my $udp = getprotobyname('udp');
-    my $syslog = getservbyname('syslog','udp');
-    my $this = sockaddr_in($syslog, INADDR_ANY);
-    my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host");
-    socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp)          || croak "socket: $!";
-    connect(SYSLOG,$that)                           || croak "connect: $!";
+    unless ( $sock_unix ) {
+        my $udp = getprotobyname('udp');
+        my $syslog = getservbyname('syslog','udp');
+        my $this = sockaddr_in($syslog, INADDR_ANY);
+        my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host");
+        socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp)           || croak "socket: $!";
+        connect(SYSLOG,$that)                            || croak "connect: $!";
+    } else {
+        my $syslog = &_PATH_LOG                          || croak "_PATH_LOG not found in syslog.ph";
+        my $that = sockaddr_un($syslog)                  || croak "Can't locate $syslog";
+        socket(SYSLOG,AF_UNIX,SOCK_STREAM,0)             || croak "open: $!";
+        connect(SYSLOG,$that)                            || croak "connect: $!";
+    }
     local($old) = select(SYSLOG); $| = 1; select($old);
     $connected = 1;
 }