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 } 459
Indexes created Thu Apr 23 00:23:13 UTC 2026