7 # Copyright (C) 1999,2000 Hans Lambermont and Origin B.V.
9 # Permission to use, copy, modify and distribute this software and its
10 # documentation for any purpose and without fee is hereby granted,
11 # provided that the above copyright notice appears in all copies and
12 # that both the copyright notice and this permission notice appear in
13 # supporting documentation. This software is supported as is and without
14 # any express or implied warranties, including, without limitation, the
15 # implied warranties of merchantability and fitness for a particular
16 # purpose. The name Origin B.V. must not be used to endorse or promote
17 # products derived from this software without prior written permission.
19 # Hans Lambermont <ntpsweep@lambermont.dyndns.org>
24 use lib "@PERLLIBDIR@";
25 use NTP::Util qw(do_dns ntp_read_vars ntp_peers ntp_sntp_line);
27 (my $program = $0) =~ s%.*/(.+?)(.pl)?$%$1%;
28 my ($showpeers, $maxlevel, $strip);
29 my (%known_host_info, %known_host_peers);
31 exit run(@ARGV) unless caller;
35 if (!processOptions(\@_, $opts) ||
36 (((@_ != 1) && !$opts->{host} && !@{$opts->{'host-list'}}))) {
42 ($showpeers, $maxlevel, $strip) =
43 ($opts->{peers}, $opts->{maxlevel}, $opts->{strip});
45 my $hostsfile = shift;
52 push @hosts, $opts->{host};
55 @hosts = read_hosts($hostsfile) if $hostsfile;
56 push @hosts, @{$opts->{'host-list'}};
61 Host st offset(s) version system processor
62 --------------------------------+--+---------+-----------+------------+---------
65 %known_host_info = ();
66 %known_host_peers = ();
77 scan_host($host, 0, $host => 1);
85 open my $hosts, $hostsfile
86 or die "$program: FATAL: unable to read $hostsfile: $!\n";
89 next if /^\s*(#|$)/; # comment/empty
99 my ($host, $level, %trace) = @_;
102 my $daemonversion = "";
108 if (exists $known_host_info{$host}) {
112 ($offset, $stratum) = ntp_sntp_line($host);
114 # got answers ? If so, go on.
116 my $vars = ntp_read_vars(0, [qw(processor system daemon_version)], $host) || {};
117 $daemonversion = $vars->{daemon_version};
118 $system = $vars->{system};
119 $processor = $vars->{processor};
121 # Shorten daemon_version string.
122 $daemonversion =~ s/(;|Mon|Tue|Wed|Thu|Fri|Sat|Sun).*$//;
123 $daemonversion =~ s/version=//;
124 $daemonversion =~ s/(x|)ntpd //;
125 $daemonversion =~ s/(\(|\))//g;
126 $daemonversion =~ s/beta/b/;
127 $daemonversion =~ s/multicast/mc/;
129 # Shorten system string
130 $system =~ s/UNIX\///;
131 $system =~ s/RELEASE/r/;
132 $system =~ s/CURRENT/c/;
134 # Shorten processor string
135 $processor =~ s/unknown//;
138 # got answers ? If so, go on.
139 if ($daemonversion) {
141 my $peers_ref = ntp_peers($host);
142 my @peers_tmp = @$peers_ref;
144 $_->{remote} =~ s/^(?: |x|\.|-|\+|#|\*|o)([^ ]+)/$1/;
145 push @peers, $_->{remote};
150 # Add scanned host to known_hosts array
151 #push @known_hosts, $host;
153 $known_host_info{$host} = sprintf "%2d %9.3f %-11s %-12s %s",
154 $stratum, $offset, (substr $daemonversion, 0, 11),
155 (substr $system, 0, 12), (substr $processor, 0, 9);
158 # Stratum level 0 is consider invalid
159 $known_host_info{$host} = " ?";
161 $known_host_peers{$host} = [@peers];
164 if ($stratum || $known_host) { # Valid or known host
165 my $printhost = ' ' x $level . (do_dns($host) || $host);
166 # Shorten host string
168 $printhost =~ s/$strip//;
170 # append number of peers in brackets if requested and valid
171 if ($showpeers && ($known_host_info{$host} ne " ?")) {
172 $printhost .= " (" . @{$known_host_peers{$host}} . ")";
174 # Finally print complete host line
176 (substr $printhost, 0, 32), $known_host_info{$host};
177 if ($showpeers && ($maxlevel ? $level < $maxlevel : 1)) {
180 foreach my $peer (@{$known_host_peers{$host}}) {
181 if (exists $trace{$peer}) {
182 # we've detected a loop !
183 $printhost = ' ' x ($level + 1) . "= " . $peer;
184 # Shorten host string
185 $printhost =~ s/$strip// if $strip;
186 printf "%-32s\n", substr $printhost, 0, 32;
188 if ((substr $peer, 0, 3) ne "127") {
189 scan_host($peer, $level + 1, %trace);
195 else { # We did not get answers from this host
196 my $printhost = ' ' x $level . (do_dns($host) || $host);
197 $printhost =~ s/$strip// if $strip;
198 printf "%-32s ?\n", substr $printhost, 0, 32;