/[pxelator]/lib/PXElator/dhcpd.pm
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 /lib/PXElator/dhcpd.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 48 - (hide annotations)
Thu Jul 30 00:07:57 2009 UTC (14 years, 8 months ago) by dpavlin
File size: 4563 byte(s)
fix package name

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

  ViewVC Help
Powered by ViewVC 1.1.26