--- bin/dhcpd.pl 2009/07/29 14:29:55 40 +++ lib/PXElator/dhcpd.pm 2009/07/29 20:55:44 44 @@ -1,6 +1,14 @@ #!/usr/bin/perl -# based on http://www.perlmonks.org/index.pl?node_id=325248 +=head1 dhcpd + +start with: + + perl -Ilib/PXElator -Ilib -Mdhcpd -e start + +based on L + +=cut use strict; use warnings; @@ -11,46 +19,33 @@ use File::Slurp; use Data::Dump qw/dump/; use Net::Ping; +use Module::Refresh; -use lib 'lib'; +use lib '..'; use Net::DHCP::Packet; use Net::DHCP::Constants 0.67; -die "need to run $0 as root like this\nsudo $0\n" unless $< == 0; -my $debug = shift @ARGV; +use server; + +my $debug = 1; our ( $file, $gpxe_file ); our ( $ip_from, $ip_to ) = ( 10, 100 ); -our $server_ip = readlink 'conf/server.ip' if -l 'conf/server.ip'; - -if ( ! $server_ip ) { - $server_ip = `/sbin/ifconfig`; +if ( ! $server::ip ) { + my $server_ip = `/sbin/ifconfig`; $server_ip =~ s/^.+?addr:([\d\.]+).*$/$1/gs; - warn "auto-configure server ip to $server_ip\n"; -} else { - warn "server ip $server_ip\n"; + $server::ip = $server_ip; } -my $sock = IO::Socket::INET->new( - LocalPort => 67, -# LocalAddr => 'localhost', -# LocalAddr => '10.0.0.100', - LocalAddr => '0.0.0.0', - Proto => 'udp', - ReuseAddr => 1, -# PeerPort => getservbyname('bootpc', 'udp'), - Broadcast => 1, - Type => SOCK_DGRAM, -) or die "Failed to bind to socket: $@"; - +warn "server ip $server::ip\n"; my $addr = $ip_from; sub client_ip { my ( $mac ) = @_; - my $conf = "conf/$server_ip"; + my $conf = "conf/$server::ip"; mkdir $conf unless -e $conf; if ( -e "$conf/mac/$mac" ) { @@ -63,7 +58,7 @@ my $p = Net::Ping->new; - my $prefix = $server_ip; + my $prefix = $server::ip; $prefix =~ s{\.\d+$}{.}; my $ip = $prefix . $addr; while ( -e "conf/ip/$ip" || $p->ping( $ip ) ) { @@ -83,99 +78,122 @@ return $ip; } -my $transaction = 0; # FIXME predictible transaction numbers - -while (1) { - - require "config.pl"; # refresh config +our $transaction = 0; # FIXME predictible transaction numbers - print "waiting for DHCP requests on ",$sock->sockhost,":",$sock->sockport,"\n"; +sub process_packet { + my $sock = shift; my $buf; $sock->recv($buf, 1024); - print "<< ",$sock->peerhost,":",$sock->peerport,"\n"; + my $size = 'empty'; + $size = length($buf) . ' bytes' if defined $buf; - if (defined $buf) { + print "packet from ",$sock->peerhost,":",$sock->peerport," $size\n"; + return unless $buf; - my $dhcp = Net::DHCP::Packet->new($buf); - $dhcp->comment( $transaction++ ); + my $dhcp = Net::DHCP::Packet->new($buf); + $dhcp->comment( $transaction++ ); - warn "recv: ", $dhcp->toString, "\n\n"; + warn "recv: ", $dhcp->toString; - my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2); - my $ip = client_ip($mac); - my $user_class = $dhcp->getOptionValue(DHO_USER_CLASS()); + my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2); + my $ip = client_ip($mac); - if ( $user_class eq 'gPXE' ) { - $file = $gpxe_file; - } elsif ( ! $file ) { - $file = 'undionly.kpxe'; - } +=for later + + my $user_class = $dhcp->getOptionValue(DHO_USER_CLASS()); - my $packet = { - Op => BOOTREPLY(), - Hops => $dhcp->hops(), - Xid => $dhcp->xid(), - Flags => $dhcp->flags(), - Ciaddr => $dhcp->ciaddr(), - Yiaddr => $ip, - Siaddr => $server_ip, - Giaddr => $dhcp->giaddr(), - Chaddr => $dhcp->chaddr(), - File => $file, - }; - - my $messagetype = $dhcp->getOptionValue(DHO_DHCP_MESSAGE_TYPE()); - - if ($messagetype eq DHCPDISCOVER()) { - warn "DHCP DISCOVER"; - $packet->{Comment} = $dhcp->comment(); - $packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPOFFER(); - } elsif ($messagetype eq DHCPREQUEST()) { - my $requested_ip = $dhcp->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS()); - warn "DHCP REQUEST $requested_ip"; - if ( $ip eq $requested_ip ) { - $packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPACK(); - $packet->{DHO_DHCP_LEASE_TIME()} = 5 * 60; # 5 min -# $packet->{DHO_DHCP_SERVER_IDENTIFIER()} = $server_ip; # FIXME - $packet->{DHO_SUBNET_MASK()} = '255.255.255.0'; - $packet->{DHO_ROUTERS()} = $server_ip; -# $packet->{DHO_DOMAIN_NAME()} = 'pxelator.lan'; -# $packet->{DHO_NAME_SERVERS()} = $server_ip; -# $packet->{DHO_ROOT_PATH()} = '/exports/foobar'; - } else { - $packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPNAK(); - $packet->{DHO_DHCP_MESSAGE()} = "Bad request, expected $ip"; - } - } elsif ($messagetype eq DHCPINFORM()) { - warn "DHCP INFORM ignored"; + if ( $user_class eq 'gPXE' ) { + $file = $gpxe_file; + } elsif ( ! $file ) { + $file = 'undionly.kpxe'; + } + +=cut + + my $packet = { + Op => BOOTREPLY(), + Hops => $dhcp->hops(), + Xid => $dhcp->xid(), + Flags => $dhcp->flags(), + Ciaddr => $dhcp->ciaddr(), + Yiaddr => $ip, + Siaddr => $server::ip, + Giaddr => $dhcp->giaddr(), + Chaddr => $dhcp->chaddr(), + File => $file, + }; + + my $messagetype = $dhcp->getOptionValue(DHO_DHCP_MESSAGE_TYPE()); + + if ($messagetype eq DHCPDISCOVER()) { + warn "DHCP DISCOVER"; + $packet->{Comment} = $dhcp->comment(); + $packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPOFFER(); + } elsif ($messagetype eq DHCPREQUEST()) { + my $requested_ip = $dhcp->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS()); + warn "DHCP REQUEST $requested_ip"; + if ( $ip eq $requested_ip ) { + $packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPACK(); + $packet->{DHO_DHCP_LEASE_TIME()} = 5 * 60; # 5 min +# $packet->{DHO_DHCP_SERVER_IDENTIFIER()} = $server::ip; # FIXME + $packet->{DHO_SUBNET_MASK()} = '255.255.255.0'; + $packet->{DHO_ROUTERS()} = $server::ip; +# $packet->{DHO_DOMAIN_NAME()} = 'pxelator.lan'; +# $packet->{DHO_NAME_SERVERS()} = $server::ip; +# $packet->{DHO_ROOT_PATH()} = '/exports/foobar'; } else { - warn "$messagetype igored (bootp?)"; + $packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPNAK(); + $packet->{DHO_DHCP_MESSAGE()} = "Bad request, expected $ip"; } + } elsif ($messagetype eq DHCPINFORM()) { + warn "DHCP INFORM ignored"; + } else { + warn "$messagetype igored (bootp?)"; + } + warn ">> $mac == $ip server: $server::ip", $file ? " file: $file\n" : "\n"; - warn ">> $mac == $ip server: $server_ip", $file ? " file: $file\n" : "\n"; + $packet = new Net::DHCP::Packet( %$packet ); + warn "## ",$packet->toString(),"\n" if $debug; - $packet = new Net::DHCP::Packet( %$packet ); - warn "## ",$packet->toString(),"\n" if $debug; + my $reply = IO::Socket::INET->new( + LocalAddr => $server::ip, + LocalPort => 67, + Proto => "udp", + Broadcast => 1, + PeerAddr => '255.255.255.255', + PeerPort => 68, + Reuse => 1, + ) or die "socket: $@"; - my $reply = IO::Socket::INET->new( - LocalAddr => $server_ip, - LocalPort => 67, - Proto => "udp", - Broadcast => 1, - PeerAddr => '255.255.255.255', - PeerPort => 68, - Reuse => 1, - ) or die "socket: $@"; + my $buff = $packet->serialize(); + $reply->send( $buff, 0 ) or die "Error sending: $!\n"; - my $buff = $packet->serialize(); - $reply->send( $buff, 0 ) or die "Error sending: $!\n"; +# system("arp -s $ip $mac"), -# system("arp -s $ip $mac"), +} - } else { - print "No bootp request.\n"; - } +sub start { + my $sock = IO::Socket::INET->new( + LocalPort => 67, +# LocalAddr => 'localhost', +# LocalAddr => '10.0.0.100', + LocalAddr => '0.0.0.0', + Proto => 'udp', + ReuseAddr => 1, +# PeerPort => getservbyname('bootpc', 'udp'), + Broadcast => 1, + Type => SOCK_DGRAM, + ) or die "Failed to bind to socket: $@"; + + print "DHCP listen on ",$sock->sockhost,":",$sock->sockport,"\n"; + + while (1) { + Module::Refresh->refresh; + process_packet $sock; + } } + +1;