/[pxelator]/bin/dhcpd.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /bin/dhcpd.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations)
Sun Jul 26 00:38:57 2009 UTC (13 years, 4 months ago) by dpavlin
File MIME type: text/plain
File size: 2231 byte(s)
first cut at dhcp and tftp servers in perl (gPXE boot works)

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     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     my $debug = shift @ARGV;
16    
17     my $ip_server = '10.0.0.100';
18    
19     my $sock = IO::Socket::INET->new(
20     LocalPort => 67,
21     # LocalAddr => 'localhost',
22     # LocalAddr => '10.0.0.100',
23     LocalAddr => '0.0.0.0',
24     Proto => 'udp',
25     ReuseAddr => 1,
26     # PeerPort => getservbyname('bootpc', 'udp'),
27     Broadcast => 1,
28     Type => SOCK_DGRAM,
29     ) or die "Failed to bind to socket: $@";
30    
31     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     while (1) {
53    
54     print "waiting for DHCP requests on ",$sock->sockhost,":",$sock->sockport,"\n";
55    
56     my $buf;
57     $sock->recv($buf, 1024);
58     print "<< peer:",$sock->peerhost,":",$sock->peerport,"\n";
59    
60     if (defined $buf) {
61    
62     my $dhcp;
63    
64     eval { $dhcp = Net::DHCP::Packet->new($buf); };
65     die "can't use request", dump( $buf ) if $@;
66    
67     if ( $debug ) {
68     warn "recv: ", $dhcp->toString, "\n\n";
69     }
70    
71     my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2);
72     my $ip = client_ip($mac);
73    
74     my $packet = new Net::DHCP::Packet(
75     Op => BOOTREPLY(),
76     Hops => $dhcp->hops(),
77     Xid => $dhcp->xid(),
78     Flags => $dhcp->flags(),
79     Ciaddr => $dhcp->ciaddr(),
80     Yiaddr => $ip,
81     Siaddr => $ip_server,
82     Giaddr => $dhcp->giaddr(),
83     Chaddr => $dhcp->chaddr(),
84     File => 'undionly.kpxe',
85     # DHO_DHCP_MESSAGE_TYPE() => DHCPACK(),
86     DHO_SUBNET_MASK() => '255.0.0.0',
87     );
88    
89     warn ">> $mac == $ip server $ip_server\n";
90    
91     warn "## ",$packet->toString(),"\n" if $debug;
92    
93     my $reply = IO::Socket::INET->new(
94     LocalAddr => $ip_server,
95     LocalPort => 67,
96     Proto => "udp",
97     Broadcast => 1,
98     PeerAddr => '255.255.255.255',
99     PeerPort => 68,
100     Reuse => 1,
101     ) or die "socket: $@";
102    
103     my $buff = $packet->serialize();
104     $reply->send( $buff, 0 ) or die "Error sending: $!\n";
105    
106     # system("arp -s $ip $mac"),
107    
108     } else {
109     print "No bootp request.\n";
110     }
111    
112     }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26