8 our @EXPORT_OK = qw(ntp_read_vars do_dns ntp_peers ntp_sntp_line);
10 my $ntpq_path = 'ntpq';
11 my $sntp_path = 'sntp';
17 if (version->parse($Socket::VERSION) >= version->parse(1.94)) {
18 Socket->import(qw(getaddrinfo getnameinfo SOCK_RAW AF_INET));
22 Socket->import(qw(inet_aton SOCK_RAW AF_INET));
28 rootdispersion => 'rootdisp',
32 my ($peer, $vars, $host) = @_;
34 my %out_vars = map {; $_ => undef } @$vars;
36 $out_vars{status_line} = {} if $do_all;
38 my $cmd = "$ntpq_path -n -c 'rv $peer ".(join ',', @$vars)."'";
39 $cmd .= " $host" if defined $host;
42 open my $fh, $cmd or croak "Could not start ntpq: $!";
45 return undef if /Connection refused/;
47 if (/^asso?c?id=0 status=(\S{4}) (\S+), (\S+),/gi) {
48 $out_vars{status_line}{status} = $1;
49 $out_vars{status_line}{leap} = $2;
50 $out_vars{status_line}{sync} = $3;
53 while (/(\w+)=([^,]+),?\s/g) {
54 my ($var, $val) = ($1, $2);
55 $val =~ s/^"([^"]+)"$/$1/;
56 $var = $obsolete_vars{$var} if exists $obsolete_vars{$var};
58 $out_vars{$var} = $val
61 $out_vars{$var} = $val if exists $out_vars{$var};
66 close $fh or croak "running ntpq failed: $! (exit status $?)";
76 ($err, $res) = getaddrinfo($host, '', {socktype => SOCK_RAW});
77 die "getaddrinfo failed: $err\n" if $err;
79 ($err, $res) = getnameinfo($res->{addr}, 0);
80 die "getnameinfo failed: $err\n" if $err;
84 # Too old perl, do only ipv4
85 elsif ($host =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
86 return gethostbyaddr inet_aton($host), AF_INET;
97 my $cmd = "$ntpq_path -npw $host |";
99 open my $fh, $cmd or croak "Could not start ntpq: $!";
103 my @columns = qw(tally host refid st t when poll reach delay offset jitter);
106 if (/^([ x+#*o-])((?:[\w.*:-]+\s+){10}|([\w.*:-]+\s+))$/) {
108 my @line = ($1, split /\s+/, $2);
110 defined ($_ = <$fh>) or last;
112 push @line, split /\s+/;
114 my $r = { map {; $columns[ $col++ ] => $_ } @line };
115 $r->{remote} = $r->{tally} . $r->{host};
119 #TODO return error (but not needed anywhere now)
124 close $fh or croak "running ntpq failed: $! (exit status $?)";
128 # TODO: we don't need this but it would be nice to have all the line parsed
132 my $cmd = "$sntp_path $host |";
133 open my $fh, $cmd or croak "Could not start sntp: $!";
135 my ($offset, $stratum);
137 next if !/^\d{4}-\d\d-\d\d/;
139 my @output = split / /;
141 $offset = $output[3];
143 } elsif ($output[7] =~ /s(\d{1,2})/) {
145 # warn "Found stratum at #7\n";
146 } elsif ($output[8] =~ /s(\d{1,2})/) {
148 # warn "Found stratum at #8\n";
151 close $fh or croak "running sntp failed: $! (exit status $?)";
152 return ($offset, $stratum);