Annotation of embedaddon/ntp/scripts/monitoring/ntploopstat, revision 1.1.1.1
1.1 misho 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:
33: require "ctime.pl";
34: ;# handle bug in early ctime distributions
35: $ENV{'TZ'} = 'MET' unless defined($ENV{'TZ'}) || $] > 4.010;
36:
37: if (defined(@ctime'MoY))
38: {
39: *MonthName = *ctime'MoY;
40: }
41: else
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
48: sub 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:
61: usage:
62: $0 [-d<delay>] [-t<timeout>] [-l <logfile>] [-v] [ntpserver]
63: E-O-S
64:
65: while($_ = 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:
99: if (@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:
117: if (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: }
147: else
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
204: eval 'sub INTEL {1;}' unless defined(&INTEL);
205: eval 'sub ATT {1;}' unless defined(&ATT);
206:
207: require "sys/socket.ph";
208:
209: require '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:
215: if ($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: }
227: else
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: ;#
246: 0 && &SOCK_DGRAM; # satisfy perl -w ...
247: socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) ||
248: die("Cannot open socket: $!\n");
249:
250: bind(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:
267: undef($lasttime);
268: $lostpacket = 0;
269:
270: while(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: }
378: continue
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:
387: sub 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
429: sub 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: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>