Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: d388d2ea88
Fetching contributors…

Cannot retrieve contributors at this time

executable file 215 lines (168 sloc) 5.247 kB
#!/usr/bin/env perl
use strict;
use Net::NTP 1.3;
use Time::HiRes;
use JSON qw(decode_json encode_json);
use Capture::Tiny qw(capture_merged);
use HTTP::Tiny;
my $VERSION = "1.1";
$Net::NTP::TIMEOUT = 2;
$| = 1;
sub logsay {
my @msg = map { ref $_ ? encode_json($_) : $_ } @_;
print join(" ", @msg), "\n";
}
# How often should the server be rechecked?
my $sleeptime = 120;
my $api_key = shift or die "$0 [api_key] [pool-server]\n";
my $pool_server = shift || "http://www.pool.ntp.org/monitor";
$pool_server .= '?api_key=' . $api_key;
my $verbose = 1;
# check if this machine has good time.
$Net::NTP::CLIENT_TIME_SEND = undef;
$Net::NTP::CLIENT_TIME_RECEIVE = undef;
my $mon_host = 'localhost';
my %pkt = eval { get_ntp_response($mon_host) };
if (!$pkt{'Stratum'} or $pkt{'Stratum'} == 0 or $pkt{'Stratum'} > 6) {
warn "monitoring server not synchronized\n";
sleep 10;
exit 2;
}
#use Data::Dump qw(pp);
#pp(\%pkt);
# Add sbin to the path as ntpdc/ntpq may live there
$ENV{PATH} .= ':/usr/sbin:/usr/local/sbin';
sub sanity_check {
my $ok = 0;
while (!$ok) {
$ok = sanity_check_local_offset() ? 1 : 0;
$ok = $ok and sanity_check_network();
unless ($ok) {
logsay("sanity not okay; waiting two minutes");
sleep 120;
}
}
}
sub sanity_check_local_offset {
my $offset_ms;
my $ntpdc = capture_merged {
system('ntpdc -c loopinfo $mon_host');
};
if ($ntpdc =~ m/offset: *([^ ]+)/s) {
$ntpdc =~ s/.*offset: *([^ ]+).*/\1/s;
$offset_ms = 1000*abs($ntpdc);
}
else {
my $ntpq = capture_merged {
system('ntpq -c rv $mon_host');
};
if ($ntpq =~ m/offset=([^,]+)*/s) {
$ntpq =~ s/.*offset=([^,]+)*.*/\1/s;
$offset_ms = abs($ntpq);
}
else {
warn "Neither ntpdc nor ntpq found";
sleep 15;
exit 2;
}
}
if ($offset_ms > 10) {
warn "Offset $offset_ms too large";
return 0;
}
return 1;
}
sub sanity_check_network {
# check if we're connected
$Net::NTP::CLIENT_TIME_SEND = undef;
$Net::NTP::CLIENT_TIME_RECEIVE = undef;
%pkt = eval { get_ntp_response('tick.ucla.edu') };
if ($pkt{'Stratum'} == 0 or $pkt{'Stratum'} > 6) {
$Net::NTP::CLIENT_TIME_SEND = undef;
$Net::NTP::CLIENT_TIME_RECEIVE = undef;
%pkt = eval { get_ntp_response('clock-b.develooper.com') };
if ($@ or $pkt{'Stratum'} == 0 or $pkt{'Stratum'} > 6) {
warn "no time from ntp1 or clock-b\n";
return 0;
}
}
return 1;
}
sub catch_TERM {
exit(0);
}
$SIG{TERM} = \&catch_TERM;
my $ua = HTTP::Tiny->new( agent => "NTPPool-Monitor/$VERSION" );
while (1) {
sleep 1;
sanity_check();
logsay("Getting servers to check");
my $response = $ua->get($pool_server);
my $data = eval { decode_json($response->{content}) } || {};
my $err = $@;
if (!$response->{success} or $data->{error} or $err or !$data) {
logsay(
"$pool_server error: ",
$response->{reason},
"\n",
($data->{error} ? "Server Response: " . $data . "\n" : ()),
($err ? "Data decoding error: $err\n" . $response->{content} . "\n" : ())
);
sleep 20;
next;
}
my @hosts = @{ $data->{servers} };
# If the server has nothing to do for us, come back later.
if (not @hosts) {
logsay("No work; waiting $sleeptime seconds");
sleep $sleeptime;
next;
}
my @status;
logsay("Checking servers:", @hosts);
for my $server (@hosts) {
$server =~ m/::/ and require IO::Socket::INET6;
my $status = { server => $server };
logsay("Checking $server");
# try twice
for (my $i = 0; !defined($status->{offset}) and $i < 2; $i++) {
$Net::NTP::CLIENT_TIME_RECEIVE = undef;
my $time_then = Time::HiRes::time;
$Net::NTP::CLIENT_TIME_SEND = $time_then;
my %pkt = eval { get_ntp_response($server); };
my $time_now = Time::HiRes::time;
$status->{ts} = $time_now;
if (!$pkt{Stratum} or $!) {
$status->{no_response} = 1;
}
else {
delete $status->{no_response};
my $recv_org = $pkt{'Receive Timestamp'} - $time_now;
my $trans_dest = $pkt{'Transmit Timestamp'} - $time_then;
$status->{offset} = ($recv_org + $trans_dest) / 2;
$status->{stratum} = $pkt{Stratum};
}
}
logsay("Status of $server", $status);
push @status, $status;
}
logsay("Posting response", \@status);
$response = $ua->request(
'POST',
$pool_server,
{ headers => {'Content-Type' => 'application/json'},
content => encode_json({version => 1, servers => \@status})
}
);
unless ($response->{success}) {
logsay("$pool_server error:", $response->{reason});
sleep 30;
next;
}
my $data = decode_json($response->{content});
if ($data->{warnings} && @{ $data->{warnings} }) {
for my $w (@{ $data->{warnings} }) {
logsay("WARNING: $w");
}
}
}
Jump to Line
Something went wrong with that request. Please try again.