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