usr.sbin/ntp/scripts/ntptrace

   1 #! /usr/local/bin/perl -w
   2 #
   3 # $FreeBSD$
   4
   5 # John Hay -- John.Hay@icomtek.csir.co.za / jhay@FreeBSD.org
   6
   7 use Socket;
   8 use Getopt::Std;
   9 use vars qw($opt_n);
  10
  11 $ntpq = "ntpq";
  12
  13 getopts('n');
  14
  15 $dodns = 1;
  16 $dodns = 0 if (defined($opt_n));
  17
  18 $host = shift;
  19 $host ||= "127.0.0.1";
  20
  21 for (;;) {
  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