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 | 9 | use Socket; |
55497cff | 10 | use Sys::Hostname; |
37120919 | 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; | |
2eae817d | 27 | syslog $priority, $format, @args; |
5be1dfc7 HF |
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 | ||
2eae817d | 47 | =item syslog $priority, $format, @args |
5be1dfc7 | 48 | |
2eae817d | 49 | If I<$priority> permits, logs I<($format, @args)> |
5be1dfc7 HF |
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 | ||
55497cff | 89 | Tom Christiansen E<lt>F<tchrist@perl.com>E<gt> and Larry Wall E<lt>F<larry@wall.org>E<gt> |
5be1dfc7 HF |
90 | |
91 | =cut | |
a0d0e21e | 92 | |
a0d0e21e LW |
93 | require 'syslog.ph'; |
94 | ||
95 | $maskpri = &LOG_UPTO(&LOG_DEBUG); | |
96 | ||
97 | sub openlog { | |
98 | ($ident, $logopt, $facility) = @_; # package vars | |
99 | $lo_pid = $logopt =~ /\bpid\b/; | |
100 | $lo_ndelay = $logopt =~ /\bndelay\b/; | |
101 | $lo_cons = $logopt =~ /\bcons\b/; | |
102 | $lo_nowait = $logopt =~ /\bnowait\b/; | |
103 | &connect if $lo_ndelay; | |
104 | } | |
105 | ||
106 | sub closelog { | |
107 | $facility = $ident = ''; | |
108 | &disconnect; | |
109 | } | |
110 | ||
111 | sub setlogmask { | |
112 | local($oldmask) = $maskpri; | |
113 | $maskpri = shift; | |
114 | $oldmask; | |
115 | } | |
116 | ||
117 | sub syslog { | |
118 | local($priority) = shift; | |
119 | local($mask) = shift; | |
120 | local($message, $whoami); | |
121 | local(@words, $num, $numpri, $numfac, $sum); | |
122 | local($facility) = $facility; # may need to change temporarily. | |
123 | ||
124 | croak "syslog: expected both priority and mask" unless $mask && $priority; | |
125 | ||
126 | @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility". | |
127 | undef $numpri; | |
128 | undef $numfac; | |
129 | foreach (@words) { | |
130 | $num = &xlate($_); # Translate word to number. | |
131 | if (/^kern$/ || $num < 0) { | |
132 | croak "syslog: invalid level/facility: $_"; | |
133 | } | |
134 | elsif ($num <= &LOG_PRIMASK) { | |
135 | croak "syslog: too many levels given: $_" if defined($numpri); | |
136 | $numpri = $num; | |
137 | return 0 unless &LOG_MASK($numpri) & $maskpri; | |
138 | } | |
139 | else { | |
140 | croak "syslog: too many facilities given: $_" if defined($numfac); | |
141 | $facility = $_; | |
142 | $numfac = $num; | |
143 | } | |
144 | } | |
145 | ||
146 | croak "syslog: level must be given" unless defined($numpri); | |
147 | ||
148 | if (!defined($numfac)) { # Facility not specified in this call. | |
149 | $facility = 'user' unless $facility; | |
150 | $numfac = &xlate($facility); | |
151 | } | |
152 | ||
153 | &connect unless $connected; | |
154 | ||
155 | $whoami = $ident; | |
156 | ||
5dad0344 | 157 | if (!$whoami && $mask =~ /^(\S.*?):\s?(.*)/) { |
a0d0e21e LW |
158 | $whoami = $1; |
159 | $mask = $2; | |
160 | } | |
161 | ||
162 | unless ($whoami) { | |
163 | ($whoami = getlogin) || | |
164 | ($whoami = getpwuid($<)) || | |
165 | ($whoami = 'syslog'); | |
166 | } | |
167 | ||
168 | $whoami .= "[$$]" if $lo_pid; | |
169 | ||
170 | $mask =~ s/%m/$!/g; | |
171 | $mask .= "\n" unless $mask =~ /\n$/; | |
172 | $message = sprintf ($mask, @_); | |
173 | ||
174 | $sum = $numpri + $numfac; | |
175 | unless (send(SYSLOG,"<$sum>$whoami: $message",0)) { | |
176 | if ($lo_cons) { | |
177 | if ($pid = fork) { | |
178 | unless ($lo_nowait) { | |
cb1a09d0 | 179 | $died = waitpid($pid, 0); |
a0d0e21e LW |
180 | } |
181 | } | |
182 | else { | |
183 | open(CONS,">/dev/console"); | |
184 | print CONS "<$facility.$priority>$whoami: $message\r"; | |
185 | exit if defined $pid; # if fork failed, we're parent | |
186 | close CONS; | |
187 | } | |
188 | } | |
189 | } | |
190 | } | |
191 | ||
192 | sub xlate { | |
193 | local($name) = @_; | |
55497cff | 194 | $name = uc $name; |
a0d0e21e | 195 | $name = "LOG_$name" unless $name =~ /^LOG_/; |
748a9306 | 196 | $name = "Sys::Syslog::$name"; |
36477c24 | 197 | defined &$name ? &$name : -1; |
a0d0e21e LW |
198 | } |
199 | ||
200 | sub connect { | |
4fc7577b | 201 | unless ($host) { |
202 | require Sys::Hostname; | |
2eae817d | 203 | my($host_uniq) = Sys::Hostname::hostname(); |
204 | ($host) = $host_uniq =~ /(\w+)/; | |
4fc7577b | 205 | } |
cb1a09d0 AD |
206 | my $udp = getprotobyname('udp'); |
207 | my $syslog = getservbyname('syslog','udp'); | |
208 | my $this = sockaddr_in($syslog, INADDR_ANY); | |
209 | my $that = sockaddr_in($syslog, inet_aton($host) || croak "Can't lookup $host"); | |
210 | socket(SYSLOG,AF_INET,SOCK_DGRAM,$udp) || croak "socket: $!"; | |
211 | connect(SYSLOG,$that) || croak "connect: $!"; | |
a0d0e21e LW |
212 | local($old) = select(SYSLOG); $| = 1; select($old); |
213 | $connected = 1; | |
214 | } | |
215 | ||
216 | sub disconnect { | |
217 | close SYSLOG; | |
218 | $connected = 0; | |
219 | } | |
220 | ||
221 | 1; |