contrib/ntp/scripts/ntpsweep/ntpsweep.in

   1 #! @PATH_PERL@ -w
   2 #
   3 # $Id$
   4 #
   5 # DISCLAIMER
   6 #
   7 # Copyright (C) 1999,2000 Hans Lambermont and Origin B.V.
   8 #
   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.
  18 #
  19 # Hans Lambermont <ntpsweep@lambermont.dyndns.org>
  20
  21 package ntpsweep;
  22 use 5.006_000;
  23 use strict;
  24 use lib "@PERLLIBDIR@";
  25 use NTP::Util qw(do_dns ntp_read_vars ntp_peers ntp_sntp_line);
  26
  27 (my $program = $0) =~ s%.*/(.+?)(.pl)?$%$1%;
  28 my ($showpeers, $maxlevel, $strip);
  29 my (%known_host_info, %known_host_peers);
  30
  31 exit run(@ARGV) unless caller;
  32
  33 sub run {
  34     my $opts;
  35     if (!processOptions(\@_, $opts) ||
  36         (((@_ != 1) && !$opts->{host} && !@{$opts->{'host-list'}}))) {
  37         usage(1);
  38     };
  39
  40     # no STDOUT buffering
  41     $| = 1;
  42     ($showpeers, $maxlevel, $strip) =
  43         ($opts->{peers}, $opts->{maxlevel}, $opts->{strip});
  44
  45     my $hostsfile = shift;
  46
  47     # Main program
  48
  49     my @hosts;
  50
  51     if ($opts->{host}) {
  52         push @hosts, $opts->{host};
  53     }
  54     else {
  55         @hosts = read_hosts($hostsfile) if $hostsfile;
  56         push @hosts, @{$opts->{'host-list'}};
  57     }
  58
  59     # Print header
  60     print <<EOF;
  61 Host                             st offset(s) version     system       processor
  62 --------------------------------+--+---------+-----------+------------+---------
  63 EOF
  64
  65     %known_host_info = ();
  66     %known_host_peers = ();
  67     scan_hosts(@hosts);
  68
  69     return 0;
  70 }
  71
  72 sub scan_hosts {
  73     my (@hosts) = @_;
  74
  75     my $host;
  76     for $host (@hosts) {
  77         scan_host($host, 0, $host => 1);
  78     }
  79 }
  80
  81 sub read_hosts {
  82     my ($hostsfile) = @_;
  83     my @hosts;
  84
  85     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
  98 sub 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
 204 1;
 205 __END__