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 | # |
e929a76b |
11 | # usage: require 'syslog.pl'; |
0f85fab0 |
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 | |
e929a76b |
32 | require 'syslog.ph'; |
0f85fab0 |
33 | |
34 | sub main'openlog { |
35 | ($ident, $logopt, $facility) = @_; # package vars |
36 | $lo_pid = $logopt =~ /\bpid\b/; |
37 | $lo_ndelay = $logopt =~ /\bndelay\b/; |
38 | $lo_cons = $logopt =~ /\bncons\b/; |
39 | $lo_nowait = $logopt =~ /\bnowait\b/; |
40 | &connect if $lo_ndelay; |
41 | } |
42 | |
43 | sub main'closelog { |
44 | $facility = $ident = ''; |
45 | &disconnect; |
46 | } |
47 | |
48 | sub main'syslog { |
49 | local($priority) = shift; |
50 | local($mask) = shift; |
51 | local($message, $whoami); |
52 | |
53 | &connect unless $connected; |
54 | |
55 | $whoami = $ident; |
56 | |
57 | die "syslog: expected both priority and mask" unless $mask && $priority; |
58 | |
59 | $facility = "user" unless $facility; |
60 | |
61 | if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) { |
62 | $whoami = $1; |
63 | $mask = $2; |
64 | } |
65 | $whoami .= " [$$]" if $lo_pid; |
66 | |
67 | $mask =~ s/%m/$!/g; |
68 | $mask .= "\n" unless $mask =~ /\n$/; |
69 | $message = sprintf ($mask, @_); |
70 | |
71 | $whoami = sprintf ("%s %d",$ENV{'USER'}||$ENV{'LOGNAME'},$$) unless $whoami; |
72 | |
73 | $sum = &xlate($priority) + &xlate($facility); |
74 | unless (send(SYSLOG,"<$sum>$whoami: $message",0)) { |
75 | if ($lo_cons) { |
76 | if ($pid = fork) { |
77 | unless ($lo_nowait) { |
78 | do {$died = wait;} until $died == $pid || $died < 0; |
79 | } |
80 | } |
81 | else { |
82 | open(CONS,">/dev/console"); |
83 | print CONS "$<facility.$priority>$whoami: $message\n"; |
84 | exit if defined $pid; # if fork failed, we're parent |
85 | close CONS; |
86 | } |
87 | } |
88 | } |
89 | } |
90 | |
91 | sub xlate { |
92 | local($name) = @_; |
93 | $name =~ y/a-z/A-Z/; |
94 | $name = "LOG_$name" unless $name =~ /^LOG_/; |
95 | $name = "syslog'$name"; |
96 | &$name; |
97 | } |
98 | |
99 | sub connect { |
100 | $pat = 'S n C4 x8'; |
101 | |
102 | $af_unix = 1; |
103 | $af_inet = 2; |
104 | |
105 | $stream = 1; |
106 | $datagram = 2; |
107 | |
108 | ($name,$aliases,$proto) = getprotobyname('udp'); |
109 | $udp = $proto; |
110 | |
111 | ($name,$aliase,$port,$proto) = getservbyname('syslog','udp'); |
112 | $syslog = $port; |
113 | |
114 | if (chop($myname = `hostname`)) { |
115 | ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname); |
116 | die "Can't lookup $myname\n" unless $name; |
117 | @bytes = unpack("C4",$addrs[0]); |
118 | } |
119 | else { |
120 | @bytes = (0,0,0,0); |
121 | } |
122 | $this = pack($pat, $af_inet, 0, @bytes); |
123 | |
124 | if ($host =~ /^\d+\./) { |
125 | @bytes = split(/\./,$host); |
126 | } |
127 | else { |
128 | ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host); |
129 | die "Can't lookup $host\n" unless $name; |
130 | @bytes = unpack("C4",$addrs[0]); |
131 | } |
132 | $that = pack($pat,$af_inet,$syslog,@bytes); |
133 | |
134 | socket(SYSLOG,$af_inet,$datagram,$udp) || die "socket: $!\n"; |
135 | bind(SYSLOG,$this) || die "bind: $!\n"; |
136 | connect(SYSLOG,$that) || die "connect: $!\n"; |
137 | |
138 | local($old) = select(SYSLOG); $| = 1; select($old); |
139 | $connected = 1; |
140 | } |
141 | |
142 | sub disconnect { |
143 | close SYSLOG; |
144 | $connected = 0; |
145 | } |
146 | |
147 | 1; |