7 # Copyright (C) 1999,2000 Hans Lambermont and Origin B.V.
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.
19 # Hans Lambermont <Hans.Lambermont@nl.origin-it.com>/<H.Lambermont@chello.nl>
22 require 5.0; # But actually tested on 5.004 ;)
23 use Getopt::Long; # GetOptions()
27 (my $program = $0) =~ s%.*/(.+?)(.pl)?$%$1%;
29 # Hardcoded paths/program names
30 my $ntpdate = "ntpdate";
36 my ($help, $single_host, $showpeers, $maxlevel, $strip, $askversion);
37 my $res = GetOptions("help!" => \$help,
38 "host=s" => \$single_host,
39 "peers!" => \$showpeers,
40 "maxlevel=s" => \$maxlevel,
42 "version!" => \$askversion);
49 if ($help || ((@ARGV != 1) && !$single_host)) {
51 This is $program, version $version
52 Copyright (C) 1999,2000 Hans Lambermont and Origin B.V. Disclaimer inside.
55 $program [--help|--peers|--strip <string>|--maxlevel <level>|--version] \\
56 <file>|[--host <hostname>]
59 $program prints per host given in <file> the NTP stratum level, the
60 clock offset in seconds, the daemon version, the operating system and
61 the processor. Optionally recursing through all peers.
65 Print this short help text and exit.
67 Print version ($version) and exit.
69 Specify hosts file. File format is one hostname or ip number per line.
70 Lines beginning with # are considered as comment.
72 Speficy a single host, bypassing the need for a hosts file.
74 Recursively list all peers a host synchronizes to.
75 An '= ' before a peer means a loop. Recursion stops here.
77 Traverse peers up to this level (4 is a reasonable number).
79 Strip <string> from hostnames.
82 $program myhosts.txt --strip .foo.com
83 $program --host some.host --peers --maxlevel 4
88 my $hostsfile = shift;
89 my (@hosts, @known_hosts);
90 my (%known_host_info, %known_host_peers);
95 open (HOSTS, $hostsfile) ||
96 die "$program: FATAL: unable to read $hostsfile: $!\n";
98 next if /^\s*(#|$)/; # comment/empty
105 # translate IP to hostname if possible
108 my($addr, $name, $aliases, $addrtype, $length, @addrs);
109 $addr = pack('C4', split(/\./, $ip));
110 ($name, $aliases, $addrtype, $length, @addrs) = gethostbyaddr($addr, 2);
112 # return lower case name
119 # item_in_list($item, @list): returns 1 if $item is in @list, 0 if not
121 my($item, @list) = @_;
124 return 1 if ($item eq $i);
129 sub scan_host($;$;$) {
130 my($host, $level, @trace) = @_;
133 my $daemonversion = "";
139 if (&item_in_list($host, @known_hosts)) {
143 open(NTPDATE, "$ntpdate -bd $host 2>/dev/null |") ||
144 die "Cannot open ntpdate pipe: $!\n";
146 /^stratum\s+(\d+).*$/ && do {
149 /^offset\s+([0-9.-]+)$/ && do {
155 # got answers ? If so, go on.
158 my $ntpqparams = "-c 'rv 0 processor,system,daemon_version'";
159 open(NTPQ, "$ntpq $ntpqparams $host 2>/dev/null |") ||
160 die "Cannot open ntpq pipe: $!\n";
162 /daemon_version="(.*)"/ && do {
165 /system="([^"]*)"/ && do {
168 /processor="([^"]*)"/ && do {
174 # Shorten daemon_version string.
175 $daemonversion =~ s/(;|Mon|Tue|Wed|Thu|Fri|Sat|Sun).*$//;
176 $daemonversion =~ s/version=//;
177 $daemonversion =~ s/(x|)ntpd //;
178 $daemonversion =~ s/(\(|\))//g;
179 $daemonversion =~ s/beta/b/;
180 $daemonversion =~ s/multicast/mc/;
182 # Shorten system string
183 $system =~ s/UNIX\///;
184 $system =~ s/RELEASE/r/;
185 $system =~ s/CURRENT/c/;
187 # Shorten processor string
188 $processor =~ s/unknown//;
191 # got answers ? If so, go on.
192 if ($daemonversion) {
193 # ntpq again, find out the peers this time
195 my $ntpqparams = "-pn";
196 open(NTPQ, "$ntpq $ntpqparams $host 2>/dev/null |") ||
197 die "Cannot open ntpq pipe: $!\n";
199 /^No association ID's returned$/ && do {
208 /^( |x|\.|-|\+|#|\*|o)([^ ]+)/ && do {
209 push(@peers, ip2name($2));
218 # Add scanned host to known_hosts array
219 push(@known_hosts, $host);
221 $known_host_info{$host} = sprintf("%2d %9.3f %-11s %-12s %s",
222 $stratum, $offset, substr($daemonversion,0,11),
223 substr($system,0,12), substr($processor,0,9));
225 # Stratum level 0 is consider invalid
226 $known_host_info{$host} = sprintf(" ?");
228 $known_host_peers{$host} = [@peers];
231 if ($stratum || $known_host) { # Valid or known host
232 my $printhost = ' ' x $level . $host;
233 # Shorten host string
235 $printhost =~ s/$strip//;
237 # append number of peers in brackets if requested and valid
238 if ($showpeers && ($known_host_info{$host} ne " ?")) {
239 $printhost .= " (" . @{$known_host_peers{$host}} . ")";
241 # Finally print complete host line
243 substr($printhost,0,32), $known_host_info{$host});
244 if ($showpeers && (eval($maxlevel ? $level < $maxlevel : 1))) {
248 foreach $peer (@{$known_host_peers{$host}}) {
249 if (&item_in_list($peer, @trace)) {
250 # we've detected a loop !
251 $printhost = ' ' x ($level + 1) . "= " . $peer;
252 # Shorten host string
254 $printhost =~ s/$strip//;
257 substr($printhost,0,32));
259 if (substr($peer,0,3) ne "127") {
260 &scan_host($peer, $level + 1, @trace);
265 } else { # We did not get answers from this host
266 my $printhost = ' ' x $level . $host;
267 # Shorten host string
269 $printhost =~ s/$strip//;
271 printf("%-32s ?\n", substr($printhost,0,32));
281 scan_host($host, 0, @trace);
288 push(@hosts, $single_host);
290 &read_hosts($hostsfile);
295 Host st offset(s) version system processor
296 --------------------------------+--+---------+-----------+------------+---------