--- bin/dhcpd.pl 2009/07/28 16:35:49 22 +++ lib/PXElator/dhcpd.pm 2009/08/06 20:14:43 167 @@ -1,6 +1,14 @@ -#!/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; @@ -8,141 +16,224 @@ 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; - -my $debug = shift @ARGV; - -our ( $file, $gpxe_file ); -our ( $ip_from, $ip_to ) = ( 10, 100 ); +use lib '..'; +use Net::DHCP::Packet; +use Net::DHCP::Constants 0.67; -our $server_ip = readlink 'conf/server.ip' if -l 'conf/server.ip'; +use server; +my $debug = server::debug; -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 range: $server::ip_from - $server::ip_to\n"; -my $addr = $ip_from; +my $addr = $server::ip_from; sub client_ip { my ( $mac ) = @_; - my $conf = "conf/$server_ip"; + my $conf = $server::conf; mkdir $conf unless -e $conf; if ( -e "$conf/mac/$mac" ) { my $ip = read_file "$conf/mac/$mac"; - print "$mac old $ip\n"; + print "RENEW $mac $ip\n"; return $ip; } - mkdir $_ foreach grep { ! -e $_ } map { "$conf/$_" } ( 'ip', 'mac' ); + 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" ) { + + while ( -e "$conf/ip/$ip" || $p->ping( $ip ) ) { $ip = $prefix . $addr++; - die "all addresses allocated!" if $addr == $ip_to; + die "all addresses allocated!" if $addr == $server::ip_to; } write_file "$conf/mac/$mac", $ip; - unlink "$conf/ip/$ip" if -e "$conf/ip/$ip"; - symlink "$conf/mac/$mac", "$conf/ip/$ip"; + + my $ip_path = "$conf/ip/$ip"; + mkdir $ip_path unless -e $ip_path; + + if ( -l "$ip_path/mac" && readlink "$ip_path/mac" ne "$conf/mac/$mac" ) { + warn "$mac IP changed from ", readlink "$ip_path/mac", " to $ip"; + unlink "$ip_path/mac"; + }; + symlink "$conf/mac/$mac", "$ip_path/mac"; print "$mac NEW $ip\n"; return $ip; } -while (1) { +use log; +use config; +use pxelinux; +use client; - require "config.pl"; # refresh config +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 "<< ",$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); + +=for later + + my $user_class = $dhcp->getOptionValue(DHO_USER_CLASS()); + + if ( $user_class eq 'gPXE' ) { + $file = $gpxe_file; + } elsif ( ! $file ) { + $file = 'undionly.kpxe'; + } - my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2); - my $ip = client_ip($mac); - my $user_class = $dhcp->getOptionValue(DHO_USER_CLASS()); - - if ( $user_class eq 'gPXE' ) { - $file = $gpxe_file; - } elsif ( ! $file ) { - $file = 'undionly.kpxe'; +=cut + + 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, + DHO_DHCP_SERVER_IDENTIFIER() => $server::ip, # busybox/udhcpc needs it but doesn't request + }; + + my $options = { + DHO_SUBNET_MASK() => $server::netmask, + DHO_ROUTERS() => $server::ip, + DHO_DOMAIN_NAME() => $server::domain_name, + DHO_NAME_SERVERS() => $server::ip, + DHO_DOMAIN_NAME_SERVERS() => $server::ip, + DHO_HOST_NAME() => client::conf( $ip, 'hostname' ), + DHO_BROADCAST_ADDRESS() => $server::bcast, +# DHO_NTP_SERVERS() => '', + }; + + my @requested = split(/\s/, $dhcp->getOptionValue(DHO_DHCP_PARAMETER_REQUEST_LIST)); + warn "options ",dump( $options ), ' requested: ',dump( @requested ) if $debug; + + my @missing; + foreach ( @requested ) { + if ( defined $options->{$_} ) { + $packet->{$_} = $options->{$_}; + } else { + push @missing, $_; } + } - 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 => $file, -# DHO_DHCP_MESSAGE_TYPE() => DHCPACK(), - DHO_SUBNET_MASK() => '255.0.0.0', - ); - - warn ">> $mac == $ip server: $server_ip file: $file\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: $@"; + warn "W: options requested but missing: ",dump( @missing ); - my $buff = $packet->serialize(); - $reply->send( $buff, 0 ) or die "Error sending: $!\n"; + 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\n" if $debug; + $packet->{ $DH0 } = $v; + } -# system("arp -s $ip $mac"), + 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_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; + + $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;