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;
$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;
}
if ($self->{file_handle}) {
if ($self->{_leases}) {
my $fh = $self->{file_handle};
- my %leases = %{$self->{_leases}};
- while ((my $lease, my $elems) = each (%leases)) {
+ 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) {
$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;
}
#########################################################################
my $get_mac_ip4 = sub {
- my ($self, $dhcpreq) = @_;
+ my ($self, $req) = @_;
my $mac;
- $mac = $dhcpreq->chaddr();
+ $mac = $req->chaddr();
$mac =~ s/0+$//;
return $mac;
};
my $can_client_use_net_ip4 = sub {
- my ($self, $dhcpreq, $network) = @_;
- my (@allow, $found);
+ my ($self, $req, $network) = @_;
+ my ($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)) {
+ $self->$logger("Allow: " . Dumper($self->{_config}->{$network}->{allow}));
+ foreach (@{$self->{_config}->{$network}->{allow}}) {
+ if ($_ eq $self->$get_mac_ip4($req)) {
$found = 1;
last;
}
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) = @_;
+ my ($self, $resp) = @_;
if ($self->{lease_time}) {
- $dhcpreq->addOptionValue(DHO_DHCP_LEASE_TIME, $self->{lease_time});
+ $resp->addOptionValue(DHO_DHCP_LEASE_TIME, $self->{lease_time});
}
if ($self->{lease_time_renew}) {
- $dhcpreq->addOptionValue(DHO_DHCP_RENEWAL_TIME, $self->{lease_time_renew});
+ $resp->addOptionValue(DHO_DHCP_RENEWAL_TIME, $self->{lease_time_renew});
}
if ($self->{subnet_mask}) {
- $dhcpreq->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
+ $resp->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
}
if ($self->{routers}) {
- $dhcpreq->addOptionValue(DHO_ROUTERS, $self->{routers});
+ $resp->addOptionValue(DHO_ROUTERS, $self->{routers});
}
if ($self->{broadcast_addr}) {
- $dhcpreq->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
+ $resp->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
}
if ($self->{domain_name}) {
- $dhcpreq->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
+ $resp->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
}
if ($self->{ntp_servers}) {
- $dhcpreq->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
+ $resp->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
}
if ($self->{dns_servers}) {
- $dhcpreq->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
+ $resp->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
}
};
-my $calculate_net_ip4 = sub {
- my ($self, $dhcpreq) = @_;
- 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;
- }
- }
+my $send_nak = sub {
+ my ($self, $req, $message) = @_;
+
+ $message = 'Bad request' unless $message;
+ my $peeraddr = ($req->ciaddr() && $req->ciaddr() ne inet_ntoa(INADDR_ANY)) ?
+ $req->ciaddr() : inet_ntoa(INADDR_BROADCAST);
+
+ my $sock = IO::Socket::IP->new(
+ Broadcast => 1,
+ PeerPort => 68,
+ PeerAddr => $peeraddr,
+ Proto => 'udp'
+ ) || do {
+ my $err = $@;
+ $self->$logger("[discover_ip4] Socket creation error: $err", ERROR);
+ die "[discover_ip4] Socket creation error: $err\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;
+};
+
+my $send_accept = sub {
+ my ($self, $req, $calc_ip, $reply) = @_;
+ my $msg;
+
+ my $peeraddr = ($req->ciaddr() && $req->ciaddr() ne inet_ntoa(INADDR_ANY)) ?
+ $req->ciaddr() : inet_ntoa(INADDR_BROADCAST);
+
+ if ($reply == DHCP_OFFER) {
+ $reply = DHCPOFFER();
+ $msg = 'DHCP_OFFER';
+ } elsif ($reply == DHCP_ACK) {
+ $reply = DHCPACK();
+ $msg = 'DHCP_ACK';
} 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;
- }
- }
+ my $err = "$reply: Unknown reply";
+ $self->$logger($err, ERROR);
+ die $err;
}
- $self->$logger("Network: " . ($network ? $network : 'None'));
+ my $sock = IO::Socket::IP->new(
+ Broadcast => 1,
+ PeerPort => 68,
+ PeerAddr => $peeraddr,
+ Proto => 'udp'
+ ) || do {
+ my $err = $@;
+ $self->$logger("[discover_ip4] Socket creation error: $err", ERROR);
+ die "[discover_ip4] Socket creation error: $err\n";
+ };
- return $network;
+ 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 $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 $update_transaction = sub {
+ my ($self, $req, $tx) = @_;
+ my ($res, $xid, $offer);
- 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));
+ $xid = $req->xid();
+ return -1 unless $xid;
- 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;
- }
+ 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 {
- $lease = $self->$create_new_lease_ip4($dhcpreq, $network);
- $ip = $nip;
- last;
+ $self->$logger("Offer '$offer' accepted by client xid=$xid", INFO);
+ $res = 0;
}
+ } else {
+ # Caught request for other DHCP server
}
- if (! $ip && $free) {
- ($ip, $lease) = each($free);
- $lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
+ } 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 ($ip, $lease);
- };
+ return $res;
+};
- 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);
- }
+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'};
+ }
+};
- $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'};
+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;
}
- if ($self->{_config}->{$network}->{'ntp-servers'}) {
- $self->{ntp_servers} = $self->{_config}->{$network}->{'ntp-servers'};
+ }
+ } 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;
}
- } else {
- $ip = undef;
+ last if $ip;
+ }
+ if (! $ip && $free) {
+ $ip = $free;
}
}
+ $self->$logger("[find_ip_ip4] IP: " . ($ip ? $ip : 'None'), INFO);
+
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;
+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;
}
}
- if ($req_addr) {
- if ($calc_ip && $req_addr != $calc_ip) {
- $calc_ip = 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 {
- $calc_ip = $self->$renew_lease_ip4($dhcpreq, $network, $req_addr);
+ ($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 {
- $calc_ip = $self->$renew_lease_ip4($dhcpreq, $network);
}
- return $calc_ip;
+ return ($network, $ip);
};
my $discover_ip4 = sub {
- my ($self, $dhcpreq) = @_;
- my ($res, $dhcpresp, $calc_ip, $req_addr);
+ my ($self, $req) = @_;
+ my ($tx, $res, $resp, $network, $calc_ip, $req_addr);
- # calculate address
- # $calc_ip = "192.168.9.2";
+ $self->$logger("Got ip4 discover request: \n" . $req->toString(), INFO);
- $self->$logger("Got request\n".$dhcpreq->toString());
+ $res = $self->$update_transaction($req);
+ if ($res) {
+ my $err = "Missing transaction ID";
+ $self->$send_nak($req, $err);
+ $self->$logger($err, ERROR);
+ die $err;
+ }
- $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 = $req->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
+ $res = $self->$read_lease_file();
+ $self->$logger("Starting with empty lease file", INFO) unless $res;
- $res = $self->$read_lease_file();#$self->read_lease_file();
if ($self->{LOG_LEVEL} <= INFO) {
- $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
if ($req_addr) {
- $self->$logger("Requested IP: $req_addr", INFO);
+ $self->$logger("[D] Requested IP: $req_addr", INFO);
} else {
- $self->$logger("Requested IP: None", INFO);
+ $self->$logger("[D] 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(),
- 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_ip4($dhcpreq);
+
+ $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
- $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...",
- );
+ my $err = "$req_addr: Not available";
+ $self->$logger($err, INFO);
+ $self->$send_nak($req, $err);
}
- $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";
+ $self->$logger("Transaction:\n".Dumper($self->{_transaction}), INFO);
};
my $request_ip4 = sub {
- my ($self, $dhcpreq) = @_;
- my ($calc_ip, $dhcpresp, $peeraddr, $result);
-
- $self->$logger("Got request\n".$dhcpreq->toString());
-
- $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";
- };
+ my ($self, $req) = @_;
+ my ($calc_ip, $network, $res);
+
+ $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 $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);
+ 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);
+ }
}
- # compare calculated address with requested address
- if ($calc_ip) {
- # 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_ip4($dhcpreq);
- $result = 'ACK';
+ ($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
- $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->$send_nak($req);
}
- $self->$logger("Sending response to " .
- $self->{_sock_out_ip4}->peerhost . ':' .
- $self->{_sock_out_ip4}->peerport, INFO);
+ # This transaction is finished with either NAK or ACK
+ my $xid = $req->xid();
+ delete($self->{_transaction}->{$xid});
- # 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";
+ $self->$logger("Transaction:\n".Dumper($self->{_transaction}), INFO);
};
my $release_ip4 = sub {
}
$self->$write_lease_file();
}
+ $self->$logger("Transaction:\n".Dumper($self->{_transaction}), INFO);
};
#########################################################################
#########################################################################
my $excuse_me_ip6 = sub {
- my ($self, $addr, $dhcpreq) = @_;
+ my ($self, $addr, $req) = @_;
- $self->$logger("IPv6 request from [$addr]: $dhcpreq", INFO);
+ $self->$logger("IPv6 request from [$addr]: $req", INFO);
$self->{_sock_out_ip6} = IO::Socket::IP->new(
Domain => PF_INET6,
V6Only => 1,
# 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;
+ $self->{_transaction} = ();
# public
$self->{log_file} ||= 'syslog';
until ($time_to_die) {
my $buf = undef;
my $fromaddr;
- my $dhcpreq;
+ my $req;
eval { # catch fatal errors
while (@ready = $sel->can_read) {
$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
+
+ $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=$self->{_transaction_ip4} src=$ipaddr:$port length=".length($buf), INFO);
+ $self->$logger("Got a packet tr=$xid 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());
+ my $messagetype = $req->getOptionValue(DHO_DHCP_MESSAGE_TYPE());
if ($messagetype eq DHCPDISCOVER()) {
- $self->$discover_ip4($dhcpreq);
+ $self->$discover_ip4($req);
} elsif ($messagetype eq DHCPREQUEST()) {
- $self->$request_ip4($dhcpreq);
+ $self->$request_ip4($req);
} elsif ($messagetype eq DHCPINFORM()) {
$self->$logger("Not implemented: DHCPINFORM", WARNING);
} elsif ($messagetype eq DHCPRELEASE()) {
- $self->$release_ip4($dhcpreq);
+ $self->$release_ip4($req);
} else {
- $self->$logger("Packet dropped", WARNING);
+ $self->$logger("$messagetype: Packet dropped since unknown message type", WARNING);
# bad messagetype, we drop it
}
} else {
$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;
projects / pve-dhcp-server.git / commitdiff