Some minor fixes

[pve-dhcp-server.git] / DHCPServer.pm

package PVE::DHCPServer;

use strict;
use warnings;
use Carp qw(croak);
use Sys::Hostname;
use Socket;
use Socket6;
use NetAddr::IP;
use IO::Socket::IP;
use IO::File;
use IO::Select;
use Sys::Syslog;
use Fcntl qw(:DEFAULT :flock SEEK_END);
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,
	DHCP_OFFER	=> 100,
	DHCP_ACK	=> 101,
};

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(
	run
	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;

#########################################################################
# Private methods
#########################################################################

my $logger = sub {
	my ($self, $message, $level) = @_;

	$level ||= DEBUG;
	return unless ($level >= $self->{LOG_LEVEL});

	$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;

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

my $run_with_timeout = sub {
    my ($self, $code, @param) = @_;

    die "got timeout" if $self->{timeout} <= 0;

    my $prev_alarm;

    my $sigcount = 0;

    my $res;

    local $SIG{ALRM} = sub { $sigcount++; }; # catch alarm outside eval

    eval {
		local $SIG{ALRM} = sub { $sigcount++; die "got timeout"; };
		local $SIG{PIPE} = sub { $sigcount++; die "broken pipe" };
		local $SIG{__DIE__};   # see SA bug 4631

		$prev_alarm = alarm($self->{timeout});

		$res = &$code(@param);

		alarm(0); # avoid race conditions
    };

    my $err = $@;

    alarm($prev_alarm) if defined($prev_alarm);

    die "unknown error" if $sigcount && !$err; # seems to happen sometimes

    die $err if $err;

    return $res;
};

my $lock = sub {
	my ($self, $file, $shared) = @_;

	my $mode = $shared ? LOCK_SH : LOCK_EX;

	my $lock_func = sub {
		if ($mode == LOCK_SH) {
			$self->{file_handle} = new IO::File ("<$file") ||
                die "can't open file '$file' for read - $!";
		} else {
			$self->{file_handle} = new IO::File (">$file") ||
                die "can't open file '$file' for write - $!";
		}
        $self->$logger("trying to aquire lock on '$file'...");
        if (!flock ($self->{file_handle}, $mode|LOCK_NB)) {
			my $success;
			while(1) {
				$success = flock($self->{file_handle}, $mode);
				# try again on EINTR (see bug #273)
				if ($success || ($! != EINTR)) {
					last;
				}
			}
			if ($mode == LOCK_SH) {
				seek($self->{file_handle}, 0, SEEK_END) or $success = 0;
			}
			if (!$success) {
				$self->$logger(" failed");
				die "can't aquire lock - $!";
			}
        }
		$self->$logger(" OK");
    };

    my $res;
    my $err = undef;

    eval {
		$res = $self->$run_with_timeout($lock_func);
	};
    if ($@) {
		$self->$logger("can't lock file '$file' - $@", ERROR);
		$self->{file_handle} = undef;
		return undef;
    }

    return $res;
};

my $unlock = sub {
	my ($self, $file) = @_;

	return '' unless($self->{file_handle});
	my $unlock_func = sub {
        $self->$logger("trying to unlock '$file'...");
        if (!flock($self->{file_handle}, LOCK_UN)) {

			my $success;
			while(1) {
				$success = flock($self->{file_handle}, LOCK_UN);
				# try again on EINTR (see bug #273)
				if ($success || ($! != EINTR)) {
					last;
				}
			}
			if (!$success) {
				$self->$logger(" failed");
				die "can't unlock - $!";
			}
        }
		$self->$logger(" OK");
    };

    my $res;
    my $err = undef;

    eval {
		$res = $self->$run_with_timeout($unlock_func);
	};
    if ($@) {
		$self->$logger("can't lock file '$file' - $@", ERROR);
		$self->{file_handle} = undef;
		$res = undef;
    }

    return $res;
};

my $convert_timestamp = sub {
	my ($self, $timestamp, $strtotime) = @_;
	my ($res, $mday, $mon, $year, $hour, $min, $sec);

	$self->$logger("Timestamp: $timestamp");
	if ($strtotime) {
		if ($timestamp !~ /^\d{4}\/\d{2}\/\d{2}\s+\d{2}:\d{2}:\d{2}$/) {
			$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: (timetostr) Bad format", ERROR);
			$res = undef;
		} else {
			($sec,$min,$hour,$mday,$mon,$year) = localtime($timestamp);
			$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");
		}
	}

	return $res;
};


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);
	return unless $ts;
	$lease->{starts} = $ts;
	$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 => $self->{_reverse}->{$mac}");
};

#lease vvv.xxx.yyy.zzz {
#	starts yyyy/mm/dd hh:mm:ss;
#	ends yyyy/mm/dd hh:mm:ss;
#	binding state active|free;
#	hardware ethernet MAC;
#	client-hostname "name"
#}
my $read_lease_file = sub {
	my ($self) = @_;
	my ($res, $key, $lease);
	my $error = 0;

	# 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: $_");
			if ($_ =~ /^\s*lease\s+([\d\.]+)\s+{\s*/) {
				$self->$add_lease($key, $lease) if $lease;
				$key = $1;
				$lease = undef;
				$error = 0;
				$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");
				} else {
					$key = 'UNDEF' unless $key;
					$self->$logger("$key: Bad format", ERROR);
					$key = undef;
					$lease = undef;
					$error = 1;
				}
			}
		}
		if ($lease && !$error) {
			$self->$logger("Key: $key");
			$self->$add_lease($key, $lease);
		}
		$self->$logger("Leases data structure: \n" . Dumper($self->{_leases}));
		$self->$unlock($self->{lease_file});
		$res = 1;
	} else {
		$self->$logger("Could not read leases file", INFO);
		$res = 0;
	}

	return $res;
};

my $write_lease_file = sub {
	my ($self) = @_;
	my $res;

	$res = $self->$lock($self->{lease_file}, 0);
	if ($self->{file_handle}) {
		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";
				}
				print $fh "}\n";
			}
		}
		$self->$unlock($self->{lease_file});
		$res = 1;
	} else {
		$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;
#	ttl 7200;
#	rttl 3600;
#	router 192.168.9.254;
#	dns-servers 192.168.2.201;
#	ntp-servers 192.168.9.254;
#	broadcast 192.168.9.255;
#	domain-name "foo.bar";
#	{
#		allow 001cc0c33317,001cc0c33318,001cc0c33319,001cc0c33320;
#		static 001cc0c33317 192.168.9.100,001cc0c33318 192.168.9.200;
#	}
#}
my $read_config = sub {
	my ($self) = @_;
	my ($res, $key, $netmask, $config, $subopt);

	$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: $_");
			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}");
			} 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");
				} elsif ($subopt &&$_ =~ /^\s*}\s*/) {
					$subopt = 0;
				} elsif ($subopt || $_ =~ /^\s*{\s*/) {
					if ($subopt) {
						if ($_ =~ /^\s*(allow|static)\s+(.+)\s*;/) {
							my @vals = split(/\s*,\s*/, $2);
							$config->{$1} = [@vals];
							$self->$logger("Key: $1 Value: $2");
						} else {
							$key = 'UNDEF' unless $key;
							my $err = "$key: 'suboptions' Bad format";
							$self->$logger($err, ERROR);
							$key = undef;
							$config = undef;
							die $err;
						}
					} else {
						$subopt = 1;
					}
				} else {
					$key = 'UNDEF' unless $key;
					my $err = "$key: Bad format";
					$self->$logger($err, ERROR);
					$key = undef;
					$config = undef;
					die $err;
				}
			}
		}
		if ($config) {
			$self->{_config}->{$key} = $config;
		}
		$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";
	}
};

#########################################################################
#  Private methods which handle DHCP4 requests
#########################################################################

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;
			}
		}
	} else {
		$found = 1;
	}

	return $found;
};

my $add_options_ip4 = sub {
	my ($self, $resp) = @_;

	if ($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}) {
		$resp->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
	}
	if ($self->{routers}) {
		$resp->addOptionValue(DHO_ROUTERS, $self->{routers});
	}
	if ($self->{broadcast_addr}) {
		$resp->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
	}
	if ($self->{domain_name}) {
		$resp->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
	}
	if ($self->{ntp_servers}) {
		$resp->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
	}
	if ($self->{dns_servers}) {
		$resp->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
	}
};

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 $err = "$reply: Unknown reply";
		$self->$logger($err, ERROR);
		die $err;
	}

	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 => $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
		my $err = "$req_addr: Not available";
		$self->$logger($err, INFO);
		$self->$send_nak($req, $err);
	}

	$self->$logger("Transaction:\n".Dumper($self->{_transaction}), INFO);
};

my $request_ip4 = sub {
	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 $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);
		}
	}

	($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);
};

#########################################################################
#  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,
		PeerPort  => 546,
		PeerAddr  => $addr,
		Proto     => 'udp',
	) || do {
		my $err = $@;
		$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);
	$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';

    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});

	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);
				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;