Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

simple DHCP server in Perl

by morgon (Deacon)
on Jul 16, 2014 at 17:56 UTC ( #1093916=perlquestion: print w/ replies, xml ) Need Help??
morgon has asked for the wisdom of the Perl Monks concerning the following question:

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!

Comment on simple DHCP server in Perl
Download Code
Re: simple DHCP server in Perl
by RonW (Monk) on Jul 16, 2014 at 22:38 UTC

    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.

Re: simple DHCP server in Perl
by Rhandom (Curate) on Jul 17, 2014 at 14:21 UTC
    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"; }


    my @a=qw(random brilliant braindead); print $a[rand(@a)];

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1093916]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (14)
As of 2014-07-23 21:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (152 votes), past polls