X-Git-Url: http://git.datanom.net/pve-dhcp-server.git/blobdiff_plain/2470397ffb9d6eeebfcbda3cfcab8858916c1f0e..HEAD:/DHCPServer.pm

diff --git a/DHCPServer.pm b/DHCPServer.pm
index ebf7144..8084c3f 100644
--- a/DHCPServer.pm
+++ b/DHCPServer.pm
@@ -6,8 +6,7 @@ use Carp qw(croak);
 use Sys::Hostname;
 use Socket;
 use Socket6;
-use Net::DHCP::Packet;
-use Net::DHCP::Constants;
+use NetAddr::IP;
 use IO::Socket::IP;
 use IO::File;
 use IO::Select;
@@ -17,234 +16,80 @@ use POSIX qw(EINTR setsid strftime);
 use Data::Dumper;
 use Time::Local;
 
+use Net::DHCP::Packet;
+use Net::DHCP::Constants;
+
 use constant {
-	DEBUG => 0,
-	INFO => 1,
-	NOTICE => 2,
-	WARNING => 3,
-	ERROR => 4,
-	CRITICAL => 5,
-	ALERT => 6,
-	EMERGENCY => 7,
+	DEBUG		=> 0,
+	INFO		=> 1,
+	NOTICE		=> 2,
+	WARNING		=> 3,
+	ERROR		=> 4,
+	CRITICAL	=> 5,
+	ALERT		=> 6,
+	EMERGENCY	=> 7,
+	DHCP_OFFER	=> 100,
+	DHCP_ACK	=> 101,
 };
 
 use Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT = qw(run);
-
-our @EXPORT_OK = (
-	'DEBUG',
-	'INFO',
-	'NOTICE',
-	'WARNING',
-	'ERROR',
-	'CRITICAL',
-	'ALERT',
-	'EMERGENCY'
+our @EXPORT = qw(
+	run
+	DEBUG
+	INFO
+	NOTICE
+	WARNING
+	ERROR
+	CRITICAL
+	ALERT
+	EMERGENCY
 );
 
-our %EXPORT_TAGS = ( constants => [
-	'DEBUG',
-	'INFO',
-	'NOTICE',
-	'WARNING',
-	'ERROR',
-	'CRITICAL',
-	'ALERT',
-	'EMERGENCY'
-]);
-
 our $VERSION = '0.01';
 our $NAME = 'PVE::DHCPServer';
+our $DEFAULT_LEASE = 7200;
+our $DEFAULT_LEASE_RENEW = 5400;
 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;
-
-# ignore any PIPE signal: standard behaviour is to quit process
-$SIG{PIPE} = 'IGNORE';
-
-sub new {
-    my ($class, %self) = @_;
-
-    # OOP stuff
-    $class = ref($class) || $class;
-    my $self = \%self;
-    bless $self, $class;
+#########################################################################
+# Private methods
+#########################################################################
 
-	# private
-    $self->{_sock_in_ip4}	  = undef;
-    $self->{_sock_out_ip4}	  = undef;
-    $self->{_sock_in_ip6}	  = undef;
-    $self->{_sock_out_ip6}	  = undef;
-    $self->{_leases}		  = undef;
-    $self->{_reverse}		  = undef;
-    $self->{_config}		  = undef;
-	$self->{_transaction_ip4} = 0;
-	$self->{_transaction_ip6} = 0;
-
-	# public
-	$self->{log_file}		||= 'syslog';
-    $self->{lease_time}		||= 7200;
-    $self->{subnet_mask}	||= undef;
-    $self->{routers}		||= undef;
-    $self->{broadcast_addr}	||= undef;
-    $self->{domain_name}	||= undef;
-    $self->{dns_servers}	||= undef;
-	$self->{ntp_servers}	||= undef;
-	$self->{LOG_LEVEL} 		= ERROR unless defined $self->{LOG_LEVEL};
-	$self->{NODAEMON}		||= 0;
-	$self->{DEBUG}			||= 0;
-	$self->{timeout}		||= 10;
-	$self->{lease_file}		||= '/tmp/dhcpd.leases';
-	$self->{conf_file}		||= '/tmp/dhcpd.cfg';
-
-    return $self;
-}
-
-sub run {
-	my ($self) = @_;
-	my ($sel, @ready, $socket, $res);
-
-	eval {
-		$self->read_config();
-	};
-	if ($@) {
-		my $err = $@;
-		$self->logger($err, ERROR);
-		die $err;
-	}
-	$self->logger("Starting dhcpd", INFO);
-	if ($self->{NODAEMON} < 1) {
-		$self->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;
-		do {
-			my $err = $!;
-			$self->logger("Couldn't fork: $err", ERROR);
-			die "Couldn't fork: $err";
-		} unless defined($pid);
-
-		POSIX::setsid() || do {
-			my $err = $!;
-			$self->logger("Can't start a new session: $err", ERROR);
-			die "Can't start a new session: $err";
-		};
-		$self->logger("Now in Daemon mode", INFO);
-	}
-
-	$res = $self->read_lease_file();
-	$self->logger("Starting with empty leases file '$self->{lease_file}'", INFO) unless $res;
-
-	$self->logger("Initialization complete", INFO);
-
-	# open listening socket
-	$self->{_sock_in_ip4} = IO::Socket::IP->new(
-		Domain		=> PF_INET,
-		LocalPort	=> 67,
-		LocalAddr	=> inet_ntoa(INADDR_ANY),
-		Proto		=> 'udp'
-	) || do {
-		my $err = $@;
-		$self->logger("IP4 Socket creation error: $err", ERROR);
-		die "IP4 Socket creation error: $err\n";
-	};
-	$self->{_sock_in_ip6} = IO::Socket::IP->new(
-		Domain		=> PF_INET6,
-		V6Only		=> 1,
-		LocalPort	=> 547,
-		LocalAddr	=> '::',
-		Proto		=> 'udp'
-	) || do {
-		my $err = $@;
-		$self->logger("IP6 Socket creation error: $err", ERROR);
-		die "IP6 Socket creation error: $err\n";
-	};
-
-	$sel = IO::Select->new($self->{_sock_in_ip4});
-	$sel->add($self->{_sock_in_ip6});
-
-	until ($time_to_die) {
-		my $buf = undef;
-		my $fromaddr;
-		my $dhcpreq;
-
-		eval {	# catch fatal errors
-			while (@ready = $sel->can_read) {
-				$self->logger("Waiting for incoming packet", INFO);
-				foreach $socket (@ready) {
-					if ($socket == $self->{_sock_in_ip4}) {
-						# receive ipv4 packet
-						$fromaddr = $self->{_sock_in_ip4}->recv($buf, 4096)
-							|| $self->logger("recv: $!", ERROR);
-						next if ($!);	# continue loop if an error occured
-						$self->{_transaction_ip4}++;	# transaction counter
-
-						{
-							use bytes;
-							my ($port,$addr) = unpack_sockaddr_in($fromaddr);
-							my $ipaddr = inet_ntoa($addr);
-							$self->logger("Got a packet tr=$self->{_transaction_ip4} src=$ipaddr:$port length=".length($buf), INFO);
-						}
-
-
-						my $dhcpreq = new Net::DHCP::Packet($buf);
-						$dhcpreq->comment($self->{_transaction_ip4});
+my $logger = sub {
+	my ($self, $message, $level) = @_;
 
-						my $messagetype = $dhcpreq->getOptionValue(DHO_DHCP_MESSAGE_TYPE());
+	$level ||= DEBUG;
+	return unless ($level >= $self->{LOG_LEVEL});
 
-						if ($messagetype eq DHCPDISCOVER()) {
-								$self->discover_ip4($dhcpreq);
-						} elsif ($messagetype eq DHCPREQUEST()) {
-								$self->request_ip4($dhcpreq);
-						} elsif ($messagetype eq DHCPINFORM()) {
-							$self->logger("Not implemented: DHCPINFORM", WARNING);
-						} elsif ($messagetype eq DHCPRELEASE()) {
-								$self->release_ip4($dhcpreq);
-						} else {
-							$self->logger("Packet dropped", WARNING);
-							# bad messagetype, we drop it
-						}
-					} else {
-						# Receive ipv6 packet
-						my $ipaddr;
+	$level = "debug" if $level eq DEBUG;
+	$level = "info" if $level eq INFO;
+	$level = "notice" if $level eq NOTICE;
+	$level = "warning" if $level eq WARNING;
+	$level = "err" if $level eq ERROR;
+	$level = "crit" if $level eq CRITICAL;
+	$level = "alert" if $level eq ALERT;
+	$level = "emerg" if $level eq EMERGENCY;
 
-						$fromaddr = $self->{_sock_in_ip6}->recv($buf, 4096)
-							|| $self->logger("recv: $!", ERROR);
-						next if ($!);	# continue loop if an error occured
-						$self->{_transaction_ip6}++;	# transaction counter
-						$self->logger("recv: $buf", INFO);
-						{
-							use bytes;
-							my ($port,$addr) = unpack_sockaddr_in6($fromaddr);
-							$ipaddr = inet_ntop(AF_INET6, $addr);
-							$self->logger("Got a packet tr=$self->{_transaction_ip6} src=$ipaddr:$port length=".length($buf), INFO);
-						}
-						$self->excuse_me_ip6($ipaddr, $buf);
-					}
-				}
-			}
-		};	# end of 'eval' blocks
-		if ($@) {
-			$self->logger("Caught error in main loop: $@", ERROR);
+	if ($self->{DEBUG}) {
+		print STDOUT strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
+		print STDOUT "$level: " . ($message ? $message : 'No message') . "\n";
+	} elsif ($self->{log_file} eq 'syslog') {
+		openlog($NAME, 'ndelay,pid', 'user');
+		syslog($level, $message);
+		closelog();
+	} else {
+		my $fh = new IO::File;
+		if (! $fh->open("> $self->{log_file}")) {
+			croak "$self->{log_file}: $!";
 		}
+		print $fh strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
+		print $fh "$level: $message\n";
+		undef $fh;
 	}
-	$self->{_sock_in_ip4}->close;
-	$self->{_sock_in_ip6}->close;
-	$self->logger("Exiting dhcpd", INFO);
-}
+};
 
-sub run_with_timeout {
+my $run_with_timeout = sub {
     my ($self, $code, @param) = @_;
 
     die "got timeout" if $self->{timeout} <= 0;
@@ -278,9 +123,9 @@ sub run_with_timeout {
     die $err if $err;
 
     return $res;
-}
+};
 
-sub lock {
+my $lock = sub {
 	my ($self, $file, $shared) = @_;
 
 	my $mode = $shared ? LOCK_SH : LOCK_EX;
@@ -293,7 +138,7 @@ sub lock {
 			$self->{file_handle} = new IO::File (">$file") ||
                 die "can't open file '$file' for write - $!";
 		}
-        $self->logger("trying to aquire lock on '$file'...");
+        $self->$logger("trying to aquire lock on '$file'...");
         if (!flock ($self->{file_handle}, $mode|LOCK_NB)) {
 			my $success;
 			while(1) {
@@ -307,34 +152,34 @@ sub lock {
 				seek($self->{file_handle}, 0, SEEK_END) or $success = 0;
 			}
 			if (!$success) {
-				$self->logger(" failed");
+				$self->$logger(" failed");
 				die "can't aquire lock - $!";
 			}
         }
-		$self->logger(" OK");
+		$self->$logger(" OK");
     };
 
     my $res;
     my $err = undef;
 
     eval {
-		$res = $self->run_with_timeout($lock_func);
+		$res = $self->$run_with_timeout($lock_func);
 	};
     if ($@) {
-		$self->logger("can't lock file '$file' - $@", ERROR);
+		$self->$logger("can't lock file '$file' - $@", ERROR);
 		$self->{file_handle} = undef;
 		return undef;
     }
 
     return $res;
-}
+};
 
-sub unlock {
+my $unlock = sub {
 	my ($self, $file) = @_;
 
 	return '' unless($self->{file_handle});
 	my $unlock_func = sub {
-        $self->logger("trying to unlock '$file'...");
+        $self->$logger("trying to unlock '$file'...");
         if (!flock($self->{file_handle}, LOCK_UN)) {
 
 			my $success;
@@ -346,75 +191,77 @@ sub unlock {
 				}
 			}
 			if (!$success) {
-				$self->logger(" failed");
+				$self->$logger(" failed");
 				die "can't unlock - $!";
 			}
         }
-		$self->logger(" OK");
+		$self->$logger(" OK");
     };
 
     my $res;
     my $err = undef;
 
     eval {
-		$res = $self->run_with_timeout($unlock_func);
+		$res = $self->$run_with_timeout($unlock_func);
 	};
     if ($@) {
-		$self->logger("can't lock file '$file' - $@", ERROR);
+		$self->$logger("can't lock file '$file' - $@", ERROR);
 		$self->{file_handle} = undef;
 		$res = undef;
     }
 
     return $res;
-}
+};
 
-sub convert_timestamp {
+my $convert_timestamp = sub {
 	my ($self, $timestamp, $strtotime) = @_;
 	my ($res, $mday, $mon, $year, $hour, $min, $sec);
 
-	$self->logger("Timestamp: $timestamp");
+	$self->$logger("Timestamp: $timestamp");
 	if ($strtotime) {
 		if ($timestamp !~ /^\d{4}\/\d{2}\/\d{2}\s+\d{2}:\d{2}:\d{2}$/) {
-			$self->logger("$timestamp: Bad format", ERROR);
+			$self->$logger("$timestamp: (strtotime) Bad format", ERROR);
 			$res = undef;
 		} else {
 			($year,$mon,$mday,$hour,$min,$sec) = split(/[\s\/:]+/, $timestamp);
 			$res = timelocal($sec,$min,$hour,$mday,$mon-1,$year);
 		}
 	} else{
+		$self->$logger($timestamp);
 		if ($timestamp !~ /^\d+$/) {
-			$self->logger("$timestamp: Bad format", ERROR);
+			$self->$logger("$timestamp: (timetostr) Bad format", ERROR);
 			$res = undef;
 		} else {
 			($sec,$min,$hour,$mday,$mon,$year) = localtime($timestamp);
-			$self->logger("Timestamp: $sec,$min,$hour,$mday,$mon,$year");
+			$self->$logger("Timestamp: $sec,$min,$hour,$mday,$mon,$year");
 			$res = sprintf("%d/%02d/%02d %02d:%02d:%02d", ($year+1900),($mon+1),$mday,$hour,$min,$sec);
-			$self->logger("Timestamp: $res");
+			$self->$logger("Timestamp: $res");
 		}
 	}
 
 	return $res;
-}
+};
 
 
-sub add_lease {
+my $add_lease = sub {
 	my ($self, $ip, $lease) = @_;
 	my $ts;
 
 	my $mac = $lease->{'hardware ethernet'};
 	$mac =~ tr/://d;
 	$lease->{'hardware ethernet'} = $mac;
-	$ts = $self->convert_timestamp($lease->{starts}, 1);
+	$ts = $self->$convert_timestamp($lease->{starts}, 1);
 	return unless $ts;
 	$lease->{starts} = $ts;
-	$ts = $self->convert_timestamp($lease->{ends}, 1);
+	$ts = $self->$convert_timestamp($lease->{ends}, 1);
 	return unless $ts;
 	$lease->{ends} = $ts;
 
 	$self->{_leases}->{$ip} = $lease;
+	$self->$logger(Dumper($self->{_leases}->{$ip}));
 	$self->{_reverse}->{$mac} = $ip;
-	$self->logger("$mac =>\n" . Dumper($self->{_reverse}->{$mac}));
-}
+	$self->$logger("$mac => $self->{_reverse}->{$mac}");
+};
 
 #lease vvv.xxx.yyy.zzz {
 #	starts yyyy/mm/dd hh:mm:ss;
@@ -423,32 +270,37 @@ sub add_lease {
 #	hardware ethernet MAC;
 #	client-hostname "name"
 #}
-sub read_lease_file {
+my $read_lease_file = sub {
 	my ($self) = @_;
 	my ($res, $key, $lease);
 	my $error = 0;
 
-	$self->lock($self->{lease_file}, 1);
+	# Start with empty leases file?
+	if (! -e $self->{lease_file}) {
+		return 0;
+	}
+
+	$self->$lock($self->{lease_file}, 1);
 	if ($self->{file_handle}) {
 		my $fh = $self->{file_handle};
 		my @lines = <$fh>;
 		foreach (@lines) {
-			$self->logger("Read: $_");
+			$self->$logger("Read: $_");
 			if ($_ =~ /^\s*lease\s+([\d\.]+)\s+{\s*/) {
-				$self->add_lease($key, $lease) if $lease;
+				$self->$add_lease($key, $lease) if $lease;
 				$key = $1;
 				$lease = undef;
 				$error = 0;
-				$self->logger("Key: $key");
+				$self->$logger("Key: $key");
 			} else {
 				next if $error;
 				next if ($_ =~ /^\s*}\s*/ || $_ =~ /^\s*$/ || $_ =~ /^\s*#.*/);
 				if ($_ =~ /^\s*(starts|ends|binding state|hardware ethernet|client-hostname)\s+(.+)\s*;/) {
 					$lease->{$1} = $2;
-					$self->logger("Key: $1 Value: $2");
+					$self->$logger("Key: $1 Value: $2");
 				} else {
 					$key = 'UNDEF' unless $key;
-					$self->logger("$key: Bad format", ERROR);
+					$self->$logger("$key: Bad format", ERROR);
 					$key = undef;
 					$lease = undef;
 					$error = 1;
@@ -456,48 +308,51 @@ sub read_lease_file {
 			}
 		}
 		if ($lease && !$error) {
-			$self->logger("Key: $key");
-			$self->add_lease($key, $lease);
+			$self->$logger("Key: $key");
+			$self->$add_lease($key, $lease);
 		}
-		$self->logger("Leases data structure: \n" . Dumper($self->{_leases}));
-		$self->unlock($self->{lease_file});
+		$self->$logger("Leases data structure: \n" . Dumper($self->{_leases}));
+		$self->$unlock($self->{lease_file});
 		$res = 1;
 	} else {
-		$self->logger("Could not read leases file", ERROR);
+		$self->$logger("Could not read leases file", INFO);
 		$res = 0;
 	}
 
 	return $res;
-}
+};
 
-sub write_lease_file {
+my $write_lease_file = sub {
 	my ($self) = @_;
 	my $res;
 
-	$res = $self->lock($self->{lease_file}, 0);
+	$res = $self->$lock($self->{lease_file}, 0);
 	if ($self->{file_handle}) {
-		my $fh = $self->{file_handle};
-		while ((my $lease, my $elems) = each $self->{_leases}) {
-			$self->logger("Writing: $lease");
-			print $fh "lease $lease {\n";
-			while ((my $key, my $val) = each %$elems) {
-				if ($key =~ /^(starts|ends)$/) {
-					$val = $self->convert_timestamp($val, 0);
+		if ($self->{_leases}) {
+			my $fh = $self->{file_handle};
+			my $leases = $self->{_leases};
+			while ((my $lease, my $elems) = each (%$leases)) {
+				$self->$logger("Writing: $lease");
+				print $fh "lease $lease {\n";
+				while ((my $key, my $val) = each %$elems) {
+					if ($key =~ /^(starts|ends)$/) {
+						$val = $self->$convert_timestamp($val, 0);
+					}
+					$self->$logger("Writing: $key $val");
+					print $fh "\t$key $val;\n";
 				}
-				$self->logger("Writing: $key $val");
-				print $fh "\t$key $val;\n";
+				print $fh "}\n";
 			}
-			print $fh "}\n";
 		}
-		$self->unlock($self->{lease_file});
+		$self->$unlock($self->{lease_file});
 		$res = 1;
 	} else {
-		$self->logger("Could not write leases file", ERROR);
+		$self->$logger("$self->{lease_file}: Could not write leases file", ERROR);
 		$res = 0;
 	}
 
 	return $res;
-}
+};
 
 #subnet 192.168.9.0 netmask 255.255.255.0 {
 #	range 192.168.9.2 192.168.9.100;
@@ -513,28 +368,28 @@ sub write_lease_file {
 #		static 001cc0c33317 192.168.9.100,001cc0c33318 192.168.9.200;
 #	}
 #}
-sub read_config {
+my $read_config = sub {
 	my ($self) = @_;
 	my ($res, $key, $netmask, $config, $subopt);
 
-	$self->lock($self->{conf_file}, 1);
+	$self->$lock($self->{conf_file}, 1);
 	if ($self->{file_handle}) {
 		my $fh = $self->{file_handle};
 		my @lines = <$fh>;
 		$subopt = 0;
 		foreach (@lines) {
-			$self->logger("Read: $_");
+			$self->$logger("Read: $_");
 			if ($_ =~ /^\s*subnet\s+([\d\.]+)\s+netmask\s+([\d\.]+)\s+{\s*/) {
 				$self->{_config}->{$key} = $config if $config;
 				$key = $1;
 				$config = undef;
 				$config->{netmask} = $2;
-				$self->logger("Key: $key Netmask: $config->{netmask}");
+				$self->$logger("Key: $key Netmask: $config->{netmask}");
 			} else {
 				next if (($_ =~ /^\s*}\s*/ && ! $subopt) || $_ =~ /^\s*$/ || $_ =~ /^\s*#.*/);
 				if (! $subopt && $_ =~ /^\s*(range|ttl|rttl|router|dns-servers|ntp-servers|broadcast|domain-name)\s+(.+)\s*;/) {
 					$config->{$1} = $2;
-					$self->logger("Key: $1 Value: $2");
+					$self->$logger("Key: $1 Value: $2");
 				} elsif ($subopt &&$_ =~ /^\s*}\s*/) {
 					$subopt = 0;
 				} elsif ($subopt || $_ =~ /^\s*{\s*/) {
@@ -542,11 +397,11 @@ sub read_config {
 						if ($_ =~ /^\s*(allow|static)\s+(.+)\s*;/) {
 							my @vals = split(/\s*,\s*/, $2);
 							$config->{$1} = [@vals];
-							$self->logger("Key: $1 Value: $2");
+							$self->$logger("Key: $1 Value: $2");
 						} else {
 							$key = 'UNDEF' unless $key;
 							my $err = "$key: 'suboptions' Bad format";
-							$self->logger($err, ERROR);
+							$self->$logger($err, ERROR);
 							$key = undef;
 							$config = undef;
 							die $err;
@@ -557,7 +412,7 @@ sub read_config {
 				} else {
 					$key = 'UNDEF' unless $key;
 					my $err = "$key: Bad format";
-					$self->logger($err, ERROR);
+					$self->$logger($err, ERROR);
 					$key = undef;
 					$config = undef;
 					die $err;
@@ -567,227 +422,562 @@ sub read_config {
 		if ($config) {
 			$self->{_config}->{$key} = $config;
 		}
-		$self->logger("Config data structure: \n" . Dumper($self->{_config}));
-		$self->unlock($self->{conf_file});
+		$self->$logger("Config data structure: \n" . Dumper($self->{_config}));
+		$self->$unlock($self->{conf_file});
 		if (!$self->{_config}) {
 			die "Empty config file";
 		}
 	} else {
 		die "Could not read config file";
 	}
-}
+};
 
-sub logger {
-	my ($self, $message, $level) = @_;
+my $cleanup_leases = sub {
+	my ($self, $last_run) = @_;
+	my ($current, $last, $lease, $dirty);
+
+    $self->{INTERVAL} = 5 if $self->{INTERVAL} <= 0;
+    $current = time;
+    $last = $last_run + ($self->{INTERVAL} * 60);
+
+	$self->$logger("Run 'cleanup_leases' $last < $current", INFO);
+
+	if ($last < $current) {
+		$last_run = $current;
+		my $leases = $self->{_leases};
+		$dirty = 0;
+		while ((my $lease, my $elems) = each (%$leases)) {
+			$self->$logger("Clean up lease: $lease\n". Dumper($elems));
+			if ($elems->{ends} < $last_run) {
+				$self->$logger("Considering $lease for clean up: $elems->{ends} < $last_run\n". Dumper($elems));
+				if ($elems->{'binding state'} eq 'active') {
+					$self->$logger("Setting $lease 'binding state' to free", INFO);
+					$elems->{'binding state'} = 'free';
+					$dirty = 1;
+				}
+			}
+		}
+		if ($dirty) {
+			my $res = $self->$write_lease_file();
+			if ($res) {
+				$self->$logger("Updated lease file", INFO);
+			}
+		}
+	}
 
-	$level = DEBUG unless ($level);
-	return unless ($level >= $self->{LOG_LEVEL});
+	return $last_run;
+};
 
-	$level = "debug" if $level eq DEBUG;
-	$level = "info" if $level eq INFO;
-	$level = "notice" if $level eq NOTICE;
-	$level = "warning" if $level eq WARNING;
-	$level = "err" if $level eq ERROR;
-	$level = "crit" if $level eq CRITICAL;
-	$level = "alert" if $level eq ALERT;
-	$level = "emerg" if $level eq EMERGENCY;
+#########################################################################
+#  Private methods which handle DHCP4 requests
+#########################################################################
 
-	if ($self->{DEBUG}) {
-		print STDOUT strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
-		print STDOUT "$level: $message\n";
-	} elsif ($self->{log_file} eq 'syslog') {
-		openlog($NAME, 'ndelay,pid', 'user');
-		syslog($level, $message);
-		closelog();
-	} else {
-		my $fh = new IO::File;
-		if (! $fh->open("> $self->{log_file}")) {
-			croak "$self->{log_file}: $!";
+my $get_mac_ip4 = sub {
+	my ($self, $req) = @_;
+	my $mac;
+
+	$mac = $req->chaddr();
+	$mac =~ s/0+$//;
+
+	return $mac;
+};
+
+my $can_client_use_net_ip4 = sub {
+	my ($self, $req, $network) = @_;
+	my ($found);
+
+	# Is client allowed to request IP?
+	$found = 0;
+	if ($self->{_config}->{$network}->{allow}) {
+		$self->$logger("Allow: " . Dumper($self->{_config}->{$network}->{allow}));
+		foreach (@{$self->{_config}->{$network}->{allow}}) {
+			if ($_ eq $self->$get_mac_ip4($req)) {
+				$found = 1;
+				last;
+			}
 		}
-		print $fh strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
-		print $fh "$level: $message\n";
-		undef $fh;
+	} else {
+		$found = 1;
 	}
-}
 
-sub add_options {
-	my ($self, $dhcpresp) = @_;
+	return $found;
+};
+
+my $add_options_ip4 = sub {
+	my ($self, $resp) = @_;
 
 	if ($self->{lease_time}) {
-		$dhcpresp->addOptionValue(DHO_DHCP_LEASE_TIME, $self->{lease_time});
+		$resp->addOptionValue(DHO_DHCP_LEASE_TIME, $self->{lease_time});
+	}
+	if ($self->{lease_time_renew}) {
+		$resp->addOptionValue(DHO_DHCP_RENEWAL_TIME, $self->{lease_time_renew});
 	}
 	if ($self->{subnet_mask}) {
-		$dhcpresp->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
+		$resp->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
 	}
 	if ($self->{routers}) {
-		$dhcpresp->addOptionValue(DHO_ROUTERS, $self->{routers});
+		$resp->addOptionValue(DHO_ROUTERS, $self->{routers});
 	}
 	if ($self->{broadcast_addr}) {
-		$dhcpresp->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
+		$resp->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
 	}
 	if ($self->{domain_name}) {
-		$dhcpresp->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
+		$resp->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
 	}
 	if ($self->{ntp_servers}) {
-		$dhcpresp->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
+		$resp->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
 	}
 	if ($self->{dns_servers}) {
-		$dhcpresp->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
+		$resp->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
 	}
-}
-
-sub discover_ip4 {
-	my ($self, $dhcpreq) = @_;
-	my ($calc_ip, $req_addr, $dhcpresp);
-	my $res;
+};
 
-	# calculate address
-	$calc_ip = "192.168.9.2";
+my $send_nak = sub {
+	my ($self, $req, $message) = @_;
 
-	$self->logger("Got request\n".$dhcpreq->toString());
+	$message = 'Bad request' unless $message;
+	my $peeraddr = ($req->ciaddr() && $req->ciaddr() ne inet_ntoa(INADDR_ANY)) ?
+		$req->ciaddr() : inet_ntoa(INADDR_BROADCAST);
 
-	$self->{_sock_out_ip4} = IO::Socket::IP->new(
+	my $sock = IO::Socket::IP->new(
 		Broadcast => 1,
 		PeerPort => 68,
-		PeerAddr => inet_ntoa(INADDR_BROADCAST),
+		PeerAddr => $peeraddr,
 		Proto    => 'udp'
 	) || do {
 		my $err = $@;
-		$self->logger("[discover_ip4] Socket creation error: $err", ERROR);
+		$self->$logger("[discover_ip4] Socket creation error: $err", ERROR);
 		die "[discover_ip4] Socket creation error: $err\n";
 	};
 
-	$req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
-	$req_addr = '' unless $req_addr;
-	$self->logger("Requested IP: $req_addr", INFO);
-
-	$res = $self->read_lease_file();
-	$res = $self->write_lease_file();
-	if ($res && ($req_addr =~ /^$/ || $calc_ip eq $req_addr)) {
-		$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(),
-			DHO_DHCP_SERVER_IDENTIFIER() => $self->{_sock_out_ip4}->sockhost
-		);
-		$self->add_options($dhcpresp);
-	} 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...",
-		);
-	}
-
-	$self->logger("Sending response to " .
-		$self->{_sock_out_ip4}->peerhost . ':' .
-		$self->{_sock_out_ip4}->peerport, INFO);
-
-	# Socket object keeps track of whom sent last packet
-	# so we don't need to specify target address
-	$self->logger($dhcpresp->toString());
-	$self->logger("Sending OFFER tr=".$dhcpresp->comment(), INFO);
-	$self->{_sock_out_ip4}->send($dhcpresp->serialize()) || die "Error sending OFFER: $!\n";
-}
+	my $resp = new Net::DHCP::Packet(
+		Comment => $req->comment(),
+		Op => BOOTREPLY(),
+		Hops => $req->hops(),
+		Xid => $req->xid(),
+		Flags => $req->flags(),
+		Ciaddr => $req->ciaddr(),
+		Yiaddr => "0.0.0.0",
+		Siaddr => $req->siaddr(),
+		Giaddr => $req->giaddr(),
+		Chaddr => $req->chaddr(),
+		DHO_DHCP_MESSAGE_TYPE() => DHCPNAK(),
+		DHO_DHCP_MESSAGE(), $message,
+	);
+
+	$self->$logger("Sending NAK to " .	$sock->peerhost . ':' .	$sock->peerport .
+		"\nReason: $message", INFO);
+	$self->$logger($resp->toString());
+
+	my $xid = $req->xid() ? $req->xid() : 'Missing';
+	$self->$logger("Sending OFFER tr=$xid", INFO);
+
+	$sock->send($resp->serialize()) || die "Error sending OFFER: $!\n";
+	$sock->close;
+};
 
-sub request_ip4 {
-	my ($self, $dhcpreq) = @_;
-	my ($calc_ip, $dhcpresp, $peeraddr, $result);
+my $send_accept = sub {
+	my ($self, $req, $calc_ip, $reply) = @_;
+	my $msg;
 
-	$calc_ip = "192.168.9.2";
+	my $peeraddr = ($req->ciaddr() && $req->ciaddr() ne inet_ntoa(INADDR_ANY)) ?
+		$req->ciaddr() : inet_ntoa(INADDR_BROADCAST);
 
-	$peeraddr = $dhcpreq->ciaddr() ? $dhcpreq->ciaddr() : inet_ntoa(INADDR_BROADCAST);
-	$self->{_sock_out_ip4} = IO::Socket::IP->new(
+	if ($reply == DHCP_OFFER) {
+		$reply = DHCPOFFER();
+		$msg = 'DHCP_OFFER';
+	} elsif ($reply == DHCP_ACK) {
+		$reply = DHCPACK();
+		$msg = 'DHCP_ACK';
+	} else {
+		my $err = "$reply: Unknown reply";
+		$self->$logger($err, ERROR);
+		die $err;
+	}
+
+	my $sock = IO::Socket::IP->new(
 		Broadcast => 1,
 		PeerPort => 68,
 		PeerAddr => $peeraddr,
-		Proto    => 'udp',
+		Proto    => 'udp'
 	) || do {
 		my $err = $@;
-		$self->logger("[request_ip4] Socket creation error: $err", ERROR);
-		die "[request_ip4] Socket creation error: $err\n";
+		$self->$logger("[discover_ip4] Socket creation error: $err", ERROR);
+		die "[discover_ip4] Socket creation error: $err\n";
 	};
 
-	# 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(),
-			DHO_DHCP_SERVER_IDENTIFIER() => $self->{_sock_out_ip4}->sockhost,
-		);
-		$self->add_options($dhcpresp);
-		$result = 'ACK';
+	my $resp = new Net::DHCP::Packet(
+		Comment => $req->comment(),
+		Op => BOOTREPLY(),
+		Hops => $req->hops(),
+		Xid => $req->xid(),
+		Flags => $req->flags(),
+		Ciaddr => $req->ciaddr(),
+		Yiaddr => $calc_ip,
+		Siaddr => $req->siaddr(),
+		Giaddr => $req->giaddr(),
+		Chaddr => $req->chaddr(),
+		DHO_DHCP_MESSAGE_TYPE() => $reply,
+		DHO_DHCP_SERVER_IDENTIFIER() => $sock->sockhost
+	);
+	$self->$add_options_ip4($resp);
+	my $xid = $req->xid();
+	$self->{_transaction}->{$xid}->{me} = $sock->sockhost;
+
+	$self->$logger("Sending $msg to " .	$sock->peerhost . ':' .	$sock->peerport, INFO);
+	$self->$logger($resp->toString());
+
+	$self->$logger("Sending OFFER tr=".$req->xid(), INFO);
+
+	$sock->send($resp->serialize()) || die "Error sending $msg: $!\n";
+	$sock->close;
+};
+
+my $update_transaction = sub {
+	my ($self, $req, $tx) = @_;
+	my ($res, $xid, $offer);
+
+	$xid = $req->xid();
+	return -1 unless $xid;
+
+	if ($tx) {
+		$self->{_transaction}->{$xid} = $tx;
+		$res = 0;
+	} else {
+		if ($self->{_transaction}->{$xid} && $self->{_transaction}->{$xid}->{me}) {
+			my $me = $req->getOptionValue(DHO_DHCP_SERVER_IDENTIFIER());
+			$me = $req->ciaddr() unless $me;
+			$offer = $self->{_transaction}->{$xid}->{offer_ip};
+			if ($me) {
+				if ($me ne $self->{_transaction}->{$xid}->{me}) {
+					# Another DHCP server is chosen by client
+					$self->$logger("$me: Offer '".($offer? $offer : 'None')."' refused by client xid=$xid", INFO);
+					delete($self->{_transaction}->{$xid});
+					delete($self->{_leases}->{$offer}) if $offer;
+					$self->$write_lease_file();
+					$res = 1;
+				} else {
+					$self->$logger("Offer '$offer' accepted by client xid=$xid", INFO);
+					$res = 0;
+				}
+			} else {
+				# Caught request for other DHCP server
+			}
+		} else {
+			if ($self->{_transaction}->{$xid}) {
+				$offer = $self->{_transaction}->{$xid}->{offer_ip};
+				$self->$logger("Offer '$offer' wait approval from client xid=$xid", INFO);
+				$res = 0;
+			}
+		}
+	}
+
+	return $res;
+};
+
+my $create_new_lease_ip4 = sub {
+	my ($self, $req, $network) = @_;
+	my $lease;
+
+	$lease->{'hardware ethernet'} = $self->$get_mac_ip4($req);
+	my $client = $req->getOptionValue(DHO_HOST_NAME());
+	$lease->{'client-hostname'} = $client ? $client : $self->$get_mac_ip4($req);
+	$lease->{'binding state'} = 'active';
+	my $start = time;
+	my $end = $start + $self->{_config}->{$network}->{ttl};
+	$lease->{starts} = $self->$convert_timestamp($start, 0);
+	$lease->{ends} = $self->$convert_timestamp($end, 0);
+
+	return $lease;
+};
+
+my $add_lease_ip4 = sub {
+	my ($self, $req, $network, $ip) = @_;
+
+	my $lease = $self->$create_new_lease_ip4($req, $network);
+	$self->$add_lease($ip, $lease);
+	$self->{lease_time} = $DEFAULT_LEASE;
+	if ($self->{_config}->{$network}->{ttl}) {
+		$self->{lease_time}	= $self->{_config}->{$network}->{ttl};
+	}
+	$self->{lease_time_renew} = $DEFAULT_LEASE_RENEW;
+	if ($self->{_config}->{$network}->{rttl}) {
+		$self->{lease_time_renew} = $self->{_config}->{$network}->{rttl};
+	}
+	if ($self->{_config}->{$network}->{netmask}) {
+		$self->{subnet_mask} = $self->{_config}->{$network}->{netmask};
+	}
+	if ($self->{_config}->{$network}->{router}) {
+		$self->{routers} = $self->{_config}->{$network}->{router};
+	}
+	if ($self->{_config}->{$network}->{broadcast}) {
+		$self->{broadcast_addr}	= $self->{_config}->{$network}->{broadcast};
+	}
+	if ($self->{_config}->{$network}->{'domain-name'}) {
+		$self->{domain_name} = $self->{_config}->{$network}->{'domain-name'};
+	}
+	if ($self->{_config}->{$network}->{'dns-servers'}) {
+		$self->{dns_servers} = $self->{_config}->{$network}->{'dns-servers'};
+	}
+	if ($self->{_config}->{$network}->{'ntp-servers'}) {
+		$self->{ntp_servers} = $self->{_config}->{$network}->{'ntp-servers'};
+	}
+};
+
+my $find_ip_ip4 = sub {
+	my ($self, $req, $network, $reqaddr) = @_;
+	my ($start, $end, $ip);
+
+	my @range_str = split(/\s+/, $self->{_config}->{$network}->{range});
+	$self->$logger("Range: " . $range_str[0] . " - " . $range_str[1], INFO);
+	$start = NetAddr::IP->new($range_str[0].'/'.$self->{_config}->{$network}->{netmask});
+	$end = NetAddr::IP->new($range_str[1].'/'.$self->{_config}->{$network}->{netmask});
+	$self->$logger(Dumper($start) . Dumper($end));
+
+	if ($reqaddr) {
+		my $request = NetAddr::IP->new($reqaddr);
+		if ($start->numeric() <= $request->numeric() && $request->numeric() <= $start->numeric()) {
+			my $cip = $request->addr();
+			$self->$logger("[find_ip_ip4] reqaddr: $reqaddr IP: $cip", INFO);
+			if ($self->{_leases}->{$cip}) {
+				my $lease = $self->{_leases}->{$cip};
+				my $mac = $self->$get_mac_ip4($req);
+				if ($lease->{'hardware ethernet'} eq $mac) {
+					$ip = $cip;
+				}
+			} else {
+				$ip = $cip;
+			}
+		}
+	} else {
+		my $free = undef;
+		for (; $start <= $end; $start = $start + 1) {
+			my $cip = $start->addr();
+			$self->$logger("[find_ip_ip4] IP: $cip");
+			if ($self->{_leases}->{$cip} && ! $free) {
+				my $lease = $self->{_leases}->{$cip};
+				my $mac = $self->$get_mac_ip4($req);
+				if ($lease->{'hardware ethernet'} eq $mac) {
+					$ip = $cip;
+				} elsif ($lease->{'binding state'} eq 'free') {
+					$free = $cip;
+				}
+			} else {
+				$ip = $cip;
+			}
+			last if $ip;
+		}
+		if (! $ip && $free) {
+			$ip = $free;
+		}
+	}
+
+	$self->$logger("[find_ip_ip4] IP: " . ($ip ? $ip : 'None'), INFO);
+
+	return $ip;
+};
+
+my $calculate_net_ip4 = sub {
+	my ($self, $req, $req_addr) = @_;
+	my ($network, $net, $ip);
+
+	$self->$logger("Req IP: " . ($req_addr ? $req_addr : 'None'), INFO);
+	foreach $net (keys %{$self->{_config}}) {
+		my $opt = $self->{_config}->{$net};
+		$self->$logger("Network: $net/$opt->{netmask}\n" . Dumper($opt), INFO);
+		$network = $net if ($self->$can_client_use_net_ip4($req, $net));
+		if ($network) {
+			if ($req_addr) {
+				$ip = $self->$find_ip_ip4($req, $network, $req_addr);
+			} else {
+				$ip = $self->$find_ip_ip4($req, $network);
+			}
+			last if $ip;
+			$network = undef;
+		}
+	}
+	$self->$logger("Network: " . ($network ? $network : 'None') . " IP: " .	($ip ? $ip : 'None'), INFO);
+
+	return ($network, $ip);
+};
+
+my $calculate_ip_ip4 = sub {
+	my ($self, $req, $state, $reqaddr) = @_;
+	my ($network, $ip);
+
+	if ($state == DHCP_OFFER) {
+		if ($reqaddr) {
+			($network, $ip) = $self->$calculate_net_ip4($req, $reqaddr);
+		} else {
+			($network, $ip) = $self->$calculate_net_ip4($req);
+		}
+	} elsif ($state == DHCP_ACK) {
+		# If no $reqaddr then client fail
+		if ($reqaddr) {
+			my $xid = $req->xid();
+			if ($self->{_transaction}->{$xid}) {
+				my $offer = $self->{_transaction}->{$xid}->{offer_ip};
+				if ($offer eq $reqaddr) {
+					$network = $self->{_transaction}->{$xid}->{network};
+					$ip = $self->{_transaction}->{$xid}->{offer_ip}
+				}
+				delete($self->{_transaction}->{$xid});
+			} else {
+				# No prior discovery. We maintain transaction
+				($network, $ip) = $self->$calculate_net_ip4($req, $reqaddr);
+			}
+		}
+	} else {
+	}
+
+	return ($network, $ip);
+};
+
+my $discover_ip4 = sub {
+	my ($self, $req) = @_;
+	my ($tx, $res, $resp, $network, $calc_ip, $req_addr);
+
+	$self->$logger("Got ip4 discover request: \n" . $req->toString(), INFO);
+
+	$res = $self->$update_transaction($req);
+	if ($res) {
+		my $err = "Missing transaction ID";
+		$self->$send_nak($req, $err);
+		$self->$logger($err, ERROR);
+		die $err;
+	}
+
+	$req_addr = $req->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
+	$res = $self->$read_lease_file();
+	$self->$logger("Starting with empty lease file", INFO) unless $res;
+
+
+	if ($self->{LOG_LEVEL} <= INFO) {
+		if ($req_addr) {
+			$self->$logger("[D] Requested IP: $req_addr", INFO);
+		} else {
+			$self->$logger("[D] Requested IP: None", INFO);
+		}
+	}
+
+	$tx->{req_ip} = $req_addr ? $req_addr : 'None';
+
+	($network, $calc_ip) = $self->$calculate_ip_ip4($req, DHCP_OFFER, $req_addr);
+	$tx->{offer_ip} = $calc_ip ? $calc_ip : 'None';
+	$tx->{network} = $network ? $network : 'None';
+
+	$self->$logger("Offer: $tx->{offer_ip}");
+
+	if ($network && $calc_ip) {
+		$self->$logger("Creating lease for $calc_ip", INFO);
+		$res = $self->$update_transaction($req, $tx);
+		if ($res) {
+				my $err = "Could not create transaction";
+				$self->$logger($err, ERROR);
+				$self->$send_nak($req, $err);
+		} else {
+			$self->$add_lease_ip4($req, $network, $calc_ip);
+			$res = $self->$write_lease_file();
+			if (! $res) {
+				my $err = "Could not write lease file. Bailing";
+				$self->$logger($err, ERROR);
+				my $xid = $req->xid();
+				delete($self->{_transaction}->{$xid});
+				$self->$send_nak($req, $err);
+			} else {
+				$self->$send_accept($req, $calc_ip, DHCP_OFFER);
+			}
+		}
 	} else {
 		# bad request, we send a NAK
-		$self->write_lease_file();
-		$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...",
-		);
-		$result = 'NAK';
-	}
-
-	$self->logger("Sending response to " .
-		$self->{_sock_out_ip4}->peerhost . ':' .
-		$self->{_sock_out_ip4}->peerport, INFO);
-
-	# Socket object keeps track of whom sent last packet
-	# so we don't need to specify target address
-	$self->logger($dhcpresp->toString());
-	$self->logger("Sending $result tr=".$dhcpresp->comment(), INFO);
-	$self->{_sock_out_ip4}->send($dhcpresp->serialize()) || die "Error sending ACK/NAK: $!\n";
-}
+		my $err = "$req_addr: Not available";
+		$self->$logger($err, INFO);
+		$self->$send_nak($req, $err);
+	}
+
+	$self->$logger("Transaction:\n".Dumper($self->{_transaction}), INFO);
+};
 
-sub release_ip4 {
-	my ($self, $dhcpreq) = @_;
+my $request_ip4 = sub {
+	my ($self, $req) = @_;
+	my ($calc_ip, $network, $res);
 
-	$self->logger($dhcpreq->toString());
-	$self->write_lease_file();
-}
+	$self->$logger("Got request\n".$req->toString());
+
+	$res = $self->$update_transaction($req);
+	if ($res) {
+		if ($res < 0) {
+			my $err = "Missing transaction ID";
+			$self->$send_nak($req, $err);
+			$self->$logger($err, ERROR);
+			die $err;
+		} else {
+			return;
+		}
+	}
+
+	my $req_addr = $req->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
+	if ($self->{LOG_LEVEL} <= INFO) {
+		if ($req_addr) {
+			$self->$logger("[R] Requested IP: $req_addr", INFO);
+		} else {
+			$self->$logger("[R] Requested IP: None", INFO);
+		}
+	}
 
-sub excuse_me_ip6 {
-	my ($self, $addr, $dhcpreq) = @_;
+	($network, $calc_ip) = $self->$calculate_ip_ip4($req, DHCP_ACK, $req_addr);
+	if ($network && $calc_ip) {
+		$self->$logger("Creating lease for $calc_ip", INFO);
+		$self->$add_lease_ip4($req, $network, $calc_ip);
+		$res = $self->$write_lease_file();
+		if (! $res) {
+			my $err = "Could not write lease file. Bailing";
+			$self->$logger($err, ERROR);
+			$self->$send_nak($req, $err);
+		} else {
+			$self->$send_accept($req, $calc_ip, DHCP_ACK);
+		}
+	} else {
+		# bad request, we send a NAK
+		$self->$send_nak($req);
+	}
+
+	# This transaction is finished with either NAK or ACK
+	my $xid = $req->xid();
+	delete($self->{_transaction}->{$xid});
+
+	$self->$logger("Transaction:\n".Dumper($self->{_transaction}), INFO);
+};
+
+my $release_ip4 = sub {
+	my ($self, $req) = @_;
+	my ($ip, $mac);
+
+	$self->$logger($req->toString());
+	$ip = $req->ciaddr();
+	$mac = $self->$get_mac_ip4($req);
+	$self->$logger("Release request for IP: $ip MAC: $mac", INFO);
+
+	if ($self->{_leases}->{$ip}) {
+		my $lease = $self->{_leases}->{$ip};
+		if ($lease->{'hardware ethernet'} eq $mac) {
+			$self->$logger("Set binding state free IP: $ip MAC: $mac", INFO);
+			$lease->{'binding state'} = 'free';
+			$self->$write_lease_file();
+		}
+	}
+	$self->$logger("Transaction:\n".Dumper($self->{_transaction}), INFO);
+};
 
-	$self->logger("IPv6 request from [$addr]: $dhcpreq", INFO);
-	$self->{_sock_out_ip6} = IO::Socket::IP->new(
+#########################################################################
+#  Private methods which handle DHCP6 requests
+#########################################################################
+
+my $excuse_me_ip6 = sub {
+	my ($self, $addr, $req) = @_;
+
+	$self->$logger("IPv6 request from [$addr]: $req", INFO);
+	my $sock = IO::Socket::IP->new(
 		Domain	  => PF_INET6,
 		V6Only	  => 1,
 		Broadcast => 1,
@@ -796,11 +986,204 @@ sub excuse_me_ip6 {
 		Proto     => 'udp',
 	) || do {
 		my $err = $@;
-		$self->logger("[excuse_me_ip6] Socket creation error: $err", ERROR);
+		$self->$logger("[excuse_me_ip6] Socket creation error: $err", ERROR);
 		die "[excuse_me_ip6] Socket creation error: $err\n";
 	};
-	$self->logger("$addr: Not implemented here", INFO);
-	$self->{_sock_out_ip6}->send("Not implemented here") || die "Error sending excuse: $!\n";
+	$self->$logger("$addr: Not implemented here", INFO);
+	$sock->send("Not implemented here") || die "Error sending excuse: $!\n";
+	$sock->close;
+};
+
+#########################################################################
+# Public methods
+#########################################################################
+
+# generic signal handler to cause daemon to stop
+sub signal_handler {
+    $time_to_die = 1;
+}
+$SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&signal_handler;
+
+# ignore any PIPE signal: standard behaviour is to quit process
+$SIG{PIPE} = 'IGNORE';
+
+sub new {
+    my ($class, %self) = @_;
+
+    # OOP stuff
+    $class = ref($class) || $class;
+    my $self = \%self;
+    bless $self, $class;
+
+	# private
+    $self->{_sock_in_ip4}	  	= undef;
+    $self->{_sock_in_ip6}	  	= undef;
+    $self->{_leases}		  	= undef;
+    $self->{_reverse}		  	= undef;
+    $self->{_config}		  	= undef;
+	$self->{_dhpcp_ip4}			= undef;
+	$self->{_transaction}		= ();
+
+	# public
+	$self->{log_file}			||= 'syslog';
+    $self->{lease_time}			||= $DEFAULT_LEASE;
+    $self->{lease_time_renew}	||= $DEFAULT_LEASE_RENEW;
+    $self->{subnet_mask}		||= undef;
+    $self->{routers}			||= undef;
+    $self->{broadcast_addr}		||= undef;
+    $self->{domain_name}		||= undef;
+    $self->{dns_servers}		||= undef;
+	$self->{ntp_servers}		||= undef;
+	$self->{LOG_LEVEL} 			= ERROR unless defined $self->{LOG_LEVEL};
+	$self->{NODAEMON}			||= 0;
+	$self->{DEBUG}				||= 0;
+	$self->{timeout}			||= 10;
+	$self->{lease_file}			||= '/tmp/dhcpd.leases';
+	$self->{conf_file}			||= '/tmp/dhcpd.cfg';
+	$self->{INTERVAL}			||= 5;
+
+    return $self;
+}
+
+sub run {
+	my ($self) = @_;
+	my ($sel, @ready, $socket, $res);
+
+	eval {
+		$self->$read_config();
+	};
+	if ($@) {
+		my $err = $@;
+		$self->$logger($err, ERROR);
+		die $err;
+	}
+	$self->$logger("Starting dhcpd", INFO);
+	if ($self->{NODAEMON} < 1) {
+		$self->$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;
+		do {
+			my $err = $!;
+			$self->$logger("Couldn't fork: $err", ERROR);
+			die "Couldn't fork: $err";
+		} unless defined($pid);
+
+		POSIX::setsid() || do {
+			my $err = $!;
+			$self->$logger("Can't start a new session: $err", ERROR);
+			die "Can't start a new session: $err";
+		};
+		$self->$logger("Now in Daemon mode", INFO);
+	}
+
+	$res = $self->$read_lease_file();
+	$self->$logger("Starting with empty leases file '$self->{lease_file}'", INFO)
+		if (! $res || ! $self->{_leases});
+
+	$self->$logger("Initialization complete", INFO);
+
+	# open listening socket
+	$self->{_sock_in_ip4} = IO::Socket::IP->new(
+		Domain		=> PF_INET,
+		LocalPort	=> 67,
+		LocalAddr	=> inet_ntoa(INADDR_ANY),
+		Proto		=> 'udp'
+	) || do {
+		my $err = $@;
+		$self->$logger("IP4 Socket creation error: $err", ERROR);
+		die "IP4 Socket creation error: $err\n";
+	};
+	$self->{_sock_in_ip6} = IO::Socket::IP->new(
+		Domain		=> PF_INET6,
+		V6Only		=> 1,
+		LocalPort	=> 547,
+		LocalAddr	=> '::',
+		Proto		=> 'udp'
+	) || do {
+		my $err = $@;
+		$self->$logger("IP6 Socket creation error: $err", ERROR);
+		die "IP6 Socket creation error: $err\n";
+	};
+
+	$sel = IO::Select->new($self->{_sock_in_ip4});
+	$sel->add($self->{_sock_in_ip6});
+
+	my $last_run = time;
+
+	until ($time_to_die) {
+		my $buf = undef;
+		my $fromaddr;
+		my $req;
+
+		eval {	# catch fatal errors
+			while (@ready = $sel->can_read) {
+				$self->$logger("Waiting for incoming packet", INFO);
+				$last_run = $self->$cleanup_leases($last_run);
+				foreach $socket (@ready) {
+					if ($socket == $self->{_sock_in_ip4}) {
+						# receive ipv4 packet
+						$fromaddr = $socket->recv($buf, 4096)
+							|| $self->$logger("recv: $!", ERROR);
+						next if ($!);	# continue loop if an error occured
+
+						$req = new Net::DHCP::Packet($buf);
+
+						{
+							use bytes;
+							my $xid = $req->xid();
+							$xid = $xid ? $xid : 'None';
+							my ($port,$addr) = unpack_sockaddr_in($fromaddr);
+							my $ipaddr = inet_ntoa($addr);
+							$self->$logger("Got a packet tr=$xid src=$ipaddr:$port length=".length($buf), INFO);
+						}
+
+						my $messagetype = $req->getOptionValue(DHO_DHCP_MESSAGE_TYPE());
+
+						if ($messagetype eq DHCPDISCOVER()) {
+								$self->$discover_ip4($req);
+						} elsif ($messagetype eq DHCPREQUEST()) {
+								$self->$request_ip4($req);
+						} elsif ($messagetype eq DHCPINFORM()) {
+							$self->$logger("Not implemented: DHCPINFORM", WARNING);
+						} elsif ($messagetype eq DHCPRELEASE()) {
+								$self->$release_ip4($req);
+						} else {
+							$self->$logger("$messagetype: Packet dropped since unknown message type", WARNING);
+							# bad messagetype, we drop it
+						}
+					} else {
+						# Receive ipv6 packet
+						my $myaddr = $socket->sockhost;
+
+						$fromaddr = $socket->recv($buf, 4096)
+							|| $self->$logger("recv: $!", ERROR);
+						next if ($!);	# continue loop if an error occured
+						$self->$logger("recv: $buf", INFO);
+						{
+							use bytes;
+							my ($port,$addr) = unpack_sockaddr_in6($fromaddr);
+							my $ipaddr = inet_ntop(AF_INET6, $addr);
+							$self->$logger("Got a packet tr=$self->{_transaction_ip6} src=$ipaddr:$port length=".length($buf), INFO);
+						}
+						$self->$excuse_me_ip6($myaddr, $buf);
+					}
+				}
+			}
+		};	# end of 'eval' blocks
+		if ($@) {
+			$self->$logger("Caught error in main loop: $@", ERROR);
+		}
+	}
+	$self->{_sock_in_ip4}->close;
+	$self->{_sock_in_ip6}->close;
+	$self->$logger("Exiting dhcpd", INFO);
 }
 
 1;