;;;;;;;;;;;;;;;;;;;;;;
$0 =~ s!^.*/([^/]+)$!\1!;
$ntpserver = 'localhost'; $delay = 60; ; ;
require "ctime.pl";
;$ENV{'TZ'} = 'MET' unless defined($ENV{'TZ'}) || $] > 4.010;
if (defined(@ctime'MoY))
{
*MonthName = *ctime'MoY;
}
else
{
@MonthName = ('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
}
;sub msg
{
return unless $verbose;
print STDERR "$0: ";
printf STDERR @_;
}
;;;$usage = <<"E-O-S";
usage:
$0 [-d<delay>] [-t<timeout>] [-l <logfile>] [-v] [ntpserver]
E-O-S
while($_ = shift)
{
/^-v(\d*)$/ && ($verbose=($1 eq '') ? 1 : $1,1) && next;
/^-d(\d*)$/ &&
do {
($1 ne '') && ($delay = $1,1) && next;
@ARGV || die("$0: delay value missing after -d\n$usage");
$delay = shift;
($delay >= 0) || die("$0: bad delay value \"$delay\"\n$usage");
next;
};
/^-l$/ &&
do {
@ARGV || die("$0: logfile missing after -l\n$usage");
$logfile = shift;
next;
};
/^-t(\d*(\.\d*)?)$/ &&
do {
($1 ne '') && ($timeout = $1,1) && next;
@ARGV || die("$0: timeout value missing after -t\n$usage\n");
$timeout = shift;
($timeout > 0) ||
die("$0: bad timeout value \"$timeout\"\n$usage");
next;
};
/^-/ && die("$0: unknown option \"$_\"\n$usage");
; $ntpserver = $_;
last;
}
if (@ARGV)
{
warn("unexpected arguments: ".join(" ",@ARGV).".\n");
die("$0: too many servers specified\n$usage");
}
;;;;$logfile = "loopstats:$ntpserver." unless defined($logfile);
$timeout = 12.0 unless defined($timeout);
$MAX_FAIL = 60;
$MJD_1970 = 40587;
if (eval 'require "syscall.ph";')
{
if (defined(&SYS_gettimeofday))
{
; ; ; ; ; eval 'sub time { local($tz) = pack("LL",0,0);
(&msg("gettimeofday failed: $!\n"),
return (time))
unless syscall(&SYS_gettimeofday,$tz,undef) == 0;
local($s,$us) = unpack("LL",$tz);
return $s + $us/1000000; }';
local($t1,$t2,$t3);
$t1 = time;
eval '$t2 = &time;';
$t3 = time;
die("$0: gettimeofday failed: $@.\n") if defined($@) && $@;
die("$0: gettimeofday inconsistency time=$t1,gettimeofday=$t2,time=$t2\n")
if (int($t1) != int($t2) && int($t3) != int($t2));
&msg("Using gettimeofday for timestamps\n");
}
else
{
warn("No gettimeofday syscall found - using time builtin for timestamps\n");
eval 'sub time { return time; }';
}
}
else
{
warn("No syscall.ph file found - using time builtin for timestamps\n");
eval 'sub time { return time; }';
}
;;;
;;;;;;;;;;;;
;$IMPL_XNTPD = 2;
$REQ_LOOP_INFO = 8;
;;;;;;;;;$loopinfo_reqpkt =
pack("CCCC nn x32 x8", 0x17, 0, $IMPL_XNTPD, $REQ_LOOP_INFO, 0, 0);
;$loopinfo_response_size =
1+1+1+1+2+2 + 8 + 8 + 4 + 4 ;
$loopinfo_response_fmt = "C4n2N2N2NN";
$loopinfo_response_fmt_v2 = "C4n2N2N2N2N";
;;;
;eval 'sub INTEL {1;}' unless defined(&INTEL);
eval 'sub ATT {1;}' unless defined(&ATT);
require "sys/socket.ph";
require 'netinet/in.ph';
;;;
if ($ntpserver =~ /^((0x?)?\w+)\.((0x?)?\w+)\.((0x?)?\w+)\.((0x?)?\w+)$/)
{
local($a,$b,$c,$d) = ($1,$3,$5,$7);
$a = oct($a) if defined($2);
$b = oct($b) if defined($4);
$c = oct($c) if defined($6);
$d = oct($d) if defined($8);
$server_addr = pack("C4", $a,$b,$c,$d);
$server_mainname
= (gethostbyaddr($server_addr,&AF_INET))[$[] || $ntpserver;
}
else
{
($server_mainname,$server_addr)
= (gethostbyname($ntpserver))[$[,$[+4];
die("$0: host \"$ntpserver\" is unknown\n")
unless defined($server_addr);
}
&msg ("Address of server \"$ntpserver\" is \"%d.%d.%d.%d\"\n",
unpack("C4",$server_addr));
$proto_udp = (getprotobyname('udp'))[$[+2] || &IPPROTO_UDP;
$ntp_port =
(getservbyname('ntp','udp'))[$[+2] ||
(warn "Could not get port number for service \"ntp/udp\" using 123\n"),
($ntp_port=123);
;0 && &SOCK_DGRAM; socket(S, &AF_INET, &SOCK_DGRAM, $proto_udp) ||
die("Cannot open socket: $!\n");
bind(S, pack("S n N x8", &AF_INET, 0, &INADDR_ANY)) ||
die("Cannot bind: $!\n");
($my_port, $my_addr) = (unpack("S n a4 x8",getsockname(S)))[$[+1,$[+2];
&msg("Listening at address %d.%d.%d.%d port %d\n",
unpack("C4",$my_addr), $my_port);
$server_inaddr = pack("Sna4x8", &AF_INET, $ntp_port, $server_addr);
;;;;;;
undef($lasttime);
$lostpacket = 0;
while(1)
{
$stime = &time;
&msg("Sending request $stime...\n");
$ret = send(S,$loopinfo_reqpkt,0,$server_inaddr);
if (! defined($ret) || $ret < length($loopinfo_reqpkt))
{
warn("$0: send failed ret=($ret): $!\n");
$fail++;
next;
}
&msg("Waiting for reply...\n");
$mask = ""; vec($mask,fileno(S),1) = 1;
$ret = select($mask,undef,undef,$timeout);
if (! defined($ret))
{
warn("$0: select failed: $!\n");
$fail++;
next;
}
elsif ($ret == 0)
{
warn("$0: request to $ntpserver timed out ($timeout seconds)\n");
; ; ; $lostpacket = 1;
next;
}
&msg("Receiving reply...\n");
$len = 520; $reply = ""; $ret = recv(S,$reply,$len,0);
if (!defined($ret))
{
warn("$0: recv failed: $!\n");
$fail++;
next;
}
$etime = &time;
&msg("Received at\t$etime\n");
; $time = $etime; ; ; ;
&msg(sprintf("Reply from %d.%d.%d.%d took %f seconds\n",
(unpack("SnC4",$ret))[$[+2 .. $[+5], ($etime - $stime)));
if ($len < $loopinfo_response_size)
{
warn("$0: short packet ($len bytes) received ($loopinfo_response_size bytes expected\n");
$fail++;
next;
}
($b1,$b2,$b3,$b4,$s1,$s2,
$offset_i,$offset_f,$drift_i,$drift_f,$compl,$watchdog)
= unpack($loopinfo_response_fmt,$reply);
; if (($s1 >> 12) != 0) {
die("$0: got error reply ".($s1>>12)."\n");
}
if (($b1 != 0x97 && $b1 != 0x9f) || ($b2 != 0 && $b2 != 0x80) || $b3 != $IMPL_XNTPD || $b4 != $REQ_LOOP_INFO || $s1 != 1 || ($s2 != 24 && $s2 != 28) )
{
warn("$0: Bad/unexpected reply from server:\n");
warn(" \"".unpack("H*",$reply)."\"\n");
warn(" ".sprintf("b1=%x b2=%x b3=%x b4=%x s1=%d s2=%d\n",
$b1,$b2,$b3,$b4,$s1,$s2));
$fail++;
next;
}
elsif ($s2 == 28)
{
; ($b1,$b2,$b3,$b4,$s1,$s2,
$offset_i,$offset_f,$drift_i,$drift_f,$compl_i,$compl_f,$watchdog)
= unpack($loopinfo_response_fmt_v2,$reply);
$compl = &lfptoa($compl_i, $compl_f);
}
$time -= $watchdog;
$offset = &lfptoa($offset_i, $offset_f);
$drift = &lfptoa($drift_i, $drift_f);
&log($time,$offset,$drift,$compl) && ($fail = 0);;
}
continue
{
die("$0: Too many failures - terminating\n") if $fail > $MAX_FAIL;
&msg("Sleeping " . ($lostpacket ? ($delay / 2) : $delay) . " seconds...\n");
sleep($lostpacket ? ($delay / 2) : $delay);
$lostpacket = 0;
}
sub log
{
local($time,$offs,$freq,$cmpl) = @_;
local($y,$m,$d);
local($fname,$suff) = ($logfile);
; if (defined($lasttime) && ($lasttime + 2) >= $time)
{
&msg("Dropped packet - old sample\n");
return 1;
}
; ; ;
($d,$m,$y) = (localtime($time))[$[+3 .. $[+5];
$suff = sprintf("%04d%02d%02d",$y+1900,$m+1,$d);
$fname .= $suff;
if (!open(LOG,">>$fname"))
{
warn("$0: open($fname) failed: $!\n");
$fail++;
return 0;
}
else
{
; ; printf LOG ("%d %.3lf %.8lf %.7lf %d\n",
int($time/86400)+$MJD_1970,
$time - int($time/86400) * 86400,
$offs,$freq,$cmpl);
close(LOG);
$lasttime = $time;
}
return 1;
}
;sub lfptoa
{
local($i,$f) = @_;
local($sign) = 1;
if ($i & 0x80000000)
{
if ($f == 0)
{
$i = -$i;
}
else
{
$f = -$f;
$i = ~$i;
$i += 1; }
$sign = -1;
; }
else
{
; }
; ; ; return $sign * ($i + $f/2**32);
}