contrib/ntp/scripts/lib/NTP/Util.pm

   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;