File:  [ELWIX - Embedded LightWeight unIX -] / embedaddon / ntp / scripts / monitoring / ntploopstat
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs - revision graph
Tue May 29 12:08:38 2012 UTC (12 years, 1 month ago) by misho
Branches: ntp, MAIN
CVS tags: v4_2_6p5p0, v4_2_6p5, HEAD
ntp 4.2.6p5

    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>