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