monitor

#!/usr/bin/env perl
use strict;
use Net::NTP 1.3;
use LWP;
use Time::HiRes;
use JSON qw(decode_json encode_json);
use Capture::Tiny qw(capture_merged);

my $VERSION = "0.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) {
    die "monitoring server not synchronized\n";
}

#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 = LWP::UserAgent->new;
$ua->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->is_success or $data->{error} or $err or !$data) {
        logsay(
            "$pool_server error: ",
            $response->status_line,
            "\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->post($pool_server, Content_Type => 'application/json',
			  Content => encode_json({ version => 1, servers => \@status }));

    unless ($response->is_success) {
        logsay("$pool_server error:", $response->status_line);
        sleep 30;
        next;
    }
            
    my $data = decode_json($response->content);
    if ($data->{warnings} && @{ $data->{warnings} }) {
	for my $w (@{ $data->{warnings} }) {
	    logsay("WARNING: $w");
	}
    }
}