12b15cb3dSCy Schubert#! @PATH_PERL@ -w 2*f5f40dd6SCy Schubert# @configure_input@ 32b15cb3dSCy Schubert# 42b15cb3dSCy Schubert# $Id$ 52b15cb3dSCy Schubert# 62b15cb3dSCy Schubert# DISCLAIMER 72b15cb3dSCy Schubert# 82b15cb3dSCy Schubert# Copyright (C) 1999,2000 Hans Lambermont and Origin B.V. 92b15cb3dSCy Schubert# 102b15cb3dSCy Schubert# Permission to use, copy, modify and distribute this software and its 112b15cb3dSCy Schubert# documentation for any purpose and without fee is hereby granted, 122b15cb3dSCy Schubert# provided that the above copyright notice appears in all copies and 132b15cb3dSCy Schubert# that both the copyright notice and this permission notice appear in 142b15cb3dSCy Schubert# supporting documentation. This software is supported as is and without 152b15cb3dSCy Schubert# any express or implied warranties, including, without limitation, the 162b15cb3dSCy Schubert# implied warranties of merchantability and fitness for a particular 172b15cb3dSCy Schubert# purpose. The name Origin B.V. must not be used to endorse or promote 182b15cb3dSCy Schubert# products derived from this software without prior written permission. 192b15cb3dSCy Schubert# 202b15cb3dSCy Schubert# Hans Lambermont <ntpsweep@lambermont.dyndns.org> 212b15cb3dSCy Schubert 222b15cb3dSCy Schubertpackage ntpsweep; 232b15cb3dSCy Schubertuse 5.006_000; 242b15cb3dSCy Schubertuse strict; 252b15cb3dSCy Schubertuse lib "@PERLLIBDIR@"; 262b15cb3dSCy Schubertuse NTP::Util qw(do_dns ntp_read_vars ntp_peers ntp_sntp_line); 272b15cb3dSCy Schubert 282b15cb3dSCy Schubert(my $program = $0) =~ s%.*/(.+?)(.pl)?$%$1%; 292b15cb3dSCy Schubertmy ($showpeers, $maxlevel, $strip); 302b15cb3dSCy Schubertmy (%known_host_info, %known_host_peers); 312b15cb3dSCy Schubert 322b15cb3dSCy Schubertexit run(@ARGV) unless caller; 332b15cb3dSCy Schubert 342b15cb3dSCy Schubertsub run { 352b15cb3dSCy Schubert my $opts; 362b15cb3dSCy Schubert if (!processOptions(\@_, $opts) || 372b15cb3dSCy Schubert (((@_ != 1) && !$opts->{host} && !@{$opts->{'host-list'}}))) { 382b15cb3dSCy Schubert usage(1); 392b15cb3dSCy Schubert }; 402b15cb3dSCy Schubert 412b15cb3dSCy Schubert # no STDOUT buffering 422b15cb3dSCy Schubert $| = 1; 432b15cb3dSCy Schubert ($showpeers, $maxlevel, $strip) = 442b15cb3dSCy Schubert ($opts->{peers}, $opts->{maxlevel}, $opts->{strip}); 452b15cb3dSCy Schubert 462b15cb3dSCy Schubert my $hostsfile = shift; 472b15cb3dSCy Schubert 482b15cb3dSCy Schubert # Main program 492b15cb3dSCy Schubert 502b15cb3dSCy Schubert my @hosts; 512b15cb3dSCy Schubert 522b15cb3dSCy Schubert if ($opts->{host}) { 532b15cb3dSCy Schubert push @hosts, $opts->{host}; 542b15cb3dSCy Schubert } 552b15cb3dSCy Schubert else { 562b15cb3dSCy Schubert @hosts = read_hosts($hostsfile) if $hostsfile; 572b15cb3dSCy Schubert push @hosts, @{$opts->{'host-list'}}; 582b15cb3dSCy Schubert } 592b15cb3dSCy Schubert 602b15cb3dSCy Schubert # Print header 612b15cb3dSCy Schubert print <<EOF; 622b15cb3dSCy SchubertHost st offset(s) version system processor 632b15cb3dSCy Schubert--------------------------------+--+---------+-----------+------------+--------- 642b15cb3dSCy SchubertEOF 652b15cb3dSCy Schubert 662b15cb3dSCy Schubert %known_host_info = (); 672b15cb3dSCy Schubert %known_host_peers = (); 682b15cb3dSCy Schubert scan_hosts(@hosts); 692b15cb3dSCy Schubert 702b15cb3dSCy Schubert return 0; 712b15cb3dSCy Schubert} 722b15cb3dSCy Schubert 732b15cb3dSCy Schubertsub scan_hosts { 742b15cb3dSCy Schubert my (@hosts) = @_; 752b15cb3dSCy Schubert 762b15cb3dSCy Schubert my $host; 772b15cb3dSCy Schubert for $host (@hosts) { 782b15cb3dSCy Schubert scan_host($host, 0, $host => 1); 792b15cb3dSCy Schubert } 802b15cb3dSCy Schubert} 812b15cb3dSCy Schubert 822b15cb3dSCy Schubertsub read_hosts { 832b15cb3dSCy Schubert my ($hostsfile) = @_; 842b15cb3dSCy Schubert my @hosts; 852b15cb3dSCy Schubert 862b15cb3dSCy Schubert open my $hosts, $hostsfile 872b15cb3dSCy Schubert or die "$program: FATAL: unable to read $hostsfile: $!\n"; 882b15cb3dSCy Schubert 892b15cb3dSCy Schubert while (<$hosts>) { 902b15cb3dSCy Schubert next if /^\s*(#|$)/; # comment/empty 912b15cb3dSCy Schubert chomp; 922b15cb3dSCy Schubert push @hosts, $_; 932b15cb3dSCy Schubert } 942b15cb3dSCy Schubert 952b15cb3dSCy Schubert close $hosts; 962b15cb3dSCy Schubert return @hosts; 972b15cb3dSCy Schubert} 982b15cb3dSCy Schubert 992b15cb3dSCy Schubertsub scan_host { 1002b15cb3dSCy Schubert my ($host, $level, %trace) = @_; 1012b15cb3dSCy Schubert my $stratum = 0; 1022b15cb3dSCy Schubert my $offset = 0; 1032b15cb3dSCy Schubert my $daemonversion = ""; 1042b15cb3dSCy Schubert my $system = ""; 1052b15cb3dSCy Schubert my $processor = ""; 1062b15cb3dSCy Schubert my @peers; 1072b15cb3dSCy Schubert my $known_host = 0; 1082b15cb3dSCy Schubert 1092b15cb3dSCy Schubert if (exists $known_host_info{$host}) { 1102b15cb3dSCy Schubert $known_host = 1; 1112b15cb3dSCy Schubert } 1122b15cb3dSCy Schubert else { 1132b15cb3dSCy Schubert ($offset, $stratum) = ntp_sntp_line($host); 1142b15cb3dSCy Schubert 1152b15cb3dSCy Schubert # got answers ? If so, go on. 1162b15cb3dSCy Schubert if ($stratum) { 1172b15cb3dSCy Schubert my $vars = ntp_read_vars(0, [qw(processor system daemon_version)], $host) || {}; 1182b15cb3dSCy Schubert $daemonversion = $vars->{daemon_version}; 1192b15cb3dSCy Schubert $system = $vars->{system}; 1202b15cb3dSCy Schubert $processor = $vars->{processor}; 1212b15cb3dSCy Schubert 1222b15cb3dSCy Schubert # Shorten daemon_version string. 1232b15cb3dSCy Schubert $daemonversion =~ s/(;|Mon|Tue|Wed|Thu|Fri|Sat|Sun).*$//; 1242b15cb3dSCy Schubert $daemonversion =~ s/version=//; 1252b15cb3dSCy Schubert $daemonversion =~ s/(x|)ntpd //; 1262b15cb3dSCy Schubert $daemonversion =~ s/(\(|\))//g; 1272b15cb3dSCy Schubert $daemonversion =~ s/beta/b/; 1282b15cb3dSCy Schubert $daemonversion =~ s/multicast/mc/; 1292b15cb3dSCy Schubert 1302b15cb3dSCy Schubert # Shorten system string 1312b15cb3dSCy Schubert $system =~ s/UNIX\///; 1322b15cb3dSCy Schubert $system =~ s/RELEASE/r/; 1332b15cb3dSCy Schubert $system =~ s/CURRENT/c/; 1342b15cb3dSCy Schubert 1352b15cb3dSCy Schubert # Shorten processor string 1362b15cb3dSCy Schubert $processor =~ s/unknown//; 1372b15cb3dSCy Schubert } 1382b15cb3dSCy Schubert 1392b15cb3dSCy Schubert # got answers ? If so, go on. 1402b15cb3dSCy Schubert if ($daemonversion) { 1412b15cb3dSCy Schubert if ($showpeers) { 1429034852cSGleb Smirnoff my $peers_ref = ntp_peers($host); 1439034852cSGleb Smirnoff my @peers_tmp = @$peers_ref; 1442b15cb3dSCy Schubert for (@peers_tmp) { 1452b15cb3dSCy Schubert $_->{remote} =~ s/^(?: |x|\.|-|\+|#|\*|o)([^ ]+)/$1/; 1462b15cb3dSCy Schubert push @peers, $_->{remote}; 1472b15cb3dSCy Schubert } 1482b15cb3dSCy Schubert } 1492b15cb3dSCy Schubert } 1502b15cb3dSCy Schubert 1512b15cb3dSCy Schubert # Add scanned host to known_hosts array 1522b15cb3dSCy Schubert #push @known_hosts, $host; 1532b15cb3dSCy Schubert if ($stratum) { 1542b15cb3dSCy Schubert $known_host_info{$host} = sprintf "%2d %9.3f %-11s %-12s %s", 1552b15cb3dSCy Schubert $stratum, $offset, (substr $daemonversion, 0, 11), 1562b15cb3dSCy Schubert (substr $system, 0, 12), (substr $processor, 0, 9); 1572b15cb3dSCy Schubert } 1582b15cb3dSCy Schubert else { 1592b15cb3dSCy Schubert # Stratum level 0 is consider invalid 1602b15cb3dSCy Schubert $known_host_info{$host} = " ?"; 1612b15cb3dSCy Schubert } 1622b15cb3dSCy Schubert $known_host_peers{$host} = [@peers]; 1632b15cb3dSCy Schubert } 1642b15cb3dSCy Schubert 1652b15cb3dSCy Schubert if ($stratum || $known_host) { # Valid or known host 1662b15cb3dSCy Schubert my $printhost = ' ' x $level . (do_dns($host) || $host); 1672b15cb3dSCy Schubert # Shorten host string 1682b15cb3dSCy Schubert if ($strip) { 1692b15cb3dSCy Schubert $printhost =~ s/$strip//; 1702b15cb3dSCy Schubert } 1712b15cb3dSCy Schubert # append number of peers in brackets if requested and valid 1722b15cb3dSCy Schubert if ($showpeers && ($known_host_info{$host} ne " ?")) { 1732b15cb3dSCy Schubert $printhost .= " (" . @{$known_host_peers{$host}} . ")"; 1742b15cb3dSCy Schubert } 1752b15cb3dSCy Schubert # Finally print complete host line 1762b15cb3dSCy Schubert printf "%-32s %s\n", 1772b15cb3dSCy Schubert (substr $printhost, 0, 32), $known_host_info{$host}; 1782b15cb3dSCy Schubert if ($showpeers && ($maxlevel ? $level < $maxlevel : 1)) { 1792b15cb3dSCy Schubert $trace{$host} = 1; 1802b15cb3dSCy Schubert # Loop through peers 1812b15cb3dSCy Schubert foreach my $peer (@{$known_host_peers{$host}}) { 1822b15cb3dSCy Schubert if (exists $trace{$peer}) { 1832b15cb3dSCy Schubert # we've detected a loop ! 1842b15cb3dSCy Schubert $printhost = ' ' x ($level + 1) . "= " . $peer; 1852b15cb3dSCy Schubert # Shorten host string 1862b15cb3dSCy Schubert $printhost =~ s/$strip// if $strip; 1872b15cb3dSCy Schubert printf "%-32s\n", substr $printhost, 0, 32; 1882b15cb3dSCy Schubert } else { 1892b15cb3dSCy Schubert if ((substr $peer, 0, 3) ne "127") { 1902b15cb3dSCy Schubert scan_host($peer, $level + 1, %trace); 1912b15cb3dSCy Schubert } 1922b15cb3dSCy Schubert } 1932b15cb3dSCy Schubert } 1942b15cb3dSCy Schubert } 1952b15cb3dSCy Schubert } 1962b15cb3dSCy Schubert else { # We did not get answers from this host 1972b15cb3dSCy Schubert my $printhost = ' ' x $level . (do_dns($host) || $host); 1982b15cb3dSCy Schubert $printhost =~ s/$strip// if $strip; 1992b15cb3dSCy Schubert printf "%-32s ?\n", substr $printhost, 0, 32; 2002b15cb3dSCy Schubert } 2012b15cb3dSCy Schubert} 2022b15cb3dSCy Schubert 2032b15cb3dSCy Schubert@ntpsweep_opts@ 2042b15cb3dSCy Schubert 2052b15cb3dSCy Schubert1; 2062b15cb3dSCy Schubert__END__ 207