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