contrib/ntp/scripts/monitoring/ntploopstat

   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 }