#!/usr/bin/perl
#
# checkhost version 2.0 by Phil Stracchino
# All rights assigned to the Bacula project
# Licensed under the GPL v2, or at your option any later version
#
# Check whether a bacula client is alive and responding on the network.
# Optionally, send a wake-on-LAN packet to the client before testing.
#
# Checkhost does not perform a Bacula connection handshake or verify
# that passwords match; it only verifies that the client is reachable
# on the network and responding, and that the Bacula client is running
# and listening on port 9102.
#
# Usage:  checkhost [-r] [-v] [-i seconds] hostname|ipaddress
# Options:
#     -r, --retry:    Try three times to connect (default: try only once)
#     -i, --interval: Specify time in seconds to wait between retries
#                         (default: 30 seconds)
#     -v, --verbose:  output verbose status messages, for interactive
#                     use (default:  operate silently)
#     -w, --wake:     send wake-on-LAN packet before trying to connect
#
# Wake-on-LAN functionality requires the following schema to be created, by
# default, with a correct authentication group set up in .my.cnf for the
# group Bacula runs as:
# CREATE DATABASE ethers;
# CREATE TABLE ethers.ethers (id int primary key auto_increment,
#                             hostname varchar(128),
#                             ethers varchar(128),
#                             index host (hostname));
# The hostname field should contain a short or fully qualified hostname,
# while the ethers field should contain a list of hardware MAC addresses
# for that host, separated by spaces.

use strict;
use Getopt::Long;
use DBI;
use Socket;
use Net::Ping;
use Net::Telnet ();


# Return values:
#	-1  Program error or no host specified
#        0  Success, FD found and responding
#        1  Client alive but FD not listening
#	 2  Client not found on network

my $ret = -1;
my ($etherdb, $ethergroup) = qw(ethers ethers);
my $broadcast = '10.24.32.255';
my $my_ip = '10.24.32.14';
my ($host, %opts);

die "You must set the broadcast and my_ip addresses before running this tool" unless ($my_ip);

Getopt::Long::Configure ("bundling");
GetOptions(\%opts,
           'interval|i=i',
           'retry|r',
           'verbose|v',
           'wake|w');

$host = shift || die "No host specified!\n";

$ret = check_host($host) if ($host);
print "Client $host not found on network\n" if ($ret == 2);
print "Returning value $ret\n" if ($opts{verbose});

exit ($ret);


sub check_host
{
    my $host = $_[0];
    my ($hostname, $p, $retrycount);

    if ($host =~ /^\d+\.\d+\.\d+\.\d+$/)
    {
        my $ip = inet_aton($host);
        $hostname = gethostbyaddr($ip, AF_INET);
        print "Host $host has name $hostname\n" if ($opts{verbose});
    }
    else
    {
        $hostname = $host;
        printf("Client $host has address %d.%d.%d.%d\n",
               unpack('C4',
                      (my @addrs = (gethostbyname($host))[4])[0]));
    }

    if ($opts{wake})
    {
        foreach my $ether (split(/\s+/, get_ethers_by_host(shift())))
        {
            wake_host_by_hwaddr($ether);
        }
        printf("Wake-on-LAN packet sent to $host; sleeping for %s seconds\n",
               $opts{interval} || 30) if ($opts{verbose});
        sleep ($opts{interval} || 30);
    }


    $p = Net::Ping->new("icmp");
    $p->bind($my_ip);

    $retrycount = ($opts{retry} ? 3 : 1);

    while ($retrycount && ($ret != 0))
    {
        if ($p->ping($host, 2))
        {
            print "Host $host is alive\n" if ($opts{verbose});
            my $t = new Net::Telnet (Timeout => 10,
                                     Port    => 9102,
                                     Prompt  => '/bash\$ $/');
            if ($t->open($host))
            {
                print "Bacula-FD listening on port 9102\n" if ($opts{verbose});
                $ret = 0;
            }
            else
            {
                print "Bacula-FD not running on host $host\n";
               $ret = 1;
            }
            $t->close;
        }
        else
        {
            $ret = 2;
        }
        $retrycount--;
        if ($opts{retry} && ($ret != 0))
        {
            printf("\tNot found on try %d",
                   3 - $retrycount) if ($opts{verbose});
            if ($retrycount)
            {
                printf("; sleeping for %s seconds before retrying\n",
                       $opts{interval} || 30) if ($opts{verbose});
                sleep($opts{interval} || 30);
            }
            else
            {
                print "\n" if ($opts{verbose});
            }
        }
    }
    $p->close();

    return ($ret);
}



sub wake_host_by_hwaddr
{
    my ($packet, $hwaddr, $raddr, $port);

    foreach (split /:/, $_[0])
    {
        $hwaddr .= chr(hex($_));
    }
    $packet = chr(0xFF) x 6 . $hwaddr x 16;
    
    socket((SOCK, AF_INET, SOCK_DGRAM, getprotobyname('udp'))) || die "socket : $!";
    setsockopt(SOCK, SOL_SOCKET, SO_BROADCAST, 1) || die "setsockopt : $!";

    $port = getservbyname('discard', 'udp');
    $raddr = gethostbyname($broadcast);
    send(SOCK, $packet, 0, pack_sockaddr_in($port, $raddr)) || die "send : $!";

    close (SOCK);

    return;
}


sub get_ethers_by_host
{
    my ($dbh, $sth, $query, $ethers);

    $dbh = open_db();
    $query = sprintf('SELECT ethers FROM ethers WHERE hostname = \'%s\'',
                     $_[0]);
    $sth = $dbh->prepare($query);
    $sth->execute || die "Error:" . $dbh->errstr . "\n";
    while (my $ref = $sth->fetchrow_arrayref)
    {
        $ethers = $$ref[0];
    }
    $sth->finish();
    $dbh->disconnect();

    return ($ethers);
}


sub open_db
{
    my $home = $ENV{'HOME'};
    my ($dsn, $dbh, $user, $password);

    $dsn = "DBI:mysql:database=$etherdb;"
         . "mysql_read_default_group=$ethergroup;"
         . "mysql_read_default_file=$home/.my.cnf;"
         . "mysql_mysql_client_found_rows=TRUE;"
         . "mysql_mysql_ssl=TRUE";

    $dbh = DBI->connect($dsn, undef, undef, {RaiseError => 1, AutoCommit => 0});

    return ($dbh);
}