ntploopstat revision 290001 
1#!/usr/bin/perl -w
2# --*-perl-*-
3;#
4;# ntploopstat,v 3.1 1993/07/06 01:09:11 jbj Exp
5;# 
6;# Poll NTP server using NTP mode 7 loopinfo request.
7;# Log info and timestamp to file for processing by ntploopwatch.
8;#
9;#
10;# Copyright (c) 1992
11;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg
12;#
13;#################################################################
14;#
15;# The format written to the logfile is the same as used by xntpd
16;# for the loopstats file.
17;# This script however allows to gather loop filter statistics from
18;# remote servers where you do not have access to the loopstats logfile.
19;#
20;# Please note: Communication delays affect the accuracy of the
21;#              timestamps recorded. Effects from these delays will probably
22;#              not show up, as timestamps are recorded to the second only.
23;#              (Should have implemented &gettimeofday()..)
24;#
25
26$0 =~ s!^.*/([^/]+)$!$1!;		# beautify script name
27
28$ntpserver = 'localhost';		# default host to poll
29$delay = 60;				# default sampling rate
30				       ;# keep it shorter than minpoll (=64)
31				       ;# to get all values
32
33require "ctime.pl";
34;# handle bug in early ctime distributions
35$ENV{'TZ'} = 'MET' unless defined($ENV{'TZ'}) || $] > 4.010;
36
37if (defined(@ctime'MoY))
38{
39    *MonthName = *ctime'MoY;
40}
41else
42{
43    @MonthName = ('Jan','Feb','Mar','Apr','May','Jun',
44		  'Jul','Aug','Sep','Oct','Nov','Dec');
45}
46
47;# this routine can be redefined to point to syslog if necessary
48sub msg
49{
50    return unless $verbose;
51
52    print  STDERR "$0: ";
53    printf STDERR @_;
54}
55
56;#############################################################
57;#
58;# process command line
59$usage = <<"E-O-S";
60
61usage:
62  $0 [-d<delay>] [-t<timeout>] [-l <logfile>] [-v] [ntpserver]
63E-O-S
64
65while($_ = shift)
66{
67    /^-v(\d*)$/ && ($verbose=($1 eq '') ? 1 : $1,1) && next;
68    /^-d(\d*)$/ &&
69	do {
70	    ($1 ne '') && ($delay = $1,1) && next;
71	    @ARGV || die("$0: delay value missing after -d\n$usage");
72	    $delay = shift;
73	    ($delay  >= 0) || die("$0: bad delay value \"$delay\"\n$usage");
74	    next;
75	};
76    /^-l$/ &&
77	do {
78	    @ARGV || die("$0: logfile missing after -l\n$usage");
79	    $logfile = shift;
80	    next;
81	};
82    /^-t(\d*(\.\d*)?)$/ &&
83	do {
84	    ($1 ne '') && ($timeout = $1,1) && next;
85	    @ARGV || die("$0: timeout value missing after -t\n$usage\n");
86	    $timeout = shift;
87	    ($timeout > 0) ||
88		die("$0: bad timeout value \"$timeout\"\n$usage");
89	    next;
90	};
91    
92    /^-/ && die("$0: unknown option \"$_\"\n$usage");
93
94    ;# any other argument is server to poll
95    $ntpserver = $_;
96    last;
97}
98
99if (@ARGV)
100{
101    warn("unexpected arguments: ".join(" ",@ARGV).".\n");
102    die("$0: too many servers specified\n$usage");
103}
104
105;# logfile defaults to include server name
106;# The name of the current month is appended and
107;# the file is opened and closed for each sample.
108;#
109$logfile = "loopstats:$ntpserver." unless defined($logfile);
110$timeout = 12.0 unless defined($timeout); # wait $timeout seconds for reply
111
112$MAX_FAIL = 60;				# give up after $MAX_FAIL failed polls
113
114
115$MJD_1970 = 40587;
116
117if (eval 'require "syscall.ph";')
118{
119    if (defined(&SYS_gettimeofday))
120    {
121	;# assume standard
122 	;# gettimeofday(struct timeval *tp,struct timezone *tzp)
123	;# syntax for gettimeofday syscall
124 	;# tzp = NULL -> undef
125	;# tp = (long,long)
126	eval 'sub time { local($tz) = pack("LL",0,0);
127              (&msg("gettimeofday failed: $!\n"),
128	      return (time))
129	      unless syscall(&SYS_gettimeofday,$tz,undef) == 0;
130              local($s,$us) = unpack("LL",$tz);
131              return $s + $us/1000000; }';
132	local($t1,$t2,$t3);
133	$t1 = time;
134	eval '$t2 = &time;';
135	$t3 = time;
136	die("$0: gettimeofday failed: $@.\n") if defined($@) && $@;
137	die("$0: gettimeofday inconsistency time=$t1,gettimeofday=$t2,time=$t2\n")
138	    if (int($t1) != int($t2) && int($t3) != int($t2));
139	&msg("Using gettimeofday for timestamps\n");
140    }
141    else
142    {
143	warn("No gettimeofday syscall found - using time builtin for timestamps\n");
144        eval 'sub time { return time; }';
145    }
146}
147else
148{
149    warn("No syscall.ph file found - using time builtin for timestamps\n");
150    eval 'sub time { return time; }';
151}
152
153
154;#------------------+
155;# from ntp_request.h
156;#------------------+
157
158;# NTP mode 7 packet format:
159;#	Byte 1:     ResponseBit MoreBit Version(3bit) Mode(3bit)==7
160;#      Byte 2:     AuthBit Sequence #   - 0 - 127 see MoreBit
161;#      Byte 3:     Implementation #
162;#      Byte 4:     Request Code
163;#
164;#      Short 1:    Err(3bit) NumItems(12bit)
165;#      Short 2:    MBZ(3bit)=0 DataItemSize(12bit)
166;#      0 - 500 byte Data 
167;#  if AuthBit is set:
168;#      Long:       KeyId
169;#      2xLong:     AuthCode
170
171;# 
172$IMPL_XNTPD  = 2;
173$REQ_LOOP_INFO = 8;
174
175
176;# request packet for REQ_LOOP_INFO:
177;#     B1:  RB=0 MB=0 V=2 M=7 
178;#     B2:  S# = 0
179;#     B3:  I# = IMPL_XNTPD
180;#     B4:  RC = REQ_LOOP_INFO
181;#     S1:  E=0 NI=0
182;#     S2:  MBZ=0 DIS=0
183;#     data:  32 byte 0 padding
184;#            8byte timestamp if encryption, 0 padding otherwise
185$loopinfo_reqpkt = 
186    pack("CCCC nn x32 x8", 0x17, 0, $IMPL_XNTPD, $REQ_LOOP_INFO, 0, 0);
187
188;# ignore any auth data in packets
189$loopinfo_response_size =
190    1+1+1+1+2+2			# header size like request pkt
191    + 8				# l_fp last_offset
192    + 8				# l_fp drift_comp
193    + 4				# u_long compliance
194    + 4				# u_long watchdog_timer
195    ;
196$loopinfo_response_fmt    = "C4n2N2N2NN"; 
197$loopinfo_response_fmt_v2 = "C4n2N2N2N2N"; 
198
199;#
200;# prepare connection to server
201;# 
202
203;# workaround for broken socket.ph on dynix_ptx
204eval 'sub INTEL {1;}' unless defined(&INTEL);
205eval 'sub ATT {1;}'  unless defined(&ATT);
206
207require "sys/socket.ph";
208
209require 'netinet/in.ph';
210
211;# if you do not have netinet/in.ph enable the following lines
212;#eval 'sub INADDR_ANY { 0x00000000; }' unless defined(&INADDR_ANY);
213;#eval 'sub IPPRORO_UDP { 17; }' unless defined(&IPPROTO_UDP);
214
215if ($ntpserver =~ /^((0x?)?\w+)\.((0x?)?\w+)\.((0x?)?\w+)\.((0x?)?\w+)$/)
216{
217    local($a,$b,$c,$d) = ($1,$3,$5,$7);
218    $a = oct($a) if defined($2);
219    $b = oct($b) if defined($4);
220    $c = oct($c) if defined($6);
221    $d = oct($d) if defined($8);
222    $server_addr = pack("C4", $a,$b,$c,$d);
223
224    $server_mainname
225	= (gethostbyaddr($server_addr,&AF_INET))[$[] || $ntpserver;
226}
227else
228{
229    ($server_mainname,$server_addr)
230	= (gethostbyname($ntpserver))[$[,$[+4];
231
232    die("$0: host \"$ntpserver\" is unknown\n")
233	unless defined($server_addr);
234}
235&msg ("Address of server \"$ntpserver\" is \"%d.%d.%d.%d\"\n",
236      unpack("C4",$server_addr));
237
238$proto_udp = (getprotobyname('udp'))[$[+2] || &IPPROTO_UDP;
239 
240$ntp_port =
241    (getservbyname('ntp','udp'))[$[+2] ||
242    (warn "Could not get port number for service \"ntp/udp\" using 123\n"),
243    ($ntp_port=123);
244 
245;# 
2460 && &SOCK_DGRAM;		# satisfy perl -w ...
247socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) ||
248    die("Cannot open socket: $!\n");
249
250bind(S, pack("S n N x8", &AF_INET, 0, &INADDR_ANY)) ||
251    die("Cannot bind: $!\n");
252 
253($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2];
254
255&msg("Listening at address %d.%d.%d.%d port %d\n",
256     unpack("C4",$my_addr), $my_port);
257
258$server_inaddr = pack("Sna4x8", &AF_INET, $ntp_port, $server_addr);
259
260;############################################################
261;#
262;# the main loop:
263;#	send request
264;#      get reply
265;#      wait til next sample time
266
267undef($lasttime);
268$lostpacket = 0;
269
270while(1)
271{
272    $stime = &time;
273
274    &msg("Sending request $stime...\n");
275
276    $ret = send(S,$loopinfo_reqpkt,0,$server_inaddr);
277
278    if (! defined($ret) || $ret < length($loopinfo_reqpkt))
279    {
280	warn("$0: send failed ret=($ret): $!\n");
281	$fail++;
282	next;
283    }
284
285    &msg("Waiting for reply...\n");
286
287    $mask = ""; vec($mask,fileno(S),1) = 1;
288    $ret = select($mask,undef,undef,$timeout);
289
290    if (! defined($ret))
291    {
292	warn("$0: select failed: $!\n");
293	$fail++;
294	next;
295    }
296    elsif ($ret == 0)
297    {
298	warn("$0: request to $ntpserver timed out ($timeout seconds)\n");
299	;# do not count this event as failure
300	;# it usually this happens due to dropped udp packets on noisy and
301	;# havily loaded lines, so just try again;
302	$lostpacket = 1;
303	next;
304    }
305
306    &msg("Receiving reply...\n");
307
308    $len = 520;				# max size of a mode 7 packet
309    $reply = "";			# just make it defined for -w
310    $ret = recv(S,$reply,$len,0);
311
312    if (!defined($ret))
313    {
314	warn("$0: recv failed: $!\n");
315	$fail++;
316	next;
317    }
318
319    $etime = &time;
320    &msg("Received at\t$etime\n");
321
322    ;#$time = ($stime + $etime) / 2; # symmetric delay assumed
323    $time = $etime;		# the above assumption breaks for X25
324			       ;# so taking etime makes timestamps be a
325			       ;# little late, but keeps them increasing
326			       ;# monotonously
327
328    &msg(sprintf("Reply from %d.%d.%d.%d took %f seconds\n",
329		 (unpack("SnC4",$ret))[$[+2 .. $[+5], ($etime - $stime)));
330
331    if ($len < $loopinfo_response_size)
332    {
333	warn("$0: short packet ($len bytes) received ($loopinfo_response_size bytes expected\n");
334	$fail++;
335	next;
336    }
337    
338    ($b1,$b2,$b3,$b4,$s1,$s2,
339     $offset_i,$offset_f,$drift_i,$drift_f,$compl,$watchdog)
340	= unpack($loopinfo_response_fmt,$reply);
341
342    ;# check reply
343    if (($s1 >> 12) != 0)	      # error !
344    {
345	die("$0: got error reply ".($s1>>12)."\n");
346    }
347    if (($b1 != 0x97 && $b1 != 0x9f) || # Reply NotMore V=2 M=7
348	($b2 != 0 && $b2 != 0x80) ||	# S=0 Auth no/yes
349	$b3 != $IMPL_XNTPD ||		# ! IMPL_XNTPD
350	$b4 != $REQ_LOOP_INFO ||	# Ehh.. not loopinfo reply ?
351	$s1 != 1 ||			# ????
352	($s2 != 24 && $s2 != 28)	# 
353	)
354    {
355	warn("$0: Bad/unexpected reply from server:\n");
356	warn("  \"".unpack("H*",$reply)."\"\n");
357	warn("   ".sprintf("b1=%x b2=%x b3=%x b4=%x s1=%d s2=%d\n",
358			   $b1,$b2,$b3,$b4,$s1,$s2));
359	$fail++;
360	next;
361    }
362    elsif ($s2 == 28)
363    {
364      ;# seems to be a version 2 xntpd
365      ($b1,$b2,$b3,$b4,$s1,$s2,
366       $offset_i,$offset_f,$drift_i,$drift_f,$compl_i,$compl_f,$watchdog)
367	  = unpack($loopinfo_response_fmt_v2,$reply);
368      $compl = &lfptoa($compl_i, $compl_f);
369    }
370
371    $time -= $watchdog;
372
373    $offset = &lfptoa($offset_i, $offset_f);
374    $drift  = &lfptoa($drift_i, $drift_f);
375
376    &log($time,$offset,$drift,$compl) && ($fail = 0);;
377}
378continue
379{
380    die("$0: Too many failures - terminating\n") if $fail > $MAX_FAIL;
381    &msg("Sleeping " . ($lostpacket ? ($delay / 2) : $delay) . " seconds...\n");
382
383    sleep($lostpacket ? ($delay / 2) : $delay);
384    $lostpacket = 0;
385}
386
387sub log
388{
389    local($time,$offs,$freq,$cmpl) = @_;
390    local($y,$m,$d);
391    local($fname,$suff) = ($logfile);
392
393
394    ;# silently drop sample if distance to last sample is too low
395    if (defined($lasttime) && ($lasttime + 2) >= $time)
396    {
397      &msg("Dropped packet - old sample\n");
398      return 1;
399    }
400
401    ;# $suff determines which samples end up in the same file
402    ;# could have used $year (;-) or WeekOfYear, DayOfYear,....
403    ;# Change it to your suit...
404
405    ($d,$m,$y) = (localtime($time))[$[+3 .. $[+5];
406    $suff = sprintf("%04d%02d%02d",$y+1900,$m+1,$d);
407    $fname .= $suff;
408    if (!open(LOG,">>$fname"))
409    {
410	warn("$0: open($fname) failed: $!\n");
411	$fail++;
412	return 0;
413    }
414    else
415    {
416	;# file format
417	;#          MJD seconds offset drift compliance
418	printf LOG ("%d %.3lf %.8lf %.7lf %d\n",
419		    int($time/86400)+$MJD_1970,
420		    $time - int($time/86400) * 86400,
421		    $offs,$freq,$cmpl);
422	close(LOG);
423	$lasttime = $time;
424    }
425    return 1;
426}
427
428;# see ntp_fp.h to understand this
429sub lfptoa
430{
431    local($i,$f) = @_;
432    local($sign) = 1;
433
434    
435    if ($i & 0x80000000)
436    {
437	if ($f == 0)
438	{
439	    $i = -$i;
440	}
441	else
442	{
443	    $f = -$f;
444	    $i = ~$i;
445	    $i += 1;			# 2s complement
446	}
447	$sign = -1;
448	;#print "NEG: $i $f\n";
449    }
450    else
451    {
452	;#print "POS: $i $f\n";
453    }
454    ;# unlike xntpd I have perl do the dirty work.
455    ;# Using floats here may affect precision, but
456    ;# currently these bits aren't significant anyway
457    return $sign * ($i + $f/2**32);    
458}
459