xref: /netbsd-src/external/bsd/ntp/dist/scripts/lib/NTP/Util.pm (revision 6a493d6bc668897c91594964a732d38505b70cbb) 
1package NTP::Util;
2use strict;
3use warnings;
4use Exporter 'import';
5use Carp;
6
7our @EXPORT_OK = qw(ntp_read_vars do_dns ntp_peers ntp_sntp_line);
8
9my $ntpq_path = 'ntpq';
10my $sntp_path = 'sntp';
11
12our $IP_AGNOSTIC;
13
14BEGIN {
15    require Socket;
16    if ($Socket::VERSION >= 1.94) {
17        Socket->import(qw(getaddrinfo getnameinfo SOCK_RAW AF_INET));
18        $IP_AGNOSTIC = 1;
19    }
20    else {
21        Socket->import(qw(inet_aton SOCK_RAW AF_INET));
22    }
23}
24
25my %obsolete_vars = (
26    phase          => 'offset',
27    rootdispersion => 'rootdisp',
28);
29
30sub ntp_read_vars {
31    my ($peer, $vars, $host) = @_;
32    my $do_all   = !@$vars;
33    my %out_vars = map {; $_ => undef } @$vars;
34
35    $out_vars{status_line} = {} if $do_all;
36
37    my $cmd = "$ntpq_path -n -c 'rv $peer ".(join ',', @$vars)."'";
38    $cmd .= " $host" if defined $host;
39    $cmd .= " |";
40
41    open my $fh, $cmd or croak "Could not start ntpq: $!";
42
43    while (<$fh>) {
44        return undef if /Connection refused/;
45
46        if (/^asso?c?id=0 status=(\S{4}) (\S+), (\S+),/gi) {
47            $out_vars{status_line}{status} = $1;
48            $out_vars{status_line}{leap}   = $2;
49            $out_vars{status_line}{sync}   = $3;
50        }
51
52        while (/(\w+)=([^,]+),?\s/g) {
53            my ($var, $val) = ($1, $2);
54            $val =~ s/^"([^"]+)"$/$1/;
55            $var = $obsolete_vars{$var} if exists $obsolete_vars{$var};
56            if ($do_all) {
57                $out_vars{$var} = $val
58            }
59            else {
60                $out_vars{$var} = $val if exists $out_vars{$var};
61            }
62        }
63    }
64
65    close $fh or croak "running ntpq failed: $! (exit status $?)";
66    return \%out_vars;
67}
68
69sub do_dns {
70    my ($host) = @_;
71
72    if ($IP_AGNOSTIC) {
73        my ($err, $res);
74
75        ($err, $res) = getaddrinfo($host, '', {socktype => SOCK_RAW});
76        die "getaddrinfo failed: $err\n" if $err;
77
78        ($err, $res) = getnameinfo($res->{addr}, 0);
79        die "getnameinfo failed: $err\n" if $err;
80
81        return $res;
82    }
83    # Too old perl, do only ipv4
84    elsif ($host =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/) {
85        return gethostbyaddr inet_aton($host), AF_INET;
86    }
87    else {
88        return;
89    }
90}
91
92sub ntp_peers {
93    my ($host) = @_;
94
95    my $cmd = "$ntpq_path -np $host |";
96
97    open my $fh, $cmd or croak "Could not start ntpq: $!";
98
99    <$fh> for 1 .. 2;
100
101    my @columns = qw(remote refid st t when poll reach delay offset jitter);
102    my @peers;
103    while (<$fh>) {
104        if (/(?:[\w\.\*-]+\s*){10}/) {
105            my $col = 0;
106            push @peers, { map {; $columns[ $col++ ] => $_ } split /(?<=.)\s+/ };
107        }
108        else {
109            #TODO return error (but not needed anywhere now)
110            warn "ERROR: $_";
111        }
112    }
113
114    close $fh or croak "running ntpq failed: $! (exit status $?)";
115    return \@peers;
116}
117
118# TODO: we don't need this but it would be nice to have all the line parsed
119sub ntp_sntp_line {
120    my ($host) = @_;
121
122    my $cmd = "$sntp_path $host |";
123    open my $fh, $cmd or croak "Could not start sntp: $!";
124
125    my ($offset, $stratum);
126    while (<$fh>) {
127        next if !/^\d{4}-\d\d-\d\d/;
128        chomp;
129        my @output = split / /;
130
131        $offset = $output[3];
132        ($stratum = pop @output) =~ s/s(\d{1,2})/$1/;
133    }
134    close $fh or croak "running sntp failed: $! (exit status $?)";
135    return ($offset, $stratum);
136}
137