1#! /usr/local/bin/perl -w 2# 3 4# John Hay -- John.Hay@icomtek.csir.co.za / jhay@FreeBSD.org 5 6use Socket; 7use Getopt::Std; 8use vars qw($opt_n); 9 10$ntpq = "ntpq"; 11 12getopts('n'); 13 14$dodns = 1; 15$dodns = 0 if (defined($opt_n)); 16 17$host = shift; 18$host ||= "127.0.0.1"; 19 20for (;;) { 21 $stratum = 255; 22 $cmd = "$ntpq -n -c rv $host"; 23 open(PH, $cmd . "|") || die "failed to start command $cmd: $!"; 24 while (<PH>) { 25 $stratum = $1 if (/stratum=(\d+)/); 26 $peer = $1 if (/peer=(\d+)/); 27 # Very old servers report phase and not offset. 28 $offset = $1 if (/(?:offset|phase)=([^\s,]+)/); 29 $rootdelay = $1 if (/rootdelay=([^\s,]+)/); 30 $refid = $1 if (/refid=([^\s,]+)/); 31 } 32 close(PH) || die "$cmd failed"; 33 last if ($stratum == 255); 34 $offset /= 1000; 35 $rootdelay /= 1000; 36 $dhost = $host; 37 # Only do lookups of IPv4 addresses. The standard lookup functions 38 # of perl only do IPv4 and I don't know if we should require extras. 39 if ($dodns && $host =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) { 40 $iaddr = inet_aton($host); 41 $name = (gethostbyaddr($iaddr, AF_INET))[0]; 42 $dhost = $name if (defined($name)); 43 } 44 printf("%s: stratum %d, offset %f, root distance %f", 45 $dhost, $stratum, $offset, $rootdelay); 46 printf(", refid '%s'", $refid) if ($stratum == 1); 47 printf("\n"); 48 last if ($stratum == 0 || $stratum == 1 || $stratum == 16); 49 last if ($refid =~ /^127\.127\.\d{1,3}\.\d{1,3}$/); 50 51 $cmd = "$ntpq -n -c \"pstat $peer\" $host"; 52 open(PH, $cmd . "|") || die "failed to start command $cmd: $!"; 53 $thost = ""; 54 while (<PH>) { 55 $thost = $1, last if (/srcadr=(\S+),/); 56 } 57 close(PH) || die "$cmd failed"; 58 last if ($thost eq ""); 59 $host = $thost; 60} 61 62