--- bin/dhcpd.pl 2009/07/26 14:21:48 4 +++ lib/PXElator/dhcpd.pm 2009/08/05 23:22:17 153 @@ -1,116 +1,215 @@ -#!/usr/bin/perl +package dhcpd; -# 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; +use autodie; + use IO::Socket::INET; -use Net::DHCP::Packet; -use Net::DHCP::Constants; +use File::Slurp; use Data::Dump qw/dump/; +use Net::Ping; -die "need to run $0 as root like this\nsudo $0\n" unless $< == 0; +use lib '..'; +use Net::DHCP::Packet; +use Net::DHCP::Constants 0.67; -my $debug = shift @ARGV; +use server; +my $debug = server::debug; -our ( $server_ip, $next_file ); -require "config.pl"; +if ( ! $server::ip ) { + my $server_ip = `/sbin/ifconfig`; + $server_ip =~ s/^.+?addr:([\d\.]+).*$/$1/gs; + $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: $@"; - -my $_ip = 10; -my $_mac2ip; -my $_ip_file; +warn "server ip $server::ip range: $server::ip_from - $server::ip_to\n"; + +my $addr = $server::ip_from; sub client_ip { my ( $mac ) = @_; - my $ip = $_mac2ip->{$mac}; - return $ip if $ip; + my $conf = "$server::base_dir/conf/$server::ip"; + mkdir $conf unless -e $conf; - $ip = "10.0.0.$_ip"; - $_mac2ip->{$mac} = $ip; + if ( -e "$conf/mac/$mac" ) { + my $ip = read_file "$conf/mac/$mac"; + print "RENEW $mac $ip\n"; + return $ip; + } - $_ip++; - if ( $_ip == 100 ) { - warn "IP roll-over to 10\n"; - $_ip = 10; + my $p = Net::Ping->new; + + my $prefix = $server::ip; + $prefix =~ s{\.\d+$}{.}; + my $ip = $prefix . $addr; + while ( -e "$conf/ip/$ip" || $p->ping( $ip ) ) { + $ip = $prefix . $addr++; + die "all addresses allocated!" if $addr == $server::ip_to; } + write_file "$conf/mac/$mac", $ip; + + if ( -l "$conf/ip/$ip" && readlink "$conf/ip/$ip" ne "$conf/mac/$mac" ) { + unlink "$conf/ip/$ip"; + warn "$mac IP changed from ", readlink "$conf/ip/$ip", " to $ip"; + }; + symlink "$conf/mac/$mac", "$conf/ip/$ip"; + + print "$mac NEW $ip\n"; + return $ip; } -while (1) { +use log; +use config; +use pxelinux; + +our $file; +our $transaction = 0; # FIXME predictible transaction numbers - print "waiting for DHCP requests on ",$sock->sockhost,":",$sock->sockport,"\n"; +sub process_packet { + my $sock = shift; + + server->refresh; my $buf; $sock->recv($buf, 1024); - print "<< peer:",$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" if $debug; + return unless $buf; - my $dhcp; + my $dhcp = Net::DHCP::Packet->new($buf); + $dhcp->comment( $transaction++ ); - eval { $dhcp = Net::DHCP::Packet->new($buf); }; - die "can't use request", dump( $buf ) if $@; + warn "recv: ", $dhcp->toString if $debug; - if ( $debug ) { - warn "recv: ", $dhcp->toString, "\n\n"; - } + my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2); + my $ip = client_ip($mac); - my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2); - my $ip = client_ip($mac); +=for later - my $packet = new Net::DHCP::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 => $_ip_file->{$ip} || 'undionly.kpxe', -# DHO_DHCP_MESSAGE_TYPE() => DHCPACK(), - DHO_SUBNET_MASK() => '255.0.0.0', - ); - - $_ip_file->{$ip} = $next_file; - - warn ">> $mac == $ip server $server_ip\n"; - - 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 $user_class = $dhcp->getOptionValue(DHO_USER_CLASS()); + + if ( $user_class eq 'gPXE' ) { + $file = $gpxe_file; + } elsif ( ! $file ) { + $file = 'undionly.kpxe'; + } - my $buff = $packet->serialize(); - $reply->send( $buff, 0 ) or die "Error sending: $!\n"; +=cut -# system("arp -s $ip $mac"), + config::for_ip( $ip ); + 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, + }; + + foreach my $opt ( 'magic', 'config_file', 'path_prefix', 'reboot_time' ) { + my $DH0 = eval 'DHO_PXELINUX_' . uc $opt; + warn "DH0: $@" if $@; + my $v = eval "\$pxelinux::$opt"; + warn "v: $@" if $@; + next unless defined $v; + warn "pxelinux dhcp option $opt = $DH0 = $v"; + $packet->{ $DH0 } = $v; + } + + my $messagetype = $dhcp->getOptionValue(DHO_DHCP_MESSAGE_TYPE()); + + if ($messagetype eq DHCPDISCOVER()) { + log::mac $mac, "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()); + log::mac $mac, "DHCP REQUEST $requested_ip $ip $file"; + 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()) { + log::mac $mac, "DHCP INFORM ignored"; } else { - print "No bootp request.\n"; + log::mac $mac, "$messagetype igored (bootp?)"; } + warn ">> $mac == $ip server: $server::ip", $file ? " file: $file\n" : "\n" if $debug; + +warn "## created packet ", dump( $packet ); + + $packet = new Net::DHCP::Packet( %$packet ); + warn "send ",$packet->toString() 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 $buff = $packet->serialize(); + $reply->send( $buff, 0 ) or die "Error sending: $!\n"; + +# system("arp -s $ip $mac"), + } + +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) { + process_packet $sock; + } +} + +warn "loaded"; + +1;