contrib/ntp/scripts/ntptrace/ntptrace.in

   1 #! @PATH_PERL@ -w
   2 # John Hay -- John.Hay@icomtek.csir.co.za / jhay@FreeBSD.org
   3
   4 package ntptrace;
   5 use 5.006_000;
   6 use strict;
   7 use lib "@PERLLIBDIR@";
   8 use NTP::Util qw(ntp_read_vars do_dns);
   9
  10 exit run(@ARGV) unless caller;
  11
  12 sub run {
  13     my $opts;
  14     if (!processOptions(\@_, $opts)) {
  15         usage(1);
  16     };
  17
  18     my $dodns     = $opts->{numeric} ? 0 : 1;
  19     my $max_hosts = $opts->{'max-hosts'};
  20     my $host      = shift || $opts->{host};
  21     my $nb_host   = 0;
  22
  23     for (;;) {
  24         $nb_host++;
  25
  26         my %info = get_info($host);
  27         last if not %info;
  28
  29         my $dhost = $host;
  30         if ($dodns) {
  31             my $name = do_dns($host);
  32             $dhost = $name if defined $name;
  33         }
  34
  35         printf "%s: stratum %d, offset %f, synch distance %f",
  36             $dhost, $info{stratum}, $info{offset}, $info{syncdistance};
  37         printf ", refid '%s'", $info{refid} if $info{stratum} == 1;
  38         print "\n";
  39
  40         last if $info{stratum} == 0 || $info{stratum} == 1 ||
  41                 $info{stratum} == 16;
  42         last if $info{refid} =~ /^127\.127\.\d{1,3}\.\d{1,3}$/;
  43         last if $nb_host == $max_hosts;
  44
  45         my $next_host = get_next_host($info{peer}, $host);
  46         last if $next_host eq '';
  47         last if $next_host  =~ /^127\.127\.\d{1,3}\.\d{1,3}$/;
  48
  49         $host = $next_host;
  50     }
  51     return 0;
  52 }
  53
  54 sub get_info {
  55     my ($host) = @_;
  56     my ($rootdelay, $rootdisp, $info) = (0, 0);
  57
  58     $info = ntp_read_vars(0, [], $host);
  59     return if not defined $info;
  60     return if not exists $info->{stratum};
  61
  62     $info->{offset} /= 1000;
  63     $info->{syncdistance} = ($info->{rootdisp} + ($info->{rootdelay} / 2)) / 1000;
  64
  65     return %$info;
  66 }
  67
  68
  69 sub get_next_host {
  70     my ($peer, $host) = @_;
  71
  72     my $info = ntp_read_vars($peer, [qw(srcadr)], $host);
  73     return if not defined $info;
  74     return $info->{srcadr};
  75 }
  76
  77 @ntptrace_opts@
  78
  79 1;
  80 __END__