xref: /freebsd/contrib/ntp/scripts/ntpsweep/ntpsweep.in (revision f5f40dd63bc7acbb5312b26ac1ea1103c12352a6)
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