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);
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 if (open(CONS,">/dev/console")) {
246 print CONS "<$facility.$priority>$whoami: $message\r";
249 exit if defined $pid; # if fork failed, we're parent
258 $name = "LOG_$name" unless $name =~ /^LOG_/;
259 $name = "Sys::Syslog::$name";
260 eval { &$name } || -1;
265 require Sys::Hostname;
266 my($host_uniq) = Sys::Hostname::hostname();
267 ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
269 unless ( $sock_type ) {
270 my $udp = getprotobyname('udp');
271 my $syslog = getservbyname('syslog','udp');
272 my $this = sockaddr_in($syslog, INADDR_ANY);
273 my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host");
274 socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!";
275 connect(SYSLOG,$that) || croak "connect: $!";
277 my $syslog = _PATH_LOG() || croak "_PATH_LOG not found in syslog.ph";
278 my $that = sockaddr_un($syslog) || croak "Can't locate $syslog";
279 socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "socket: $!";
280 if (!connect(SYSLOG,$that)) {
281 socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0) || croak "socket: $!";
282 connect(SYSLOG,$that) || croak "connect: $! (SOCK_DGRAM after trying SOCK_STREAM)";
285 local($old) = select(SYSLOG); $| = 1; select($old);