Home | History | Annotate | Line # | Download | only in NTP 
      1 package NTP::Util;
      2 use strict;
      3 use warnings;
      4 use Exporter 'import';
      5 use Carp;
      6 use version 0.77;
      7 
      8 our @EXPORT_OK = qw(ntp_read_vars do_dns ntp_peers ntp_sntp_line);
      9 
     10 my $ntpq_path = 'ntpq';
     11 my $sntp_path = 'sntp';
     12 
     13 our $IP_AGNOSTIC;
     14 
     15 BEGIN {
     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 
     26 my %obsolete_vars = (
     27     phase          => 'offset',
     28     rootdispersion => 'rootdisp',
     29 );
     30 
     31 sub 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 
     70 sub 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 
     93 sub 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
    129 sub 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 
    155 1;
    156