From 48b79db93c8e53a022bad9a90613398acd26a777 Mon Sep 17 00:00:00 2001 From: Michael Rasmussen Date: Mon, 21 Jul 2014 23:57:30 +0200 Subject: [PATCH] Initial checkin --- DHCPServer.pm | 721 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 721 insertions(+) create mode 100644 DHCPServer.pm diff --git a/DHCPServer.pm b/DHCPServer.pm new file mode 100644 index 0000000..7c43f82 --- /dev/null +++ b/DHCPServer.pm @@ -0,0 +1,721 @@ +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; -- 2.39.2