#!/usr/bin/perl
use warnings;
use strict;

use Nagios::Plugin;
use File::Basename;
use Time::HiRes qw( gettimeofday tv_interval );
use IO::Socket::INET;

# My plugin copies some code from Net::VNC, so I've licensed this plugin to
# match that module (Artistic or GPL). See http://dev.perl.org/licenses/

my $VERSION = "1.0";

# Constructor
my $p = Nagios::Plugin->new(
        usage => "Usage: %s -H host [-p port] [-t timeout]",
        shortname => 'VNC',
        version   => $VERSION,
        license   => 'Perl (Artistic or GPL)',
        blurb     => 'check VNC connectivity',
        extra     => 'Verify that VNC is running on the host. This script does not try to authenticate; it merely checks the RFB version.',
        url       => 'http://www.ktdreyer.com/',
        plugin    => basename($0),
        timeout   => 5,
);

$p->add_arg(
        spec => 'hostname|H=s',
        help => 'The name or address you want to query',
        required => 1,
);

$p->add_arg(
        spec => 'port|p=i',
        help => 'TCP port for the connection',
        default => 5900,
);

$p->getopts;

# set an alarm for the plugin's timeout value
alarm $p->opts->timeout;
my $start_time = [gettimeofday];

# This script uses a lot of code from Net::VNC on CPAN.
# If Net::VNC had a simple public "rfb_version" subroutine, I would love to use
# that instead of copying the code out of Net::VNC.  Alas, Net::VNC has no such
# API, favoring simplicity over complexity, so for now I will copy and paste
# the code.

my $MAX_PROTOCOL_VERSION = 'RFB 003.008' . chr(0x0a);  # Max version supported

my $hostname = $p->opts->hostname;
my $port     = $p->opts->port;
my $rfb_version;

my $net_timeout = $p->opts->timeout - 0.1 ;

eval {
	my $socket   = IO::Socket::INET->new(
		PeerAddr => $hostname,
		PeerPort => $port,
		Proto    => 'tcp',
		Timeout  => $net_timeout,
	) || die "Error connecting to $hostname: $@\n";

	$rfb_version = &handshake_protocol_version($socket);
};
my $error = $@;
if ($error) {
	$p->nagios_die($error);
}

my $elapsed_time = tv_interval($start_time);
$p->add_perfdata(
        label => "time",
        value => $elapsed_time,
        uom => "s",
);

if ($rfb_version) {
        $p->nagios_exit(OK, 'RFB version '.$rfb_version);
} else {
        $p->nagios_die('Plugin script exited with no messages.');
}

sub handshake_protocol_version {
    my $socket = shift;
    my $rfb_version;
    $socket->read( my $protocol_version, 12 ) || die 'unexpected end of data';

    #    warn "prot: $protocol_version";

    my $protocol_pattern = qr/\A RFB [ ] (\d{3}\.\d{3}) \s* \z/xms;
    if ( $protocol_version !~ m/$protocol_pattern/xms ) {
        die 'Malformed RFB protocol: ' . $protocol_version;
    }
    $rfb_version = $1;

    if ( $protocol_version gt $MAX_PROTOCOL_VERSION ) {
        $protocol_version = $MAX_PROTOCOL_VERSION;

        # Repeat with the changed version
        if ( $protocol_version !~ m/$protocol_pattern/xms ) {
            die 'Malformed RFB protocol';
        }
        $rfb_version = $1;
    }

    if ( $rfb_version lt '003.003' ) {
        die 'RFB protocols earlier than v3.3 are not supported';
    }

   # let's use the same version of the protocol, or the max, whichever's lower
    $socket->print($protocol_version);
	return $rfb_version;
}