7 @ISA = qw(Exporter DynaLoader);
8 @EXPORT = qw(openlog closelog setlogmask syslog);
9 @EXPORT_OK = qw(setlogsock);
15 # adapted from syslog.pl
17 # Tom Christiansen <tchrist@convex.com>
18 # modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
19 # NOTE: openlog now takes three arguments, just like openlog(3)
20 # Modified to add UNIX domain sockets by Sean Robinson <robinson_s@sc.maricopa.edu>
21 # with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list
22 # Modified to use an XS backend instead of syslog.ph by Tom Hughes <tom@compton.nu>
24 # Todo: enable connect to try all three types before failing (auto setlogsock)?
28 Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls
32 use Sys::Syslog; # all except setlogsock, or:
33 use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock
35 setlogsock $sock_type;
36 openlog $ident, $logopt, $facility;
37 syslog $priority, $format, @args;
38 $oldmask = setlogmask $mask_priority;
43 Sys::Syslog is an interface to the UNIX C<syslog(3)> program.
44 Call C<syslog()> with a string priority and a list of C<printf()> args
45 just like C<syslog(3)>.
47 Syslog provides the functions:
51 =item openlog $ident, $logopt, $facility
53 I<$ident> is prepended to every message.
54 I<$logopt> contains zero or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
55 I<$facility> specifies the part of the system
57 =item syslog $priority, $format, @args
59 If I<$priority> permits, logs I<($format, @args)>
60 printed as by C<printf(3V)>, with the addition that I<%m>
61 is replaced with C<"$!"> (the latest error message).
63 =item setlogmask $mask_priority
65 Sets log mask I<$mask_priority> and returns the old mask.
67 =item setlogsock $sock_type (added in 5.004_02)
69 Sets the socket type to be used for the next call to
70 C<openlog()> or C<syslog()> and returns TRUE on success,
73 A value of 'unix' will connect to the UNIX domain socket returned by
74 C<_PATH_LOG> in F<syslog.ph>. A value of 'inet' will connect to an
75 INET socket returned by getservbyname(). Any other value croaks.
77 The default is for the INET socket to be used.
85 Note that C<openlog> now takes three arguments, just like C<openlog(3)>.
89 openlog($program, 'cons,pid', 'user');
90 syslog('info', 'this is another test');
91 syslog('mail|warning', 'this is a better test: %d', time);
94 syslog('debug', 'this is the last test');
97 openlog("$program $$", 'ndelay', 'user');
98 syslog('notice', 'fooprogram: this is really done');
102 syslog('info', 'problem was %m'); # %m == $! in syslog(3)
110 Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt>.
111 UNIX domain sockets added by Sean Robinson E<lt>F<robinson_s@sc.maricopa.edu>E<gt>
112 with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list.
113 Dependency on F<syslog.ph> replaced with XS code bu Tom Hughes E<lt>F<tom@compton.nu>E<gt>.
118 # This AUTOLOAD is used to 'autoload' constants from the constant()
123 ($constname = $AUTOLOAD) =~ s/.*:://;
124 croak "& not defined" if $constname eq 'constant';
125 my $val = constant($constname, @_ ? $_[0] : 0);
127 croak "Your vendor has not defined Sys::Syslog macro $constname";
129 *$AUTOLOAD = sub { $val };
133 bootstrap Sys::Syslog $VERSION;
135 $maskpri = &LOG_UPTO(&LOG_DEBUG);
138 ($ident, $logopt, $facility) = @_; # package vars
139 $lo_pid = $logopt =~ /\bpid\b/;
140 $lo_ndelay = $logopt =~ /\bndelay\b/;
141 $lo_cons = $logopt =~ /\bcons\b/;
142 $lo_nowait = $logopt =~ /\bnowait\b/;
143 return 1 unless $lo_ndelay;
148 $facility = $ident = '';
153 local($oldmask) = $maskpri;
159 local($setsock) = shift;
160 &disconnect if $connected;
161 if (lc($setsock) eq 'unix') {
162 if (defined &_PATH_LOG) {
167 } elsif (lc($setsock) eq 'inet') {
168 if (getservbyname('syslog','udp')) {
174 croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'";
180 local($priority) = shift;
181 local($mask) = shift;
182 local($message, $whoami);
183 local(@words, $num, $numpri, $numfac, $sum);
184 local($facility) = $facility; # may need to change temporarily.
186 croak "syslog: expected both priority and mask" unless $mask && $priority;
188 @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
192 $num = &xlate($_); # Translate word to number.
193 if (/^kern$/ || $num < 0) {
194 croak "syslog: invalid level/facility: $_";
196 elsif ($num <= &LOG_PRIMASK) {
197 croak "syslog: too many levels given: $_" if defined($numpri);
199 return 0 unless &LOG_MASK($numpri) & $maskpri;
202 croak "syslog: too many facilities given: $_" if defined($numfac);
208 croak "syslog: level must be given" unless defined($numpri);
210 if (!defined($numfac)) { # Facility not specified in this call.
211 $facility = 'user' unless $facility;
212 $numfac = &xlate($facility);
215 &connect unless $connected;
219 if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) {
225 ($whoami = getlogin) ||
226 ($whoami = getpwuid($<)) ||
227 ($whoami = 'syslog');
230 $whoami .= "[$$]" if $lo_pid;
233 $mask .= "\n" unless $mask =~ /\n$/;
234 $message = sprintf ($mask, @_);
236 $sum = $numpri + $numfac;
237 unless (send(SYSLOG,"<$sum>$whoami: $message\0",0)) {
240 unless ($lo_nowait) {
241 $died = waitpid($pid, 0);
245 open(CONS,">/dev/console");
246 print CONS "<$facility.$priority>$whoami: $message\r";
247 exit if defined $pid; # if fork failed, we're parent
257 $name = "LOG_$name" unless $name =~ /^LOG_/;
258 $name = "Sys::Syslog::$name";
259 eval { &$name } || -1;
264 require Sys::Hostname;
265 my($host_uniq) = Sys::Hostname::hostname();
266 ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
268 unless ( $sock_type ) {
269 my $udp = getprotobyname('udp');
270 my $syslog = getservbyname('syslog','udp');
271 my $this = sockaddr_in($syslog, INADDR_ANY);
272 my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host");
273 socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!";
274 connect(SYSLOG,$that) || croak "connect: $!";
276 my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph";
277 my $that = sockaddr_un($syslog) || croak "Can't locate $syslog";
278 socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "socket: $!";
279 if (!connect(SYSLOG,$that)) {
280 socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0) || croak "socket: $!";
281 connect(SYSLOG,$that) || croak "connect: $! (SOCK_DGRAM after trying SOCK_STREAM)";
284 local($old) = select(SYSLOG); $| = 1; select($old);