lib/PXElator/dhcpd.pm

#!/usr/bin/perl

# based on http://www.perlmonks.org/index.pl?node_id=325248

use strict;
use warnings;

use autodie;

use IO::Socket::INET;
use File::Slurp;
use Data::Dump qw/dump/;
use Net::Ping;

use lib '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 );

our $server_ip = readlink 'conf/server.ip' if -l 'conf/server.ip';

if ( ! $server_ip ) {
        $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";
}

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 $addr = $ip_from;

sub client_ip {
        my ( $mac ) = @_;

        my $conf = "conf/$server_ip";
        mkdir $conf unless -e $conf;

        if ( -e "$conf/mac/$mac" ) {
                my $ip = read_file "$conf/mac/$mac";
                print "$mac old $ip\n";
                return $ip;
        }

        mkdir $_ foreach grep { ! -e $_ } map { "$conf/$_" } ( 'ip', 'mac' );

        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 == $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";
                symlink    "$conf/mac/$mac", "$conf/ip/$ip";
                warn "$mac IP changed to $ip";
        }

        print "$mac NEW $ip\n";

        return $ip;
}

my $transaction = 0; # FIXME predictible transaction numbers

while (1) {

        require "config.pl"; # refresh config

        print "waiting for DHCP requests on ",$sock->sockhost,":",$sock->sockport,"\n";

        my $buf;
        $sock->recv($buf, 1024);
        print "<< ",$sock->peerhost,":",$sock->peerport,"\n";

        if (defined $buf) {

                my $dhcp = Net::DHCP::Packet->new($buf);
                $dhcp->comment( $transaction++ );

                warn "recv: ", $dhcp->toString, "\n\n";

                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';
                }

                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";
                } else {
                        warn "$messagetype igored (bootp?)";
                }


                warn ">> $mac == $ip server: $server_ip", $file ? " file: $file\n" : "\n";

                $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 $buff = $packet->serialize();
                $reply->send( $buff, 0 ) or die "Error sending: $!\n";

#               system("arp -s $ip $mac"),

        } else {
                print "No bootp request.\n";
        }

}
1	dpavlin	1	#!/usr/bin/perl
2
3			# based on http://www.perlmonks.org/index.pl?node_id=325248
4
5			use strict;
6			use warnings;
7
8	dpavlin	22	use autodie;
9
10	dpavlin	1	use IO::Socket::INET;
11	dpavlin	17	use File::Slurp;
12	dpavlin	1	use Data::Dump qw/dump/;
13	dpavlin	36	use Net::Ping;
14	dpavlin	1
15	dpavlin	27	use lib 'lib';
16			use Net::DHCP::Packet;
17			use Net::DHCP::Constants 0.67;
18	dpavlin	1	die "need to run $0 as root like this\nsudo $0\n" unless $< == 0;
19
20			my $debug = shift @ARGV;
21
22	dpavlin	22	our ( $file, $gpxe_file );
23	dpavlin	17	our ( $ip_from, $ip_to ) = ( 10, 100 );
24	dpavlin	1
25	dpavlin	22	our $server_ip = readlink 'conf/server.ip' if -l 'conf/server.ip';
26	dpavlin	17
27	dpavlin	22	if ( ! $server_ip ) {
28			$server_ip = `/sbin/ifconfig`;
29			$server_ip =~ s/^.+?addr:([\d\.]+).*$/$1/gs;
30			warn "auto-configure server ip to $server_ip\n";
31			} else {
32			warn "server ip $server_ip\n";
33			}
34
35	dpavlin	1	my $sock = IO::Socket::INET->new(
36			LocalPort => 67,
37			# LocalAddr => 'localhost',
38			# LocalAddr => '10.0.0.100',
39			LocalAddr => '0.0.0.0',
40			Proto => 'udp',
41			ReuseAddr => 1,
42			# PeerPort => getservbyname('bootpc', 'udp'),
43			Broadcast => 1,
44			Type => SOCK_DGRAM,
45			) or die "Failed to bind to socket: $@";
46
47
48	dpavlin	17	my $addr = $ip_from;
49
50	dpavlin	1	sub client_ip {
51			my ( $mac ) = @_;
52
53	dpavlin	17	my $conf = "conf/$server_ip";
54			mkdir $conf unless -e $conf;
55	dpavlin	1
56	dpavlin	22	if ( -e "$conf/mac/$mac" ) {
57			my $ip = read_file "$conf/mac/$mac";
58	dpavlin	17	print "$mac old $ip\n";
59			return $ip;
60			}
61	dpavlin	1
62	dpavlin	17	mkdir $_ foreach grep { ! -e $_ } map { "$conf/$_" } ( 'ip', 'mac' );
63
64	dpavlin	36	my $p = Net::Ping->new;
65
66	dpavlin	17	my $prefix = $server_ip;
67			$prefix =~ s{\.\d+$}{.};
68			my $ip = $prefix . $addr;
69	dpavlin	36	while ( -e "conf/ip/$ip" \|\| $p->ping( $ip ) ) {
70	dpavlin	17	$ip = $prefix . $addr++;
71			die "all addresses allocated!" if $addr == $ip_to;
72	dpavlin	1	}
73
74	dpavlin	17	write_file "$conf/mac/$mac", $ip;
75	dpavlin	33	if ( -l "$conf/ip/$ip" && readlink "$conf/ip/$ip" ne "$conf/mac/$mac") {
76			unlink "$conf/ip/$ip";
77			symlink "$conf/mac/$mac", "$conf/ip/$ip";
78			warn "$mac IP changed to $ip";
79			}
80	dpavlin	17
81			print "$mac NEW $ip\n";
82
83	dpavlin	1	return $ip;
84			}
85
86	dpavlin	27	my $transaction = 0; # FIXME predictible transaction numbers
87
88	dpavlin	1	while (1) {
89
90	dpavlin	12	require "config.pl"; # refresh config
91
92	dpavlin	1	print "waiting for DHCP requests on ",$sock->sockhost,":",$sock->sockport,"\n";
93
94			my $buf;
95			$sock->recv($buf, 1024);
96	dpavlin	17	print "<< ",$sock->peerhost,":",$sock->peerport,"\n";
97	dpavlin	1
98			if (defined $buf) {
99
100	dpavlin	27	my $dhcp = Net::DHCP::Packet->new($buf);
101			$dhcp->comment( $transaction++ );
102	dpavlin	1
103	dpavlin	27	warn "recv: ", $dhcp->toString, "\n\n";
104	dpavlin	1
105			my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2);
106			my $ip = client_ip($mac);
107	dpavlin	22	my $user_class = $dhcp->getOptionValue(DHO_USER_CLASS());
108	dpavlin	1
109	dpavlin	22	if ( $user_class eq 'gPXE' ) {
110			$file = $gpxe_file;
111			} elsif ( ! $file ) {
112			$file = 'undionly.kpxe';
113	dpavlin	12	}
114	dpavlin	6
115	dpavlin	27	my $packet = {
116	dpavlin	1	Op => BOOTREPLY(),
117			Hops => $dhcp->hops(),
118			Xid => $dhcp->xid(),
119			Flags => $dhcp->flags(),
120			Ciaddr => $dhcp->ciaddr(),
121			Yiaddr => $ip,
122	dpavlin	3	Siaddr => $server_ip,
123	dpavlin	1	Giaddr => $dhcp->giaddr(),
124			Chaddr => $dhcp->chaddr(),
125	dpavlin	6	File => $file,
126	dpavlin	27	};
127	dpavlin	1
128	dpavlin	27	my $messagetype = $dhcp->getOptionValue(DHO_DHCP_MESSAGE_TYPE());
129	dpavlin	22
130	dpavlin	27	if ($messagetype eq DHCPDISCOVER()) {
131			warn "DHCP DISCOVER";
132			$packet->{Comment} = $dhcp->comment();
133			$packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPOFFER();
134			} elsif ($messagetype eq DHCPREQUEST()) {
135			my $requested_ip = $dhcp->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
136			warn "DHCP REQUEST $requested_ip";
137			if ( $ip eq $requested_ip ) {
138	dpavlin	40	$packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPACK();
139			$packet->{DHO_DHCP_LEASE_TIME()} = 5 * 60; # 5 min
140			# $packet->{DHO_DHCP_SERVER_IDENTIFIER()} = $server_ip; # FIXME
141			$packet->{DHO_SUBNET_MASK()} = '255.255.255.0';
142			$packet->{DHO_ROUTERS()} = $server_ip;
143			# $packet->{DHO_DOMAIN_NAME()} = 'pxelator.lan';
144			# $packet->{DHO_NAME_SERVERS()} = $server_ip;
145			# $packet->{DHO_ROOT_PATH()} = '/exports/foobar';
146	dpavlin	27	} else {
147			$packet->{DHO_DHCP_MESSAGE_TYPE()} = DHCPNAK();
148			$packet->{DHO_DHCP_MESSAGE()} = "Bad request, expected $ip";
149			}
150			} elsif ($messagetype eq DHCPINFORM()) {
151			warn "DHCP INFORM ignored";
152			} else {
153			warn "$messagetype igored (bootp?)";
154			}
155
156
157			warn ">> $mac == $ip server: $server_ip", $file ? " file: $file\n" : "\n";
158
159			$packet = new Net::DHCP::Packet( %$packet );
160	dpavlin	1	warn "## ",$packet->toString(),"\n" if $debug;
161
162			my $reply = IO::Socket::INET->new(
163	dpavlin	3	LocalAddr => $server_ip,
164	dpavlin	1	LocalPort => 67,
165			Proto => "udp",
166			Broadcast => 1,
167			PeerAddr => '255.255.255.255',
168			PeerPort => 68,
169			Reuse => 1,
170			) or die "socket: $@";
171
172			my $buff = $packet->serialize();
173			$reply->send( $buff, 0 ) or die "Error sending: $!\n";
174
175			# system("arp -s $ip $mac"),
176
177			} else {
178			print "No bootp request.\n";
179			}
180
181			}