simple DHCP server in Perl

[morgon]

Hi

for curiosity's sake am trying to implement a very simple DHCP-server in Perl but unfortunately I am having problems...

All the server is supposed to do is to assign an IP, a subnet-mask and a DNS-server to a client in a network that only consists of two machines (my laptop as server and a blueray player as client).

The only example for a dhcp-server I could find was part of the Net::DHCP::Packet distribution, so I tried to make that work (it does not as it is) and here is my code:

use strict;

use IO::Socket;
use Net::DHCP::Packet;
use Net::DHCP::Constants;

my $server_ip = "10.10.10.1";
my $client_ip = "10.10.10.10";
my $subnet_mask = "255.255.255.0";

my $socket_in = IO::Socket::INET->new(
                                        LocalPort => 67,
                                        LocalAddr => "255.255.255.255"
+,
                                        Proto    => 'udp') or die $@;

while(1) {
  my $buf;
  $socket_in->recv($buf,4096);
  my $packet = new Net::DHCP::Packet($buf);

  my $messagetype = $packet->getOptionValue(DHO_DHCP_MESSAGE_TYPE());

  if ($messagetype eq DHCPDISCOVER()) {
                  send_offer($packet);
  } elsif ($messagetype eq DHCPREQUEST()) {
                  send_ack($packet);
  }
}

sub send_offer {
  my($request)=@_;

  my $socket_out = IO::Socket::INET->new(
                                          PeerPort => 68,
                                          PeerAddr => "255.255.255.255
+",
                                          LocalAddr => "$server_ip:67"
+,
                                          Broadcast => 1,
                                          Proto    => 'udp') or die $@
+;

  my $offer = new Net::DHCP::Packet(
                                     Op => BOOTREPLY(),
                                     Xid => $request->xid(),
                                     Flags => $request->flags(),
                                     Ciaddr => $request->ciaddr(),
                                     Yiaddr => $client_ip,
                                     Siaddr => $server_ip,
                                     Giaddr => $request->giaddr(),
                                     Chaddr => $request->chaddr(),
                                     DHO_DHCP_MESSAGE_TYPE() => DHCPOF
+FER(),
                                   );

  $offer->addOptionValue(DHO_SUBNET_MASK(), $subnet_mask);
  $offer->addOptionValue(DHO_NAME_SERVERS, $server_ip);

  $socket_out->send($offer->serialize()) or die $!;
  print STDERR "sent offer\n";
}

sub send_ack {
 print STDERR "send ack\n";
}

The problem that I have here is that while I can see in wireshark the dhcp-offers going out (and they look ok) the client ignores them and just keeps sending discoveries.

I believe the reason for that is that the outgoing ethernet-frames do not use the client's ethernet-address as destination but use ff:ff:ff:ff:ff:ff.

So how can I fix that or what else may I be doing wrong?

If anybody knows of a working DHCP server implementation in Perl I would be intererested to hear about it as to my surprice I could not find any.

Many thanks!

[RonW]

In your send_offer, you provide a hardcoded IP peer address of 255.255.255.255, which, correctly, maps to an ethernet address of ff:ff:ff:ff:ff:ff.

When you receive the discovery message, you need to get the sender's ethernet address then provide that.

[Rhandom]

To make life easier, here is a Net::Server based approach:



#!/usr/bin/env perl
use strict;
use warnings;

use base qw(Net::Server::Fork);
use Net::DHCP::Packet;
use Net::DHCP::Constants;

my $server_ip = "10.10.10.1";
my $client_ip = "10.10.10.10";
my $subnet_mask = "255.255.255.0";

__PACKAGE__->run(
    proto => 'udp',
    port  => 67,
    host  => "255.255.255.255",
);

sub process_request {
    my ($self, $client) = @_;

    my $buf = $self->{'server'}->{'udp_data'};
    my $packet = Net::DHCP::Packet->new($buf);

    my $messagetype = $packet->getOptionValue(DHO_DHCP_MESSAGE_TYPE())
+;

    if ($messagetype eq DHCPDISCOVER()) {
        send_offer($client, $packet);
    } elsif ($messagetype eq DHCPREQUEST()) {
        send_ack($client, $packet);
    }
}

sub send_offer {
    my ($client, $request) = @_;

    my $offer = Net::DHCP::Packet->new(
        Op     => BOOTREPLY(),
        Xid    => $request->xid(),
        Flags  => $request->flags(),
        Ciaddr => $request->ciaddr(),
        Yiaddr => $client_ip,
        Siaddr => $server_ip,
        Giaddr => $request->giaddr(),
        Chaddr => $request->chaddr(),
        DHO_DHCP_MESSAGE_TYPE() => DHCPOFFER(),
    );

    $offer->addOptionValue(DHO_SUBNET_MASK(), $subnet_mask);
    $offer->addOptionValue(DHO_NAME_SERVERS, $server_ip);

    $client->send($offer->serialize()) or die $!;
    print STDERR "sent offer\n";
}

sub send_ack {
    my ($client, $request) = @_;
    print STDERR "send ack\n";
}