xref: /freebsd/contrib/ntp/scripts/monitoring/ntptrap (revision 1e413cf93298b5b97441a21d9a50fdcd0ee9945e) 
1#!/local/bin/perl --*-perl-*-
2;#
3;# ntptrap,v 3.1 1993/07/06 01:09:15 jbj Exp
4;#
5;# a client for the xntp mode 6 trap mechanism
6;#
7;# Copyright (c) 1992
8;#  Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
9;#
10;#
11;#############################################################
12$0 =~ s!^.*/([^/]+)$!$1!;		# strip to filename
13;# enforce STDOUT and STDERR to be line buffered
14$| = 1;
15select((select(STDERR),$|=1)[$[]);
16
17;#######################################
18;# load utility routines and definitions
19;#
20require('ntp.pl');			# implementation of the NTP protocol
21use Socket;
22
23#eval { require('sys/socket.ph'); require('netinet/in.ph') unless defined(&INADDR_ANY); } ||
24#do {
25  #die("$0: $@") unless $[ == index($@, "Can't locate ");
26  #warn "$0: $@";
27  #warn "$0: supplying some default definitions\n";
28  #eval 'sub INADDR_ANY { 0; } sub AF_INET {2;} sub SOCK_DGRAM {2;} 1;' || die "$0: $@";
29#};
30require('getopts.pl');			# option parsing
31require('ctime.pl');			# date/time formatting
32
33;######################################
34;# define some global constants
35;#
36$BASE_TIMEOUT=10;
37$FRAG_TIMEOUT=10;
38$MAX_TRY = 5;
39$REFRESH_TIME=60*15;		# 15 minutes (server uses 1 hour)
40$ntp'timeout = $FRAG_TIMEOUT; #';
41$ntp'timeout if 0;
42
43;######################################
44;# now process options
45;#
46sub usage
47{
48    die("usage: $0 [-n] [-p <port>] [-l <logfile>] [host] ...\n");
49}
50
51$opt_l = "/dev/null";	# where to write debug messages to
52$opt_p = 0;		# port to use locally - (0 does mean: will be choosen by kernel)
53
54&usage unless &Getopts('l:p:');
55&Getopts if 0;	# make -w happy
56
57@Hosts = ($#ARGV < $[) ? ("localhost") : @ARGV;
58
59;# setup for debug output
60$DEBUGFILE=$opt_l;
61$DEBUGFILE="&STDERR" if $DEBUGFILE eq '-';
62
63open(DEBUG,">>$DEBUGFILE") || die("Cannot open \"$DEBUGFILE\": $!\n");
64select((select(DEBUG),$|=1)[$[]);
65
66;# &log prints a single trap record (adding a (local) time stamp)
67sub log
68{
69    chop($date=&ctime(time));
70    print "$date ",@_,"\n";
71}
72
73sub debug
74{
75    print DEBUG @_,"\n";
76}
77;#
78$proto_udp = (getprotobyname('udp'))[$[+2] ||
79		(warn("$0: Could not get protocoll number for 'udp' using 17"), 17);
80
81$ntp_port = (getservbyname('ntp','udp'))[$[+2] ||
82	      (warn("$0: Could not get port number for service ntp/udp using 123"), 123);
83
84;#
85socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) || die("Cannot open socket: $!\n");
86
87;#
88bind(S, pack("S n a4 x8", &AF_INET, $opt_p, &INADDR_ANY)) ||
89    die("Cannot bind: $!\n");
90
91($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2];
92&log(sprintf("Listening at address %d.%d.%d.%d port %d",
93	     unpack("C4",$my_addr), $my_port));
94
95;# disregister with all servers in case of termination
96sub cleanup
97{
98    &log("Aborted by signal \"$_[$[]\"") if defined($_[$[]);
99
100    foreach (@Hosts)
101    {
102	if ( ! defined($Host{$_}) )
103	{
104		print "no info for host '$_'\n";
105		next;
106	}
107	&ntp'send(S,31,0,"",pack("Sna4x8",&AF_INET,$ntp_port,$Host{$_})); #';
108    }
109    close(S);
110    exit(2);
111}
112
113$SIG{'HUP'} = 'cleanup';
114$SIG{'INT'} = 'cleanup';
115$SIG{'QUIT'} = 'cleanup';
116$SIG{'TERM'} = 'cleanup';
117
1180 && $a && $b;
119sub timeouts			# sort timeout id array
120{
121    $TIMEOUTS{$a} <=> $TIMEOUTS{$b};
122}
123
124;# a Request element looks like: pack("a4SC",addr,associd,op)
125@Requests= ();
126
127;# compute requests for set trap control msgs to each host given
128{
129    local($name,$addr);
130
131    foreach (@Hosts)
132    {
133	if (/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
134	{
135	    ($name,$addr) =
136		(gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET))[$[,$[+4];
137	    unless (defined($name))
138	    {
139		$name = sprintf("[[%d.%d.%d.%d]]",$1,$2,$3,$4);
140		$addr = pack("C4",$1,$2,$3,$4);
141	    }
142	}
143	else
144	{
145	    ($name,$addr) = (gethostbyname($_))[$[,$[+4];
146	    unless (defined($name))
147	    {
148		warn "$0: unknown host \"$_\" - ignored\n";
149		next;
150	    }
151	}
152	next if defined($Host{$name});
153	$Host{$name} = $addr;
154	$Host{$_} = $addr;
155	push(@Requests,pack("a4SC",$addr,0,6));	# schedule a set trap request for $name
156    }
157}
158
159sub hostname
160{
161    local($addr) = @_;
162    return $HostName{$addr} if defined($HostName{$addr});
163    local($name) = gethostbyaddr($addr,&AF_INET);
164    &debug(sprintf("hostname(%d.%d.%d.%d) = \"%s\"",unpack("C4",$addr),$name))
165	if defined($name);
166    defined($name) && ($HostName{$addr} = $name) && (return $name);
167    &debug(sprintf("Failed to get name for %d.%d.%d.%d",unpack("C4",$addr)));
168    return sprintf("[%d.%d.%d.%d]",unpack("C4",$addr));
169}
170
171;# when no hosts were given on the commandline no requests have been scheduled
172&usage unless (@Requests);
173
174&debug(sprintf("%d request(s) scheduled",scalar(@Requests)));
175grep(&debug("    - ".$_),keys(%Host));
176
177;# allocate variables;
178$addr="";
179$assoc=0;
180$op = 0;
181$timeout = 0;
182$ret="";
183%TIMEOUTS = ();
184%TIMEOUT_PROCS = ();
185@TIMEOUTS = ();
186
187$len = 512;
188$buf = " " x $len;
189
190while (1)
191{
192    if (@Requests || @TIMEOUTS)		# if there is some work pending
193    {
194	if (@Requests)
195	{
196	    ($addr,$assoc,$op) = unpack("a4SC",($req = shift(@Requests)));
197	    &debug(sprintf("Request: %s: %s(%d)",&hostname($addr), &ntp'cntrlop_name($op), $assoc)); #';))
198	    $ret = &ntp'send(S,$op,$assoc,"", #'(
199                             pack("Sna4x8",&AF_INET,$ntp_port,$addr));
200	    &set_timeout("retry-".unpack("H*",$req),time+$BASE_TIMEOUT,
201			 sprintf("&retry(\"%s\");",unpack("H*",$req)));
202
203	    last unless (defined($ret)); # warn called by ntp'send();
204
205	    ;# if there are more requests just have a quick look for new messages
206	    ;# otherwise grant server time for a response
207	    $timeout = @Requests ? 0 : $BASE_TIMEOUT;
208	}
209	if ($timeout && @TIMEOUTS)
210	{
211	    ;# ensure not to miss a timeout
212	    if ($timeout + time > $TIMEOUTS{$TIMEOUTS[$[]})
213	    {
214		$timeout = $TIMEOUTS{$TIMEOUTS[$[]} - time;
215		$timeout = 0 if $timeout < 0;
216	    }
217	}
218    }
219    else
220    {
221	;# no work yet - wait for some messages dropping in
222	;# usually this will not hapen as the refresh semantic will
223	;# always have a pending timeout
224	undef($timeout);
225    }
226
227    vec($mask="",fileno(S),1) = 1;
228    $ret = select($mask,undef,undef,$timeout);
229
230    warn("$0: select: $!\n"),last if $ret < 0;	# give up on error return from select
231
232    if ($ret == 0)
233    {
234	;# timeout
235	if (@TIMEOUTS && time > $TIMEOUTS{$TIMEOUTS[$[]})
236	{
237	    ;# handle timeout
238	    $timeout_proc =
239		(delete $TIMEOUT_PROCS{$TIMEOUTS[$[]},
240		 delete $TIMEOUTS{shift(@TIMEOUTS)})[$[];
241	    eval $timeout_proc;
242	    die "timeout eval (\"$timeout_proc\"): $@\n" if $@;
243	}
244	;# else: there may be something to be sent
245    }
246    else
247    {
248	;# data avail
249	$from = recv(S,$buf,$len,0);
250	;# give up on error return from recv
251	warn("$0: recv: $!\n"), last unless (defined($from));
252
253	$from = (unpack("Sna4",$from))[$[+2]; # keep host addr only
254	;# could check for ntp_port - but who cares
255	&debug("-Packet from ",&hostname($from));
256
257	;# stuff packet into ntp mode 6 receive machinery
258	($ret,$data,$status,$associd,$op,$seq,$auth_keyid) =
259	    &ntp'handle_packet($buf,$from); # ';
260	&debug(sprintf("%s uses auth_keyid %d",&hostname($from),$auth_keyid)) if defined($auth_keyid);
261	next unless defined($ret);
262
263	if ($ret eq "")
264	{
265	    ;# handle packet
266	    ;# simple trap response messages have neither timeout nor retries
267	    &clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op))) unless $op == 7;
268	    delete $RETRY{pack("a4SC",$from,$associd,$op)} unless $op == 7;
269
270	    &process_response($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid);
271	}
272	else
273	{
274	    ;# some kind of error
275	    &log(sprintf("%50s: %s: %s",(gethostbyaddr($from,&AF_INET))[$[],$ret,$data));
276	    if ($ret ne "TIMEOUT" && $ret ne "ERROR")
277	    {
278		&clear_timeout("retry-".unpack("H*",pack("a4SC",$from,$associd,$op)));
279	    }
280	}
281    }
282
283}
284
285warn("$0: terminating\n");
286&cleanup;
287exit 0;
288
289;##################################################
290;# timeout support
291;#
292sub set_timeout
293{
294    local($id,$time,$proc) = @_;
295
296    $TIMEOUTS{$id} = $time;
297    $TIMEOUT_PROCS{$id} = $proc;
298    @TIMEOUTS = sort timeouts keys(%TIMEOUTS);
299    chop($date=&ctime($time));
300    &debug(sprintf("Schedule timeout \"%s\" for %s", $id, $date));
301}
302
303sub clear_timeout
304{
305    local($id) = @_;
306    delete $TIMEOUTS{$id};
307    delete $TIMEOUT_PROCS{$id};
308    @TIMEOUTS = sort timeouts keys(%TIMEOUTS);
309    &debug("Clear  timeout \"$id\"");
310}
311
3120 && &refresh;
313sub refresh
314{
315    local($addr) = @_[$[];
316    $addr = pack("H*",$addr);
317    &debug(sprintf("Refreshing trap for %s", &hostname($addr)));
318    push(@Requests,pack("a4SC",$addr,0,6));
319}
320
3210 && &retry;
322sub retry
323{
324    local($tag) = @_;
325    $tag = pack("H*",$tag);
326    $RETRY{$tag} = 0 if (!defined($RETRY{$tag}));
327
328    if (++$RETRY{$tag} > $MAX_TRY)
329    {
330	&debug(sprintf("Retry failed: %s assoc %5d op %d",
331		       &hostname(substr($tag,$[,4)),
332		       unpack("x4SC",$tag)));
333	return;
334    }
335    &debug(sprintf("Retrying: %s assoc %5d op %d",
336		       &hostname(substr($tag,$[,4)),
337		       unpack("x4SC",$tag)));
338    push(@Requests,$tag);
339}
340
341sub process_response
342{
343    local($from,$ret,$data,$status,$associd,$op,$seq,$auth_keyid) = @_;
344
345    $msg="";
346    if ($op == 7)		# trap response
347    {
348	$msg .= sprintf("%40s trap#%-5d",
349			&hostname($from),$seq);
350	&debug (sprintf("\nTrap %d associd %d:\n%s\n===============\n",$seq,$associd,$data));
351	if ($associd == 0)	# system event
352	{
353	    $msg .= "  SYSTEM   ";
354	    $evnt = &ntp'SystemEvent($status); #';
355	    $msg .= "$evnt ";
356	    ;# for special cases add additional info
357	    ($stratum) = ($data =~ /stratum=(\d+)/);
358	    ($refid) = ($data =~ /refid=([\w\.]+)/);
359	    $msg .= "stratum=$stratum refid=$refid";
360	    if ($refid =~ /\[?(\d+)\.(\d+)\.(\d+)\.(\d+)/)
361	    {
362		local($x) = (gethostbyaddr(pack("C4",$1,$2,$3,$4),&AF_INET));
363		$msg .= " " . $x if defined($x)
364	    }
365	    if ($evnt eq "event_sync_chg")
366	    {
367		$msg .= sprintf("%s %s ",
368				&ntp'LI($status), #',
369				&ntp'ClockSource($status) #'
370				);
371	    }
372	    elsif ($evnt eq "event_sync/strat_chg")
373	    {
374		($peer) = ($data =~ /peer=([0-9]+)/);
375		$msg .= " peer=$peer";
376	    }
377	    elsif ($evnt eq "event_clock_excptn")
378	    {
379		if (($device) = ($data =~ /device=\"([^\"]+)\"/))
380		{
381		    ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
382		    $Cstatus = hex($cstatus);
383		    $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
384		    ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
385		    $msg .= " \"$device\" \"$timecode\"";
386		}
387		else
388		{
389		    push(@Requests,pack("a4SC",$from, $associd, 4));
390		}
391	    }
392	}
393	else			# peer event
394	{
395	    $msg .= sprintf("peer %5d ",$associd);
396	    ($srcadr) = ($data =~ /srcadr=\[?([\d\.]+)/);
397	    $msg .= sprintf("%-18s %40s ", "[$srcadr]",
398			    &hostname(pack("C4",split(/\./,$srcadr))));
399	    $evnt = &ntp'PeerEvent($status); #';
400	    $msg .= "$evnt ";
401	    ;# for special cases include additional info
402	    if ($evnt eq "event_clock_excptn")
403	    {
404		if (($device) = ($data =~ /device=\"([^\"]+)\"/))
405		{
406		    ;#&debug("----\n$data\n====\n");
407		    ($cstatus) = ($data =~ /refclockstatus=0?x?([\da-fA-F]+)/);
408		    $Cstatus = hex($cstatus);
409		    $msg .= sprintf("- %-32s",&ntp'clock_status($Cstatus)); #');
410		    ($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
411		    $msg .= " \"$device\" \"$timecode\"";
412		}
413		else
414		{
415		    ;# no clockvars included - post a cv request
416		    push(@Requests,pack("a4SC",$from, $associd, 4));
417		}
418	    }
419	    elsif ($evnt eq "event_stratum_chg")
420	    {
421		($stratum) = ($data =~ /stratum=(\d+)/);
422		$msg .= "new stratum $stratum";
423	    }
424	}
425    }
426    elsif ($op == 6)		# set trap resonse
427    {
428	&debug("Set trap ok from ",&hostname($from));
429	&set_timeout("refresh-".unpack("H*",$from),time+$REFRESH_TIME,
430		     sprintf("&refresh(\"%s\");",unpack("H*",$from)));
431	return;
432    }
433    elsif ($op == 4)		# read clock variables response
434    {
435	;# status of clock
436	$msg .= sprintf(" %40s ", &hostname($from));
437	if ($associd == 0)
438	{
439	    $msg .= "system clock status: ";
440	}
441	else
442	{
443	    $msg .= sprintf("peer %5d clock",$associd);
444	}
445	$msg .= sprintf("%-32s",&ntp'clock_status($status)); #');
446	($device) = ($data =~ /device=\"([^\"]+)\"/);
447	($timecode) = ($data =~ /timecode=\"([^\"]+)\"/);
448	$msg .= " \"$device\" \"$timecode\"";
449    }
450    elsif ($op == 31)		# unset trap response (UNOFFICIAL op)
451    {
452	;# clear timeout
453	&debug("Clear Trap ok from ",&hostname($from));
454	&clear_timeout("refresh-".unpack("H*",$from));
455	return;
456    }
457    else			# unexpected response
458    {
459	$msg .= "unexpected response to op $op assoc=$associd";
460	$msg .= sprintf(" status=%04x",$status);
461    }
462    &log($msg);
463}
464