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
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
63 by C<_PATH_LOG> in F<syslog.ph>. A value of 'inet' will connect
64 to an INET socket returned by getservbyname().
65 Any other value croaks.
67 The default is for the INET socket to be used.
76 Note that C<openlog> now takes three arguments, just like C<openlog(3)>.
80 openlog($program, 'cons,pid', 'user');
81 syslog('info', 'this is another test');
82 syslog('mail|warning', 'this is a better test: %d', time);
85 syslog('debug', 'this is the last test');
88 openlog("$program $$", 'ndelay', 'user');
89 syslog('notice', 'fooprogram: this is really done');
93 syslog('info', 'problem was %m'); # %m == $! in syslog(3)
97 B<Sys::Syslog> needs F<syslog.ph>, which can be created with C<h2ph>.
105 Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt>.
106 UNIX domain sockets added by Sean Robinson E<lt>F<robinson_s@sc.maricopa.edu>E<gt>
107 with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list.
113 $maskpri = &LOG_UPTO(&LOG_DEBUG);
116 ($ident, $logopt, $facility) = @_; # package vars
117 $lo_pid = $logopt =~ /\bpid\b/;
118 $lo_ndelay = $logopt =~ /\bndelay\b/;
119 $lo_cons = $logopt =~ /\bcons\b/;
120 $lo_nowait = $logopt =~ /\bnowait\b/;
121 &connect if $lo_ndelay;
125 $facility = $ident = '';
130 local($oldmask) = $maskpri;
136 local($setsock) = shift;
137 if (lc($setsock) eq 'unix') {
139 } elsif (lc($setsock) eq 'inet') {
142 croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'";
147 local($priority) = shift;
148 local($mask) = shift;
149 local($message, $whoami);
150 local(@words, $num, $numpri, $numfac, $sum);
151 local($facility) = $facility; # may need to change temporarily.
153 croak "syslog: expected both priority and mask" unless $mask && $priority;
155 @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
159 $num = &xlate($_); # Translate word to number.
160 if (/^kern$/ || $num < 0) {
161 croak "syslog: invalid level/facility: $_";
163 elsif ($num <= &LOG_PRIMASK) {
164 croak "syslog: too many levels given: $_" if defined($numpri);
166 return 0 unless &LOG_MASK($numpri) & $maskpri;
169 croak "syslog: too many facilities given: $_" if defined($numfac);
175 croak "syslog: level must be given" unless defined($numpri);
177 if (!defined($numfac)) { # Facility not specified in this call.
178 $facility = 'user' unless $facility;
179 $numfac = &xlate($facility);
182 &connect unless $connected;
186 if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) {
192 ($whoami = getlogin) ||
193 ($whoami = getpwuid($<)) ||
194 ($whoami = 'syslog');
197 $whoami .= "[$$]" if $lo_pid;
200 $mask .= "\n" unless $mask =~ /\n$/;
201 $message = sprintf ($mask, @_);
203 $sum = $numpri + $numfac;
204 unless (send(SYSLOG,"<$sum>$whoami: $message\0",0)) {
207 unless ($lo_nowait) {
208 $died = waitpid($pid, 0);
212 open(CONS,">/dev/console");
213 print CONS "<$facility.$priority>$whoami: $message\r";
214 exit if defined $pid; # if fork failed, we're parent
224 $name = "LOG_$name" unless $name =~ /^LOG_/;
225 $name = "Sys::Syslog::$name";
226 defined &$name ? &$name : -1;
231 require Sys::Hostname;
232 my($host_uniq) = Sys::Hostname::hostname();
233 ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
235 unless ( $sock_unix ) {
236 my $udp = getprotobyname('udp');
237 my $syslog = getservbyname('syslog','udp');
238 my $this = sockaddr_in($syslog, INADDR_ANY);
239 my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host");
240 socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!";
241 connect(SYSLOG,$that) || croak "connect: $!";
243 my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph";
244 my $that = sockaddr_un($syslog) || croak "Can't locate $syslog";
245 socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "open: $!";
246 connect(SYSLOG,$that) || croak "connect: $!";
248 local($old) = select(SYSLOG); $| = 1; select($old);