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
