Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | package Sys::Syslog; |
2 | require 5.000; | |
3 | require Exporter; | |
4 | use Carp; | |
5 | ||
6 | @ISA = qw(Exporter); | |
7 | @EXPORT = qw(openlog closelog setlogmask syslog); | |
8 | ||
37120919 AD |
9 | use Socket; |
10 | use Sys::Hostname; | |
11 | ||
5be1dfc7 | 12 | # adapted from syslog.pl |
a0d0e21e | 13 | # |
5be1dfc7 | 14 | # Tom Christiansen <tchrist@convex.com> |
a0d0e21e LW |
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) | |
5be1dfc7 HF |
17 | |
18 | =head1 NAME | |
19 | ||
20 | Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX syslog(3) calls | |
21 | ||
22 | =head1 SYNOPSIS | |
23 | ||
24 | use Sys::Syslog; | |
25 | ||
26 | openlog $ident, $logopt, $facility; | |
27 | syslog $priority, $mask, $format, @args; | |
28 | $oldmask = setlogmask $mask_priority; | |
29 | closelog; | |
30 | ||
31 | =head1 DESCRIPTION | |
32 | ||
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)>. | |
36 | ||
37 | Syslog provides the functions: | |
38 | ||
39 | =over | |
40 | ||
41 | =item openlog $ident, $logopt, $facility | |
42 | ||
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 | |
46 | ||
47 | =item syslog $priority, $mask, $format, @args | |
48 | ||
49 | If I<$priority> and I<$mask> permit, 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). | |
52 | ||
53 | =item setlogmask $mask_priority | |
54 | ||
55 | Sets log mask I<$mask_priority> and returns the old mask. | |
56 | ||
57 | =item closelog | |
58 | ||
59 | Closes the log file. | |
60 | ||
61 | =back | |
62 | ||
63 | Note that C<openlog> now takes three arguments, just like C<openlog(3)>. | |
64 | ||
65 | =head1 EXAMPLES | |
66 | ||
67 | openlog($program, 'cons,pid', 'user'); | |
68 | syslog('info', 'this is another test'); | |
69 | syslog('mail|warning', 'this is a better test: %d', time); | |
70 | closelog(); | |
71 | ||
72 | syslog('debug', 'this is the last test'); | |
73 | openlog("$program $$", 'ndelay', 'user'); | |
74 | syslog('notice', 'fooprogram: this is really done'); | |
75 | ||
76 | $! = 55; | |
77 | syslog('info', 'problem was %m'); # %m == $! in syslog(3) | |
78 | ||
79 | =head1 DEPENDENCIES | |
80 | ||
81 | B<Sys::Syslog> needs F<syslog.ph>, which can be created with C<h2ph>. | |
82 | ||
83 | =head1 SEE ALSO | |
84 | ||
85 | L<syslog(3)> | |
86 | ||
87 | =head1 AUTHOR | |
88 | ||
89 | Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<lwall@sems.com>E<gt> | |
90 | ||
91 | =cut | |
a0d0e21e | 92 | |
37120919 | 93 | $host = hostname() unless $host; # set $Syslog::host to change |
a0d0e21e LW |
94 | |
95 | require 'syslog.ph'; | |
96 | ||
97 | $maskpri = &LOG_UPTO(&LOG_DEBUG); | |
98 | ||
99 | sub openlog { | |
100 | ($ident, $logopt, $facility) = @_; # package vars | |
101 | $lo_pid = $logopt =~ /\bpid\b/; | |
102 | $lo_ndelay = $logopt =~ /\bndelay\b/; | |
103 | $lo_cons = $logopt =~ /\bcons\b/; | |
104 | $lo_nowait = $logopt =~ /\bnowait\b/; | |
105 | &connect if $lo_ndelay; | |
106 | } | |
107 | ||
108 | sub closelog { | |
109 | $facility = $ident = ''; | |
110 | &disconnect; | |
111 | } | |
112 | ||
113 | sub setlogmask { | |
114 | local($oldmask) = $maskpri; | |
115 | $maskpri = shift; | |
116 | $oldmask; | |
117 | } | |
118 | ||
119 | sub syslog { | |
120 | local($priority) = shift; | |
121 | local($mask) = shift; | |
122 | local($message, $whoami); | |
123 | local(@words, $num, $numpri, $numfac, $sum); | |
124 | local($facility) = $facility; # may need to change temporarily. | |
125 | ||
126 | croak "syslog: expected both priority and mask" unless $mask && $priority; | |
127 | ||
128 | @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility". | |
129 | undef $numpri; | |
130 | undef $numfac; | |
131 | foreach (@words) { | |
132 | $num = &xlate($_); # Translate word to number. | |
133 | if (/^kern$/ || $num < 0) { | |
134 | croak "syslog: invalid level/facility: $_"; | |
135 | } | |
136 | elsif ($num <= &LOG_PRIMASK) { | |
137 | croak "syslog: too many levels given: $_" if defined($numpri); | |
138 | $numpri = $num; | |
139 | return 0 unless &LOG_MASK($numpri) & $maskpri; | |
140 | } | |
141 | else { | |
142 | croak "syslog: too many facilities given: $_" if defined($numfac); | |
143 | $facility = $_; | |
144 | $numfac = $num; | |
145 | } | |
146 | } | |
147 | ||
148 | croak "syslog: level must be given" unless defined($numpri); | |
149 | ||
150 | if (!defined($numfac)) { # Facility not specified in this call. | |
151 | $facility = 'user' unless $facility; | |
152 | $numfac = &xlate($facility); | |
153 | } | |
154 | ||
155 | &connect unless $connected; | |
156 | ||
157 | $whoami = $ident; | |
158 | ||
159 | if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) { | |
160 | $whoami = $1; | |
161 | $mask = $2; | |
162 | } | |
163 | ||
164 | unless ($whoami) { | |
165 | ($whoami = getlogin) || | |
166 | ($whoami = getpwuid($<)) || | |
167 | ($whoami = 'syslog'); | |
168 | } | |
169 | ||
170 | $whoami .= "[$$]" if $lo_pid; | |
171 | ||
172 | $mask =~ s/%m/$!/g; | |
173 | $mask .= "\n" unless $mask =~ /\n$/; | |
174 | $message = sprintf ($mask, @_); | |
175 | ||
176 | $sum = $numpri + $numfac; | |
177 | unless (send(SYSLOG,"<$sum>$whoami: $message",0)) { | |
178 | if ($lo_cons) { | |
179 | if ($pid = fork) { | |
180 | unless ($lo_nowait) { | |
cb1a09d0 | 181 | $died = waitpid($pid, 0); |
a0d0e21e LW |
182 | } |
183 | } | |
184 | else { | |
185 | open(CONS,">/dev/console"); | |
186 | print CONS "<$facility.$priority>$whoami: $message\r"; | |
187 | exit if defined $pid; # if fork failed, we're parent | |
188 | close CONS; | |
189 | } | |
190 | } | |
191 | } | |
192 | } | |
193 | ||
194 | sub xlate { | |
195 | local($name) = @_; | |
196 | $name =~ y/a-z/A-Z/; | |
197 | $name = "LOG_$name" unless $name =~ /^LOG_/; | |
748a9306 | 198 | $name = "Sys::Syslog::$name"; |
a0d0e21e LW |
199 | eval(&$name) || -1; |
200 | } | |
201 | ||
202 | sub connect { | |
cb1a09d0 AD |
203 | my $udp = getprotobyname('udp'); |
204 | my $syslog = getservbyname('syslog','udp'); | |
205 | my $this = sockaddr_in($syslog, INADDR_ANY); | |
206 | my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host"); | |
207 | socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!"; | |
208 | connect(SYSLOG,$that) || croak "connect: $!"; | |
a0d0e21e LW |
209 | local($old) = select(SYSLOG); $| = 1; select($old); |
210 | $connected = 1; | |
211 | } | |
212 | ||
213 | sub disconnect { | |
214 | close SYSLOG; | |
215 | $connected = 0; | |
216 | } | |
217 | ||
218 | 1; |