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 &connect if $lo_ndelay;
131 $facility = $ident = '';
136 local($oldmask) = $maskpri;
142 local($setsock) = shift;
143 &disconnect if $connected;
144 if (lc($setsock) eq 'unix') {
145 if (defined &_PATH_LOG) {
150 } elsif (lc($setsock) eq 'inet') {
151 if (getservbyname('syslog','udp')) {
157 croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'";
163 local($priority) = shift;
164 local($mask) = shift;
165 local($message, $whoami);
166 local(@words, $num, $numpri, $numfac, $sum);
167 local($facility) = $facility; # may need to change temporarily.
169 croak "syslog: expected both priority and mask" unless $mask && $priority;
171 @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
175 $num = &xlate($_); # Translate word to number.
176 if (/^kern$/ || $num < 0) {
177 croak "syslog: invalid level/facility: $_";
179 elsif ($num <= &LOG_PRIMASK) {
180 croak "syslog: too many levels given: $_" if defined($numpri);
182 return 0 unless &LOG_MASK($numpri) & $maskpri;
185 croak "syslog: too many facilities given: $_" if defined($numfac);
191 croak "syslog: level must be given" unless defined($numpri);
193 if (!defined($numfac)) { # Facility not specified in this call.
194 $facility = 'user' unless $facility;
195 $numfac = &xlate($facility);
198 &connect unless $connected;
202 if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) {
208 ($whoami = getlogin) ||
209 ($whoami = getpwuid($<)) ||
210 ($whoami = 'syslog');
213 $whoami .= "[$$]" if $lo_pid;
216 $mask .= "\n" unless $mask =~ /\n$/;
217 $message = sprintf ($mask, @_);
219 $sum = $numpri + $numfac;
220 unless (send(SYSLOG,"<$sum>$whoami: $message\0",0)) {
223 unless ($lo_nowait) {
224 $died = waitpid($pid, 0);
228 open(CONS,">/dev/console");
229 print CONS "<$facility.$priority>$whoami: $message\r";
230 exit if defined $pid; # if fork failed, we're parent
240 $name = "LOG_$name" unless $name =~ /^LOG_/;
241 $name = "Sys::Syslog::$name";
242 defined &$name ? &$name : -1;
247 require Sys::Hostname;
248 my($host_uniq) = Sys::Hostname::hostname();
249 ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
251 unless ( $sock_type ) {
252 my $udp = getprotobyname('udp');
253 my $syslog = getservbyname('syslog','udp');
254 my $this = sockaddr_in($syslog, INADDR_ANY);
255 my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host");
256 socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!";
257 connect(SYSLOG,$that) || croak "connect: $!";
259 my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph";
260 my $that = sockaddr_un($syslog) || croak "Can't locate $syslog";
261 socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "socket: $!";
262 if (!connect(SYSLOG,$that)) {
263 socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0) || croak "socket: $!";
264 connect(SYSLOG,$that) || croak "connect: $! (SOCK_DGRAM after trying SOCK_STREAM)";
267 local($old) = select(SYSLOG); $| = 1; select($old);