ntpsweep.in revision 289997
1122237Simp#! @PATH_PERL@ -w 2131807Sru# 3122237Simp# $Id$ 4122237Simp# 5122237Simp# DISCLAIMER 6122237Simp# 7122237Simp# Copyright (C) 1999,2000 Hans Lambermont and Origin B.V. 8122237Simp# 9122237Simp# Permission to use, copy, modify and distribute this software and its 10122237Simp# documentation for any purpose and without fee is hereby granted, 11122237Simp# provided that the above copyright notice appears in all copies and 12122237Simp# that both the copyright notice and this permission notice appear in 13204790Sjoel# supporting documentation. This software is supported as is and without 14122237Simp# any express or implied warranties, including, without limitation, the 15122237Simp# implied warranties of merchantability and fitness for a particular 16204790Sjoel# purpose. The name Origin B.V. must not be used to endorse or promote 17204790Sjoel# products derived from this software without prior written permission. 18204790Sjoel# 19204790Sjoel# Hans Lambermont <ntpsweep@lambermont.dyndns.org> 20204790Sjoel 21204790Sjoelpackage ntpsweep; 22204790Sjoeluse 5.006_000; 23204790Sjoeluse strict; 24122237Simpuse lib "@PERLLIBDIR@"; 25141580Sruuse NTP::Util qw(do_dns ntp_read_vars ntp_peers ntp_sntp_line); 26122237Simp 27164524Sbrueffer(my $program = $0) =~ s%.*/(.+?)(.pl)?$%$1%; 28122237Simpmy ($showpeers, $maxlevel, $strip); 29122237Simpmy (%known_host_info, %known_host_peers); 30122237Simp 31122237Simpexit run(@ARGV) unless caller; 32122238Simp 33122237Simpsub run { 34164524Sbrueffer my $opts; 35164524Sbrueffer if (!processOptions(\@_, $opts) || 36164524Sbrueffer (((@_ != 1) && !$opts->{host} && !@{$opts->{'host-list'}}))) { 37164524Sbrueffer usage(1); 38122237Simp }; 39164524Sbrueffer 40164524Sbrueffer # no STDOUT buffering 41164524Sbrueffer $| = 1; 42164524Sbrueffer ($showpeers, $maxlevel, $strip) = 43164524Sbrueffer ($opts->{peers}, $opts->{maxlevel}, $opts->{strip}); 44164524Sbrueffer 45164524Sbrueffer my $hostsfile = shift; 46164524Sbrueffer 47122237Simp # Main program 48122237Simp 49122237Simp my @hosts; 50122238Simp 51122238Simp if ($opts->{host}) { 52122238Simp push @hosts, $opts->{host}; 53122238Simp } 54122238Simp else { 55122238Simp @hosts = read_hosts($hostsfile) if $hostsfile; 56122237Simp push @hosts, @{$opts->{'host-list'}}; 57122237Simp } 58122237Simp 59131807Sru # Print header 60122237Simp print <<EOF; 61131807SruHost st offset(s) version system processor 62122237Simp--------------------------------+--+---------+-----------+------------+--------- 63131807SruEOF 64122237Simp 65122237Simp %known_host_info = (); 66122237Simp %known_host_peers = (); 67122237Simp scan_hosts(@hosts); 68122237Simp 69122237Simp return 0; 70131807Sru} 71122237Simp 72122237Simpsub scan_hosts { 73122237Simp my (@hosts) = @_; 74122240Shmp 75122240Shmp my $host; 76122240Shmp for $host (@hosts) { 77122240Shmp scan_host($host, 0, $host => 1); 78122237Simp } 79122237Simp} 80122237Simp 81122237Simpsub read_hosts { 82122237Simp my ($hostsfile) = @_; 83131807Sru my @hosts; 84122237Simp 85122237Simp open my $hosts, $hostsfile 86 or die "$program: FATAL: unable to read $hostsfile: $!\n"; 87 88 while (<$hosts>) { 89 next if /^\s*(#|$)/; # comment/empty 90 chomp; 91 push @hosts, $_; 92 } 93 94 close $hosts; 95 return @hosts; 96} 97 98sub scan_host { 99 my ($host, $level, %trace) = @_; 100 my $stratum = 0; 101 my $offset = 0; 102 my $daemonversion = ""; 103 my $system = ""; 104 my $processor = ""; 105 my @peers; 106 my $known_host = 0; 107 108 if (exists $known_host_info{$host}) { 109 $known_host = 1; 110 } 111 else { 112 ($offset, $stratum) = ntp_sntp_line($host); 113 114 # got answers ? If so, go on. 115 if ($stratum) { 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}; 120 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/; 128 129 # Shorten system string 130 $system =~ s/UNIX\///; 131 $system =~ s/RELEASE/r/; 132 $system =~ s/CURRENT/c/; 133 134 # Shorten processor string 135 $processor =~ s/unknown//; 136 } 137 138 # got answers ? If so, go on. 139 if ($daemonversion) { 140 if ($showpeers) { 141 my $peers_ref = ntp_peers($host); 142 my @peers_tmp = @$peers_ref; 143 for (@peers_tmp) { 144 $_->{remote} =~ s/^(?: |x|\.|-|\+|#|\*|o)([^ ]+)/$1/; 145 push @peers, $_->{remote}; 146 } 147 } 148 } 149 150 # Add scanned host to known_hosts array 151 #push @known_hosts, $host; 152 if ($stratum) { 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); 156 } 157 else { 158 # Stratum level 0 is consider invalid 159 $known_host_info{$host} = " ?"; 160 } 161 $known_host_peers{$host} = [@peers]; 162 } 163 164 if ($stratum || $known_host) { # Valid or known host 165 my $printhost = ' ' x $level . (do_dns($host) || $host); 166 # Shorten host string 167 if ($strip) { 168 $printhost =~ s/$strip//; 169 } 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}} . ")"; 173 } 174 # Finally print complete host line 175 printf "%-32s %s\n", 176 (substr $printhost, 0, 32), $known_host_info{$host}; 177 if ($showpeers && ($maxlevel ? $level < $maxlevel : 1)) { 178 $trace{$host} = 1; 179 # Loop through peers 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; 187 } else { 188 if ((substr $peer, 0, 3) ne "127") { 189 scan_host($peer, $level + 1, %trace); 190 } 191 } 192 } 193 } 194 } 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; 199 } 200} 201 202@ntpsweep_opts@ 203 2041; 205__END__ 206