7 @EXPORT = qw(openlog closelog setlogmask syslog);
8 @EXPORT_OK = qw(setlogsock);
13 # adapted from syslog.pl
15 # Tom Christiansen <tchrist@convex.com>
16 # modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
17 # NOTE: openlog now takes three arguments, just like openlog(3)
18 # Modified to add UNIX domain sockets by Sean Robinson <robinson_s@sc.maricopa.edu>
19 # with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list
21 # Todo: enable connect to try all three types before failing (auto setlogsock)?
25 Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls
29 use Sys::Syslog; # all except setlogsock, or:
30 use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock
32 setlogsock $sock_type;
33 openlog $ident, $logopt, $facility;
34 syslog $priority, $format, @args;
35 $oldmask = setlogmask $mask_priority;
40 Sys::Syslog is an interface to the UNIX C<syslog(3)> program.
41 Call C<syslog()> with a string priority and a list of C<printf()> args
42 just like C<syslog(3)>.
44 Syslog provides the functions:
48 =item openlog $ident, $logopt, $facility
50 I<$ident> is prepended to every message.
51 I<$logopt> contains zero or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
52 I<$facility> specifies the part of the system
54 =item syslog $priority, $format, @args
56 If I<$priority> permits, logs I<($format, @args)>
57 printed as by C<printf(3V)>, with the addition that I<%m>
58 is replaced with C<"$!"> (the latest error message).
60 =item setlogmask $mask_priority
62 Sets log mask I<$mask_priority> and returns the old mask.
64 =item setlogsock $sock_type (added in 5.004_02)
66 Sets the socket type to be used for the next call to
67 C<openlog()> or C<syslog()> and returns TRUE on success,
70 A value of 'unix' will connect to the UNIX domain socket returned by
71 C<_PATH_LOG> in F<syslog.ph>. A value of 'inet' will connect to an
72 INET socket returned by getservbyname(). Any other value croaks.
74 The default is for the INET socket to be used.
82 Note that C<openlog> now takes three arguments, just like C<openlog(3)>.
86 openlog($program, 'cons,pid', 'user');
87 syslog('info', 'this is another test');
88 syslog('mail|warning', 'this is a better test: %d', time);
91 syslog('debug', 'this is the last test');
94 openlog("$program $$", 'ndelay', 'user');
95 syslog('notice', 'fooprogram: this is really done');
99 syslog('info', 'problem was %m'); # %m == $! in syslog(3)
103 B<Sys::Syslog> needs F<syslog.ph>, which can be created with C<h2ph>.
111 Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt>.
112 UNIX domain sockets added by Sean Robinson E<lt>F<robinson_s@sc.maricopa.edu>E<gt>
113 with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list.
119 $maskpri = &LOG_UPTO(&LOG_DEBUG);
122 ($ident, $logopt, $facility) = @_; # package vars
123 $lo_pid = $logopt =~ /\bpid\b/;
124 $lo_ndelay = $logopt =~ /\bndelay\b/;
125 $lo_cons = $logopt =~ /\bcons\b/;
126 $lo_nowait = $logopt =~ /\bnowait\b/;
127 return 1 unless $lo_ndelay;
132 $facility = $ident = '';
137 local($oldmask) = $maskpri;
143 local($setsock) = shift;
144 &disconnect if $connected;
145 if (lc($setsock) eq 'unix') {
146 if (defined &_PATH_LOG) {
151 } elsif (lc($setsock) eq 'inet') {
152 if (getservbyname('syslog','udp')) {
158 croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'";
164 local($priority) = shift;
165 local($mask) = shift;
166 local($message, $whoami);
167 local(@words, $num, $numpri, $numfac, $sum);
168 local($facility) = $facility; # may need to change temporarily.
170 croak "syslog: expected both priority and mask" unless $mask && $priority;
172 @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
176 $num = &xlate($_); # Translate word to number.
177 if (/^kern$/ || $num < 0) {
178 croak "syslog: invalid level/facility: $_";
180 elsif ($num <= &LOG_PRIMASK) {
181 croak "syslog: too many levels given: $_" if defined($numpri);
183 return 0 unless &LOG_MASK($numpri) & $maskpri;
186 croak "syslog: too many facilities given: $_" if defined($numfac);
192 croak "syslog: level must be given" unless defined($numpri);
194 if (!defined($numfac)) { # Facility not specified in this call.
195 $facility = 'user' unless $facility;
196 $numfac = &xlate($facility);
199 &connect unless $connected;
203 if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) {
209 ($whoami = getlogin) ||
210 ($whoami = getpwuid($<)) ||
211 ($whoami = 'syslog');
214 $whoami .= "[$$]" if $lo_pid;
217 $mask .= "\n" unless $mask =~ /\n$/;
218 $message = sprintf ($mask, @_);
220 $sum = $numpri + $numfac;
221 unless (send(SYSLOG,"<$sum>$whoami: $message\0",0)) {
224 unless ($lo_nowait) {
225 $died = waitpid($pid, 0);
229 open(CONS,">/dev/console");
230 print CONS "<$facility.$priority>$whoami: $message\r";
231 exit if defined $pid; # if fork failed, we're parent
241 $name = "LOG_$name" unless $name =~ /^LOG_/;
242 $name = "Sys::Syslog::$name";
243 defined &$name ? &$name : -1;
248 require Sys::Hostname;
249 my($host_uniq) = Sys::Hostname::hostname();
250 ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
252 unless ( $sock_type ) {
253 my $udp = getprotobyname('udp');
254 my $syslog = getservbyname('syslog','udp');
255 my $this = sockaddr_in($syslog, INADDR_ANY);
256 my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host");
257 socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!";
258 connect(SYSLOG,$that) || croak "connect: $!";
260 my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph";
261 my $that = sockaddr_un($syslog) || croak "Can't locate $syslog";
262 socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "socket: $!";
263 if (!connect(SYSLOG,$that)) {
264 socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0) || croak "socket: $!";
265 connect(SYSLOG,$that) || croak "connect: $! (SOCK_DGRAM after trying SOCK_STREAM)";
268 local($old) = select(SYSLOG); $| = 1; select($old);