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