#!/usr/bin/perl
## >>---------------------------------------------------------------------------------

use strict;

use Sys::Hostname;
use Socket;
use Net::DHCP::Packet;
use Net::DHCP::Constants;
use POSIX qw(setsid strftime);

use IO::Socket::INET;

# sample logger
sub logger{
    my $str = shift;
    print STDOUT strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
    print STDOUT "$str\n";
}

logger("Starting dhcpd");

my $DAEMON = 0;	# run as daemon ?

# accept only from selected VENDOR classes (avoids messing existing networks)
my $VENDOR_ACCEPTED = "foo|bar";

# broadcast address
my $bcastaddr = sockaddr_in("68",INADDR_BROADCAST);

# get a flag to force daemon to stop
my $time_to_die = 0;

# generic signal handler to cause daemon to stop
sub signal_handler {
    $time_to_die = 1;
}
$SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&signal_handler;
# trap or ignore $SIG{PIPE}

# Daemon behaviour
# ignore any PIPE signal: standard behaviour is to quit process
$SIG{PIPE} = 'IGNORE';

# open listening socket
my $sock_in = IO::Socket::INET->new(
					LocalPort => 67,
					LocalAddr => "127.0.0.1",
					Proto    => 'udp') || die "Socket creation error: $@\n";

if ($DAEMON) {		# doesn't seem to work very well on cygwin
	logger("Entering Daemon mode");
	chdir '/'                 or die "Can't chdir to /: $!";
	umask 0;

	open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
	open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
	open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";

	my $pid = fork;
	exit if $pid;
	die "Couldn't fork: $!" unless defined($pid);

	POSIX::setsid() or die "Can't start a new session: $!";
	logger("Now in Daemon mode");
}

logger("Initialization complete");

# main loop
#
# process incoming packets
my $transaction = 0;			# report transaction number

	until ($time_to_die) {
		my $buf = undef;
		my $fromaddr;						# address & port from which packet was received
		my $dhcpreq;

		eval {					# catch fatal errors
			logger("Waiting for incoming packet");

			# receive packet
			$fromaddr = $sock_in->recv($buf,4096) || logger("recv:$!");
			next if ($!);		# continue loop if an error occured
			$transaction++;					# transaction counter

			{
				use bytes;
				my ($port,$addr) = unpack_sockaddr_in($fromaddr);
				my $ipaddr = inet_ntoa($addr);
	    	logger("Got a packet tr=$transaction src=$ipaddr:$port length=".length($buf));
	    }

			my $dhcpreq = new Net::DHCP::Packet($buf);
			$dhcpreq->comment($transaction);

		 	my $messagetype = $dhcpreq->getOptionValue(DHO_DHCP_MESSAGE_TYPE());

		 	if ($messagetype eq DHCPDISCOVER()) {
		 			do_discover($dhcpreq);
		 	} elsif ($messagetype eq DHCPREQUEST()) {
		 			do_request($dhcpreq);
		 	} elsif ($messagetype eq DHCPINFORM()) {

		 	} else {
		 		logger("Packet dropped");
		 		# bad messagetype, we drop it
		 	}
		};					# end of 'eval' blocks
		if ($@) {
			logger("Caught error in main loop:$@");
		}

	}
	logger("Exiting dhcpd");

#=======================================================================
sub do_discover($) {
	my ($dhcpreq) = @_;
	my $sock_out;
	my ($calc_ip, $calc_router, $calc_mask);

	# calculate address
	$calc_ip = "12.34.56.78";

	my $vendor = $dhcpreq->getOptionValue(DHO_VENDOR_CLASS_IDENTIFIER());
  if ($vendor !~ $VENDOR_ACCEPTED) {
    logger("DISCOVER rejected, unsupported VENDOR class");
    return;   # dropping packet
  }


	my $dhcpresp = new Net::DHCP::Packet(
											Comment => $dhcpreq->comment(),
											Op => BOOTREPLY(),
											Hops => $dhcpreq->hops(),
											Xid => $dhcpreq->xid(),
											Flags => $dhcpreq->flags(),
											Ciaddr => $dhcpreq->ciaddr(),
											Yiaddr => $calc_ip,
											Siaddr => $dhcpreq->siaddr(),
											Giaddr => $dhcpreq->giaddr(),
											Chaddr => $dhcpreq->chaddr(),
											DHO_DHCP_MESSAGE_TYPE() => DHCPOFFER(),
											);

	logger("Sending response");

	# Socket object keeps track of whom sent last packet
	# so we don't need to specify target address
	logger("Sending OFFER tr=".$dhcpresp->comment());
	$sock_in->send($dhcpresp->serialize()) || die "Error sending OFFER:$!\n";
	# TODO: you have to choose between sending back to sender or broadcasting to network

}

#=======================================================================
sub do_request($) {
	my ($dhcpreq) = @_;
	my $sock_out;
	my $calc_ip;
	my $dhcpresp;

	$calc_ip = "12.34.56.78";

	my $vendor = $dhcpreq->getOptionValue(DHO_VENDOR_CLASS_IDENTIFIER());
  if ($vendor !~ $VENDOR_ACCEPTED) {
    logger("REQUEST rejected, unsupported VENDOR class");
    return;   # dropping packet
  }

	# compare calculated address with requested address
	if ($calc_ip eq $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS())) {
		# address is correct, we send an ACK

		$dhcpresp = new Net::DHCP::Packet(
												Comment => $dhcpreq->comment(),
												Op => BOOTREPLY(),
												Hops => $dhcpreq->hops(),
												Xid => $dhcpreq->xid(),
												Flags => $dhcpreq->flags(),
												Ciaddr => $dhcpreq->ciaddr(),
												Yiaddr => $calc_ip,
												Siaddr => $dhcpreq->siaddr(),
												Giaddr => $dhcpreq->giaddr(),
												Chaddr => $dhcpreq->chaddr(),
												DHO_DHCP_MESSAGE_TYPE() => DHCPACK(),
												);
	} else {
		# bad request, we send a NAK
		$dhcpresp = new Net::DHCP::Packet(
												Comment => $dhcpreq->comment(),
												Op => BOOTREPLY(),
												Hops => $dhcpreq->hops(),
												Xid => $dhcpreq->xid(),
												Flags => $dhcpreq->flags(),
												Ciaddr => $dhcpreq->ciaddr(),
												Yiaddr => "0.0.0.0",
												Siaddr => $dhcpreq->siaddr(),
												Giaddr => $dhcpreq->giaddr(),
												Chaddr => $dhcpreq->chaddr(),
												DHO_DHCP_MESSAGE_TYPE() => DHCPNAK(),
												DHO_DHCP_MESSAGE(), "Bad request...",
												);
	}

	# Socket object keeps track of whom sent last packet
	# so we don't need to specify target address
	logger("Sending ACK/NAK tr=".$dhcpresp->comment());
	$sock_in->send($dhcpresp->serialize()) || die "Error sending ACK/NAK:$!\n";
  # TODO: you have to choose between sending back to sender or broadcasting to network

}