I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / syslog.pl
CommitLineData
0f85fab0 1#
2# syslog.pl
3#
395c3793 4# $Log: syslog.pl,v $
79072805 5#
0f85fab0 6# tom christiansen <tchrist@convex.com>
7# modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov>
8# NOTE: openlog now takes three arguments, just like openlog(3)
9#
10# call syslog() with a string priority and a list of printf() args
11# like syslog(3)
12#
e929a76b 13# usage: require 'syslog.pl';
0f85fab0 14#
15# then (put these all in a script to test function)
16#
17#
18# do openlog($program,'cons,pid','user');
19# do syslog('info','this is another test');
395c3793 20# do syslog('mail|warning','this is a better test: %d', time);
0f85fab0 21# do closelog();
22#
23# do syslog('debug','this is the last test');
24# do openlog("$program $$",'ndelay','user');
25# do syslog('notice','fooprogram: this is really done');
26#
27# $! = 55;
28# do syslog('info','problem was %m'); # %m == $! in syslog(3)
29
30package syslog;
31
d3a7d8c7 32use warnings::register;
33
0f85fab0 34$host = 'localhost' unless $host; # set $syslog'host to change
35
d3a7d8c7 36if ($] >= 5 && warnings::enabled()) {
7e6d00f8 37 warnings::warn("You should 'use Sys::Syslog' instead; continuing");
cb1a09d0 38}
39
34de22dd 40require 'syslog.ph';
395c3793 41
8e4ea0b4 42 eval 'use Socket; 1' ||
4a6b6a6c 43 eval { require "socket.ph" } ||
44 require "sys/socket.ph";
cb1a09d0 45
395c3793 46$maskpri = &LOG_UPTO(&LOG_DEBUG);
0f85fab0 47
48sub main'openlog {
49 ($ident, $logopt, $facility) = @_; # package vars
50 $lo_pid = $logopt =~ /\bpid\b/;
51 $lo_ndelay = $logopt =~ /\bndelay\b/;
395c3793 52 $lo_cons = $logopt =~ /\bcons\b/;
0f85fab0 53 $lo_nowait = $logopt =~ /\bnowait\b/;
54 &connect if $lo_ndelay;
55}
56
57sub main'closelog {
58 $facility = $ident = '';
59 &disconnect;
60}
395c3793 61
62sub main'setlogmask {
63 local($oldmask) = $maskpri;
64 $maskpri = shift;
65 $oldmask;
66}
0f85fab0 67
68sub main'syslog {
69 local($priority) = shift;
70 local($mask) = shift;
71 local($message, $whoami);
395c3793 72 local(@words, $num, $numpri, $numfac, $sum);
73 local($facility) = $facility; # may need to change temporarily.
0f85fab0 74
395c3793 75 die "syslog: expected both priority and mask" unless $mask && $priority;
0f85fab0 76
395c3793 77 @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility".
78 undef $numpri;
79 undef $numfac;
80 foreach (@words) {
81 $num = &xlate($_); # Translate word to number.
82 if (/^kern$/ || $num < 0) {
83 die "syslog: invalid level/facility: $_\n";
84 }
85 elsif ($num <= &LOG_PRIMASK) {
86 die "syslog: too many levels given: $_\n" if defined($numpri);
87 $numpri = $num;
88 return 0 unless &LOG_MASK($numpri) & $maskpri;
89 }
90 else {
91 die "syslog: too many facilities given: $_\n" if defined($numfac);
92 $facility = $_;
93 $numfac = $num;
94 }
95 }
0f85fab0 96
395c3793 97 die "syslog: level must be given\n" unless defined($numpri);
98
99 if (!defined($numfac)) { # Facility not specified in this call.
100 $facility = 'user' unless $facility;
101 $numfac = &xlate($facility);
102 }
103
104 &connect unless $connected;
0f85fab0 105
395c3793 106 $whoami = $ident;
0f85fab0 107
108 if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) {
109 $whoami = $1;
110 $mask = $2;
111 }
395c3793 112
113 unless ($whoami) {
114 ($whoami = getlogin) ||
115 ($whoami = getpwuid($<)) ||
116 ($whoami = 'syslog');
117 }
118
119 $whoami .= "[$$]" if $lo_pid;
0f85fab0 120
121 $mask =~ s/%m/$!/g;
122 $mask .= "\n" unless $mask =~ /\n$/;
123 $message = sprintf ($mask, @_);
124
395c3793 125 $sum = $numpri + $numfac;
0f85fab0 126 unless (send(SYSLOG,"<$sum>$whoami: $message",0)) {
127 if ($lo_cons) {
128 if ($pid = fork) {
129 unless ($lo_nowait) {
130 do {$died = wait;} until $died == $pid || $died < 0;
131 }
132 }
133 else {
134 open(CONS,">/dev/console");
395c3793 135 print CONS "<$facility.$priority>$whoami: $message\r";
0f85fab0 136 exit if defined $pid; # if fork failed, we're parent
137 close CONS;
138 }
139 }
140 }
141}
142
143sub xlate {
144 local($name) = @_;
55497cff 145 $name = uc $name;
0f85fab0 146 $name = "LOG_$name" unless $name =~ /^LOG_/;
147 $name = "syslog'$name";
36477c24 148 defined &$name ? &$name : -1;
0f85fab0 149}
150
151sub connect {
152 $pat = 'S n C4 x8';
153
cb1a09d0 154 $af_unix = &AF_UNIX;
155 $af_inet = &AF_INET;
0f85fab0 156
cb1a09d0 157 $stream = &SOCK_STREAM;
158 $datagram = &SOCK_DGRAM;
0f85fab0 159
160 ($name,$aliases,$proto) = getprotobyname('udp');
161 $udp = $proto;
162
cb1a09d0 163 ($name,$aliases,$port,$proto) = getservbyname('syslog','udp');
0f85fab0 164 $syslog = $port;
165
166 if (chop($myname = `hostname`)) {
167 ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname);
168 die "Can't lookup $myname\n" unless $name;
169 @bytes = unpack("C4",$addrs[0]);
170 }
171 else {
172 @bytes = (0,0,0,0);
173 }
174 $this = pack($pat, $af_inet, 0, @bytes);
175
176 if ($host =~ /^\d+\./) {
177 @bytes = split(/\./,$host);
178 }
179 else {
180 ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host);
181 die "Can't lookup $host\n" unless $name;
182 @bytes = unpack("C4",$addrs[0]);
183 }
184 $that = pack($pat,$af_inet,$syslog,@bytes);
185
186 socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n";
187 bind(SYSLOG,$this) || die "bind: $!\n";
188 connect(SYSLOG,$that) || die "connect: $!\n";
189
190 local($old) = select(SYSLOG); $| = 1; select($old);
191 $connected = 1;
192}
193
194sub disconnect {
195 close SYSLOG;
196 $connected = 0;
197}
198
1991;