From 245c6d23660f28a41254df73bd2b9769b512dd60 Mon Sep 17 00:00:00 2001
From: Michael Rasmussen <mir@datanom.net>
Date: Fri, 25 Jul 2014 19:33:53 +0200
Subject: [PATCH] Refactor code. Features completed. Missing lease monitor

---
 DHCPServer.pm | 736 +++++++++++++++++++++++++++-----------------------
 1 file changed, 399 insertions(+), 337 deletions(-)

diff --git a/DHCPServer.pm b/DHCPServer.pm
index 6410694..5569e96 100644
--- a/DHCPServer.pm
+++ b/DHCPServer.pm
@@ -20,14 +20,16 @@ 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;
@@ -313,7 +315,7 @@ my $read_lease_file = sub {
 		$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;
 	}
 
@@ -328,8 +330,8 @@ my $write_lease_file = sub {
 	if ($self->{file_handle}) {
 		if ($self->{_leases}) {
 			my $fh = $self->{file_handle};
-			my %leases = %{$self->{_leases}};
-			while ((my $lease, my $elems) = each (%leases)) {
+			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) {
@@ -345,7 +347,7 @@ my $write_lease_file = sub {
 		$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;
 	}
 
@@ -435,26 +437,25 @@ my $read_config = sub {
 #########################################################################
 
 my $get_mac_ip4 = sub {
-	my ($self, $dhcpreq) = @_;
+	my ($self, $req) = @_;
 	my $mac;
 
-	$mac = $dhcpreq->chaddr();
+	$mac = $req->chaddr();
 	$mac =~ s/0+$//;
 
 	return $mac;
 };
 
 my $can_client_use_net_ip4 = sub {
-	my ($self, $dhcpreq, $network) = @_;
-	my (@allow, $found);
+	my ($self, $req, $network) = @_;
+	my ($found);
 
 	# Is client allowed to request IP?
 	$found = 0;
 	if ($self->{_config}->{$network}->{allow}) {
-		@allow = $self->{_config}->{$network}->{allow};
-		$self->$logger("Allow: " . Dumper(@allow));
-		foreach (@allow) {
-			if ($_ eq $self->$get_mac_ip4($dhcpreq)) {
+		$self->$logger("Allow: " . Dumper($self->{_config}->{$network}->{allow}));
+		foreach (@{$self->{_config}->{$network}->{allow}}) {
+			if ($_ eq $self->$get_mac_ip4($req)) {
 				$found = 1;
 				last;
 			}
@@ -466,386 +467,450 @@ my $can_client_use_net_ip4 = sub {
 	return $found;
 };
 
-my $create_new_lease_ip4 = sub {
-	my ($self, $dhcpreq, $network, $lease) = @_;
-
-	if (! $lease) {
-		$lease = ();
-		$lease->{'hardware ethernet'} = $self->$get_mac_ip4($dhcpreq);
-	}
-	my $client = $dhcpreq->getOptionValue(DHO_HOST_NAME());
-	$lease->{'client-hostname'} = $client ? $client : $self->$get_mac_ip4($dhcpreq);
-	$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_options_ip4 = sub {
-	my ($self, $dhcpreq) = @_;
+	my ($self, $resp) = @_;
 
 	if ($self->{lease_time}) {
-		$dhcpreq->addOptionValue(DHO_DHCP_LEASE_TIME, $self->{lease_time});
+		$resp->addOptionValue(DHO_DHCP_LEASE_TIME, $self->{lease_time});
 	}
 	if ($self->{lease_time_renew}) {
-		$dhcpreq->addOptionValue(DHO_DHCP_RENEWAL_TIME, $self->{lease_time_renew});
+		$resp->addOptionValue(DHO_DHCP_RENEWAL_TIME, $self->{lease_time_renew});
 	}
 	if ($self->{subnet_mask}) {
-		$dhcpreq->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
+		$resp->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
 	}
 	if ($self->{routers}) {
-		$dhcpreq->addOptionValue(DHO_ROUTERS, $self->{routers});
+		$resp->addOptionValue(DHO_ROUTERS, $self->{routers});
 	}
 	if ($self->{broadcast_addr}) {
-		$dhcpreq->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
+		$resp->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
 	}
 	if ($self->{domain_name}) {
-		$dhcpreq->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
+		$resp->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
 	}
 	if ($self->{ntp_servers}) {
-		$dhcpreq->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
+		$resp->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
 	}
 	if ($self->{dns_servers}) {
-		$dhcpreq->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
+		$resp->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
 	}
 };
 
-my $calculate_net_ip4 = sub {
-	my ($self, $dhcpreq) = @_;
-	my ($req_addr, $network);
-
-	$req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
-	$self->$logger("Req IP: " . ($req_addr ? $req_addr : 'None'));
-	if ($req_addr) {
-		my ($space, $test);
-		my %config = %{$self->{_config}};
-		while (my ($net, $opt) = each (%config)) {
-			$self->$logger("Network: $net/$opt->{netmask}\n" . Dumper($opt));
-			$space = NetAddr::IP->new($net, $opt->{netmask});
-			$test = NetAddr::IP->new($req_addr);
-			if ($space->contains($test)) {
-				$network = $net if ($self->$can_client_use_net_ip4($dhcpreq, $net));
-				last;
-			}
-		}
+my $send_nak = sub {
+	my ($self, $req, $message) = @_;
+
+	$message = 'Bad request' unless $message;
+	my $peeraddr = ($req->ciaddr() && $req->ciaddr() ne inet_ntoa(INADDR_ANY)) ?
+		$req->ciaddr() : inet_ntoa(INADDR_BROADCAST);
+
+	my $sock = IO::Socket::IP->new(
+		Broadcast => 1,
+		PeerPort => 68,
+		PeerAddr => $peeraddr,
+		Proto    => 'udp'
+	) || do {
+		my $err = $@;
+		$self->$logger("[discover_ip4] Socket creation error: $err", ERROR);
+		die "[discover_ip4] Socket creation error: $err\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;
+};
+
+my $send_accept = sub {
+	my ($self, $req, $calc_ip, $reply) = @_;
+	my $msg;
+
+	my $peeraddr = ($req->ciaddr() && $req->ciaddr() ne inet_ntoa(INADDR_ANY)) ?
+		$req->ciaddr() : inet_ntoa(INADDR_BROADCAST);
+
+	if ($reply == DHCP_OFFER) {
+		$reply = DHCPOFFER();
+		$msg = 'DHCP_OFFER';
+	} elsif ($reply == DHCP_ACK) {
+		$reply = DHCPACK();
+		$msg = 'DHCP_ACK';
 	} else {
-		my ($space, $test);
-		my %config = %{$self->{_config}};
-		while (my ($net, $opt) = each (%config)) {
-			$self->$logger("Network: $net/$opt->{netmask}\n" . Dumper($opt));
-			my $can = $self->$can_client_use_net_ip4($dhcpreq, $net);
-			$self->$logger("Network usable: $can");
-			if ($can) {
-				$network = $net;
-				last;
-			}
-		}
+		my $err = "$reply: Unknown reply";
+		$self->$logger($err, ERROR);
+		die $err;
 	}
 
-	$self->$logger("Network: " . ($network ? $network : 'None'));
+	my $sock = IO::Socket::IP->new(
+		Broadcast => 1,
+		PeerPort => 68,
+		PeerAddr => $peeraddr,
+		Proto    => 'udp'
+	) || do {
+		my $err = $@;
+		$self->$logger("[discover_ip4] Socket creation error: $err", ERROR);
+		die "[discover_ip4] Socket creation error: $err\n";
+	};
 
-	return $network;
+	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 $renew_lease_ip4 = sub {
-	my ($self, $dhcpreq, $network, $req_addr) = @_;
-	my ($start, $end, $test, $ip, $lease);
-
-	my $find_ip_and_lease = sub {
-		my ($reqaddr) = @_;
+my $update_transaction = sub {
+	my ($self, $req, $tx) = @_;
+	my ($res, $xid, $offer);
 
-		my @range_str = split(/\s+/, $self->{_config}->{$network}->{range});
-		$self->$logger("Range: " . $range_str[0] . " - " . $range_str[1]);
-		$start = NetAddr::IP->new($range_str[0]);
-		$end = NetAddr::IP->new($range_str[1]);
-		$self->$logger(Dumper($start) . Dumper($end));
+	$xid = $req->xid();
+	return -1 unless $xid;
 
-		if ($reqaddr) {
-			my $request = NetAddr::IP->new($reqaddr);
-			if ($start <= $request && $request <= $start) {
-				my $nip = $start->addr();
-				$self->$logger("IP: $nip");
-				if ($self->{_leases}->{$nip}) {
-					$lease = $self->{_leases}->{$nip};
-					if ($lease->{'binding state'} eq 'free') {
-						$ip = $nip;
-						$lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
-					}
-				}
-			}
-		} else {
-			my $free = undef;
-			for (; $start <= $end; $start++) {
-				my $nip = $start->addr();
-				$self->$logger("IP: $nip");
-				if ($self->{_leases}->{$nip} && ! $free) {
-					$lease = $self->{_leases}->{$nip};
-					if ($lease->{'binding state'} eq 'free') {
-						$free = ();
-						$free->{$nip} = $lease;
-					}
+	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 {
-					$lease = $self->$create_new_lease_ip4($dhcpreq, $network);
-					$ip = $nip;
-					last;
+					$self->$logger("Offer '$offer' accepted by client xid=$xid", INFO);
+					$res = 0;
 				}
+			} else {
+				# Caught request for other DHCP server
 			}
-			if (! $ip && $free) {
-				($ip, $lease) = each($free);
-				$lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
+		} 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 ($ip, $lease);
-	};
+	return $res;
+};
 
-	if ($req_addr) {
-		if ($self->{_leases}) {
-			$lease = $self->{_leases}->{$req_addr};
-			return undef if ($lease && $lease->{'hardware ethernet'} ne $self->$get_mac_ip4($dhcpreq));
-			$lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
-			$ip = $req_addr;
-		} else {
-			($ip, $lease) = $find_ip_and_lease->($req_addr);
-		}
-	} else {
-		my $mac = $self->$get_mac_ip4($dhcpreq);
-		$self->$logger("MAC: $mac");
-		if ($self->{_reverse}->{$mac}) {
-			$self->$logger("MAC: $mac IP: " . $self->{_reverse}->{$mac});
-			$ip = $self->{_reverse}->{$mac};
-			$lease = $self->{_leases}->{$ip};
-			$lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
-		} else {
-			($ip, $lease) = $find_ip_and_lease->($req_addr);
-		}
+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'};
+	}
+};
 
-	$self->$logger("IP: $ip lease:\n" . Dumper($lease));
-	if ($ip && $lease) {
-		$self->$add_lease($ip, $lease);
-		if ($self->{_leases}->{$ip} && $self->{_leases}->{$ip}->{starts} ==	$lease->{starts}) {
-			$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'};
+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;
 			}
-			if ($self->{_config}->{$network}->{'ntp-servers'}) {
-				$self->{ntp_servers} = $self->{_config}->{$network}->{'ntp-servers'};
+		}
+	} 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;
 			}
-		} else {
-			$ip = undef;
+			last if $ip;
+		}
+		if (! $ip && $free) {
+			$ip = $free;
 		}
 	}
 
+	$self->$logger("[find_ip_ip4] IP: " . ($ip ? $ip : 'None'), INFO);
+
 	return $ip;
 };
 
-my $calculate_ip_ip4 = sub {
-	my ($self, $dhcpreq) = @_;
-	my ($req_addr, $calc_ip, $network);
-
-	return undef unless $dhcpreq->chaddr();
-	$req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
-	$network = $self->$calculate_net_ip4($dhcpreq);
-	return undef unless $network;
-
-	if ($self->{_config}->{$network}->{static}) {
-		my @static = $self->{_config}->{$network}->{static};
-		foreach (@static) {
-			my @mac = split(/\s+/, $_);
-			if ($mac[0] == $self->$get_mac_ip4($dhcpreq)) {
-				$calc_ip = $mac[1];
-				last;
+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;
 		}
 	}
-	if ($req_addr) {
-		if ($calc_ip && $req_addr != $calc_ip) {
-			$calc_ip = 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 {
-			$calc_ip = $self->$renew_lease_ip4($dhcpreq, $network, $req_addr);
+			($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 {
-		$calc_ip = $self->$renew_lease_ip4($dhcpreq, $network);
 	}
 
-	return $calc_ip;
+	return ($network, $ip);
 };
 
 my $discover_ip4 = sub {
-	my ($self, $dhcpreq) = @_;
-	my ($res, $dhcpresp, $calc_ip, $req_addr);
+	my ($self, $req) = @_;
+	my ($tx, $res, $resp, $network, $calc_ip, $req_addr);
 
-	# calculate address
-	# $calc_ip = "192.168.9.2";
+	$self->$logger("Got ip4 discover request: \n" . $req->toString(), INFO);
 
-	$self->$logger("Got request\n".$dhcpreq->toString());
+	$res = $self->$update_transaction($req);
+	if ($res) {
+		my $err = "Missing transaction ID";
+		$self->$send_nak($req, $err);
+		$self->$logger($err, ERROR);
+		die $err;
+	}
 
-	$self->{_sock_out_ip4} = IO::Socket::IP->new(
-		Broadcast => 1,
-		PeerPort => 68,
-		PeerAddr => inet_ntoa(INADDR_BROADCAST),
-		Proto    => 'udp'
-	) || do {
-		my $err = $@;
-		$self->$logger("[discover_ip4] Socket creation error: $err", ERROR);
-		die "[discover_ip4] Socket creation error: $err\n";
-	};
+	$req_addr = $req->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
+	$res = $self->$read_lease_file();
+	$self->$logger("Starting with empty lease file", INFO) unless $res;
 
-	$res = $self->$read_lease_file();#$self->read_lease_file();
 
 	if ($self->{LOG_LEVEL} <= INFO) {
-		$req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
 		if ($req_addr) {
-			$self->$logger("Requested IP: $req_addr", INFO);
+			$self->$logger("[D] Requested IP: $req_addr", INFO);
 		} else {
-			$self->$logger("Requested IP: None", INFO);
+			$self->$logger("[D] Requested IP: None", INFO);
 		}
 	}
-	$calc_ip = $self->$calculate_ip_ip4($dhcpreq);
-	$self->$logger("Offer: $calc_ip");
-	if ($calc_ip) {
-		$self->$logger("Creating lease for $calc_ip");
-		$res = $self->$write_lease_file();
-	}
-	if ($res && $calc_ip) {
-		$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_ip4($dhcpreq);
+
+	$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
-		$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...",
-		);
+		my $err = "$req_addr: Not available";
+		$self->$logger($err, INFO);
+		$self->$send_nak($req, $err);
 	}
 
-	$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";
+	$self->$logger("Transaction:\n".Dumper($self->{_transaction}), INFO);
 };
 
 my $request_ip4 = sub {
-	my ($self, $dhcpreq) = @_;
-	my ($calc_ip, $dhcpresp, $peeraddr, $result);
-
-	$self->$logger("Got request\n".$dhcpreq->toString());
-
-	$peeraddr = $dhcpreq->ciaddr() ? $dhcpreq->ciaddr() : inet_ntoa(INADDR_BROADCAST);
-	$self->{_sock_out_ip4} = IO::Socket::IP->new(
-		Broadcast => 1,
-		PeerPort => 68,
-		PeerAddr => $peeraddr,
-		Proto    => 'udp',
-	) || do {
-		my $err = $@;
-		$self->$logger("[request_ip4] Socket creation error: $err", ERROR);
-		die "[request_ip4] Socket creation error: $err\n";
-	};
+	my ($self, $req) = @_;
+	my ($calc_ip, $network, $res);
+
+	$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 $network = $self->$calculate_net_ip4($dhcpreq);
-	if ($network) {
-		my $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
-		$calc_ip = $self->$renew_lease_ip4($dhcpreq, $network, $req_addr);
+	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);
+		}
 	}
 
-	# compare calculated address with requested address
-	if ($calc_ip) {
-		# 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_ip4($dhcpreq);
-		$result = 'ACK';
+	($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
-		$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->$send_nak($req);
 	}
 
-	$self->$logger("Sending response to " .
-		$self->{_sock_out_ip4}->peerhost . ':' .
-		$self->{_sock_out_ip4}->peerport, INFO);
+	# This transaction is finished with either NAK or ACK
+	my $xid = $req->xid();
+	delete($self->{_transaction}->{$xid});
 
-	# 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";
+	$self->$logger("Transaction:\n".Dumper($self->{_transaction}), INFO);
 };
 
 my $release_ip4 = sub {
@@ -864,6 +929,7 @@ my $release_ip4 = sub {
 		}
 		$self->$write_lease_file();
 	}
+	$self->$logger("Transaction:\n".Dumper($self->{_transaction}), INFO);
 };
 
 #########################################################################
@@ -871,9 +937,9 @@ my $release_ip4 = sub {
 #########################################################################
 
 my $excuse_me_ip6 = sub {
-	my ($self, $addr, $dhcpreq) = @_;
+	my ($self, $addr, $req) = @_;
 
-	$self->$logger("IPv6 request from [$addr]: $dhcpreq", INFO);
+	$self->$logger("IPv6 request from [$addr]: $req", INFO);
 	$self->{_sock_out_ip6} = IO::Socket::IP->new(
 		Domain	  => PF_INET6,
 		V6Only	  => 1,
@@ -913,15 +979,12 @@ sub new {
 
 	# 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;
 	$self->{_dhpcp_ip4}			= undef;
+	$self->{_transaction}		= ();
 
 	# public
 	$self->{log_file}			||= 'syslog';
@@ -1016,7 +1079,7 @@ sub run {
 	until ($time_to_die) {
 		my $buf = undef;
 		my $fromaddr;
-		my $dhcpreq;
+		my $req;
 
 		eval {	# catch fatal errors
 			while (@ready = $sel->can_read) {
@@ -1027,30 +1090,30 @@ sub run {
 						$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
+
+						$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=$self->{_transaction_ip4} src=$ipaddr:$port length=".length($buf), INFO);
+							$self->$logger("Got a packet tr=$xid src=$ipaddr:$port length=".length($buf), INFO);
 						}
 
-						$dhcpreq = new Net::DHCP::Packet($buf);
-						$dhcpreq->comment($self->{_transaction_ip4});
-
-						my $messagetype = $dhcpreq->getOptionValue(DHO_DHCP_MESSAGE_TYPE());
+						my $messagetype = $req->getOptionValue(DHO_DHCP_MESSAGE_TYPE());
 
 						if ($messagetype eq DHCPDISCOVER()) {
-								$self->$discover_ip4($dhcpreq);
+								$self->$discover_ip4($req);
 						} elsif ($messagetype eq DHCPREQUEST()) {
-								$self->$request_ip4($dhcpreq);
+								$self->$request_ip4($req);
 						} elsif ($messagetype eq DHCPINFORM()) {
 							$self->$logger("Not implemented: DHCPINFORM", WARNING);
 						} elsif ($messagetype eq DHCPRELEASE()) {
-								$self->$release_ip4($dhcpreq);
+								$self->$release_ip4($req);
 						} else {
-							$self->$logger("Packet dropped", WARNING);
+							$self->$logger("$messagetype: Packet dropped since unknown message type", WARNING);
 							# bad messagetype, we drop it
 						}
 					} else {
@@ -1060,7 +1123,6 @@ sub run {
 						$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;
-- 
2.39.2