mdap/bin/bootpd.pl

#!/usr/bin/perl

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

use strict;
use warnings;

use IO::Socket::INET;
use Net::DHCP::Packet;
use Net::DHCP::Constants;
use Data::Dump qw/dump/;

die "need to run $0 as root like this\nsudo $0\n" unless $< == 0;

my $debug = shift @ARGV;

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 $device = 'eth1';

my $_ip = 10;
my $_mac2ip;

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

        return $ip;
}

my $ip_server = '10.0.0.100';

while (1) {

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

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

        if (defined $buf) {

                my $dhcp;

                eval { $dhcp = Net::DHCP::Packet->new($buf); };
                die "can't use request", dump( $buf ) if $@;

                if ( $debug ) {
                        warn "recv: ", $dhcp->toString, "\n\n";
                }

                my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2);
                my $ip = client_ip($mac);

                my $packet = new Net::DHCP::Packet(
                        Op              => BOOTREPLY(),
                        Hops    => $dhcp->hops(),
                        Xid             => $dhcp->xid(),
                        Flags   => $dhcp->flags(),
                        Ciaddr  => $dhcp->ciaddr(),
                        Yiaddr  => $ip,
                        Siaddr  => $ip_server,
                        Giaddr  => $dhcp->giaddr(),
                        Chaddr  => $dhcp->chaddr(),
                        File    => $dhcp->file(),
#                       DHO_DHCP_MESSAGE_TYPE() => DHCPACK(),
                DHO_SUBNET_MASK() => '255.0.0.0',
                );

                warn ">> $mac == $ip server $ip_server\n";
                
                warn "## ",$packet->toString(),"\n" if $debug;

                my $reply = IO::Socket::INET->new(
                        LocalAddr => $ip_server,
                        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	61	#!/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			use IO::Socket::INET;
9			use Net::DHCP::Packet;
10			use Net::DHCP::Constants;
11			use Data::Dump qw/dump/;
12
13			die "need to run $0 as root like this\nsudo $0\n" unless $< == 0;
14
15	dpavlin	68	my $debug = shift @ARGV;
16	dpavlin	61
17			my $sock = IO::Socket::INET->new(
18			LocalPort => 67,
19			# LocalAddr => 'localhost',
20			# LocalAddr => '10.0.0.100',
21			LocalAddr => '0.0.0.0',
22			Proto => 'udp',
23			ReuseAddr => 1,
24			# PeerPort => getservbyname('bootpc', 'udp'),
25			Broadcast => 1,
26			Type => SOCK_DGRAM,
27			) or die "Failed to bind to socket: $@";
28
29			my $device = 'eth1';
30
31	dpavlin	68	my $_ip = 10;
32			my $_mac2ip;
33
34			sub client_ip {
35			my ( $mac ) = @_;
36
37			my $ip = $_mac2ip->{$mac};
38			return $ip if $ip;
39
40			$ip = "10.0.0.$_ip";
41			$_mac2ip->{$mac} = $ip;
42
43			$_ip++;
44			if ( $_ip == 100 ) {
45			warn "IP roll-over to 10\n";
46			$_ip = 10;
47			}
48
49			return $ip;
50			}
51
52	dpavlin	61	my $ip_server = '10.0.0.100';
53
54			while (1) {
55
56			print "waiting for BOOTP requests on ",$sock->sockhost,":",$sock->sockport,"\n";
57
58			my $buf;
59			$sock->recv($buf, 1024);
60			print "<< peer:",$sock->peerhost,":",$sock->peerport,"\n";
61
62			if (defined $buf) {
63
64			my $dhcp;
65
66			eval { $dhcp = Net::DHCP::Packet->new($buf); };
67			die "can't use request", dump( $buf ) if $@;
68
69			if ( $debug ) {
70			warn "recv: ", $dhcp->toString, "\n\n";
71			}
72
73	dpavlin	68	my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2);
74			my $ip = client_ip($mac);
75
76	dpavlin	61	my $packet = new Net::DHCP::Packet(
77			Op => BOOTREPLY(),
78			Hops => $dhcp->hops(),
79			Xid => $dhcp->xid(),
80			Flags => $dhcp->flags(),
81			Ciaddr => $dhcp->ciaddr(),
82			Yiaddr => $ip,
83			Siaddr => $ip_server,
84			Giaddr => $dhcp->giaddr(),
85			Chaddr => $dhcp->chaddr(),
86			File => $dhcp->file(),
87			# DHO_DHCP_MESSAGE_TYPE() => DHCPACK(),
88			DHO_SUBNET_MASK() => '255.0.0.0',
89			);
90
91	dpavlin	68	warn ">> $mac == $ip server $ip_server\n";
92
93			warn "## ",$packet->toString(),"\n" if $debug;
94	dpavlin	61
95			my $reply = IO::Socket::INET->new(
96	dpavlin	63	LocalAddr => $ip_server,
97	dpavlin	61	LocalPort => 67,
98			Proto => "udp",
99			Broadcast => 1,
100			PeerAddr => '255.255.255.255',
101			PeerPort => 68,
102			Reuse => 1,
103			) or die "socket: $@";
104
105			my $buff = $packet->serialize();
106			$reply->send( $buff, 0 ) or die "Error sending: $!\n";
107
108	dpavlin	68	# system("arp -s $ip $mac"),
109	dpavlin	63
110	dpavlin	61	} else {
111			print "No bootp request.\n";
112			}
113
114			}