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,
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
- $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;
+#########################################################################
+# Private methods
+#########################################################################
- 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", ERROR);
$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("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) = @_;
+#########################################################################
+# Private methods which handle DHCP4 requests
+#########################################################################
- $level = DEBUG unless ($level);
- return unless ($level >= $self->{LOG_LEVEL});
+my $get_mac_ip4 = sub {
+ my ($self, $dhcpreq) = @_;
+ my $mac;
- $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;
+ $mac = $dhcpreq->chaddr();
+ $mac =~ s/0+$//;
- 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}: $!";
+ return $mac;
+};
+
+my $can_client_use_net_ip4 = sub {
+ my ($self, $dhcpreq, $network) = @_;
+ my (@allow, $found);
+
+ # Is client allowed to request IP?
+ $found = 0;
+ if ($self->{_config}->{$network}->{allow}) {
+ @allow = $self->{_config}->{$network}->{allow};
+ $self->$logger("Allow: " . Dumper(@allow));
+ foreach (@allow) {
+ if ($_ eq $self->$get_mac_ip4($dhcpreq)) {
+ $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 $create_new_lease_ip4 = sub {
+ my ($self, $dhcpreq, $network, $lease) = @_;
+
+ if (! $lease) {
+ $lease = ();
+ $lease->{'hardware ethernet'} = $self->$get_mac_ip4($dhcpreq);
+ }
+ my $client = $dhcpreq->getOptionValue(DHO_HOST_NAME());
+ $lease->{'client-hostname'} = $client ? $client : $self->$get_mac_ip4($dhcpreq);
+ $lease->{'binding state'} = 'active';
+ my $start = time;
+ my $end = $start + $self->{_config}->{$network}->{ttl};
+ $lease->{starts} = $self->$convert_timestamp($start, 0);
+ $lease->{ends} = $self->$convert_timestamp($end, 0);
+
+ return $lease;
+};
+
+my $add_options_ip4 = sub {
+ my ($self, $dhcpreq) = @_;
if ($self->{lease_time}) {
- $dhcpresp->addOptionValue(DHO_DHCP_LEASE_TIME, $self->{lease_time});
+ $dhcpreq->addOptionValue(DHO_DHCP_LEASE_TIME, $self->{lease_time});
+ }
+ if ($self->{lease_time_renew}) {
+ $dhcpreq->addOptionValue(DHO_DHCP_RENEWAL_TIME, $self->{lease_time_renew});
}
if ($self->{subnet_mask}) {
- $dhcpresp->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
+ $dhcpreq->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
}
if ($self->{routers}) {
- $dhcpresp->addOptionValue(DHO_ROUTERS, $self->{routers});
+ $dhcpreq->addOptionValue(DHO_ROUTERS, $self->{routers});
}
if ($self->{broadcast_addr}) {
- $dhcpresp->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
+ $dhcpreq->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
}
if ($self->{domain_name}) {
- $dhcpresp->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
+ $dhcpreq->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
}
if ($self->{ntp_servers}) {
- $dhcpresp->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
+ $dhcpreq->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
}
if ($self->{dns_servers}) {
- $dhcpresp->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
+ $dhcpreq->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
}
-}
+};
-sub discover_ip4 {
+my $calculate_net_ip4 = sub {
my ($self, $dhcpreq) = @_;
- my ($calc_ip, $req_addr, $dhcpresp);
- my $res;
+ my ($req_addr, $network);
+
+ $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
+ $self->$logger("Req IP: " . ($req_addr ? $req_addr : 'None'));
+ if ($req_addr) {
+ my ($space, $test);
+ my %config = %{$self->{_config}};
+ while (my ($net, $opt) = each (%config)) {
+ $self->$logger("Network: $net/$opt->{netmask}\n" . Dumper($opt));
+ $space = NetAddr::IP->new($net, $opt->{netmask});
+ $test = NetAddr::IP->new($req_addr);
+ if ($space->contains($test)) {
+ $network = $net if ($self->$can_client_use_net_ip4($dhcpreq, $net));
+ last;
+ }
+ }
+ } else {
+ my ($space, $test);
+ my %config = %{$self->{_config}};
+ while (my ($net, $opt) = each (%config)) {
+ $self->$logger("Network: $net/$opt->{netmask}\n" . Dumper($opt));
+ my $can = $self->$can_client_use_net_ip4($dhcpreq, $net);
+ $self->$logger("Network usable: $can");
+ if ($can) {
+ $network = $net;
+ last;
+ }
+ }
+ }
+
+ $self->$logger("Network: " . ($network ? $network : 'None'));
+
+ return $network;
+};
+
+my $renew_lease_ip4 = sub {
+ my ($self, $dhcpreq, $network, $req_addr) = @_;
+ my ($start, $end, $test, $ip, $lease);
+
+ my $find_ip_and_lease = sub {
+ my ($reqaddr) = @_;
+
+ my @range_str = split(/\s+/, $self->{_config}->{$network}->{range});
+ $self->$logger("Range: " . $range_str[0] . " - " . $range_str[1]);
+ $start = NetAddr::IP->new($range_str[0]);
+ $end = NetAddr::IP->new($range_str[1]);
+ $self->$logger(Dumper($start) . Dumper($end));
+
+ if ($reqaddr) {
+ my $request = NetAddr::IP->new($reqaddr);
+ if ($start <= $request && $request <= $start) {
+ my $nip = $start->addr();
+ $self->$logger("IP: $nip");
+ if ($self->{_leases}->{$nip}) {
+ $lease = $self->{_leases}->{$nip};
+ if ($lease->{'binding state'} eq 'free') {
+ $ip = $nip;
+ $lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
+ }
+ }
+ }
+ } else {
+ my $free = undef;
+ for (; $start <= $end; $start++) {
+ my $nip = $start->addr();
+ $self->$logger("IP: $nip");
+ if ($self->{_leases}->{$nip} && ! $free) {
+ $lease = $self->{_leases}->{$nip};
+ if ($lease->{'binding state'} eq 'free') {
+ $free = ();
+ $free->{$nip} = $lease;
+ }
+ } else {
+ $lease = $self->$create_new_lease_ip4($dhcpreq, $network);
+ $ip = $nip;
+ last;
+ }
+ }
+ if (! $ip && $free) {
+ ($ip, $lease) = each($free);
+ $lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
+ }
+ }
+
+ return ($ip, $lease);
+ };
+
+ if ($req_addr) {
+ if ($self->{_leases}) {
+ $lease = $self->{_leases}->{$req_addr};
+ return undef if ($lease && $lease->{'hardware ethernet'} ne $self->$get_mac_ip4($dhcpreq));
+ $lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
+ $ip = $req_addr;
+ } else {
+ ($ip, $lease) = $find_ip_and_lease->($req_addr);
+ }
+ } else {
+ my $mac = $self->$get_mac_ip4($dhcpreq);
+ $self->$logger("MAC: $mac");
+ if ($self->{_reverse}->{$mac}) {
+ $self->$logger("MAC: $mac IP: " . $self->{_reverse}->{$mac});
+ $ip = $self->{_reverse}->{$mac};
+ $lease = $self->{_leases}->{$ip};
+ $lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
+ } else {
+ ($ip, $lease) = $find_ip_and_lease->($req_addr);
+ }
+ }
+
+ $self->$logger("IP: $ip lease:\n" . Dumper($lease));
+ if ($ip && $lease) {
+ $self->$add_lease($ip, $lease);
+ if ($self->{_leases}->{$ip} && $self->{_leases}->{$ip}->{starts} == $lease->{starts}) {
+ $self->{lease_time} = $DEFAULT_LEASE;
+ if ($self->{_config}->{$network}->{ttl}) {
+ $self->{lease_time} = $self->{_config}->{$network}->{ttl};
+ }
+ $self->{lease_time_renew} = $DEFAULT_LEASE_RENEW;
+ if ($self->{_config}->{$network}->{rttl}) {
+ $self->{lease_time_renew} = $self->{_config}->{$network}->{rttl};
+ }
+ if ($self->{_config}->{$network}->{netmask}) {
+ $self->{subnet_mask} = $self->{_config}->{$network}->{netmask};
+ }
+ if ($self->{_config}->{$network}->{router}) {
+ $self->{routers} = $self->{_config}->{$network}->{router};
+ }
+ if ($self->{_config}->{$network}->{broadcast}) {
+ $self->{broadcast_addr} = $self->{_config}->{$network}->{broadcast};
+ }
+ if ($self->{_config}->{$network}->{'domain-name'}) {
+ $self->{domain_name} = $self->{_config}->{$network}->{'domain-name'};
+ }
+ if ($self->{_config}->{$network}->{'dns-servers'}) {
+ $self->{dns_servers} = $self->{_config}->{$network}->{'dns-servers'};
+ }
+ if ($self->{_config}->{$network}->{'ntp-servers'}) {
+ $self->{ntp_servers} = $self->{_config}->{$network}->{'ntp-servers'};
+ }
+ } else {
+ $ip = undef;
+ }
+ }
+
+ return $ip;
+};
+
+my $calculate_ip_ip4 = sub {
+ my ($self, $dhcpreq) = @_;
+ my ($req_addr, $calc_ip, $network);
+
+ return undef unless $dhcpreq->chaddr();
+ $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
+ $network = $self->$calculate_net_ip4($dhcpreq);
+ return undef unless $network;
+
+ if ($self->{_config}->{$network}->{static}) {
+ my @static = $self->{_config}->{$network}->{static};
+ foreach (@static) {
+ my @mac = split(/\s+/, $_);
+ if ($mac[0] == $self->$get_mac_ip4($dhcpreq)) {
+ $calc_ip = $mac[1];
+ last;
+ }
+ }
+ }
+ if ($req_addr) {
+ if ($calc_ip && $req_addr != $calc_ip) {
+ $calc_ip = undef;
+ } else {
+ $calc_ip = $self->$renew_lease_ip4($dhcpreq, $network, $req_addr);
+ }
+ } else {
+ $calc_ip = $self->$renew_lease_ip4($dhcpreq, $network);
+ }
+
+ return $calc_ip;
+};
+
+my $discover_ip4 = sub {
+ my ($self, $dhcpreq) = @_;
+ my ($res, $dhcpresp, $calc_ip, $req_addr);
# calculate address
- $calc_ip = "192.168.9.2";
+ # $calc_ip = "192.168.9.2";
- $self->logger("Got request\n".$dhcpreq->toString());
+ $self->$logger("Got request\n".$dhcpreq->toString());
$self->{_sock_out_ip4} = IO::Socket::IP->new(
Broadcast => 1,
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();#$self->read_lease_file();
- $res = $self->read_lease_file();
- $res = $self->write_lease_file();
- if ($res && ($req_addr =~ /^$/ || $calc_ip eq $req_addr)) {
+ if ($self->{LOG_LEVEL} <= INFO) {
+ $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
+ if ($req_addr) {
+ $self->$logger("Requested IP: $req_addr", INFO);
+ } else {
+ $self->$logger("Requested IP: None", INFO);
+ }
+ }
+ $calc_ip = $self->$calculate_ip_ip4($dhcpreq);
+ $self->$logger("Offer: $calc_ip");
+ if ($calc_ip) {
+ $self->$logger("Creating lease for $calc_ip");
+ $res = $self->$write_lease_file();
+ }
+ if ($res && $calc_ip) {
$dhcpresp = new Net::DHCP::Packet(
Comment => $dhcpreq->comment(),
Op => BOOTREPLY(),
DHO_DHCP_MESSAGE_TYPE() => DHCPOFFER(),
DHO_DHCP_SERVER_IDENTIFIER() => $self->{_sock_out_ip4}->sockhost
);
- $self->add_options($dhcpresp);
+ $self->$add_options_ip4($dhcpreq);
} else {
# bad request, we send a NAK
$dhcpresp = new Net::DHCP::Packet(
);
}
- $self->logger("Sending response to " .
+ $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->$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 $request_ip4 = sub {
my ($self, $dhcpreq) = @_;
my ($calc_ip, $dhcpresp, $peeraddr, $result);
- $calc_ip = "192.168.9.2";
+ $self->$logger("Got request\n".$dhcpreq->toString());
$peeraddr = $dhcpreq->ciaddr() ? $dhcpreq->ciaddr() : inet_ntoa(INADDR_BROADCAST);
$self->{_sock_out_ip4} = IO::Socket::IP->new(
Proto => 'udp',
) || do {
my $err = $@;
- $self->logger("[request_ip4] Socket creation error: $err", ERROR);
+ $self->$logger("[request_ip4] Socket creation error: $err", ERROR);
die "[request_ip4] Socket creation error: $err\n";
};
+ my $network = $self->$calculate_net_ip4($dhcpreq);
+ if ($network) {
+ my $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
+ $calc_ip = $self->$renew_lease_ip4($dhcpreq, $network, $req_addr);
+ }
+
# compare calculated address with requested address
- if ($calc_ip eq $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS())) {
+ if ($calc_ip) {
# address is correct, we send an ACK
$dhcpresp = new Net::DHCP::Packet(
Comment => $dhcpreq->comment(),
DHO_DHCP_MESSAGE_TYPE() => DHCPACK(),
DHO_DHCP_SERVER_IDENTIFIER() => $self->{_sock_out_ip4}->sockhost,
);
- $self->add_options($dhcpresp);
+ $self->$add_options_ip4($dhcpreq);
$result = 'ACK';
} else {
# bad request, we send a NAK
- $self->write_lease_file();
$dhcpresp = new Net::DHCP::Packet(
Comment => $dhcpreq->comment(),
Op => BOOTREPLY(),
$result = 'NAK';
}
- $self->logger("Sending response to " .
+ $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->$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 $release_ip4 = sub {
my ($self, $dhcpreq) = @_;
+ my ($ip, $mac);
- $self->logger($dhcpreq->toString());
- $self->write_lease_file();
-}
+ $self->$logger($dhcpreq->toString());
+ $ip = $dhcpreq->ciaddr();
+ $mac = $self->$get_mac_ip4($dhcpreq);
+ $self->$logger("Release request for IP: $ip MAC: $mac", INFO);
-sub excuse_me_ip6 {
+ if ($self->{_leases}->{$ip}) {
+ my $lease = $self->{_leases}->{$ip};
+ if ($lease->{'hardware ethernet'} eq $mac) {
+ $lease->{'binding state'} = 'free';
+ }
+ $self->$write_lease_file();
+ }
+};
+
+#########################################################################
+# Private methods which handle DHCP6 requests
+#########################################################################
+
+my $excuse_me_ip6 = sub {
my ($self, $addr, $dhcpreq) = @_;
- $self->logger("IPv6 request from [$addr]: $dhcpreq", INFO);
+ $self->$logger("IPv6 request from [$addr]: $dhcpreq", INFO);
$self->{_sock_out_ip6} = IO::Socket::IP->new(
Domain => PF_INET6,
V6Only => 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->$logger("$addr: Not implemented here", INFO);
$self->{_sock_out_ip6}->send("Not implemented here") || die "Error sending excuse: $!\n";
+};
+
+#########################################################################
+# 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_out_ip4} = undef;
+ $self->{_sock_in_ip6} = undef;
+ $self->{_sock_out_ip6} = undef;
+ $self->{_leases} = undef;
+ $self->{_reverse} = undef;
+ $self->{_config} = undef;
+ $self->{_transaction_ip4} = 0;
+ $self->{_transaction_ip6} = 0;
+ $self->{_dhpcp_ip4} = undef;
+
+ # public
+ $self->{log_file} ||= 'syslog';
+ $self->{lease_time} ||= $DEFAULT_LEASE;
+ $self->{lease_time_renew} ||= $DEFAULT_LEASE_RENEW;
+ $self->{subnet_mask} ||= undef;
+ $self->{routers} ||= undef;
+ $self->{broadcast_addr} ||= undef;
+ $self->{domain_name} ||= undef;
+ $self->{dns_servers} ||= undef;
+ $self->{ntp_servers} ||= undef;
+ $self->{LOG_LEVEL} = ERROR unless defined $self->{LOG_LEVEL};
+ $self->{NODAEMON} ||= 0;
+ $self->{DEBUG} ||= 0;
+ $self->{timeout} ||= 10;
+ $self->{lease_file} ||= '/tmp/dhcpd.leases';
+ $self->{conf_file} ||= '/tmp/dhcpd.cfg';
+
+ return $self;
+}
+
+sub run {
+ my ($self) = @_;
+ my ($sel, @ready, $socket, $res);
+
+ eval {
+ $self->$read_config();
+ };
+ if ($@) {
+ my $err = $@;
+ $self->$logger($err, ERROR);
+ die $err;
+ }
+ $self->$logger("Starting dhcpd", INFO);
+ if ($self->{NODAEMON} < 1) {
+ $self->$logger("Entering Daemon mode");
+ chdir '/' or die "Can't chdir to /: $!";
+ umask 0;
+
+ open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
+ open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
+ open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";
+
+ my $pid = fork;
+ exit if $pid;
+ do {
+ my $err = $!;
+ $self->$logger("Couldn't fork: $err", ERROR);
+ die "Couldn't fork: $err";
+ } unless defined($pid);
+
+ POSIX::setsid() || do {
+ my $err = $!;
+ $self->$logger("Can't start a new session: $err", ERROR);
+ die "Can't start a new session: $err";
+ };
+ $self->$logger("Now in Daemon mode", INFO);
+ }
+
+ $res = $self->$read_lease_file();
+ $self->$logger("Starting with empty leases file '$self->{lease_file}'", INFO)
+ if (! $res || ! $self->{_leases});
+
+ $self->$logger("Initialization complete", INFO);
+
+ # open listening socket
+ $self->{_sock_in_ip4} = IO::Socket::IP->new(
+ Domain => PF_INET,
+ LocalPort => 67,
+ LocalAddr => inet_ntoa(INADDR_ANY),
+ Proto => 'udp'
+ ) || do {
+ my $err = $@;
+ $self->$logger("IP4 Socket creation error: $err", ERROR);
+ die "IP4 Socket creation error: $err\n";
+ };
+ $self->{_sock_in_ip6} = IO::Socket::IP->new(
+ Domain => PF_INET6,
+ V6Only => 1,
+ LocalPort => 547,
+ LocalAddr => '::',
+ Proto => 'udp'
+ ) || do {
+ my $err = $@;
+ $self->$logger("IP6 Socket creation error: $err", ERROR);
+ die "IP6 Socket creation error: $err\n";
+ };
+
+ $sel = IO::Select->new($self->{_sock_in_ip4});
+ $sel->add($self->{_sock_in_ip6});
+
+ until ($time_to_die) {
+ my $buf = undef;
+ my $fromaddr;
+ my $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);
+ }
+
+ $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 $myaddr = $self->{_sock_in_ip6}->sockhost;
+
+ $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);
+ 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 / commitdiff