/[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 17 - (hide annotations)
Tue Jul 28 10:29:33 2009 UTC (12 years, 4 months ago) by dpavlin
File MIME type: text/plain
File size: 2872 byte(s)
read data from filesystem files and symlinks in conf/

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 dpavlin 17 use File::Slurp;
12 dpavlin 1 use Data::Dump qw/dump/;
13    
14     die "need to run $0 as root like this\nsudo $0\n" unless $< == 0;
15    
16     my $debug = shift @ARGV;
17    
18 dpavlin 17 our ( $file, $next_file );
19     our ( $ip_from, $ip_to ) = ( 10, 100 );
20 dpavlin 1
21 dpavlin 17 our $server_ip = readlink 'conf/server.ip';
22    
23 dpavlin 1 my $sock = IO::Socket::INET->new(
24     LocalPort => 67,
25     # LocalAddr => 'localhost',
26     # LocalAddr => '10.0.0.100',
27     LocalAddr => '0.0.0.0',
28     Proto => 'udp',
29     ReuseAddr => 1,
30     # PeerPort => getservbyname('bootpc', 'udp'),
31     Broadcast => 1,
32     Type => SOCK_DGRAM,
33     ) or die "Failed to bind to socket: $@";
34    
35    
36 dpavlin 17 my $addr = $ip_from;
37    
38 dpavlin 1 sub client_ip {
39     my ( $mac ) = @_;
40    
41 dpavlin 17 my $conf = "conf/$server_ip";
42     mkdir $conf unless -e $conf;
43 dpavlin 1
44 dpavlin 17 if ( -e "$conf/$mac" ) {
45     my $ip = read_file "conf/mac/$mac";
46     print "$mac old $ip\n";
47     return $ip;
48     }
49 dpavlin 1
50 dpavlin 17 mkdir $_ foreach grep { ! -e $_ } map { "$conf/$_" } ( 'ip', 'mac' );
51    
52     my $prefix = $server_ip;
53     $prefix =~ s{\.\d+$}{.};
54     my $ip = $prefix . $addr;
55     while ( -e "conf/ip/$ip" ) {
56     $ip = $prefix . $addr++;
57     die "all addresses allocated!" if $addr == $ip_to;
58 dpavlin 1 }
59    
60 dpavlin 17 write_file "$conf/mac/$mac", $ip;
61     symlink "$conf/mac/$mac", "conf/ip/$ip";
62    
63     print "$mac NEW $ip\n";
64    
65 dpavlin 1 return $ip;
66     }
67    
68     while (1) {
69    
70 dpavlin 12 require "config.pl"; # refresh config
71    
72 dpavlin 1 print "waiting for DHCP requests on ",$sock->sockhost,":",$sock->sockport,"\n";
73    
74     my $buf;
75     $sock->recv($buf, 1024);
76 dpavlin 17 print "<< ",$sock->peerhost,":",$sock->peerport,"\n";
77 dpavlin 1
78     if (defined $buf) {
79    
80     my $dhcp;
81    
82     eval { $dhcp = Net::DHCP::Packet->new($buf); };
83     die "can't use request", dump( $buf ) if $@;
84    
85     if ( $debug ) {
86     warn "recv: ", $dhcp->toString, "\n\n";
87     }
88    
89     my $mac = substr($dhcp->chaddr(),0,$dhcp->hlen()*2);
90     my $ip = client_ip($mac);
91    
92 dpavlin 12 if ( ! $file ) {
93     if ( $dhcp->getOptionValue(DHO_USER_CLASS()) ne 'gPXE' ) {
94     $file = 'undionly.kpxe';
95     } else {
96     $file = $next_file;
97     }
98     }
99 dpavlin 6
100 dpavlin 1 my $packet = new Net::DHCP::Packet(
101     Op => BOOTREPLY(),
102     Hops => $dhcp->hops(),
103     Xid => $dhcp->xid(),
104     Flags => $dhcp->flags(),
105     Ciaddr => $dhcp->ciaddr(),
106     Yiaddr => $ip,
107 dpavlin 3 Siaddr => $server_ip,
108 dpavlin 1 Giaddr => $dhcp->giaddr(),
109     Chaddr => $dhcp->chaddr(),
110 dpavlin 6 File => $file,
111 dpavlin 1 # DHO_DHCP_MESSAGE_TYPE() => DHCPACK(),
112     DHO_SUBNET_MASK() => '255.0.0.0',
113     );
114    
115 dpavlin 3 warn ">> $mac == $ip server $server_ip\n";
116 dpavlin 1
117     warn "## ",$packet->toString(),"\n" if $debug;
118    
119     my $reply = IO::Socket::INET->new(
120 dpavlin 3 LocalAddr => $server_ip,
121 dpavlin 1 LocalPort => 67,
122     Proto => "udp",
123     Broadcast => 1,
124     PeerAddr => '255.255.255.255',
125     PeerPort => 68,
126     Reuse => 1,
127     ) or die "socket: $@";
128    
129     my $buff = $packet->serialize();
130     $reply->send( $buff, 0 ) or die "Error sending: $!\n";
131    
132     # system("arp -s $ip $mac"),
133    
134     } else {
135     print "No bootp request.\n";
136     }
137    
138     }

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26