1132458Sroberto#! /usr/local/bin/perl -w 2132458Sroberto# 3132458Sroberto# $FreeBSD$ 4132458Sroberto 5132458Sroberto# John Hay -- John.Hay@icomtek.csir.co.za / jhay@FreeBSD.org 6132458Sroberto 7132458Srobertouse Socket; 8132458Srobertouse Getopt::Std; 9132458Srobertouse vars qw($opt_n); 10132458Sroberto 11132458Sroberto$ntpq = "ntpq"; 12132458Sroberto 13132458Srobertogetopts('n'); 14132458Sroberto 15132458Sroberto$dodns = 1; 16132458Sroberto$dodns = 0 if (defined($opt_n)); 17132458Sroberto 18132458Sroberto$host = shift; 19132458Sroberto$host ||= "127.0.0.1"; 20132458Sroberto 21132458Srobertofor (;;) { 22132458Sroberto $stratum = 255; 23132458Sroberto $cmd = "$ntpq -n -c rv $host"; 24132458Sroberto open(PH, $cmd . "|") || die "failed to start command $cmd: $!"; 25132458Sroberto while (<PH>) { 26132458Sroberto $stratum = $1 if (/stratum=(\d+)/); 27132458Sroberto $peer = $1 if (/peer=(\d+)/); 28132458Sroberto # Very old servers report phase and not offset. 29132458Sroberto $offset = $1 if (/(?:offset|phase)=([^\s,]+)/); 30132458Sroberto $rootdelay = $1 if (/rootdelay=([^\s,]+)/); 31132458Sroberto $refid = $1 if (/refid=([^\s,]+)/); 32132458Sroberto } 33132458Sroberto close(PH) || die "$cmd failed"; 34132458Sroberto last if ($stratum == 255); 35132458Sroberto $offset /= 1000; 36132458Sroberto $rootdelay /= 1000; 37132458Sroberto $dhost = $host; 38132458Sroberto # Only do lookups of IPv4 addresses. The standard lookup functions 39132458Sroberto # of perl only do IPv4 and I don't know if we should require extras. 40132458Sroberto if ($dodns && $host =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) { 41132458Sroberto $iaddr = inet_aton($host); 42132458Sroberto $name = (gethostbyaddr($iaddr, AF_INET))[0]; 43132458Sroberto $dhost = $name if (defined($name)); 44132458Sroberto } 45132458Sroberto printf("%s: stratum %d, offset %f, root distance %f", 46132458Sroberto $dhost, $stratum, $offset, $rootdelay); 47132458Sroberto printf(", refid '%s'", $refid) if ($stratum == 1); 48132458Sroberto printf("\n"); 49132458Sroberto last if ($stratum == 0 || $stratum == 1 || $stratum == 16); 50132458Sroberto last if ($refid =~ /^127\.127\.\d{1,3}\.\d{1,3}$/); 51132458Sroberto 52132458Sroberto $cmd = "$ntpq -n -c \"pstat $peer\" $host"; 53132458Sroberto open(PH, $cmd . "|") || die "failed to start command $cmd: $!"; 54132458Sroberto $thost = ""; 55132458Sroberto while (<PH>) { 56132458Sroberto $thost = $1, last if (/srcadr=(\S+),/); 57132458Sroberto } 58132458Sroberto close(PH) || die "$cmd failed"; 59132458Sroberto last if ($thost eq ""); 60132458Sroberto $host = $thost; 61132458Sroberto} 62132458Sroberto 63