Commit | Line | Data |
0f85fab0 |
1 | # |
2 | # syslog.pl |
3 | # |
4 | # tom christiansen <tchrist@convex.com> |
5 | # modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov> |
6 | # NOTE: openlog now takes three arguments, just like openlog(3) |
7 | # |
8 | # call syslog() with a string priority and a list of printf() args |
9 | # like syslog(3) |
10 | # |
11 | # usage: do 'syslog.pl' || die "syslog.pl: $@"; |
12 | # |
13 | # then (put these all in a script to test function) |
14 | # |
15 | # |
16 | # do openlog($program,'cons,pid','user'); |
17 | # do syslog('info','this is another test'); |
18 | # do syslog('warn','this is a better test: %d', time); |
19 | # do closelog(); |
20 | # |
21 | # do syslog('debug','this is the last test'); |
22 | # do openlog("$program $$",'ndelay','user'); |
23 | # do syslog('notice','fooprogram: this is really done'); |
24 | # |
25 | # $! = 55; |
26 | # do syslog('info','problem was %m'); # %m == $! in syslog(3) |
27 | |
28 | package syslog; |
29 | |
30 | $host = 'localhost' unless $host; # set $syslog'host to change |
31 | |
32 | do '/usr/local/lib/perl/syslog.h' |
33 | || die "syslog: Can't do syslog.h: ",($@||$!),"\n"; |
34 | |
35 | sub main'openlog { |
36 | ($ident, $logopt, $facility) = @_; # package vars |
37 | $lo_pid = $logopt =~ /\bpid\b/; |
38 | $lo_ndelay = $logopt =~ /\bndelay\b/; |
39 | $lo_cons = $logopt =~ /\bncons\b/; |
40 | $lo_nowait = $logopt =~ /\bnowait\b/; |
41 | &connect if $lo_ndelay; |
42 | } |
43 | |
44 | sub main'closelog { |
45 | $facility = $ident = ''; |
46 | &disconnect; |
47 | } |
48 | |
49 | sub main'syslog { |
50 | local($priority) = shift; |
51 | local($mask) = shift; |
52 | local($message, $whoami); |
53 | |
54 | &connect unless $connected; |
55 | |
56 | $whoami = $ident; |
57 | |
58 | die "syslog: expected both priority and mask" unless $mask && $priority; |
59 | |
60 | $facility = "user" unless $facility; |
61 | |
62 | if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) { |
63 | $whoami = $1; |
64 | $mask = $2; |
65 | } |
66 | $whoami .= " [$$]" if $lo_pid; |
67 | |
68 | $mask =~ s/%m/$!/g; |
69 | $mask .= "\n" unless $mask =~ /\n$/; |
70 | $message = sprintf ($mask, @_); |
71 | |
72 | $whoami = sprintf ("%s %d",$ENV{'USER'}||$ENV{'LOGNAME'},$$) unless $whoami; |
73 | |
74 | $sum = &xlate($priority) + &xlate($facility); |
75 | unless (send(SYSLOG,"<$sum>$whoami: $message",0)) { |
76 | if ($lo_cons) { |
77 | if ($pid = fork) { |
78 | unless ($lo_nowait) { |
79 | do {$died = wait;} until $died == $pid || $died < 0; |
80 | } |
81 | } |
82 | else { |
83 | open(CONS,">/dev/console"); |
84 | print CONS "$<facility.$priority>$whoami: $message\n"; |
85 | exit if defined $pid; # if fork failed, we're parent |
86 | close CONS; |
87 | } |
88 | } |
89 | } |
90 | } |
91 | |
92 | sub xlate { |
93 | local($name) = @_; |
94 | $name =~ y/a-z/A-Z/; |
95 | $name = "LOG_$name" unless $name =~ /^LOG_/; |
96 | $name = "syslog'$name"; |
97 | &$name; |
98 | } |
99 | |
100 | sub connect { |
101 | $pat = 'S n C4 x8'; |
102 | |
103 | $af_unix = 1; |
104 | $af_inet = 2; |
105 | |
106 | $stream = 1; |
107 | $datagram = 2; |
108 | |
109 | ($name,$aliases,$proto) = getprotobyname('udp'); |
110 | $udp = $proto; |
111 | |
112 | ($name,$aliase,$port,$proto) = getservbyname('syslog','udp'); |
113 | $syslog = $port; |
114 | |
115 | if (chop($myname = `hostname`)) { |
116 | ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname); |
117 | die "Can't lookup $myname\n" unless $name; |
118 | @bytes = unpack("C4",$addrs[0]); |
119 | } |
120 | else { |
121 | @bytes = (0,0,0,0); |
122 | } |
123 | $this = pack($pat, $af_inet, 0, @bytes); |
124 | |
125 | if ($host =~ /^\d+\./) { |
126 | @bytes = split(/\./,$host); |
127 | } |
128 | else { |
129 | ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host); |
130 | die "Can't lookup $host\n" unless $name; |
131 | @bytes = unpack("C4",$addrs[0]); |
132 | } |
133 | $that = pack($pat,$af_inet,$syslog,@bytes); |
134 | |
135 | socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n"; |
136 | bind(SYSLOG,$this) || die "bind: $!\n"; |
137 | connect(SYSLOG,$that) || die "connect: $!\n"; |
138 | |
139 | local($old) = select(SYSLOG); $| = 1; select($old); |
140 | $connected = 1; |
141 | } |
142 | |
143 | sub disconnect { |
144 | close SYSLOG; |
145 | $connected = 0; |
146 | } |
147 | |
148 | 1; |