NTP Monitor

I ain't got time for a Perl module.

Hacked together from the above and Perl Monks. Seems to work!

!/usr/bin/perl

use IO::Socket;

my $programname = '/' . $0;
$programname =~ m/^.*\/([^\/]+)$/;
$programname = $1;
 
if ($programname eq '') {
    die "Bad data in program name\n"
}

my $pidfile = "/var/run/$programname.$node..$port.pid";
my $pid = "$$";

if (-f $pidfile ) {
    open(PID, "<$pidfile"); 
    my $pid = ; 
    close(PID);
    if ( $pid ) {
        chomp $pid; $pid =~ m/^(\d+)$/; $pid = $1;
        if ( $pid ) {
            kill 9, $pid;
        }
    }
    unlink($pidfile);
}

open(PID, ">$pidfile");
print PID $pid, "\n";
close(PID);

if (GetNTPTime($ARGV[0],$ARGV[1])) {
    print "OK\n";
} else {
    print "DOWN\n";
}

unlink($pidfile);
exit(0);

sub GetNTPTime{
    my $host = shift;
    my $timeout = 2;
    my $sock = IO::Socket::INET->new(
        Proto => 'udp',
        PeerPort => $ARGV[1],
        PeerAddr => $host,
      Timeout => $timeout
    )   or do { return 0 };
    my $ntp_msg = pack("B8 C3 N11", '00100011', (0)x14);
    $sock->send($ntp_msg) or do { return 0 };
    my $rin='';
    vec($rin, fileno($sock), 1) = 1;
    select(my $rout=$rin, undef, my $eout=$rin, $timeout) or do { return 0 };
    $sock->recv($ntp_msg, length($ntp_msg))
        or do { return 0 };
    my ($LIVNMode, $Stratum, $Poll, $Precision,
            $RootDelay, $RootDispersion, $RefIdentifier,
            $Reference, $ReferenceF, $Original, $OriginalF,
            $Receive, $ReceiveF, $Transmit, $TransmitF
        )   = unpack('a C2 c1 N8 N N B32', $ntp_msg);
    $Receive -= 2208988800;
    my $NTPTime = $Receive + $ReceiveF / 65536 / 65536;
    $RefIdentifier = unpack('A4', $RefIdentifier);
    my $LI = vec($LIVNMode, 3, 2);
    my $VN = unpack("C", $LIVNMode & "\x38") >> 3;
    my $Mode = unpack("C", $LIVNMode & "\x07");
    $sock->close;
    if ($RefIdentifier ne '1280') {
        return 1
    } else {
        return 0
    }
}