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