[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 Net::DHCP::Packet;
use Net::DHCP::Constants;
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 constant {
	DEBUG => 0,
	INFO => 1,
	NOTICE => 2,
	WARNING => 3,
	ERROR => 4,
	CRITICAL => 5,
	ALERT => 6,
	EMERGENCY => 7,
};

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(run);

our @EXPORT_OK = (
	'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';
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
    $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->{_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;
	$self->{NODAEMON}		||= 0;
	$self->{DEBUG}			||= 0;
	$self->{timeout}		||= 10;
	$self->{lease_file}		||= '/tmp/dhcpd.leases';

    return $self;
}

sub run {
	my ($self) = @_;
	my ($sel, @ready, $socket);

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

	my $res = $self->read_lease_file();
	do {
		$self->logger("Couldn't read leases file '$self->{lease_file}'", ERROR);
		die "Couldn't read leases file '$self->{lease_file}'";
	} 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 $messagetype = $dhcpreq->getOptionValue(DHO_DHCP_MESSAGE_TYPE());

						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;

						$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);
		}
	}
	$self->{_sock_in_ip4}->close;
	$self->{_sock_in_ip6}->close;
	$self->logger("Exiting dhcpd", INFO);
}

sub run_with_timeout {
    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;
}

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

	my $mode = $shared ? LOCK_SH : LOCK_EX;

	my $lock_func = sub {
		if ($mode == LOCK_SH) {
			$self->{file_handle} = new IO::File ("<$self->{lease_file}") ||
                die "can't open file for read - $!";
		} else {
			$self->{file_handle} = new IO::File (">$self->{lease_file}") ||
                die "can't open file write - $!";
		}
        $self->logger("trying to aquire lock on '$self->{lease_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 '$self->{lease_file}' - $@", ERROR);
		$self->{file_handle} = undef;
		return undef;
    }

    return $res;
}

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

	return '' unless($self->{file_handle});
	my $unlock_func = sub {
        $self->logger("trying to unlock '$self->{lease_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 '$self->{lease_file}' - $@", ERROR);
		$self->{file_handle} = undef;
		$res = undef;
    }

    return $res;
}

sub convert_timestamp {
	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: 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{
		if ($timestamp !~ /^\d+$/) {
			$self->logger("$timestamp: 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;
}


sub add_lease {
	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->{_reverse}->{$mac} = $ip;
	$self->logger("$mac =>\n" . Dumper($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"
#}
sub read_lease_file {
	my ($self) = @_;
	my ($res, $key, $lease);
	my $error = 0;

	$self->lock(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*$/);
				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();
		$res = 1;
	} else {
		$self->logger("Could not read leases file", ERROR);
		$res = 0;
	}

	return $res;
}

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

	$res = $self->lock(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);
				}
				$self->logger("Writing: $key $val");
				print $fh "\t$key $val;\n";
			}
			print $fh "}\n";
		}
		$self->unlock();
		$res = 1;
	} else {
		$self->logger("Could not write leases file", ERROR);
		$res = 0;
	}

	return $res;
}

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

	$level = DEBUG unless ($level);
	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\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;
	}
}

sub add_options {
	my ($self, $dhcpresp) = @_;

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

	$self->logger("Got request\n".$dhcpreq->toString());

	$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 = $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";
}

sub request_ip4 {
	my ($self, $dhcpreq) = @_;
	my ($calc_ip, $dhcpresp, $peeraddr, $result);

	$calc_ip = "192.168.9.2";

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

	# 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';
	} 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";
}

sub release_ip4 {
	my ($self, $dhcpreq) = @_;

	$self->logger($dhcpreq->toString());
	$self->write_lease_file();
}

sub excuse_me_ip6 {
	my ($self, $addr, $dhcpreq) = @_;

	$self->logger("IPv6 request from [$addr]: $dhcpreq", INFO);
	$self->{_sock_out_ip6} = 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);
	$self->{_sock_out_ip6}->send("Not implemented here") || die "Error sending excuse: $!\n";
}

1;
Commit	Line	Data
48b79db9 MR	1	package PVE::DHCPServer;
	2
	3	use strict;
	4	use warnings;
	5	use Carp qw(croak);
	6	use Sys::Hostname;
	7	use Socket;
	8	use Socket6;
	9	use Net::DHCP::Packet;
	10	use Net::DHCP::Constants;
	11	use IO::Socket::IP;
	12	use IO::File;
	13	use IO::Select;
	14	use Sys::Syslog;
	15	use Fcntl qw(:DEFAULT :flock SEEK_END);
	16	use POSIX qw(EINTR setsid strftime);
	17	use Data::Dumper;
	18	use Time::Local;
	19
	20	use constant {
	21	DEBUG => 0,
	22	INFO => 1,
	23	NOTICE => 2,
	24	WARNING => 3,
	25	ERROR => 4,
	26	CRITICAL => 5,
	27	ALERT => 6,
	28	EMERGENCY => 7,
	29	};
	30
	31	use Exporter;
	32	our @ISA = qw(Exporter);
	33	our @EXPORT = qw(run);
	34
	35	our @EXPORT_OK = (
	36	'DEBUG',
	37	'INFO',
	38	'NOTICE',
	39	'WARNING',
	40	'ERROR',
	41	'CRITICAL',
	42	'ALERT',
	43	'EMERGENCY'
	44	);
	45
	46	our %EXPORT_TAGS = ( constants => [
	47	'DEBUG',
	48	'INFO',
	49	'NOTICE',
	50	'WARNING',
	51	'ERROR',
	52	'CRITICAL',
	53	'ALERT',
	54	'EMERGENCY'
	55	]);
	56
	57	our $VERSION = '0.01';
	58	our $NAME = 'PVE::DHCPServer';
	59	my $time_to_die = 0;
	60
	61	# generic signal handler to cause daemon to stop
	62	sub signal_handler {
	63	$time_to_die = 1;
	64	}
65	$SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&signal_handler;
66
67	# ignore any PIPE signal: standard behaviour is to quit process
68	$SIG{PIPE} = 'IGNORE';
69
70	sub new {
71	my ($class, %self) = @_;
72
73	# OOP stuff
74	$class = ref($class) \|\| $class;
75	my $self = \%self;
76	bless $self, $class;
77
78	# private
79	$self->{_sock_in_ip4} = undef;
80	$self->{_sock_out_ip4} = undef;
81	$self->{_sock_in_ip6} = undef;
82	$self->{_sock_out_ip6} = undef;
83	$self->{_leases} = undef;
84	$self->{_reverse} = undef;
85	$self->{_transaction_ip4} = 0;
86	$self->{_transaction_ip6} = 0;
87
88	# public
89	$self->{log_file} \|\|= 'syslog';
90	$self->{lease_time} \|\|= 7200;
91	$self->{subnet_mask} \|\|= undef;
92	$self->{routers} \|\|= undef;
93	$self->{broadcast_addr} \|\|= undef;
94	$self->{domain_name} \|\|= undef;
95	$self->{dns_servers} \|\|= undef;
96	$self->{ntp_servers} \|\|= undef;
97	$self->{LOG_LEVEL} \|\|= ERROR;
98	$self->{NODAEMON} \|\|= 0;
99	$self->{DEBUG} \|\|= 0;
100	$self->{timeout} \|\|= 10;
101	$self->{lease_file} \|\|= '/tmp/dhcpd.leases';
102
103	return $self;
104	}
105
106	sub run {
107	my ($self) = @_;
108	my ($sel, @ready, $socket);
109
110	$self->logger("Starting dhcpd", INFO);
111	if ($self->{NODAEMON} < 1) {
112	$self->logger("Entering Daemon mode");
113	chdir '/' or die "Can't chdir to /: $!";
114	umask 0;
115
116	open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
117	open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
118	open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";
119
120	my $pid = fork;
121	exit if $pid;
122	do {
123	my $err = $!;
124	$self->logger("Couldn't fork: $err", ERROR);
125	die "Couldn't fork: $err";
126	} unless defined($pid);
127
128	POSIX::setsid() \|\| do {
129	my $err = $!;
130	$self->logger("Can't start a new session: $err", ERROR);
131	die "Can't start a new session: $err";
132	};
133	$self->logger("Now in Daemon mode", INFO);
134	}
135
136	my $res = $self->read_lease_file();
137	do {
138	$self->logger("Couldn't read leases file '$self->{lease_file}'", ERROR);
139	die "Couldn't read leases file '$self->{lease_file}'";
140	} unless $res;
141
142	$self->logger("Initialization complete", INFO);
143
144	# open listening socket
145	$self->{_sock_in_ip4} = IO::Socket::IP->new(
146	Domain => PF_INET,
147	LocalPort => 67,
148	LocalAddr => inet_ntoa(INADDR_ANY),
149	Proto => 'udp'
150	) \|\| do {
151	my $err = $@;
152	$self->logger("IP4 Socket creation error: $err", ERROR);
153	die "IP4 Socket creation error: $err\n";
154	};
155	$self->{_sock_in_ip6} = IO::Socket::IP->new(
156	Domain => PF_INET6,
157	V6Only => 1,
158	LocalPort => 547,
159	LocalAddr => '::',
160	Proto => 'udp'
161	) \|\| do {
162	my $err = $@;
163	$self->logger("IP6 Socket creation error: $err", ERROR);
164	die "IP6 Socket creation error: $err\n";
165	};
166
167	$sel = IO::Select->new($self->{_sock_in_ip4});
168	$sel->add($self->{_sock_in_ip6});
169
170	until ($time_to_die) {
171	my $buf = undef;
172	my $fromaddr;
173	my $dhcpreq;
174
175	eval { # catch fatal errors
176	while (@ready = $sel->can_read) {
177	$self->logger("Waiting for incoming packet", INFO);
178	foreach $socket (@ready) {
179	if ($socket == $self->{_sock_in_ip4}) {
180	# receive ipv4 packet
181	$fromaddr = $self->{_sock_in_ip4}->recv($buf, 4096)
182	\|\| $self->logger("recv: $!", ERROR);
183	next if ($!); # continue loop if an error occured
184	$self->{_transaction_ip4}++; # transaction counter
185
186	{
187	use bytes;
188	my ($port,$addr) = unpack_sockaddr_in($fromaddr);
189	my $ipaddr = inet_ntoa($addr);
190	$self->logger("Got a packet tr=$self->{_transaction_ip4} src=$ipaddr:$port length=".length($buf), INFO);
191	}
192
193
194	my $dhcpreq = new Net::DHCP::Packet($buf);
195	$dhcpreq->comment($self->{_transaction_ip4});
196
197	my $messagetype = $dhcpreq->getOptionValue(DHO_DHCP_MESSAGE_TYPE());
198
199	if ($messagetype eq DHCPDISCOVER()) {
200	$self->discover_ip4($dhcpreq);
201	} elsif ($messagetype eq DHCPREQUEST()) {
202	$self->request_ip4($dhcpreq);
203	} elsif ($messagetype eq DHCPINFORM()) {
204	$self->logger("Not implemented: DHCPINFORM", WARNING);
205	} elsif ($messagetype eq DHCPRELEASE()) {
206	$self->release_ip4($dhcpreq);
207	} else {
208	$self->logger("Packet dropped", WARNING);
209	# bad messagetype, we drop it
210	}
211	} else {
212	# Receive ipv6 packet
213	my $ipaddr;
214
215	$fromaddr = $self->{_sock_in_ip6}->recv($buf, 4096)
216	\|\| $self->logger("recv: $!", ERROR);
217	next if ($!); # continue loop if an error occured
218	$self->{_transaction_ip6}++; # transaction counter
219	$self->logger("recv: $buf", INFO);
220	{
221	use bytes;
222	my ($port,$addr) = unpack_sockaddr_in6($fromaddr);
223	$ipaddr = inet_ntop(AF_INET6, $addr);
224	$self->logger("Got a packet tr=$self->{_transaction_ip6} src=$ipaddr:$port length=".length($buf), INFO);
225	}
226	$self->excuse_me_ip6($ipaddr, $buf);
227	}
228	}
229	}
230	}; # end of 'eval' blocks
231	if ($@) {
232	$self->logger("Caught error in main loop: $@", ERROR);
233	}
234	}
235	$self->{_sock_in_ip4}->close;
236	$self->{_sock_in_ip6}->close;
237	$self->logger("Exiting dhcpd", INFO);
238	}
239
240	sub run_with_timeout {
241	my ($self, $code, @param) = @_;
242
243	die "got timeout" if $self->{timeout} <= 0;
244
245	my $prev_alarm;
246
247	my $sigcount = 0;
248
249	my $res;
250
251	local $SIG{ALRM} = sub { $sigcount++; }; # catch alarm outside eval
252
253	eval {
254	local $SIG{ALRM} = sub { $sigcount++; die "got timeout"; };
255	local $SIG{PIPE} = sub { $sigcount++; die "broken pipe" };
256	local $SIG{__DIE__}; # see SA bug 4631
257
258	$prev_alarm = alarm($self->{timeout});
259
260	$res = &$code(@param);
261
262	alarm(0); # avoid race conditions
263	};
264
265	my $err = $@;
266
267	alarm($prev_alarm) if defined($prev_alarm);
268
269	die "unknown error" if $sigcount && !$err; # seems to happen sometimes
270
271	die $err if $err;
272
273	return $res;
274	}
275
276	sub lock {
277	my ($self, $shared) = @_;
278
279	my $mode = $shared ? LOCK_SH : LOCK_EX;
280
281	my $lock_func = sub {
282	if ($mode == LOCK_SH) {
283	$self->{file_handle} = new IO::File ("<$self->{lease_file}") \|\|
284	die "can't open file for read - $!";
285	} else {
286	$self->{file_handle} = new IO::File (">$self->{lease_file}") \|\|
287	die "can't open file write - $!";
288	}
289	$self->logger("trying to aquire lock on '$self->{lease_file}'...");
290	if (!flock ($self->{file_handle}, $mode\|LOCK_NB)) {
291	my $success;
292	while(1) {
293	$success = flock($self->{file_handle}, $mode);
294	# try again on EINTR (see bug #273)
295	if ($success \|\| ($! != EINTR)) {
296	last;
297	}
298	}
299	if ($mode == LOCK_SH) {
300	seek($self->{file_handle}, 0, SEEK_END) or $success = 0;
301	}
302	if (!$success) {
303	$self->logger(" failed");
304	die "can't aquire lock - $!";
305	}
306	}
307	$self->logger(" OK");
308	};
309
310	my $res;
311	my $err = undef;
312
313	eval {
314	$res = $self->run_with_timeout($lock_func);
315	};
316	if ($@) {
317	$self->logger("can't lock file '$self->{lease_file}' - $@", ERROR);
318	$self->{file_handle} = undef;
319	return undef;
320	}
321
322	return $res;
323	}
324
325	sub unlock {
326	my ($self) = @_;
327
328	return '' unless($self->{file_handle});
329	my $unlock_func = sub {
330	$self->logger("trying to unlock '$self->{lease_file}'...");
331	if (!flock($self->{file_handle}, LOCK_UN)) {
332
333	my $success;
334	while(1) {
335	$success = flock($self->{file_handle}, LOCK_UN);
336	# try again on EINTR (see bug #273)
337	if ($success \|\| ($! != EINTR)) {
338	last;
339	}
340	}
341	if (!$success) {
342	$self->logger(" failed");
343	die "can't unlock - $!";
344	}
345	}
346	$self->logger(" OK");
347	};
348
349	my $res;
350	my $err = undef;
351
352	eval {
353	$res = $self->run_with_timeout($unlock_func);
354	};
355	if ($@) {
356	$self->logger("can't lock file '$self->{lease_file}' - $@", ERROR);
357	$self->{file_handle} = undef;
358	$res = undef;
359	}
360
361	return $res;
362	}
363
364	sub convert_timestamp {
365	my ($self, $timestamp, $strtotime) = @_;
366	my ($res, $mday, $mon, $year, $hour, $min, $sec);
367
368	$self->logger("Timestamp: $timestamp");
369	if ($strtotime) {
370	if ($timestamp !~ /^\d{4}\/\d{2}\/\d{2}\s+\d{2}:\d{2}:\d{2}$/) {
371	$self->logger("$timestamp: Bad format", ERROR);
372	$res = undef;
373	} else {
374	($year,$mon,$mday,$hour,$min,$sec) = split(/[\s\/:]+/, $timestamp);
375	$res = timelocal($sec,$min,$hour,$mday,$mon-1,$year);
376	}
377	} else{
378	if ($timestamp !~ /^\d+$/) {
379	$self->logger("$timestamp: Bad format", ERROR);
380	$res = undef;
381	} else {
382	($sec,$min,$hour,$mday,$mon,$year) = localtime($timestamp);
383	$self->logger("Timestamp: $sec,$min,$hour,$mday,$mon,$year");
384	$res = sprintf("%d/%02d/%02d %02d:%02d:%02d", ($year+1900),($mon+1),$mday,$hour,$min,$sec);
385	$self->logger("Timestamp: $res");
386	}
387	}
388
389	return $res;
390	}
391
392
393	sub add_lease {
394	my ($self, $ip, $lease) = @_;
395	my $ts;
396
397	my $mac = $lease->{'hardware ethernet'};
398	$mac =~ tr/://d;
399	$lease->{'hardware ethernet'} = $mac;
400	$ts = $self->convert_timestamp($lease->{starts}, 1);
401	return unless $ts;
402	$lease->{starts} = $ts;
403	$ts = $self->convert_timestamp($lease->{ends}, 1);
404	return unless $ts;
405	$lease->{ends} = $ts;
406
407	$self->{_leases}->{$ip} = $lease;
408	$self->{_reverse}->{$mac} = $ip;
409	$self->logger("$mac =>\n" . Dumper($self->{_reverse}->{$mac}));
410	}
411
412	#lease vvv.xxx.yyy.zzz {
413	# starts yyyy/mm/dd hh:mm:ss;
414	# ends yyyy/mm/dd hh:mm:ss;
415	# binding state active\|free;
416	# hardware ethernet MAC;
417	# client-hostname "name"
418	#}
419	sub read_lease_file {
420	my ($self) = @_;
421	my ($res, $key, $lease);
422	my $error = 0;
423
424	$self->lock(1);
425	if ($self->{file_handle}) {
426	my $fh = $self->{file_handle};
427	my @lines = <$fh>;
428	foreach (@lines) {
429	$self->logger("Read: $_");
430	if ($_ =~ /^\slease\s+([\d\.]+)\s+{\s/) {
431	$self->add_lease($key, $lease) if $lease;
432	$key = $1;
433	$lease = undef;
434	$error = 0;
435	$self->logger("Key: $key");
436	} else {
437	next if $error;
438	next if ($_ =~ /^\s}\s/ \|\| $_ =~ /^\s*$/);
439	if ($_ =~ /^\s(starts\|ends\|binding state\|hardware ethernet\|client-hostname)\s+(.+)\s;/) {
440	$lease->{$1} = $2;
441	$self->logger("Key: $1 Value: $2");
442	} else {
443	$key = 'UNDEF' unless $key;
444	$self->logger("$key: Bad format", ERROR);
445	$key = undef;
446	$lease = undef;
447	$error = 1;
448	}
449	}
450	}
451	if ($lease && !$error) {
452	$self->logger("Key: $key");
453	$self->add_lease($key, $lease);
454	}
455	$self->logger("Leases data structure: \n" . Dumper($self->{_leases}));
456	$self->unlock();
457	$res = 1;
458	} else {
459	$self->logger("Could not read leases file", ERROR);
460	$res = 0;
461	}
462
463	return $res;
464	}
465
466	sub write_lease_file {
467	my ($self) = @_;
468	my $res;
469
470	$res = $self->lock(0);
471	if ($self->{file_handle}) {
472	my $fh = $self->{file_handle};
473	while ((my $lease, my $elems) = each $self->{_leases}) {
474	$self->logger("Writing: $lease");
475	print $fh "lease $lease {\n";
476	while ((my $key, my $val) = each %$elems) {
477	if ($key =~ /^(starts\|ends)$/) {
478	$val = $self->convert_timestamp($val, 0);
479	}
480	$self->logger("Writing: $key $val");
481	print $fh "\t$key $val;\n";
482	}
483	print $fh "}\n";
484	}
485	$self->unlock();
486	$res = 1;
487	} else {
488	$self->logger("Could not write leases file", ERROR);
489	$res = 0;
490	}
491
492	return $res;
493	}
494
495	sub logger {
496	my ($self, $message, $level) = @_;
497
498	$level = DEBUG unless ($level);
499	return unless ($level >= $self->{LOG_LEVEL});
500
501	$level = "debug" if $level eq DEBUG;
502	$level = "info" if $level eq INFO;
503	$level = "notice" if $level eq NOTICE;
504	$level = "warning" if $level eq WARNING;
505	$level = "err" if $level eq ERROR;
506	$level = "crit" if $level eq CRITICAL;
507	$level = "alert" if $level eq ALERT;
508	$level = "emerg" if $level eq EMERGENCY;
509
510	if ($self->{DEBUG}) {
511	print STDOUT strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
512	print STDOUT "$level: $message\n";
513	} elsif ($self->{log_file} eq 'syslog') {
514	openlog($NAME, 'ndelay,pid', 'user');
515	syslog($level, $message);
516	closelog();
517	} else {
518	my $fh = new IO::File;
519	if (! $fh->open("> $self->{log_file}")) {
520	croak "$self->{log_file}: $!";
521	}
522	print $fh strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
523	print $fh "$level: $message\n";
524	undef $fh;
525	}
526	}
527
528	sub add_options {
529	my ($self, $dhcpresp) = @_;
530
531	if ($self->{lease_time}) {
532	$dhcpresp->addOptionValue(DHO_DHCP_LEASE_TIME, $self->{lease_time});
533	}
534	if ($self->{subnet_mask}) {
535	$dhcpresp->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
536	}
537	if ($self->{routers}) {
538	$dhcpresp->addOptionValue(DHO_ROUTERS, $self->{routers});
539	}
540	if ($self->{broadcast_addr}) {
541	$dhcpresp->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
542	}
543	if ($self->{domain_name}) {
544	$dhcpresp->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
545	}
546	if ($self->{ntp_servers}) {
547	$dhcpresp->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
548	}
549	if ($self->{dns_servers}) {
550	$dhcpresp->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
551	}
552	}
553
554	sub discover_ip4 {
555	my ($self, $dhcpreq) = @_;
556	my ($calc_ip, $req_addr, $dhcpresp);
557	my $res;
558
559	# calculate address
560	$calc_ip = "192.168.9.2";
561
562	$self->logger("Got request\n".$dhcpreq->toString());
563
564	$self->{_sock_out_ip4} = IO::Socket::IP->new(
565	Broadcast => 1,
566	PeerPort => 68,
567	PeerAddr => inet_ntoa(INADDR_BROADCAST),
568	Proto => 'udp'
569	) \|\| do {
570	my $err = $@;
571	$self->logger("[discover_ip4] Socket creation error: $err", ERROR);
572	die "[discover_ip4] Socket creation error: $err\n";
573	};
574
575	$req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
576	$req_addr = '' unless $req_addr;
577	$self->logger("Requested IP: $req_addr", INFO);
578
579	$res = $self->read_lease_file();
580	$res = $self->write_lease_file();
581	if ($res && ($req_addr =~ /^$/ \|\| $calc_ip eq $req_addr)) {
582	$dhcpresp = new Net::DHCP::Packet(
583	Comment => $dhcpreq->comment(),
584	Op => BOOTREPLY(),
585	Hops => $dhcpreq->hops(),
586	Xid => $dhcpreq->xid(),
587	Flags => $dhcpreq->flags(),
588	Ciaddr => $dhcpreq->ciaddr(),
589	Yiaddr => $calc_ip,
590	Siaddr => $dhcpreq->siaddr(),
591	Giaddr => $dhcpreq->giaddr(),
592	Chaddr => $dhcpreq->chaddr(),
593	DHO_DHCP_MESSAGE_TYPE() => DHCPOFFER(),
594	DHO_DHCP_SERVER_IDENTIFIER() => $self->{_sock_out_ip4}->sockhost
595	);
596	$self->add_options($dhcpresp);
597	} else {
598	# bad request, we send a NAK
599	$dhcpresp = new Net::DHCP::Packet(
600	Comment => $dhcpreq->comment(),
601	Op => BOOTREPLY(),
602	Hops => $dhcpreq->hops(),
603	Xid => $dhcpreq->xid(),
604	Flags => $dhcpreq->flags(),
605	Ciaddr => $dhcpreq->ciaddr(),
606	Yiaddr => "0.0.0.0",
607	Siaddr => $dhcpreq->siaddr(),
608	Giaddr => $dhcpreq->giaddr(),
609	Chaddr => $dhcpreq->chaddr(),
610	DHO_DHCP_MESSAGE_TYPE() => DHCPNAK(),
611	DHO_DHCP_MESSAGE(), "Bad request...",
612	);
613	}
614
615	$self->logger("Sending response to " .
616	$self->{_sock_out_ip4}->peerhost . ':' .
617	$self->{_sock_out_ip4}->peerport, INFO);
618
619	# Socket object keeps track of whom sent last packet
620	# so we don't need to specify target address
621	$self->logger($dhcpresp->toString());
622	$self->logger("Sending OFFER tr=".$dhcpresp->comment(), INFO);
623	$self->{_sock_out_ip4}->send($dhcpresp->serialize()) \|\| die "Error sending OFFER: $!\n";
624	}
625
626	sub request_ip4 {
627	my ($self, $dhcpreq) = @_;
628	my ($calc_ip, $dhcpresp, $peeraddr, $result);
629
630	$calc_ip = "192.168.9.2";
631
632	$peeraddr = $dhcpreq->ciaddr() ? $dhcpreq->ciaddr() : inet_ntoa(INADDR_BROADCAST);
633	$self->{_sock_out_ip4} = IO::Socket::IP->new(
634	Broadcast => 1,
635	PeerPort => 68,
636	PeerAddr => $peeraddr,
637	Proto => 'udp',
638	) \|\| do {
639	my $err = $@;
640	$self->logger("[request_ip4] Socket creation error: $err", ERROR);
641	die "[request_ip4] Socket creation error: $err\n";
642	};
643
644	# compare calculated address with requested address
645	if ($calc_ip eq $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS())) {
646	# address is correct, we send an ACK
647	$dhcpresp = new Net::DHCP::Packet(
648	Comment => $dhcpreq->comment(),
649	Op => BOOTREPLY(),
650	Hops => $dhcpreq->hops(),
651	Xid => $dhcpreq->xid(),
652	Flags => $dhcpreq->flags(),
653	Ciaddr => $dhcpreq->ciaddr(),
654	Yiaddr => $calc_ip,
655	Siaddr => $dhcpreq->siaddr(),
656	Giaddr => $dhcpreq->giaddr(),
657	Chaddr => $dhcpreq->chaddr(),
658	DHO_DHCP_MESSAGE_TYPE() => DHCPACK(),
659	DHO_DHCP_SERVER_IDENTIFIER() => $self->{_sock_out_ip4}->sockhost,
660	);
661	$self->add_options($dhcpresp);
662	$result = 'ACK';
663	} else {
664	# bad request, we send a NAK
665	$self->write_lease_file();
666	$dhcpresp = new Net::DHCP::Packet(
667	Comment => $dhcpreq->comment(),
668	Op => BOOTREPLY(),
669	Hops => $dhcpreq->hops(),
670	Xid => $dhcpreq->xid(),
671	Flags => $dhcpreq->flags(),
672	Ciaddr => $dhcpreq->ciaddr(),
673	Yiaddr => "0.0.0.0",
674	Siaddr => $dhcpreq->siaddr(),
675	Giaddr => $dhcpreq->giaddr(),
676	Chaddr => $dhcpreq->chaddr(),
677	DHO_DHCP_MESSAGE_TYPE() => DHCPNAK(),
678	DHO_DHCP_MESSAGE(), "Bad request...",
679	);
680	$result = 'NAK';
681	}
682
683	$self->logger("Sending response to " .
684	$self->{_sock_out_ip4}->peerhost . ':' .
685	$self->{_sock_out_ip4}->peerport, INFO);
686
687	# Socket object keeps track of whom sent last packet
688	# so we don't need to specify target address
689	$self->logger($dhcpresp->toString());
690	$self->logger("Sending $result tr=".$dhcpresp->comment(), INFO);
691	$self->{_sock_out_ip4}->send($dhcpresp->serialize()) \|\| die "Error sending ACK/NAK: $!\n";
692	}
693
694	sub release_ip4 {
695	my ($self, $dhcpreq) = @_;
696
697	$self->logger($dhcpreq->toString());
698	$self->write_lease_file();
699	}
700
701	sub excuse_me_ip6 {
702	my ($self, $addr, $dhcpreq) = @_;
703
704	$self->logger("IPv6 request from [$addr]: $dhcpreq", INFO);
705	$self->{_sock_out_ip6} = IO::Socket::IP->new(
706	Domain => PF_INET6,
707	V6Only => 1,
708	Broadcast => 1,
709	PeerPort => 546,
710	PeerAddr => $addr,
711	Proto => 'udp',
712	) \|\| do {
713	my $err = $@;
714	$self->logger("[excuse_me_ip6] Socket creation error: $err", ERROR);
715	die "[excuse_me_ip6] Socket creation error: $err\n";
716	};
717	$self->logger("$addr: Not implemented here", INFO);
718	$self->{_sock_out_ip6}->send("Not implemented here") \|\| die "Error sending excuse: $!\n";
719	}
720
721	1;