contrib/ntp/scripts/monitoring/ntploopstat

   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 }