PATCH (was: Re: [perl #18180] problem with sys:syslog on solaris 8 with perl 5.8.0)

Message-ID: <20021125163537.GC4745@banach.uvt.nl>

(The .pm patch modified a bit, and removed the false
 claim that _PATH_INFO would be coming from syslog.ph)

p4raw-id: //depot/perl@19151

3 files changed, 43 insertions, 17 deletions

diff --git a/ext/Sys/Syslog/Makefile.PL b/ext/Sys/Syslog/Makefile.PL
index 5a5da6f9da..3315db23af 100644
--- a/ext/Sys/Syslog/Makefile.PL
+++ b/ext/Sys/Syslog/Makefile.PL
@@ -9,12 +9,20 @@ WriteMakefile(
     realclean => {FILES=> 'const-c.inc const-xs.inc'},
 );
 
-# We hope syslogd understands /dev/log.
-#
-# Solaris has a -c /dev/log, but the syslog.t #1 and #2 don't
-# seem to be happy if that's _PATH_LOG.
-#
-my $_PATH_LOG = -S "/dev/log" ? "/dev/log" : "";
+my $_PATH_LOG;
+
+if (-S "/dev/log" && -w "/dev/log") {
+        # Most unixes have a unix domain socket /dev/log.
+       $_PATH_LOG = "/dev/log";
+} elsif (-c "/dev/conslog" && -w "/dev/conslog") {
+        # SunOS 5.8 has a worldwritable /dev/conslog STREAMS log driver.
+        # The /dev/log STREAMS log driver on this platform has permissions
+        # and ownership `crw-r----- root sys'.  /dev/conslog has more liberal
+        # permissions.
+       $_PATH_LOG = "/dev/conslog";
+} else {
+       $_PATH_LOG = "";
+}
 
 WriteConstants(
     NAME => 'Sys::Syslog',
diff --git a/ext/Sys/Syslog/Syslog.pm b/ext/Sys/Syslog/Syslog.pm
index e255067449..0f3c7ba6a9 100644
--- a/ext/Sys/Syslog/Syslog.pm
+++ b/ext/Sys/Syslog/Syslog.pm
@@ -75,14 +75,16 @@ Sets the socket type to be used for the next call to
 C<openlog()> or C<syslog()> and returns TRUE on success,
 undef on failure.
 
-A value of 'unix' will connect to the UNIX domain socket returned by
-the C<_PATH_LOG> macro (if your system defines it) in F<syslog.ph>.  A
-value of 'stream' will connect to the stream indicated by the pathname
-provided as the optional second parameter.  A value of 'inet' will
-connect to an INET socket (either tcp or udp, tried in that order)
-returned by getservbyname(). 'tcp' and 'udp' can also be given as
-values. The value 'console' will send messages directly to the
-console, as for the 'cons' option in the logopts in openlog().
+A value of 'unix' will connect to the UNIX domain socket (in some
+systems a character special device) returned by the C<_PATH_LOG> macro
+(if your system defines it), or F</dev/log> or F</dev/conslog>,
+whatever is writable.  A value of 'stream' will connect to the stream
+indicated by the pathname provided as the optional second parameter.
+A value of 'inet' will connect to an INET socket (either tcp or udp,
+tried in that order) returned by getservbyname(). 'tcp' and 'udp' can
+also be given as values. The value 'console' will send messages
+directly to the console, as for the 'cons' option in the logopts in
+openlog().
 
 A reference to an array can also be passed as the first parameter.
 When this calling method is used, the array should contain a list of
@@ -190,7 +192,19 @@ sub setlogsock {
     if (ref $setsock eq 'ARRAY') {
 	@connectMethods = @$setsock;
     } elsif (lc($setsock) eq 'stream') {
-	$syslog_path = '/dev/log' unless($syslog_path);
+	unless (defined $syslog_path) {
+	    my @try = qw(/dev/log /dev/conslog);
+	    if (length &_PATH_LOG) {
+		unshift @try, &_PATH_LOG;
+            }
+	    for my $try (@try) {
+		if (-w $try) {
+		    $syslog_path = $try;
+		    last;
+		}
+	    }
+	    carp "stream passed to setlogsock, but could not find any device";
+        }
 	if (!-w $syslog_path) {
 	    carp "stream passed to setlogsock, but $syslog_path is not writable";
 	    return undef;
diff --git a/ext/Sys/Syslog/syslog.t b/ext/Sys/Syslog/syslog.t
index 72171f532b..9caecb4d6c 100755
--- a/ext/Sys/Syslog/syslog.t
+++ b/ext/Sys/Syslog/syslog.t
@@ -47,8 +47,12 @@ print "1..6\n";
 
 if (Sys::Syslog::_PATH_LOG()) {
     if (-e Sys::Syslog::_PATH_LOG()) {
-        print defined(eval { setlogsock('unix') })
-		? "ok 1\n" : "not ok 1 # $!\n";
+        if ($^O =~ /^solaris$/) {
+            # we should check for stream support here, not for solaris
+            print defined(eval { setlogsock('stream') }) ? "ok 1\n" : "not ok 1 # $!\n";
+        } else { 
+            print defined(eval { setlogsock('unix') }) ? "ok 1\n" : "not ok 1 # $!\n";
+        }
         if (defined(eval { openlog('perl', 'ndelay', 'local0') })) {
 	    print "ok 2\n";
 	    print defined(eval { syslog('info', $test_string ) })