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 | |
---|
32 | require "ctime.pl"; |
---|
33 | ;# handle bug in early ctime distributions |
---|
34 | $ENV{'TZ'} = 'MET' unless defined($ENV{'TZ'}) || $] > 4.010; |
---|
35 | |
---|
36 | if (defined(@ctime'MoY)) |
---|
37 | { |
---|
38 | *MonthName = *ctime'MoY; |
---|
39 | } |
---|
40 | else |
---|
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 |
---|
47 | sub 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 | |
---|
60 | usage: |
---|
61 | $0 [-d<delay>] [-t<timeout>] [-l <logfile>] [-v] [ntpserver] |
---|
62 | E-O-S |
---|
63 | |
---|
64 | while($_ = 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 | |
---|
98 | if (@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 | |
---|
116 | if (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 | } |
---|
146 | else |
---|
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 |
---|
203 | eval 'sub INTEL {1;}' unless defined(&INTEL); |
---|
204 | eval 'sub ATT {1;}' unless defined(&ATT); |
---|
205 | |
---|
206 | require "sys/socket.ph"; |
---|
207 | |
---|
208 | require '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 | |
---|
214 | if ($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 | } |
---|
226 | else |
---|
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 | ;# |
---|
245 | 0 && &SOCK_DGRAM; # satisfy perl -w ... |
---|
246 | socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) || |
---|
247 | die("Cannot open socket: $!\n"); |
---|
248 | |
---|
249 | bind(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 | |
---|
266 | undef($lasttime); |
---|
267 | $lostpacket = 0; |
---|
268 | |
---|
269 | while(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 | } |
---|
377 | continue |
---|
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 | |
---|
386 | sub 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 |
---|
428 | sub 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 | } |
---|