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