7 @EXPORT = qw(openlog closelog setlogmask syslog);
12 # adapted from syslog.pl
14 # Tom Christiansen <tchrist@convex.com>
15 # modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
16 # NOTE: openlog now takes three arguments, just like openlog(3)
20 Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls
26 openlog $ident, $logopt, $facility;
27 syslog $priority, $format, @args;
28 $oldmask = setlogmask $mask_priority;
33 Sys::Syslog is an interface to the UNIX C<syslog(3)> program.
34 Call C<syslog()> with a string priority and a list of C<printf()> args
35 just like C<syslog(3)>.
37 Syslog provides the functions:
41 =item openlog $ident, $logopt, $facility
43 I<$ident> is prepended to every message.
44 I<$logopt> contains one or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
45 I<$facility> specifies the part of the system
47 =item syslog $priority, $format, @args
49 If I<$priority> permits, logs I<($format, @args)>
50 printed as by C<printf(3V)>, with the addition that I<%m>
51 is replaced with C<"$!"> (the latest error message).
53 =item setlogmask $mask_priority
55 Sets log mask I<$mask_priority> and returns the old mask.
57 =item setlogsock $sock_type (added in 5.004_03)
59 Sets the socket type to be used for the next call to
60 C<openlog()> or C<syslog()>.
62 A value of 'unix' will connect to the UNIX domain socket returned by
63 C<_PATH_LOG> in F<syslog.ph>. If F<syslog.ph> fails to define
64 C<_PATH_LOG>, C<setlogsock> returns C<undef>; otherwise a true value is
65 returned. A value of 'inet' will connect to an INET socket returned by
66 getservbyname(). Any other value croaks.
68 The default is for the INET socket to be used.
77 Note that C<openlog> now takes three arguments, just like C<openlog(3)>.
81 openlog($program, 'cons,pid', 'user');
82 syslog('info', 'this is another test');
83 syslog('mail|warning', 'this is a better test: %d', time);
86 syslog('debug', 'this is the last test');
89 openlog("$program $$", 'ndelay', 'user');
90 syslog('notice', 'fooprogram: this is really done');
94 syslog('info', 'problem was %m'); # %m == $! in syslog(3)
98 B<Sys::Syslog> needs F<syslog.ph>, which can be created with C<h2ph>.
106 Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt>.
107 UNIX domain sockets added by Sean Robinson E<lt>F<robinson_s@sc.maricopa.edu>E<gt>
108 with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list.
114 $maskpri = &LOG_UPTO(&LOG_DEBUG);
117 ($ident, $logopt, $facility) = @_; # package vars
118 $lo_pid = $logopt =~ /\bpid\b/;
119 $lo_ndelay = $logopt =~ /\bndelay\b/;
120 $lo_cons = $logopt =~ /\bcons\b/;
121 $lo_nowait = $logopt =~ /\bnowait\b/;
122 &connect if $lo_ndelay;
126 $facility = $ident = '';
131 local($oldmask) = $maskpri;
137 local($setsock) = shift;
138 if (lc($setsock) eq 'unix') {
139 if (defined &_PATH_LOG) {
144 } elsif (lc($setsock) eq 'inet') {
147 croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'";
153 local($priority) = shift;
154 local($mask) = shift;
155 local($message, $whoami);
156 local(@words, $num, $numpri, $numfac, $sum);
157 local($facility) = $facility; # may need to change temporarily.
159 croak "syslog: expected both priority and mask" unless $mask && $priority;
161 @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
165 $num = &xlate($_); # Translate word to number.
166 if (/^kern$/ || $num < 0) {
167 croak "syslog: invalid level/facility: $_";
169 elsif ($num <= &LOG_PRIMASK) {
170 croak "syslog: too many levels given: $_" if defined($numpri);
172 return 0 unless &LOG_MASK($numpri) & $maskpri;
175 croak "syslog: too many facilities given: $_" if defined($numfac);
181 croak "syslog: level must be given" unless defined($numpri);
183 if (!defined($numfac)) { # Facility not specified in this call.
184 $facility = 'user' unless $facility;
185 $numfac = &xlate($facility);
188 &connect unless $connected;
192 if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) {
198 ($whoami = getlogin) ||
199 ($whoami = getpwuid($<)) ||
200 ($whoami = 'syslog');
203 $whoami .= "[$$]" if $lo_pid;
206 $mask .= "\n" unless $mask =~ /\n$/;
207 $message = sprintf ($mask, @_);
209 $sum = $numpri + $numfac;
210 unless (send(SYSLOG,"<$sum>$whoami: $message\0",0)) {
213 unless ($lo_nowait) {
214 $died = waitpid($pid, 0);
218 open(CONS,">/dev/console");
219 print CONS "<$facility.$priority>$whoami: $message\r";
220 exit if defined $pid; # if fork failed, we're parent
230 $name = "LOG_$name" unless $name =~ /^LOG_/;
231 $name = "Sys::Syslog::$name";
232 defined &$name ? &$name : -1;
237 require Sys::Hostname;
238 my($host_uniq) = Sys::Hostname::hostname();
239 ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
241 unless ( $sock_unix ) {
242 my $udp = getprotobyname('udp');
243 my $syslog = getservbyname('syslog','udp');
244 my $this = sockaddr_in($syslog, INADDR_ANY);
245 my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host");
246 socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!";
247 connect(SYSLOG,$that) || croak "connect: $!";
249 my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph";
250 my $that = sockaddr_un($syslog) || croak "Can't locate $syslog";
251 socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "open: $!";
252 connect(SYSLOG,$that) || croak "connect: $!";
254 local($old) = select(SYSLOG); $| = 1; select($old);