#
#$Id: Watch.pm,v 2.3 2003/10/28 11:09:59 edelrio Exp $
#
# Net::DHCP::Watch
#
package Net::DHCP::Watch;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

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

require Exporter;

@ISA       = qw(Exporter);
@EXPORT    = qw();
@EXPORT_OK = qw();

$VERSION = do { my @r=(q$Revision: 2.3 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r };

#
# 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};
    unless ( $h = gethost($self->{Server}) ) {
	carp "Can not resolve: ",$self->{Server};
    }

    # test if client hostname given is known (name or IP)
    # and keep only the first IP address.
    $self->{Client} = $params->{client};
    unless ( $h = gethost($self->{Client}) ) {
	carp "Can not resolve: ",$self->{Client};
    }
    $self->{Client} = $h->addr_list->[0];


    # 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} || 10;

    # 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  = DHCPREQUEST
		  3
		  );
    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;
}

1;
__END__

=head1 NAME

Net::DHCP::Watch - A class for monitoring a remote DHCPD server.

=head1 SYNOPSIS


  use Net::DHCP::Watch;
  # server name
  my $Server = 'dhcpd.mydomain.com';
  # this machine ip and ethernet address
  my $IP     = '192.168.1.1';
  my $Ether  = '01:23:45:67:89:ab';
  # Net::DHCP::Watch object
  my $dhcpw = new Net::DHCP::Watch({
		server => $Server,
                client => $IP,
		ether  => $Ether
	});

  # Open network
  $dhcpw->watch();
  # Get status
  my $stat = $dhcpw->status;
  # print results
  if ( $stat->{Bad} ) print $stat->{Time},
    ": Remote DHCP on $Server unavailable (",$stat->{Bad},").\n";

  if ( $stat->{Ok}  ) print $stat->{Time},
    ": Remote DHCP on $Server online.\n";

=head1 DESCRIPTION

Net::DHCP::Watch is a module to help monitor remote DHCP servers. It
opens an udp socket to send and receive responses to and from a DHCP
server. It stores the last connection status information.

This module serves to implement This module can help to write some
simple code to implement a reliable DHCP service over complex or
simple networks.


=head1 METHODS

=over 4

=item B<new> 

Creates a new Net::DHCP::Watch object. The parameters are passed
through a hash with the following keys:

=over 4

=item I<Server>

DHCP server name or IP address to be monitored (not the local machine
performing the monitoring).

=item I<Client>

Name or IP addres to use for the local machine performing the
monitoring. Since there is no obvious way to determine that, it is
mandatory.

=item I<Ether>

Ethernet address of the local machine performing the monitoring. Since
there is no obvious way to determine that, it is mandatory. You can
pass a 6 element array of bytes or a ':' separated string of hex
values. In UNIX machines you can tipically do something like this:

	my $ether = qx[ /sbin/ifconfig eth0 | tail +1 |\
			head -1 | awk '{print \$5}'];
	chomp($ether);

=item I<Timeout>

The timeout for network operation (default 10s).

=back

=item B<watch>

Prepares for monitoring. Opens an UDP socket to the server. This
method could fail or interfere with the operation of a local DHCPd
server.

=item B<unwatch>

Closes monitoring. You should use this method before starting any local 
DHCP server.

=item B<status>

Try to comunicate with the server and returns the status in a hash. The
hash contains three keywords. I<Ok> will be true if the attempt completed
successfully, I<Bad> will be true if the attempt was not; they will
contain the number of successful (or unsuccessful) contiguous attempts
made. I<Time> contains the GMT time string of the last attempt.

=back

=head1 EXAMPLES

See the directory F<examples> in source distribution for an example.

=head1 BUGS

There should be a Net::DHCP class to handle the DHCP protocol.

=head1 LIMITATIONS

On platforms without I<alarm()> function defined the monitoring can
hang forever if some network problems show up (cable problem, etc)?

The machine that is running the test MUST BE a KNOWN client of the
remote DHCP server.

=head1 AUTHOR

Evilio del Rio, edelrio@icm.csic.es

=head1 ACKNOWLEDGEMENTS

I would like to acknowledge the valuable contributions of the people
who made suggestions to improve this code, specially to Nick Garfield
who provided the solution for monitoring disjoint networks.

=head1 SEE ALSO

L<perl(1)>, L<IO::Socket(3)>, L<Net::hostent(3)>. RFCs 2131 and 2132.

I<Ralph Droms & Ted Lemon>, B<The DHCP Handbook>, MacMillan
(Indianapolis), 1999.

=cut