DHCP Monitor

Problem this snippet solves:

This monitor uses the perl IO::socket module (included in the LTM build) to send a DHCPINFORM message to verify an expected response from load balanced DHCP servers.

It requires a single command-line argument: For a redundant pair, enter a space delimited list containing the server-facing non-floating Self-IPs of BOTH LTMs (the script will parse the correct response address for each unit in the redundant pair.); for a single unit, enter the server-facing Self-IP.

How to use this snippet:

Implementation

Create a new file containing the code below on the LTM filesystem. Recommended location is /config/eav. Permissions on the file must be 700 or better, giving root rwx access to the file. 2. Create a monitor profile of type "External" with the following values:
- External Program: . . the name of the script file created in step 1
- Arguments: . . . . . .
- Adjust the interval and timeout as appropriate for your application

Code :

#!/usr/bin/perl -w 
use strict;

#############################################################################
# When you configure this as an EAV you MUST specify *both* SELF-IPs on the
# VLAN containing the servers to be monitored for both BIG-IPs in an HA pair 
# as arguments, separated by a space.  If you only have a standalone BIG-IP 
# then just specify one...

# Note that the default timeout below is 5 seconds so I'd recommend a monitor
# frequency of interval=10, timeout=31.
#############################################################################

#############################################################################
# Configuration Section
# How long to wait for an answer
my $TimeOut = 5;

# Message type of 8 is a DHCP Inform -- 
# your DHCP server must support DHCPINFORM to use this monitor
my $MsgType = 8;
#############################################################################

package Net::DHCP::Watch;
# This is a slightly-modified version of the CPAN module
# by Evilio José del Río Silván.

use Carp;
use Config;
use Socket;
use Net::hostent;
use IO::Socket;

#
# new
#
sub new {
    my $proto  = shift;
    my $params = shift; 
    my $class  = ref($proto) || $proto;
    my $self   = {};
    bless($self, $class);
    $self->init($params);
    return $self;
}
#
# init: initalize parameters.
#
sub init {
    my $self   = shift;
    my $params = shift;
    my $h;

    # test if server hostname given is known (name or IP)
    $self->{Server} = $params->{server};

    # test if client hostname given is known (name or IP)
    # and keep only the first IP address.
    $self->{Client} = $params->{client};
    $self->{Client} = pack('CCCC', split(/\./, $params->{client}, 4));

    # test if ethernet address is either an array of six bytes or
    # a string of hex bytes separated by ':'
    $self->{Ether}  = $params->{ether};

    if ( $self->{Ether} =~ m/^([0-9a-f]{1,2}:)+[0-9a-f]{1,2}$/i ) {
my @eth = map( hex, split(':', $self->{Ether}) );
$self->{Ether} = \@eth;
    }
    elsif ( scalar($self->{Ether}) != 6 ) {
croak "Not a good ethernet addres: ",$params->{ether};
    }

    # can we use alarm() ?
    if ( $Config{d_alarm} eq 'define' ) {
$self->{_Alarm} = 1;
    }
    else {
carp "No alarm() function, network operation may hang";
$self->{_Alarm} = 0;
    }

    # set the timeout (alarm)
    $self->{TimeOut} = $params->{timeout} || 5;

    # set the timeout (alarm)
    $self->{MsgType} = $params->{msgtype} || 8;

    # initialize status result to zero
    $self->{Last} = {
Ok   => 0,
Bad  => 0,
Time => '0000-00-00 00:00:00 GMT'
    };
    return;
}

#
# watch: opens the udp socket to the server
#
sub watch {
    my $self = shift;
    if ( $self->{Watcher} ) {
carp "Already watching.";
    }
    else {
$self->{Watcher} = new IO::Socket::INET(
PeerAddr  => $self->{Server},
PeerPort  => 'bootps(67)',
#LocalAddr => inet_ntoa($self->{Client}),
LocalPort => 'bootpc(68)',
Proto     => 'udp',
Timeout   => $self->{TimeOut}
)
    or carp "Can not watch: $!";
    }
    return $self->{Watcher};
}

#
# status: returns the present status
#
sub status {
    my $self = shift;
    # now the watch/unwatch cycle is carried by status.
    $self->watch unless( $self->{Watcher} );
    $self->dhcp_query or return;
    $self->unwatch;
    return $self->{Last};
}

#
# dhcp_query: sends an udp packet containig a DHCP message 
# of type DHCPDISCOVER and listens to the reply. The random transaction id
# must match.
#
sub dhcp_query {
    my $self = shift;
    my $reply; # holdspace for udp reply
    #
    # Test if socket is ok
    #
    unless ( $self->{Watcher} ) {
carp "Not watching yet!";
return;
    };
    #
    # Transaction ID
    #
    my $xid = int(rand(2**32-1));
    #
    # DHCP Message: Fixed-Format + Options 
    # (see Droms & Lemon, 1999, Apendixes C and D).
    #
    my @fields = (
                  # op
  1,
                  # htype
  1,
                  # hlen
  6,
                  # hops
  0,
                  # xid
  $xid,
                  # secs
  0,
                  # flags
  0,
                  # ciaddr
  $self->{Client},
                  # yiaddr
  0,
                  # siaddr
  0,
                  # giaddr
  0,
                  # chaddr
  @{ $self->{Ether} },
  0,  0,  0,  0,  0,  0, 
  0,  0,  0,  0,
                  # sname
  "\0",
                  # file
  "\0",
                  # Magic cookie (RFC)
  99,130,83,99,
                  # option1 = DHCP-Message
  53,
                  # length1 = 1
  1,
                  # value1  
  $self->{MsgType}
  );
    my $query = pack(
     # It's horrible, but it works
     'CCCCNnna4NNNCCCCCCCCCCCCCCCCa64a128C*',
     @fields
     );
    my $serv_address;
    # I/O eval block
    eval {
# SIG handling for alarm()
local $SIG{ALRM} = sub { die "Alarm timeout\n" };
# Send query
alarm($self->{TimeOut})
    if $self->{_Alarm}; 
$self->{Watcher}->send($query, 0);
alarm(0)
    if $self->{_Alarm};
# Get reply
alarm($self->{TimeOut})
    if $self->{_Alarm};
$serv_address = $self->{Watcher}->recv($reply, 1024,  0);
alarm(0)
    if $self->{_Alarm};
    };
    # Die if not alarm
    if($@) {
carp $@ unless $@ =~ /alarm/i;
    }
    # Verify
    # be sure $ret_xid is not equal to $xid
    my $ret_xid = !$xid;
    if ( $reply ) {
$ret_xid = unpack('x4N',$reply);
    }
    # only if we've got a reply and the reply was correct all is ok.
    if ( $ret_xid == $xid ) {
# Increment Ok count (max: 2**31-1)
$self->{Last}->{Ok} %= 2147483647;
$self->{Last}->{Ok}++;
# Zero Bad
$self->{Last}->{Bad} = 0;
    }
    else {
# Zero ok
$self->{Last}->{Ok} = 0;
# Increment Bad count (max: 2**31-1)
$self->{Last}->{Bad} %= 2147483647;
$self->{Last}->{Bad}++;
    }
    # Get present time (GMT)
    $self->{Last}->{Time} = gmtime;
}
#
# close: just closes socket.
#
sub unwatch {
    my $self = shift;
    delete $self->{Watcher};
}
#
# Cleanup
# 
sub DESTROY {
    my $self = shift;
    $self->unwatch;
}

package main;

# Read arguments
my $Server = $ARGV[0];
$Server =~ s/::ffff://;
# Port not used
my $port = $ARGV[1];
shift @ARGV;
shift @ARGV;
my $IP = $ARGV[0];
# We need to figure out which SELF-IP is our own...
foreach (@ARGV) {
   if (system("b self $_ show >/dev/null 2>&1") == 0) {
      $IP = $_;
   }
}

# Check for and create PID file
my $monname = $ENV{MON_TMPL_NAME};
$monname = $0 unless $monname;
$monname =~ s/^.*\///;
my $pidfile = "/var/run/$monname.$Server.pid";
if (-r $pidfile) {
   open(PIDFILE, $pidfile);
   my $oldpid = ;
   close PIDFILE;
   chomp $oldpid;
   system("kill -9 $oldpid");
}
open(PIDFILE, ">$pidfile");
print PIDFILE "$$\n";
close PIDFILE;

# Net::DHCP::Watch object
my $dhcpw = new Net::DHCP::Watch({
              server => $Server,
              client => $IP,
              ether  => $Ether,
              timeout  => $TimeOut,
              msgtype  => $MsgType,
      });

# Open network
$dhcpw->watch();
# Get status
my $stat = $dhcpw->status;
# Remove PIDFILE before echoing anything to STDOUT
unlink $pidfile;
# print results
print STDERR "Down" if ( $stat->{Bad} );
print "UP" if ( $stat->{Ok}  );

Published Mar 12, 2015

Version 1.0

monitor

perl