--- bin/dhcpd.pl 2009/07/29 00:46:29 27 +++ lib/PXElator/dhcpd.pm 2009/08/19 17:01:20 267 @@ -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; @@ -11,145 +19,205 @@ use File::Slurp; use Data::Dump qw/dump/; -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; -our ( $file, $gpxe_file ); -our ( $ip_from, $ip_to ) = ( 10, 100 ); +use CouchDB; +use format; -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"; +use client; -my $addr = $ip_from; +sub client_mac_ip { + my ( $mac, $request_ip ) = @_; -sub client_ip { - my ( $mac ) = @_; + if ( ! $mac ) { + warn "W: no mac in requiest\n"; + return; + } - 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"; + 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"; } - mkdir $_ foreach grep { ! -e $_ } map { "$conf/$_" } ( 'ip', 'mac' ); + return $ip; +} - my $prefix = $server_ip; - $prefix =~ s{\.\d+$}{.}; - my $ip = $prefix . $addr; - while ( -e "conf/ip/$ip" ) { - $ip = $prefix . $addr++; - die "all addresses allocated!" if $addr == $ip_to; - } +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) ) + ); +} - write_file "$conf/mac/$mac", $ip; - unlink "$conf/ip/$ip" if -e "$conf/ip/$ip"; - symlink "$conf/mac/$mac", "$conf/ip/$ip"; +sub process_packet { + my $sock = shift; - print "$mac NEW $ip\n"; + server->refresh; - return $ip; -} + my $buf; + $sock->recv($buf, 1024); + my $size = 'empty'; + $size = length($buf) . ' bytes' if defined $buf; -my $transaction = 0; # FIXME predictible transaction numbers + print "packet from ",$sock->peerhost,":",$sock->peerport," $size\n" if $debug; + return unless $buf; -while (1) { + my $dhcp = Net::DHCP::Packet->new($buf); - require "config.pl"; # refresh config + warn "recv: ", $dhcp->toString if $debug; - print "waiting for DHCP requests on ",$sock->sockhost,":",$sock->sockport,"\n"; + $dhcp->comment( $transaction++ ); - my $buf; - $sock->recv($buf, 1024); - print "<< ",$sock->peerhost,":",$sock->peerport,"\n"; + 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} } + }, + }; - if (defined $buf) { +=for later - my $dhcp = Net::DHCP::Packet->new($buf); - $dhcp->comment( $transaction++ ); + my $user_class = $dhcp->getOptionValue(DHO_USER_CLASS()); + + if ( $user_class eq 'gPXE' ) { + $file = $gpxe_file; + } elsif ( ! $file ) { + $file = 'undionly.kpxe'; + } - warn "recv: ", $dhcp->toString, "\n\n"; +=cut - my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2); - my $ip = client_ip($mac); - my $user_class = $dhcp->getOptionValue(DHO_USER_CLASS()); + config::for_ip( $ip ); - if ( $user_class eq 'gPXE' ) { - $file = $gpxe_file; - } elsif ( ! $file ) { - $file = 'undionly.kpxe'; + 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 $messagetype = $dhcp->getOptionValue(DHO_DHCP_MESSAGE_TYPE()); - 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_MESSAGE_TYPE() => DHCPACK(), -# DHO_SUBNET_MASK() => '255.255.255.0', - }; - - 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(); - } else { - $packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPNAK(); - $packet->{DHO_DHCP_MESSAGE()} = "Bad request, expected $ip"; - } - } elsif ($messagetype eq DHCPINFORM()) { - warn "DHCP INFORM ignored"; + 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 { - warn "$messagetype igored (bootp?)"; + $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; - warn ">> $mac == $ip server: $server_ip", $file ? " file: $file\n" : "\n"; + $packet = new Net::DHCP::Packet( %$packet ); + warn "send ",$packet->toString() if $debug; - $packet = new Net::DHCP::Packet( %$packet ); - warn "## ",$packet->toString(),"\n" 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, @@ -158,13 +226,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;