--- bin/dhcpd.pl 2009/07/26 14:21:48 4 +++ lib/PXElator/dhcpd.pm 2009/08/19 10:56:04 260 @@ -1,101 +1,218 @@ -#!/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/; -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; + +use CouchDB; +use format; + +use server; +my $debug = server::debug; + +if ( ! $server::ip ) { + my $server_ip = `/sbin/ifconfig`; + $server_ip =~ s/^.+?addr:([\d\.]+).*$/$1/gs; + $server::ip = $server_ip; +} + +warn "server ip $server::ip range: $server::ip_from - $server::ip_to\n"; + +use client; -my $debug = shift @ARGV; +sub client_mac_ip { + my ( $mac, $request_ip ) = @_; -our ( $server_ip, $next_file ); -require "config.pl"; + my $conf = $server::conf; + mkdir $conf unless -e $conf; -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; - -sub client_ip { - my ( $mac ) = @_; - - my $ip = $_mac2ip->{$mac}; - return $ip if $ip; - - $ip = "10.0.0.$_ip"; - $_mac2ip->{$mac} = $ip; - - $_ip++; - if ( $_ip == 100 ) { - warn "IP roll-over to 10\n"; - $_ip = 10; + my $ip; + + if ( $ip = client::ip_from_mac( $mac ) ) { + print "RENEW $mac $ip\n"; + return $ip; + } elsif ( in_our_range( $request_ip ) ) { + $ip = client::next_ip( $mac ); + print "NEW $mac $ip\n"; + } else { + $ip = $request_ip; + client::save_ip_mac( $ip, $mac ); + warn "W: $ip our of server range $server::ip $server::netmask\n"; } return $ip; } -while (1) { +use log; +use config; +use pxelinux; +use client; + +our $file; +our $transaction = 0; # FIXME predictible transaction numbers + +sub ip2bin { pack('C*', split(/\./, $_[0])) }; +sub in_our_range { + my $ip = shift; + return 1 if $ip eq '0.0.0.0'; + return 1 if ( + ( ip2bin($ip) & ip2bin($server::netmask) ) + eq + ( ip2bin($server::ip) & ip2bin($server::netmask) ) + ); +} + +sub process_packet { + my $sock = shift; - print "waiting for DHCP requests on ",$sock->sockhost,":",$sock->sockport,"\n"; + 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; + + print "packet from ",$sock->peerhost,":",$sock->peerport," $size\n" if $debug; + return unless $buf; + + my $dhcp = Net::DHCP::Packet->new($buf); + + warn "recv: ", $dhcp->toString if $debug; - if (defined $buf) { + $dhcp->comment( $transaction++ ); - my $dhcp; + my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2); + my $ip = client_mac_ip($mac, $dhcp->ciaddr); + + my $hostname = $dhcp->getOptionValue(DHO_HOST_NAME); + print "$ip ", client::conf( $ip => 'hostname', default => $hostname ), " >> /etc/hosts\n"; + + my $audit = { mac => format::mac($mac), ip => $ip, hostname => $hostname, + options => { + map { + ( $_ => $dhcp->getOptionValue( $_ ) ) + } @{ $dhcp->{options_order} } + }, + }; + +=for later + + my $user_class = $dhcp->getOptionValue(DHO_USER_CLASS()); + + if ( $user_class eq 'gPXE' ) { + $file = $gpxe_file; + } elsif ( ! $file ) { + $file = 'undionly.kpxe'; + } - eval { $dhcp = Net::DHCP::Packet->new($buf); }; - die "can't use request", dump( $buf ) if $@; +=cut - if ( $debug ) { - warn "recv: ", $dhcp->toString, "\n\n"; + 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, $_; } + } + + warn "W: options requested but missing: ",dump( @missing ),$/; + $audit->{requested} = [ @requested ]; + $audit->{missing} = [ @missing ]; + + 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; + } - my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2); - my $ip = client_ip($mac); + my $messagetype = $dhcp->getOptionValue(DHO_DHCP_MESSAGE_TYPE()); - 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; + if ($messagetype eq DHCPDISCOVER()) { + $audit->{type} = 'discover'; + $packet->{Comment} = $dhcp->comment(); + $packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPOFFER(); + } elsif ($messagetype eq DHCPREQUEST()) { + my $requested_ip = $dhcp->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS()); + $audit->{type} = 'request'; + 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()) { + $audit->{type} = 'inform'; + } else { + $audit->{type} = sprintf('ignored %x', $messagetype); + } + + warn ">> $mac == $ip server: $server::ip", $file ? " file: $file\n" : "\n" if $debug; + $audit->{response} = $packet; + + $packet = new Net::DHCP::Packet( %$packet ); + warn "send ",$packet->toString() if $debug; + + if ( in_our_range( $ip ) ) { + my $buff = $packet->serialize(); my $reply = IO::Socket::INET->new( - LocalAddr => $server_ip, + LocalAddr => $server::ip, LocalPort => 67, Proto => "udp", Broadcast => 1, @@ -104,13 +221,40 @@ Reuse => 1, ) or die "socket: $@"; - my $buff = $packet->serialize(); $reply->send( $buff, 0 ) or die "Error sending: $!\n"; - -# system("arp -s $ip $mac"), - } else { - print "No bootp request.\n"; + $audit->{error} = "$ip our of our range $server::ip $server::netmask"; } + CouchDB::audit( $audit->{type}, $audit ); + +# 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"; + + CouchDB::audit( 'start', { addr => $sock->sockhost, port => $sock->sockport } ); + + while (1) { + process_packet $sock; + } } + +warn "loaded"; + +1;