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