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>