Util.pm revision 290001 
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    $host ||= '';
97    my $cmd = "$ntpq_path -npw $host |";
98
99    open my $fh, $cmd or croak "Could not start ntpq: $!";
100
101    <$fh> for 1 .. 2;
102
103    my @columns = qw(tally host refid st t when poll reach delay offset jitter);
104    my @peers;
105    while (<$fh>) {
106        if (/^([ x+#*o-])((?:[\w.*:-]+\s+){10}|([\w.*:-]+\s+))$/) {
107            my $col = 0;
108	    my @line = ($1, split /\s+/, $2);
109	    if( @line == 2 ) {
110		defined ($_ = <$fh>) or last;
111		s/^\s+//;
112		push @line, split /\s+/;
113	    }
114	    my $r = { map {; $columns[ $col++ ] => $_ } @line };
115	    $r->{remote} = $r->{tally} . $r->{host};
116            push @peers, $r;
117        }
118        else {
119            #TODO return error (but not needed anywhere now)
120            warn "ERROR: $_";
121        }
122    }
123
124    close $fh or croak "running ntpq failed: $! (exit status $?)";
125    return \@peers;
126}
127
128# TODO: we don't need this but it would be nice to have all the line parsed
129sub ntp_sntp_line {
130    my ($host) = @_;
131
132    my $cmd = "$sntp_path $host |";
133    open my $fh, $cmd or croak "Could not start sntp: $!";
134
135    my ($offset, $stratum);
136    while (<$fh>) {
137        next if !/^\d{4}-\d\d-\d\d/;
138        chomp;
139        my @output = split / /;
140
141        $offset = $output[3];
142	if (0) {
143	} elsif ($output[7] =~ /s(\d{1,2})/) {
144		$stratum = $1;
145		# warn "Found stratum at #7\n";
146	} elsif ($output[8] =~ /s(\d{1,2})/) {
147		$stratum = $1;
148		# warn "Found stratum at #8\n";
149	}
150    }
151    close $fh or croak "running sntp failed: $! (exit status $?)";
152    return ($offset, $stratum);
153}
154
1551;
156