From: Sean Robinson Date: Thu, 26 Jun 1997 05:45:25 +0000 (+1200) Subject: Sys::Syslog patch to allow unix domain sockets X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8297ae023be5d5af05b2a7f966169444314ba5aa;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 # modified to use sockets by Larry Wall # NOTE: openlog now takes three arguments, just like openlog(3) +# Modified to add UNIX domain sockets by Sean Robinson +# with support from Tim Bunce 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 defines I<$sock_unix>, a value +equalling Cundefines I<$sock_unix>, and any other +value croaks. +The I<$sock_unix> boolean determines whether the next +call to C or C will connect to the +UNIX domain socket returned by C<_PATH_LOG> in +I 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 now takes three arguments, just like C. 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 =head1 AUTHOR -Tom Christiansen EFE and Larry Wall EFE +Tom Christiansen EFE and Larry Wall EFE. +UNIX domain sockets added by Sean Robinson EFE +with support from Tim Bunce 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; }