1275970Scy#! @PATH_PERL@ -w 2275970Scy# 3275970Scy# $Id$ 4275970Scy# 5275970Scy# DISCLAIMER 6275970Scy# 7275970Scy# Copyright (C) 1999,2000 Hans Lambermont and Origin B.V. 8275970Scy# 9275970Scy# Permission to use, copy, modify and distribute this software and its 10275970Scy# documentation for any purpose and without fee is hereby granted, 11275970Scy# provided that the above copyright notice appears in all copies and 12275970Scy# that both the copyright notice and this permission notice appear in 13275970Scy# supporting documentation. This software is supported as is and without 14275970Scy# any express or implied warranties, including, without limitation, the 15275970Scy# implied warranties of merchantability and fitness for a particular 16275970Scy# purpose. The name Origin B.V. must not be used to endorse or promote 17275970Scy# products derived from this software without prior written permission. 18275970Scy# 19275970Scy# Hans Lambermont <ntpsweep@lambermont.dyndns.org> 20275970Scy 21275970Scypackage ntpsweep; 22275970Scyuse 5.006_000; 23275970Scyuse strict; 24275970Scyuse lib "@PERLLIBDIR@"; 25275970Scyuse NTP::Util qw(do_dns ntp_read_vars ntp_peers ntp_sntp_line); 26275970Scy 27275970Scy(my $program = $0) =~ s%.*/(.+?)(.pl)?$%$1%; 28275970Scymy ($showpeers, $maxlevel, $strip); 29275970Scymy (%known_host_info, %known_host_peers); 30275970Scy 31275970Scyexit run(@ARGV) unless caller; 32275970Scy 33275970Scysub run { 34275970Scy my $opts; 35275970Scy if (!processOptions(\@_, $opts) || 36275970Scy (((@_ != 1) && !$opts->{host} && !@{$opts->{'host-list'}}))) { 37275970Scy usage(1); 38275970Scy }; 39275970Scy 40275970Scy # no STDOUT buffering 41275970Scy $| = 1; 42275970Scy ($showpeers, $maxlevel, $strip) = 43275970Scy ($opts->{peers}, $opts->{maxlevel}, $opts->{strip}); 44275970Scy 45275970Scy my $hostsfile = shift; 46275970Scy 47275970Scy # Main program 48275970Scy 49275970Scy my @hosts; 50275970Scy 51275970Scy if ($opts->{host}) { 52275970Scy push @hosts, $opts->{host}; 53275970Scy } 54275970Scy else { 55275970Scy @hosts = read_hosts($hostsfile) if $hostsfile; 56275970Scy push @hosts, @{$opts->{'host-list'}}; 57275970Scy } 58275970Scy 59275970Scy # Print header 60275970Scy print <<EOF; 61275970ScyHost st offset(s) version system processor 62275970Scy--------------------------------+--+---------+-----------+------------+--------- 63275970ScyEOF 64275970Scy 65275970Scy %known_host_info = (); 66275970Scy %known_host_peers = (); 67275970Scy scan_hosts(@hosts); 68275970Scy 69275970Scy return 0; 70275970Scy} 71275970Scy 72275970Scysub scan_hosts { 73275970Scy my (@hosts) = @_; 74275970Scy 75275970Scy my $host; 76275970Scy for $host (@hosts) { 77275970Scy scan_host($host, 0, $host => 1); 78275970Scy } 79275970Scy} 80275970Scy 81275970Scysub read_hosts { 82275970Scy my ($hostsfile) = @_; 83275970Scy my @hosts; 84275970Scy 85275970Scy open my $hosts, $hostsfile 86275970Scy or die "$program: FATAL: unable to read $hostsfile: $!\n"; 87275970Scy 88275970Scy while (<$hosts>) { 89275970Scy next if /^\s*(#|$)/; # comment/empty 90275970Scy chomp; 91275970Scy push @hosts, $_; 92275970Scy } 93275970Scy 94275970Scy close $hosts; 95275970Scy return @hosts; 96275970Scy} 97275970Scy 98275970Scysub scan_host { 99275970Scy my ($host, $level, %trace) = @_; 100275970Scy my $stratum = 0; 101275970Scy my $offset = 0; 102275970Scy my $daemonversion = ""; 103275970Scy my $system = ""; 104275970Scy my $processor = ""; 105275970Scy my @peers; 106275970Scy my $known_host = 0; 107275970Scy 108275970Scy if (exists $known_host_info{$host}) { 109275970Scy $known_host = 1; 110275970Scy } 111275970Scy else { 112275970Scy ($offset, $stratum) = ntp_sntp_line($host); 113275970Scy 114275970Scy # got answers ? If so, go on. 115275970Scy if ($stratum) { 116275970Scy my $vars = ntp_read_vars(0, [qw(processor system daemon_version)], $host) || {}; 117275970Scy $daemonversion = $vars->{daemon_version}; 118275970Scy $system = $vars->{system}; 119275970Scy $processor = $vars->{processor}; 120275970Scy 121275970Scy # Shorten daemon_version string. 122275970Scy $daemonversion =~ s/(;|Mon|Tue|Wed|Thu|Fri|Sat|Sun).*$//; 123275970Scy $daemonversion =~ s/version=//; 124275970Scy $daemonversion =~ s/(x|)ntpd //; 125275970Scy $daemonversion =~ s/(\(|\))//g; 126275970Scy $daemonversion =~ s/beta/b/; 127275970Scy $daemonversion =~ s/multicast/mc/; 128275970Scy 129275970Scy # Shorten system string 130275970Scy $system =~ s/UNIX\///; 131275970Scy $system =~ s/RELEASE/r/; 132275970Scy $system =~ s/CURRENT/c/; 133275970Scy 134275970Scy # Shorten processor string 135275970Scy $processor =~ s/unknown//; 136275970Scy } 137275970Scy 138275970Scy # got answers ? If so, go on. 139275970Scy if ($daemonversion) { 140275970Scy if ($showpeers) { 141289997Sglebius my $peers_ref = ntp_peers($host); 142289997Sglebius my @peers_tmp = @$peers_ref; 143275970Scy for (@peers_tmp) { 144275970Scy $_->{remote} =~ s/^(?: |x|\.|-|\+|#|\*|o)([^ ]+)/$1/; 145275970Scy push @peers, $_->{remote}; 146275970Scy } 147275970Scy } 148275970Scy } 149275970Scy 150275970Scy # Add scanned host to known_hosts array 151275970Scy #push @known_hosts, $host; 152275970Scy if ($stratum) { 153275970Scy $known_host_info{$host} = sprintf "%2d %9.3f %-11s %-12s %s", 154275970Scy $stratum, $offset, (substr $daemonversion, 0, 11), 155275970Scy (substr $system, 0, 12), (substr $processor, 0, 9); 156275970Scy } 157275970Scy else { 158275970Scy # Stratum level 0 is consider invalid 159275970Scy $known_host_info{$host} = " ?"; 160275970Scy } 161275970Scy $known_host_peers{$host} = [@peers]; 162275970Scy } 163275970Scy 164275970Scy if ($stratum || $known_host) { # Valid or known host 165275970Scy my $printhost = ' ' x $level . (do_dns($host) || $host); 166275970Scy # Shorten host string 167275970Scy if ($strip) { 168275970Scy $printhost =~ s/$strip//; 169275970Scy } 170275970Scy # append number of peers in brackets if requested and valid 171275970Scy if ($showpeers && ($known_host_info{$host} ne " ?")) { 172275970Scy $printhost .= " (" . @{$known_host_peers{$host}} . ")"; 173275970Scy } 174275970Scy # Finally print complete host line 175275970Scy printf "%-32s %s\n", 176275970Scy (substr $printhost, 0, 32), $known_host_info{$host}; 177275970Scy if ($showpeers && ($maxlevel ? $level < $maxlevel : 1)) { 178275970Scy $trace{$host} = 1; 179275970Scy # Loop through peers 180275970Scy foreach my $peer (@{$known_host_peers{$host}}) { 181275970Scy if (exists $trace{$peer}) { 182275970Scy # we've detected a loop ! 183275970Scy $printhost = ' ' x ($level + 1) . "= " . $peer; 184275970Scy # Shorten host string 185275970Scy $printhost =~ s/$strip// if $strip; 186275970Scy printf "%-32s\n", substr $printhost, 0, 32; 187275970Scy } else { 188275970Scy if ((substr $peer, 0, 3) ne "127") { 189275970Scy scan_host($peer, $level + 1, %trace); 190275970Scy } 191275970Scy } 192275970Scy } 193275970Scy } 194275970Scy } 195275970Scy else { # We did not get answers from this host 196275970Scy my $printhost = ' ' x $level . (do_dns($host) || $host); 197275970Scy $printhost =~ s/$strip// if $strip; 198275970Scy printf "%-32s ?\n", substr $printhost, 0, 32; 199275970Scy } 200275970Scy} 201275970Scy 202275970Scy@ntpsweep_opts@ 203275970Scy 204275970Scy1; 205275970Scy__END__ 206