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