182498Sroberto#!/usr/bin/perl -w 282498Sroberto# --*-perl-*- 354359Sroberto;# 454359Sroberto;# ntploopstat,v 3.1 1993/07/06 01:09:11 jbj Exp 554359Sroberto;# 654359Sroberto;# Poll NTP server using NTP mode 7 loopinfo request. 754359Sroberto;# Log info and timestamp to file for processing by ntploopwatch. 854359Sroberto;# 954359Sroberto;# 1054359Sroberto;# Copyright (c) 1992 1154359Sroberto;# Rainer Pruy Friedrich-Alexander Universitaet Erlangen-Nuernberg 1254359Sroberto;# 1354359Sroberto;################################################################# 1454359Sroberto;# 1554359Sroberto;# The format written to the logfile is the same as used by xntpd 1654359Sroberto;# for the loopstats file. 1754359Sroberto;# This script however allows to gather loop filter statistics from 1854359Sroberto;# remote servers where you do not have access to the loopstats logfile. 1954359Sroberto;# 2054359Sroberto;# Please note: Communication delays affect the accuracy of the 2154359Sroberto;# timestamps recorded. Effects from these delays will probably 2254359Sroberto;# not show up, as timestamps are recorded to the second only. 2354359Sroberto;# (Should have implemented &gettimeofday()..) 2454359Sroberto;# 2554359Sroberto 2682498Sroberto$0 =~ s!^.*/([^/]+)$!$1!; # beautify script name 2754359Sroberto 2854359Sroberto$ntpserver = 'localhost'; # default host to poll 2954359Sroberto$delay = 60; # default sampling rate 3054359Sroberto ;# keep it shorter than minpoll (=64) 3154359Sroberto ;# to get all values 3254359Sroberto 3354359Srobertorequire "ctime.pl"; 3454359Sroberto;# handle bug in early ctime distributions 3554359Sroberto$ENV{'TZ'} = 'MET' unless defined($ENV{'TZ'}) || $] > 4.010; 3654359Sroberto 3754359Srobertoif (defined(@ctime'MoY)) 3854359Sroberto{ 3954359Sroberto *MonthName = *ctime'MoY; 4054359Sroberto} 4154359Srobertoelse 4254359Sroberto{ 4354359Sroberto @MonthName = ('Jan','Feb','Mar','Apr','May','Jun', 4454359Sroberto 'Jul','Aug','Sep','Oct','Nov','Dec'); 4554359Sroberto} 4654359Sroberto 4754359Sroberto;# this routine can be redefined to point to syslog if necessary 4854359Srobertosub msg 4954359Sroberto{ 5054359Sroberto return unless $verbose; 5154359Sroberto 5254359Sroberto print STDERR "$0: "; 5354359Sroberto printf STDERR @_; 5454359Sroberto} 5554359Sroberto 5654359Sroberto;############################################################# 5754359Sroberto;# 5854359Sroberto;# process command line 5954359Sroberto$usage = <<"E-O-S"; 6054359Sroberto 6154359Srobertousage: 6254359Sroberto $0 [-d<delay>] [-t<timeout>] [-l <logfile>] [-v] [ntpserver] 6354359SrobertoE-O-S 6454359Sroberto 6554359Srobertowhile($_ = shift) 6654359Sroberto{ 6754359Sroberto /^-v(\d*)$/ && ($verbose=($1 eq '') ? 1 : $1,1) && next; 6854359Sroberto /^-d(\d*)$/ && 6954359Sroberto do { 7054359Sroberto ($1 ne '') && ($delay = $1,1) && next; 7154359Sroberto @ARGV || die("$0: delay value missing after -d\n$usage"); 7254359Sroberto $delay = shift; 7354359Sroberto ($delay >= 0) || die("$0: bad delay value \"$delay\"\n$usage"); 7454359Sroberto next; 7554359Sroberto }; 7654359Sroberto /^-l$/ && 7754359Sroberto do { 7854359Sroberto @ARGV || die("$0: logfile missing after -l\n$usage"); 7954359Sroberto $logfile = shift; 8054359Sroberto next; 8154359Sroberto }; 8254359Sroberto /^-t(\d*(\.\d*)?)$/ && 8354359Sroberto do { 8454359Sroberto ($1 ne '') && ($timeout = $1,1) && next; 8554359Sroberto @ARGV || die("$0: timeout value missing after -t\n$usage\n"); 8654359Sroberto $timeout = shift; 8754359Sroberto ($timeout > 0) || 8854359Sroberto die("$0: bad timeout value \"$timeout\"\n$usage"); 8954359Sroberto next; 9054359Sroberto }; 9154359Sroberto 9254359Sroberto /^-/ && die("$0: unknown option \"$_\"\n$usage"); 9354359Sroberto 9454359Sroberto ;# any other argument is server to poll 9554359Sroberto $ntpserver = $_; 9654359Sroberto last; 9754359Sroberto} 9854359Sroberto 9954359Srobertoif (@ARGV) 10054359Sroberto{ 10154359Sroberto warn("unexpected arguments: ".join(" ",@ARGV).".\n"); 10254359Sroberto die("$0: too many servers specified\n$usage"); 10354359Sroberto} 10454359Sroberto 10554359Sroberto;# logfile defaults to include server name 10654359Sroberto;# The name of the current month is appended and 10754359Sroberto;# the file is opened and closed for each sample. 10854359Sroberto;# 10954359Sroberto$logfile = "loopstats:$ntpserver." unless defined($logfile); 11054359Sroberto$timeout = 12.0 unless defined($timeout); # wait $timeout seconds for reply 11154359Sroberto 11254359Sroberto$MAX_FAIL = 60; # give up after $MAX_FAIL failed polls 11354359Sroberto 11454359Sroberto 11554359Sroberto$MJD_1970 = 40587; 11654359Sroberto 11754359Srobertoif (eval 'require "syscall.ph";') 11854359Sroberto{ 11954359Sroberto if (defined(&SYS_gettimeofday)) 12054359Sroberto { 12154359Sroberto ;# assume standard 12254359Sroberto ;# gettimeofday(struct timeval *tp,struct timezone *tzp) 12354359Sroberto ;# syntax for gettimeofday syscall 12454359Sroberto ;# tzp = NULL -> undef 12554359Sroberto ;# tp = (long,long) 12654359Sroberto eval 'sub time { local($tz) = pack("LL",0,0); 12754359Sroberto (&msg("gettimeofday failed: $!\n"), 12854359Sroberto return (time)) 12954359Sroberto unless syscall(&SYS_gettimeofday,$tz,undef) == 0; 13054359Sroberto local($s,$us) = unpack("LL",$tz); 13154359Sroberto return $s + $us/1000000; }'; 13254359Sroberto local($t1,$t2,$t3); 13354359Sroberto $t1 = time; 13454359Sroberto eval '$t2 = &time;'; 13554359Sroberto $t3 = time; 13654359Sroberto die("$0: gettimeofday failed: $@.\n") if defined($@) && $@; 13754359Sroberto die("$0: gettimeofday inconsistency time=$t1,gettimeofday=$t2,time=$t2\n") 13854359Sroberto if (int($t1) != int($t2) && int($t3) != int($t2)); 13954359Sroberto &msg("Using gettimeofday for timestamps\n"); 14054359Sroberto } 14154359Sroberto else 14254359Sroberto { 14354359Sroberto warn("No gettimeofday syscall found - using time builtin for timestamps\n"); 14454359Sroberto eval 'sub time { return time; }'; 14554359Sroberto } 14654359Sroberto} 14754359Srobertoelse 14854359Sroberto{ 14954359Sroberto warn("No syscall.ph file found - using time builtin for timestamps\n"); 15054359Sroberto eval 'sub time { return time; }'; 15154359Sroberto} 15254359Sroberto 15354359Sroberto 15454359Sroberto;#------------------+ 15554359Sroberto;# from ntp_request.h 15654359Sroberto;#------------------+ 15754359Sroberto 15854359Sroberto;# NTP mode 7 packet format: 15954359Sroberto;# Byte 1: ResponseBit MoreBit Version(3bit) Mode(3bit)==7 16054359Sroberto;# Byte 2: AuthBit Sequence # - 0 - 127 see MoreBit 16154359Sroberto;# Byte 3: Implementation # 16254359Sroberto;# Byte 4: Request Code 16354359Sroberto;# 16454359Sroberto;# Short 1: Err(3bit) NumItems(12bit) 16554359Sroberto;# Short 2: MBZ(3bit)=0 DataItemSize(12bit) 16654359Sroberto;# 0 - 500 byte Data 16754359Sroberto;# if AuthBit is set: 16854359Sroberto;# Long: KeyId 16954359Sroberto;# 2xLong: AuthCode 17054359Sroberto 17154359Sroberto;# 17254359Sroberto$IMPL_XNTPD = 2; 17354359Sroberto$REQ_LOOP_INFO = 8; 17454359Sroberto 17554359Sroberto 17654359Sroberto;# request packet for REQ_LOOP_INFO: 17754359Sroberto;# B1: RB=0 MB=0 V=2 M=7 17854359Sroberto;# B2: S# = 0 17954359Sroberto;# B3: I# = IMPL_XNTPD 18054359Sroberto;# B4: RC = REQ_LOOP_INFO 18154359Sroberto;# S1: E=0 NI=0 18254359Sroberto;# S2: MBZ=0 DIS=0 18354359Sroberto;# data: 32 byte 0 padding 18454359Sroberto;# 8byte timestamp if encryption, 0 padding otherwise 18554359Sroberto$loopinfo_reqpkt = 18654359Sroberto pack("CCCC nn x32 x8", 0x17, 0, $IMPL_XNTPD, $REQ_LOOP_INFO, 0, 0); 18754359Sroberto 18854359Sroberto;# ignore any auth data in packets 18954359Sroberto$loopinfo_response_size = 19054359Sroberto 1+1+1+1+2+2 # header size like request pkt 19154359Sroberto + 8 # l_fp last_offset 19254359Sroberto + 8 # l_fp drift_comp 19354359Sroberto + 4 # u_long compliance 19454359Sroberto + 4 # u_long watchdog_timer 19554359Sroberto ; 19654359Sroberto$loopinfo_response_fmt = "C4n2N2N2NN"; 19754359Sroberto$loopinfo_response_fmt_v2 = "C4n2N2N2N2N"; 19854359Sroberto 19954359Sroberto;# 20054359Sroberto;# prepare connection to server 20154359Sroberto;# 20254359Sroberto 20354359Sroberto;# workaround for broken socket.ph on dynix_ptx 20454359Srobertoeval 'sub INTEL {1;}' unless defined(&INTEL); 20554359Srobertoeval 'sub ATT {1;}' unless defined(&ATT); 20654359Sroberto 20754359Srobertorequire "sys/socket.ph"; 20854359Sroberto 20954359Srobertorequire 'netinet/in.ph'; 21054359Sroberto 21154359Sroberto;# if you do not have netinet/in.ph enable the following lines 21254359Sroberto;#eval 'sub INADDR_ANY { 0x00000000; }' unless defined(&INADDR_ANY); 21354359Sroberto;#eval 'sub IPPRORO_UDP { 17; }' unless defined(&IPPROTO_UDP); 21454359Sroberto 21554359Srobertoif ($ntpserver =~ /^((0x?)?\w+)\.((0x?)?\w+)\.((0x?)?\w+)\.((0x?)?\w+)$/) 21654359Sroberto{ 21754359Sroberto local($a,$b,$c,$d) = ($1,$3,$5,$7); 21854359Sroberto $a = oct($a) if defined($2); 21954359Sroberto $b = oct($b) if defined($4); 22054359Sroberto $c = oct($c) if defined($6); 22154359Sroberto $d = oct($d) if defined($8); 22254359Sroberto $server_addr = pack("C4", $a,$b,$c,$d); 22354359Sroberto 22454359Sroberto $server_mainname 22554359Sroberto = (gethostbyaddr($server_addr,&AF_INET))[$[] || $ntpserver; 22654359Sroberto} 22754359Srobertoelse 22854359Sroberto{ 22954359Sroberto ($server_mainname,$server_addr) 23054359Sroberto = (gethostbyname($ntpserver))[$[,$[+4]; 23154359Sroberto 23254359Sroberto die("$0: host \"$ntpserver\" is unknown\n") 23354359Sroberto unless defined($server_addr); 23454359Sroberto} 23554359Sroberto&msg ("Address of server \"$ntpserver\" is \"%d.%d.%d.%d\"\n", 23654359Sroberto unpack("C4",$server_addr)); 23754359Sroberto 23854359Sroberto$proto_udp = (getprotobyname('udp'))[$[+2] || &IPPROTO_UDP; 23954359Sroberto 24054359Sroberto$ntp_port = 24154359Sroberto (getservbyname('ntp','udp'))[$[+2] || 24254359Sroberto (warn "Could not get port number for service \"ntp/udp\" using 123\n"), 24354359Sroberto ($ntp_port=123); 24454359Sroberto 24554359Sroberto;# 24654359Sroberto0 && &SOCK_DGRAM; # satisfy perl -w ... 24754359Srobertosocket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) || 24854359Sroberto die("Cannot open socket: $!\n"); 24954359Sroberto 25054359Srobertobind(S, pack("S n N x8", &AF_INET, 0, &INADDR_ANY)) || 25154359Sroberto die("Cannot bind: $!\n"); 25254359Sroberto 25354359Sroberto($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2]; 25454359Sroberto 25554359Sroberto&msg("Listening at address %d.%d.%d.%d port %d\n", 25654359Sroberto unpack("C4",$my_addr), $my_port); 25754359Sroberto 25854359Sroberto$server_inaddr = pack("Sna4x8", &AF_INET, $ntp_port, $server_addr); 25954359Sroberto 26054359Sroberto;############################################################ 26154359Sroberto;# 26254359Sroberto;# the main loop: 26354359Sroberto;# send request 26454359Sroberto;# get reply 26554359Sroberto;# wait til next sample time 26654359Sroberto 26754359Srobertoundef($lasttime); 26854359Sroberto$lostpacket = 0; 26954359Sroberto 27054359Srobertowhile(1) 27154359Sroberto{ 27254359Sroberto $stime = &time; 27354359Sroberto 27454359Sroberto &msg("Sending request $stime...\n"); 27554359Sroberto 27654359Sroberto $ret = send(S,$loopinfo_reqpkt,0,$server_inaddr); 27754359Sroberto 27854359Sroberto if (! defined($ret) || $ret < length($loopinfo_reqpkt)) 27954359Sroberto { 28054359Sroberto warn("$0: send failed ret=($ret): $!\n"); 28154359Sroberto $fail++; 28254359Sroberto next; 28354359Sroberto } 28454359Sroberto 28554359Sroberto &msg("Waiting for reply...\n"); 28654359Sroberto 28754359Sroberto $mask = ""; vec($mask,fileno(S),1) = 1; 28854359Sroberto $ret = select($mask,undef,undef,$timeout); 28954359Sroberto 29054359Sroberto if (! defined($ret)) 29154359Sroberto { 29254359Sroberto warn("$0: select failed: $!\n"); 29354359Sroberto $fail++; 29454359Sroberto next; 29554359Sroberto } 29654359Sroberto elsif ($ret == 0) 29754359Sroberto { 29854359Sroberto warn("$0: request to $ntpserver timed out ($timeout seconds)\n"); 29954359Sroberto ;# do not count this event as failure 30054359Sroberto ;# it usually this happens due to dropped udp packets on noisy and 30154359Sroberto ;# havily loaded lines, so just try again; 30254359Sroberto $lostpacket = 1; 30354359Sroberto next; 30454359Sroberto } 30554359Sroberto 30654359Sroberto &msg("Receiving reply...\n"); 30754359Sroberto 30854359Sroberto $len = 520; # max size of a mode 7 packet 30954359Sroberto $reply = ""; # just make it defined for -w 31054359Sroberto $ret = recv(S,$reply,$len,0); 31154359Sroberto 31254359Sroberto if (!defined($ret)) 31354359Sroberto { 31454359Sroberto warn("$0: recv failed: $!\n"); 31554359Sroberto $fail++; 31654359Sroberto next; 31754359Sroberto } 31854359Sroberto 31954359Sroberto $etime = &time; 32054359Sroberto &msg("Received at\t$etime\n"); 32154359Sroberto 32254359Sroberto ;#$time = ($stime + $etime) / 2; # symmetric delay assumed 32354359Sroberto $time = $etime; # the above assumption breaks for X25 32454359Sroberto ;# so taking etime makes timestamps be a 32554359Sroberto ;# little late, but keeps them increasing 32654359Sroberto ;# monotonously 32754359Sroberto 32854359Sroberto &msg(sprintf("Reply from %d.%d.%d.%d took %f seconds\n", 32954359Sroberto (unpack("SnC4",$ret))[$[+2 .. $[+5], ($etime - $stime))); 33054359Sroberto 33154359Sroberto if ($len < $loopinfo_response_size) 33254359Sroberto { 33354359Sroberto warn("$0: short packet ($len bytes) received ($loopinfo_response_size bytes expected\n"); 33454359Sroberto $fail++; 33554359Sroberto next; 33654359Sroberto } 33754359Sroberto 33854359Sroberto ($b1,$b2,$b3,$b4,$s1,$s2, 33954359Sroberto $offset_i,$offset_f,$drift_i,$drift_f,$compl,$watchdog) 34054359Sroberto = unpack($loopinfo_response_fmt,$reply); 34154359Sroberto 34254359Sroberto ;# check reply 34354359Sroberto if (($s1 >> 12) != 0) # error ! 34454359Sroberto { 34554359Sroberto die("$0: got error reply ".($s1>>12)."\n"); 34654359Sroberto } 34754359Sroberto if (($b1 != 0x97 && $b1 != 0x9f) || # Reply NotMore V=2 M=7 34854359Sroberto ($b2 != 0 && $b2 != 0x80) || # S=0 Auth no/yes 34954359Sroberto $b3 != $IMPL_XNTPD || # ! IMPL_XNTPD 35054359Sroberto $b4 != $REQ_LOOP_INFO || # Ehh.. not loopinfo reply ? 35154359Sroberto $s1 != 1 || # ???? 35254359Sroberto ($s2 != 24 && $s2 != 28) # 35354359Sroberto ) 35454359Sroberto { 35554359Sroberto warn("$0: Bad/unexpected reply from server:\n"); 35654359Sroberto warn(" \"".unpack("H*",$reply)."\"\n"); 35754359Sroberto warn(" ".sprintf("b1=%x b2=%x b3=%x b4=%x s1=%d s2=%d\n", 35854359Sroberto $b1,$b2,$b3,$b4,$s1,$s2)); 35954359Sroberto $fail++; 36054359Sroberto next; 36154359Sroberto } 36254359Sroberto elsif ($s2 == 28) 36354359Sroberto { 36454359Sroberto ;# seems to be a version 2 xntpd 36554359Sroberto ($b1,$b2,$b3,$b4,$s1,$s2, 36654359Sroberto $offset_i,$offset_f,$drift_i,$drift_f,$compl_i,$compl_f,$watchdog) 36754359Sroberto = unpack($loopinfo_response_fmt_v2,$reply); 36854359Sroberto $compl = &lfptoa($compl_i, $compl_f); 36954359Sroberto } 37054359Sroberto 37154359Sroberto $time -= $watchdog; 37254359Sroberto 37354359Sroberto $offset = &lfptoa($offset_i, $offset_f); 37454359Sroberto $drift = &lfptoa($drift_i, $drift_f); 37554359Sroberto 37654359Sroberto &log($time,$offset,$drift,$compl) && ($fail = 0);; 37754359Sroberto} 37854359Srobertocontinue 37954359Sroberto{ 38054359Sroberto die("$0: Too many failures - terminating\n") if $fail > $MAX_FAIL; 38154359Sroberto &msg("Sleeping " . ($lostpacket ? ($delay / 2) : $delay) . " seconds...\n"); 38254359Sroberto 38354359Sroberto sleep($lostpacket ? ($delay / 2) : $delay); 38454359Sroberto $lostpacket = 0; 38554359Sroberto} 38654359Sroberto 38754359Srobertosub log 38854359Sroberto{ 38954359Sroberto local($time,$offs,$freq,$cmpl) = @_; 39054359Sroberto local($y,$m,$d); 39154359Sroberto local($fname,$suff) = ($logfile); 39254359Sroberto 39354359Sroberto 39454359Sroberto ;# silently drop sample if distance to last sample is too low 39554359Sroberto if (defined($lasttime) && ($lasttime + 2) >= $time) 39654359Sroberto { 39754359Sroberto &msg("Dropped packet - old sample\n"); 39854359Sroberto return 1; 39954359Sroberto } 40054359Sroberto 40154359Sroberto ;# $suff determines which samples end up in the same file 40254359Sroberto ;# could have used $year (;-) or WeekOfYear, DayOfYear,.... 40354359Sroberto ;# Change it to your suit... 40454359Sroberto 40554359Sroberto ($d,$m,$y) = (localtime($time))[$[+3 .. $[+5]; 40654359Sroberto $suff = sprintf("%04d%02d%02d",$y+1900,$m+1,$d); 40754359Sroberto $fname .= $suff; 40854359Sroberto if (!open(LOG,">>$fname")) 40954359Sroberto { 41054359Sroberto warn("$0: open($fname) failed: $!\n"); 41154359Sroberto $fail++; 41254359Sroberto return 0; 41354359Sroberto } 41454359Sroberto else 41554359Sroberto { 41654359Sroberto ;# file format 41754359Sroberto ;# MJD seconds offset drift compliance 41854359Sroberto printf LOG ("%d %.3lf %.8lf %.7lf %d\n", 41954359Sroberto int($time/86400)+$MJD_1970, 42054359Sroberto $time - int($time/86400) * 86400, 42154359Sroberto $offs,$freq,$cmpl); 42254359Sroberto close(LOG); 42354359Sroberto $lasttime = $time; 42454359Sroberto } 42554359Sroberto return 1; 42654359Sroberto} 42754359Sroberto 42854359Sroberto;# see ntp_fp.h to understand this 42954359Srobertosub lfptoa 43054359Sroberto{ 43154359Sroberto local($i,$f) = @_; 43254359Sroberto local($sign) = 1; 43354359Sroberto 43454359Sroberto 43554359Sroberto if ($i & 0x80000000) 43654359Sroberto { 43754359Sroberto if ($f == 0) 43854359Sroberto { 43954359Sroberto $i = -$i; 44054359Sroberto } 44154359Sroberto else 44254359Sroberto { 44354359Sroberto $f = -$f; 44454359Sroberto $i = ~$i; 44554359Sroberto $i += 1; # 2s complement 44654359Sroberto } 44754359Sroberto $sign = -1; 44854359Sroberto ;#print "NEG: $i $f\n"; 44954359Sroberto } 45054359Sroberto else 45154359Sroberto { 45254359Sroberto ;#print "POS: $i $f\n"; 45354359Sroberto } 45454359Sroberto ;# unlike xntpd I have perl do the dirty work. 45554359Sroberto ;# Using floats here may affect precision, but 45654359Sroberto ;# currently these bits aren't significant anyway 45754359Sroberto return $sign * ($i + $f/2**32); 45854359Sroberto} 459