This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
patchlevel up to 54
[perl5.git] / lib / Sys / Syslog.pm
CommitLineData
a0d0e21e
LW
1package Sys::Syslog;
2require 5.000;
3require Exporter;
4use Carp;
5
6@ISA = qw(Exporter);
7@EXPORT = qw(openlog closelog setlogmask syslog);
3ffabb8c 8@EXPORT_OK = qw(setlogsock);
a0d0e21e 9
37120919 10use Socket;
55497cff 11use Sys::Hostname;
37120919 12
5be1dfc7 13# adapted from syslog.pl
a0d0e21e 14#
5be1dfc7 15# Tom Christiansen <tchrist@convex.com>
a0d0e21e
LW
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)
3ffabb8c
GS
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
20
21# Todo: enable connect to try all three types before failing (auto setlogsock)?
5be1dfc7
HF
22
23=head1 NAME
24
25Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls
26
27=head1 SYNOPSIS
28
3ffabb8c
GS
29 use Sys::Syslog; # all except setlogsock, or:
30 use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock
5be1dfc7 31
3ffabb8c 32 setlogsock $sock_type;
5be1dfc7 33 openlog $ident, $logopt, $facility;
2eae817d 34 syslog $priority, $format, @args;
5be1dfc7
HF
35 $oldmask = setlogmask $mask_priority;
36 closelog;
37
38=head1 DESCRIPTION
39
40Sys::Syslog is an interface to the UNIX C<syslog(3)> program.
41Call C<syslog()> with a string priority and a list of C<printf()> args
42just like C<syslog(3)>.
43
44Syslog provides the functions:
45
46=over
47
48=item openlog $ident, $logopt, $facility
49
50I<$ident> is prepended to every message.
b12e51c8 51I<$logopt> contains zero or more of the words I<pid>, I<ndelay>, I<cons>, I<nowait>.
5be1dfc7
HF
52I<$facility> specifies the part of the system
53
2eae817d 54=item syslog $priority, $format, @args
5be1dfc7 55
2eae817d 56If I<$priority> permits, logs I<($format, @args)>
5be1dfc7
HF
57printed as by C<printf(3V)>, with the addition that I<%m>
58is replaced with C<"$!"> (the latest error message).
59
60=item setlogmask $mask_priority
61
62Sets log mask I<$mask_priority> and returns the old mask.
63
3ffabb8c
GS
64=item setlogsock $sock_type (added in 5.004_02)
65
cb63fe9d 66Sets the socket type to be used for the next call to
3ffabb8c
GS
67C<openlog()> or C<syslog()> and returns TRUE on success,
68undef on failure.
69
f8b75b0c 70A value of 'unix' will connect to the UNIX domain socket returned by
3ffabb8c
GS
71C<_PATH_LOG> in F<syslog.ph>. A value of 'inet' will connect to an
72INET socket returned by getservbyname(). Any other value croaks.
cb63fe9d
TB
73
74The default is for the INET socket to be used.
75
5be1dfc7
HF
76=item closelog
77
78Closes the log file.
79
80=back
81
82Note that C<openlog> now takes three arguments, just like C<openlog(3)>.
83
84=head1 EXAMPLES
85
86 openlog($program, 'cons,pid', 'user');
87 syslog('info', 'this is another test');
88 syslog('mail|warning', 'this is a better test: %d', time);
89 closelog();
90
91 syslog('debug', 'this is the last test');
cb63fe9d
TB
92
93 setlogsock('unix');
5be1dfc7
HF
94 openlog("$program $$", 'ndelay', 'user');
95 syslog('notice', 'fooprogram: this is really done');
96
cb63fe9d 97 setlogsock('inet');
5be1dfc7
HF
98 $! = 55;
99 syslog('info', 'problem was %m'); # %m == $! in syslog(3)
100
101=head1 DEPENDENCIES
102
103B<Sys::Syslog> needs F<syslog.ph>, which can be created with C<h2ph>.
104
105=head1 SEE ALSO
106
107L<syslog(3)>
108
109=head1 AUTHOR
110
cb63fe9d
TB
111Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt>.
112UNIX domain sockets added by Sean Robinson E<lt>F<robinson_s@sc.maricopa.edu>E<gt>
113with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list.
5be1dfc7
HF
114
115=cut
a0d0e21e 116
a0d0e21e
LW
117require 'syslog.ph';
118
119$maskpri = &LOG_UPTO(&LOG_DEBUG);
120
121sub openlog {
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;
128}
129
130sub closelog {
131 $facility = $ident = '';
132 &disconnect;
133}
134
135sub setlogmask {
136 local($oldmask) = $maskpri;
137 $maskpri = shift;
138 $oldmask;
139}
140
cb63fe9d
TB
141sub setlogsock {
142 local($setsock) = shift;
3ffabb8c 143 &disconnect if $connected;
cb63fe9d 144 if (lc($setsock) eq 'unix') {
3ffabb8c
GS
145 if (defined &_PATH_LOG) {
146 $sock_type = 1;
147 } else {
148 return undef;
149 }
cb63fe9d 150 } elsif (lc($setsock) eq 'inet') {
3ffabb8c
GS
151 if (getservbyname('syslog','udp')) {
152 undef($sock_type);
153 } else {
154 return undef;
155 }
cb63fe9d
TB
156 } else {
157 croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'";
158 }
f8b75b0c 159 return 1;
cb63fe9d
TB
160}
161
a0d0e21e
LW
162sub syslog {
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.
168
169 croak "syslog: expected both priority and mask" unless $mask && $priority;
170
171 @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
172 undef $numpri;
173 undef $numfac;
174 foreach (@words) {
175 $num = &xlate($_); # Translate word to number.
176 if (/^kern$/ || $num < 0) {
177 croak "syslog: invalid level/facility: $_";
178 }
179 elsif ($num <= &LOG_PRIMASK) {
180 croak "syslog: too many levels given: $_" if defined($numpri);
181 $numpri = $num;
182 return 0 unless &LOG_MASK($numpri) & $maskpri;
183 }
184 else {
185 croak "syslog: too many facilities given: $_" if defined($numfac);
186 $facility = $_;
187 $numfac = $num;
188 }
189 }
190
191 croak "syslog: level must be given" unless defined($numpri);
192
193 if (!defined($numfac)) { # Facility not specified in this call.
194 $facility = 'user' unless $facility;
195 $numfac = &xlate($facility);
196 }
197
198 &connect unless $connected;
199
200 $whoami = $ident;
201
5dad0344 202 if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) {
a0d0e21e
LW
203 $whoami = $1;
204 $mask = $2;
205 }
206
207 unless ($whoami) {
208 ($whoami = getlogin) ||
209 ($whoami = getpwuid($<)) ||
210 ($whoami = 'syslog');
211 }
212
213 $whoami .= "[$$]" if $lo_pid;
214
215 $mask =~ s/%m/$!/g;
216 $mask .= "\n" unless $mask =~ /\n$/;
217 $message = sprintf ($mask, @_);
218
219 $sum = $numpri + $numfac;
cb63fe9d 220 unless (send(SYSLOG,"<$sum>$whoami: $message\0",0)) {
a0d0e21e
LW
221 if ($lo_cons) {
222 if ($pid = fork) {
223 unless ($lo_nowait) {
cb1a09d0 224 $died = waitpid($pid, 0);
a0d0e21e
LW
225 }
226 }
227 else {
228 open(CONS,">/dev/console");
229 print CONS "<$facility.$priority>$whoami: $message\r";
230 exit if defined $pid; # if fork failed, we're parent
231 close CONS;
232 }
233 }
234 }
235}
236
237sub xlate {
238 local($name) = @_;
55497cff 239 $name = uc $name;
a0d0e21e 240 $name = "LOG_$name" unless $name =~ /^LOG_/;
748a9306 241 $name = "Sys::Syslog::$name";
36477c24 242 defined &$name ? &$name : -1;
a0d0e21e
LW
243}
244
245sub connect {
4fc7577b
PP
246 unless ($host) {
247 require Sys::Hostname;
2eae817d 248 my($host_uniq) = Sys::Hostname::hostname();
3e3baf6d 249 ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _)
4fc7577b 250 }
3ffabb8c 251 unless ( $sock_type ) {
cb63fe9d
TB
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: $!";
258 } else {
259 my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph";
260 my $that = sockaddr_un($syslog) || croak "Can't locate $syslog";
3ffabb8c
GS
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)";
265 }
cb63fe9d 266 }
a0d0e21e
LW
267 local($old) = select(SYSLOG); $| = 1; select($old);
268 $connected = 1;
269}
270
271sub disconnect {
272 close SYSLOG;
273 $connected = 0;
274}
275
2761;