1 package PVE
::DHCPServer
;
10 use Net
::DHCP
::Constants
;
15 use Fcntl
qw(:DEFAULT :flock SEEK_END);
16 use POSIX
qw(EINTR setsid strftime);
32 our @ISA = qw(Exporter);
33 our @EXPORT = qw(run);
46 our %EXPORT_TAGS = ( constants
=> [
57 our $VERSION = '0.01';
58 our $NAME = 'PVE::DHCPServer';
61 # generic signal handler to cause daemon to stop
65 $SIG{INT
} = $SIG{TERM
} = $SIG{HUP
} = \
&signal_handler
;
67 # ignore any PIPE signal: standard behaviour is to quit process
68 $SIG{PIPE
} = 'IGNORE';
71 my ($class, %self) = @_;
74 $class = ref($class) || $class;
79 $self->{_sock_in_ip4
} = undef;
80 $self->{_sock_out_ip4
} = undef;
81 $self->{_sock_in_ip6
} = undef;
82 $self->{_sock_out_ip6
} = undef;
83 $self->{_leases
} = undef;
84 $self->{_reverse
} = undef;
85 $self->{_transaction_ip4
} = 0;
86 $self->{_transaction_ip6
} = 0;
89 $self->{log_file
} ||= 'syslog';
90 $self->{lease_time
} ||= 7200;
91 $self->{subnet_mask
} ||= undef;
92 $self->{routers
} ||= undef;
93 $self->{broadcast_addr
} ||= undef;
94 $self->{domain_name
} ||= undef;
95 $self->{dns_servers
} ||= undef;
96 $self->{ntp_servers
} ||= undef;
97 $self->{LOG_LEVEL
} ||= ERROR
;
98 $self->{NODAEMON
} ||= 0;
100 $self->{timeout
} ||= 10;
101 $self->{lease_file
} ||= '/tmp/dhcpd.leases';
108 my ($sel, @ready, $socket);
110 $self->logger("Starting dhcpd", INFO
);
111 if ($self->{NODAEMON
} < 1) {
112 $self->logger("Entering Daemon mode");
113 chdir '/' or die "Can't chdir to /: $!";
116 open STDIN
, '/dev/null' or die "Can't read /dev/null: $!";
117 open STDOUT
, '>/dev/null' or die "Can't write to /dev/null: $!";
118 open STDERR
, '>/dev/null' or die "Can't write to /dev/null: $!";
124 $self->logger("Couldn't fork: $err", ERROR
);
125 die "Couldn't fork: $err";
126 } unless defined($pid);
128 POSIX
::setsid
() || do {
130 $self->logger("Can't start a new session: $err", ERROR
);
131 die "Can't start a new session: $err";
133 $self->logger("Now in Daemon mode", INFO
);
136 my $res = $self->read_lease_file();
138 $self->logger("Couldn't read leases file '$self->{lease_file}'", ERROR
);
139 die "Couldn't read leases file '$self->{lease_file}'";
142 $self->logger("Initialization complete", INFO
);
144 # open listening socket
145 $self->{_sock_in_ip4
} = IO
::Socket
::IP
->new(
148 LocalAddr
=> inet_ntoa
(INADDR_ANY
),
152 $self->logger("IP4 Socket creation error: $err", ERROR
);
153 die "IP4 Socket creation error: $err\n";
155 $self->{_sock_in_ip6
} = IO
::Socket
::IP
->new(
163 $self->logger("IP6 Socket creation error: $err", ERROR
);
164 die "IP6 Socket creation error: $err\n";
167 $sel = IO
::Select
->new($self->{_sock_in_ip4
});
168 $sel->add($self->{_sock_in_ip6
});
170 until ($time_to_die) {
175 eval { # catch fatal errors
176 while (@ready = $sel->can_read) {
177 $self->logger("Waiting for incoming packet", INFO
);
178 foreach $socket (@ready) {
179 if ($socket == $self->{_sock_in_ip4
}) {
180 # receive ipv4 packet
181 $fromaddr = $self->{_sock_in_ip4
}->recv($buf, 4096)
182 || $self->logger("recv: $!", ERROR
);
183 next if ($!); # continue loop if an error occured
184 $self->{_transaction_ip4
}++; # transaction counter
188 my ($port,$addr) = unpack_sockaddr_in
($fromaddr);
189 my $ipaddr = inet_ntoa
($addr);
190 $self->logger("Got a packet tr=$self->{_transaction_ip4} src=$ipaddr:$port length=".length($buf), INFO
);
194 my $dhcpreq = new Net
::DHCP
::Packet
($buf);
195 $dhcpreq->comment($self->{_transaction_ip4
});
197 my $messagetype = $dhcpreq->getOptionValue(DHO_DHCP_MESSAGE_TYPE
());
199 if ($messagetype eq DHCPDISCOVER
()) {
200 $self->discover_ip4($dhcpreq);
201 } elsif ($messagetype eq DHCPREQUEST
()) {
202 $self->request_ip4($dhcpreq);
203 } elsif ($messagetype eq DHCPINFORM
()) {
204 $self->logger("Not implemented: DHCPINFORM", WARNING
);
205 } elsif ($messagetype eq DHCPRELEASE
()) {
206 $self->release_ip4($dhcpreq);
208 $self->logger("Packet dropped", WARNING
);
209 # bad messagetype, we drop it
212 # Receive ipv6 packet
215 $fromaddr = $self->{_sock_in_ip6
}->recv($buf, 4096)
216 || $self->logger("recv: $!", ERROR
);
217 next if ($!); # continue loop if an error occured
218 $self->{_transaction_ip6
}++; # transaction counter
219 $self->logger("recv: $buf", INFO
);
222 my ($port,$addr) = unpack_sockaddr_in6
($fromaddr);
223 $ipaddr = inet_ntop
(AF_INET6
, $addr);
224 $self->logger("Got a packet tr=$self->{_transaction_ip6} src=$ipaddr:$port length=".length($buf), INFO
);
226 $self->excuse_me_ip6($ipaddr, $buf);
230 }; # end of 'eval' blocks
232 $self->logger("Caught error in main loop: $@", ERROR
);
235 $self->{_sock_in_ip4
}->close;
236 $self->{_sock_in_ip6
}->close;
237 $self->logger("Exiting dhcpd", INFO
);
240 sub run_with_timeout
{
241 my ($self, $code, @param) = @_;
243 die "got timeout" if $self->{timeout
} <= 0;
251 local $SIG{ALRM
} = sub { $sigcount++; }; # catch alarm outside eval
254 local $SIG{ALRM
} = sub { $sigcount++; die "got timeout"; };
255 local $SIG{PIPE
} = sub { $sigcount++; die "broken pipe" };
256 local $SIG{__DIE__
}; # see SA bug 4631
258 $prev_alarm = alarm($self->{timeout
});
260 $res = &$code(@param);
262 alarm(0); # avoid race conditions
267 alarm($prev_alarm) if defined($prev_alarm);
269 die "unknown error" if $sigcount && !$err; # seems to happen sometimes
277 my ($self, $shared) = @_;
279 my $mode = $shared ? LOCK_SH
: LOCK_EX
;
281 my $lock_func = sub {
282 if ($mode == LOCK_SH
) {
283 $self->{file_handle
} = new IO
::File
("<$self->{lease_file}") ||
284 die "can't open file for read - $!";
286 $self->{file_handle
} = new IO
::File
(">$self->{lease_file}") ||
287 die "can't open file write - $!";
289 $self->logger("trying to aquire lock on '$self->{lease_file}'...");
290 if (!flock ($self->{file_handle
}, $mode|LOCK_NB
)) {
293 $success = flock($self->{file_handle
}, $mode);
294 # try again on EINTR (see bug #273)
295 if ($success || ($! != EINTR
)) {
299 if ($mode == LOCK_SH
) {
300 seek($self->{file_handle
}, 0, SEEK_END
) or $success = 0;
303 $self->logger(" failed");
304 die "can't aquire lock - $!";
307 $self->logger(" OK");
314 $res = $self->run_with_timeout($lock_func);
317 $self->logger("can't lock file '$self->{lease_file}' - $@", ERROR
);
318 $self->{file_handle
} = undef;
328 return '' unless($self->{file_handle
});
329 my $unlock_func = sub {
330 $self->logger("trying to unlock '$self->{lease_file}'...");
331 if (!flock($self->{file_handle
}, LOCK_UN
)) {
335 $success = flock($self->{file_handle
}, LOCK_UN
);
336 # try again on EINTR (see bug #273)
337 if ($success || ($! != EINTR
)) {
342 $self->logger(" failed");
343 die "can't unlock - $!";
346 $self->logger(" OK");
353 $res = $self->run_with_timeout($unlock_func);
356 $self->logger("can't lock file '$self->{lease_file}' - $@", ERROR
);
357 $self->{file_handle
} = undef;
364 sub convert_timestamp
{
365 my ($self, $timestamp, $strtotime) = @_;
366 my ($res, $mday, $mon, $year, $hour, $min, $sec);
368 $self->logger("Timestamp: $timestamp");
370 if ($timestamp !~ /^\d{4}\/\d
{2}\
/\d{2}\s+\d{2}:\d{2}:\d{2}$/) {
371 $self->logger("$timestamp: Bad format", ERROR
);
374 ($year,$mon,$mday,$hour,$min,$sec) = split(/[\s\/:]+/, $timestamp);
375 $res = timelocal
($sec,$min,$hour,$mday,$mon-1,$year);
378 if ($timestamp !~ /^\d+$/) {
379 $self->logger("$timestamp: Bad format", ERROR
);
382 ($sec,$min,$hour,$mday,$mon,$year) = localtime($timestamp);
383 $self->logger("Timestamp: $sec,$min,$hour,$mday,$mon,$year");
384 $res = sprintf("%d/%02d/%02d %02d:%02d:%02d", ($year+1900),($mon+1),$mday,$hour,$min,$sec);
385 $self->logger("Timestamp: $res");
394 my ($self, $ip, $lease) = @_;
397 my $mac = $lease->{'hardware ethernet'};
399 $lease->{'hardware ethernet'} = $mac;
400 $ts = $self->convert_timestamp($lease->{starts
}, 1);
402 $lease->{starts
} = $ts;
403 $ts = $self->convert_timestamp($lease->{ends
}, 1);
405 $lease->{ends
} = $ts;
407 $self->{_leases
}->{$ip} = $lease;
408 $self->{_reverse
}->{$mac} = $ip;
409 $self->logger("$mac =>\n" . Dumper
($self->{_reverse
}->{$mac}));
412 #lease vvv.xxx.yyy.zzz {
413 # starts yyyy/mm/dd hh:mm:ss;
414 # ends yyyy/mm/dd hh:mm:ss;
415 # binding state active|free;
416 # hardware ethernet MAC;
417 # client-hostname "name"
419 sub read_lease_file
{
421 my ($res, $key, $lease);
425 if ($self->{file_handle
}) {
426 my $fh = $self->{file_handle
};
429 $self->logger("Read: $_");
430 if ($_ =~ /^\s*lease\s+([\d\.]+)\s+{\s*/) {
431 $self->add_lease($key, $lease) if $lease;
435 $self->logger("Key: $key");
438 next if ($_ =~ /^\s*}\s*/ || $_ =~ /^\s*$/ || $_ =~ /^\s*#.*/);
439 if ($_ =~ /^\s*(starts|ends|binding state|hardware ethernet|client-hostname)\s+(.+)\s*;/) {
441 $self->logger("Key: $1 Value: $2");
443 $key = 'UNDEF' unless $key;
444 $self->logger("$key: Bad format", ERROR
);
451 if ($lease && !$error) {
452 $self->logger("Key: $key");
453 $self->add_lease($key, $lease);
455 $self->logger("Leases data structure: \n" . Dumper
($self->{_leases
}));
459 $self->logger("Could not read leases file", ERROR
);
466 sub write_lease_file
{
470 $res = $self->lock(0);
471 if ($self->{file_handle
}) {
472 my $fh = $self->{file_handle
};
473 while ((my $lease, my $elems) = each $self->{_leases
}) {
474 $self->logger("Writing: $lease");
475 print $fh "lease $lease {\n";
476 while ((my $key, my $val) = each %$elems) {
477 if ($key =~ /^(starts|ends)$/) {
478 $val = $self->convert_timestamp($val, 0);
480 $self->logger("Writing: $key $val");
481 print $fh "\t$key $val;\n";
488 $self->logger("Could not write leases file", ERROR
);
496 my ($self, $message, $level) = @_;
498 $level = DEBUG
unless ($level);
499 return unless ($level >= $self->{LOG_LEVEL
});
501 $level = "debug" if $level eq DEBUG
;
502 $level = "info" if $level eq INFO
;
503 $level = "notice" if $level eq NOTICE
;
504 $level = "warning" if $level eq WARNING
;
505 $level = "err" if $level eq ERROR
;
506 $level = "crit" if $level eq CRITICAL
;
507 $level = "alert" if $level eq ALERT
;
508 $level = "emerg" if $level eq EMERGENCY
;
510 if ($self->{DEBUG
}) {
511 print STDOUT strftime
"[%d/%b/%Y:%H:%M:%S] ", localtime;
512 print STDOUT
"$level: $message\n";
513 } elsif ($self->{log_file
} eq 'syslog') {
514 openlog
($NAME, 'ndelay,pid', 'user');
515 syslog
($level, $message);
518 my $fh = new IO
::File
;
519 if (! $fh->open("> $self->{log_file}")) {
520 croak
"$self->{log_file}: $!";
522 print $fh strftime
"[%d/%b/%Y:%H:%M:%S] ", localtime;
523 print $fh "$level: $message\n";
529 my ($self, $dhcpresp) = @_;
531 if ($self->{lease_time
}) {
532 $dhcpresp->addOptionValue(DHO_DHCP_LEASE_TIME
, $self->{lease_time
});
534 if ($self->{subnet_mask
}) {
535 $dhcpresp->addOptionValue(DHO_SUBNET_MASK
, $self->{subnet_mask
});
537 if ($self->{routers
}) {
538 $dhcpresp->addOptionValue(DHO_ROUTERS
, $self->{routers
});
540 if ($self->{broadcast_addr
}) {
541 $dhcpresp->addOptionValue(DHO_BROADCAST_ADDRESS
, $self->{broadcast_addr
});
543 if ($self->{domain_name
}) {
544 $dhcpresp->addOptionValue(DHO_DOMAIN_NAME
, $self->{domain_name
});
546 if ($self->{ntp_servers
}) {
547 $dhcpresp->addOptionValue(DHO_NTP_SERVERS
, $self->{ntp_servers
});
549 if ($self->{dns_servers
}) {
550 $dhcpresp->addOptionValue(DHO_DOMAIN_NAME_SERVERS
, $self->{dns_servers
});
555 my ($self, $dhcpreq) = @_;
556 my ($calc_ip, $req_addr, $dhcpresp);
560 $calc_ip = "192.168.9.2";
562 $self->logger("Got request\n".$dhcpreq->toString());
564 $self->{_sock_out_ip4
} = IO
::Socket
::IP
->new(
567 PeerAddr
=> inet_ntoa
(INADDR_BROADCAST
),
571 $self->logger("[discover_ip4] Socket creation error: $err", ERROR
);
572 die "[discover_ip4] Socket creation error: $err\n";
575 $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS
());
576 $req_addr = '' unless $req_addr;
577 $self->logger("Requested IP: $req_addr", INFO
);
579 $res = $self->read_lease_file();
580 $res = $self->write_lease_file();
581 if ($res && ($req_addr =~ /^$/ || $calc_ip eq $req_addr)) {
582 $dhcpresp = new Net
::DHCP
::Packet
(
583 Comment
=> $dhcpreq->comment(),
585 Hops
=> $dhcpreq->hops(),
586 Xid
=> $dhcpreq->xid(),
587 Flags
=> $dhcpreq->flags(),
588 Ciaddr
=> $dhcpreq->ciaddr(),
590 Siaddr
=> $dhcpreq->siaddr(),
591 Giaddr
=> $dhcpreq->giaddr(),
592 Chaddr
=> $dhcpreq->chaddr(),
593 DHO_DHCP_MESSAGE_TYPE
() => DHCPOFFER
(),
594 DHO_DHCP_SERVER_IDENTIFIER
() => $self->{_sock_out_ip4
}->sockhost
596 $self->add_options($dhcpresp);
598 # bad request, we send a NAK
599 $dhcpresp = new Net
::DHCP
::Packet
(
600 Comment
=> $dhcpreq->comment(),
602 Hops
=> $dhcpreq->hops(),
603 Xid
=> $dhcpreq->xid(),
604 Flags
=> $dhcpreq->flags(),
605 Ciaddr
=> $dhcpreq->ciaddr(),
607 Siaddr
=> $dhcpreq->siaddr(),
608 Giaddr
=> $dhcpreq->giaddr(),
609 Chaddr
=> $dhcpreq->chaddr(),
610 DHO_DHCP_MESSAGE_TYPE
() => DHCPNAK
(),
611 DHO_DHCP_MESSAGE
(), "Bad request...",
615 $self->logger("Sending response to " .
616 $self->{_sock_out_ip4
}->peerhost . ':' .
617 $self->{_sock_out_ip4
}->peerport, INFO
);
619 # Socket object keeps track of whom sent last packet
620 # so we don't need to specify target address
621 $self->logger($dhcpresp->toString());
622 $self->logger("Sending OFFER tr=".$dhcpresp->comment(), INFO
);
623 $self->{_sock_out_ip4
}->send($dhcpresp->serialize()) || die "Error sending OFFER: $!\n";
627 my ($self, $dhcpreq) = @_;
628 my ($calc_ip, $dhcpresp, $peeraddr, $result);
630 $calc_ip = "192.168.9.2";
632 $peeraddr = $dhcpreq->ciaddr() ?
$dhcpreq->ciaddr() : inet_ntoa
(INADDR_BROADCAST
);
633 $self->{_sock_out_ip4
} = IO
::Socket
::IP
->new(
636 PeerAddr
=> $peeraddr,
640 $self->logger("[request_ip4] Socket creation error: $err", ERROR
);
641 die "[request_ip4] Socket creation error: $err\n";
644 # compare calculated address with requested address
645 if ($calc_ip eq $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS
())) {
646 # address is correct, we send an ACK
647 $dhcpresp = new Net
::DHCP
::Packet
(
648 Comment
=> $dhcpreq->comment(),
650 Hops
=> $dhcpreq->hops(),
651 Xid
=> $dhcpreq->xid(),
652 Flags
=> $dhcpreq->flags(),
653 Ciaddr
=> $dhcpreq->ciaddr(),
655 Siaddr
=> $dhcpreq->siaddr(),
656 Giaddr
=> $dhcpreq->giaddr(),
657 Chaddr
=> $dhcpreq->chaddr(),
658 DHO_DHCP_MESSAGE_TYPE
() => DHCPACK
(),
659 DHO_DHCP_SERVER_IDENTIFIER
() => $self->{_sock_out_ip4
}->sockhost,
661 $self->add_options($dhcpresp);
664 # bad request, we send a NAK
665 $self->write_lease_file();
666 $dhcpresp = new Net
::DHCP
::Packet
(
667 Comment
=> $dhcpreq->comment(),
669 Hops
=> $dhcpreq->hops(),
670 Xid
=> $dhcpreq->xid(),
671 Flags
=> $dhcpreq->flags(),
672 Ciaddr
=> $dhcpreq->ciaddr(),
674 Siaddr
=> $dhcpreq->siaddr(),
675 Giaddr
=> $dhcpreq->giaddr(),
676 Chaddr
=> $dhcpreq->chaddr(),
677 DHO_DHCP_MESSAGE_TYPE
() => DHCPNAK
(),
678 DHO_DHCP_MESSAGE
(), "Bad request...",
683 $self->logger("Sending response to " .
684 $self->{_sock_out_ip4
}->peerhost . ':' .
685 $self->{_sock_out_ip4
}->peerport, INFO
);
687 # Socket object keeps track of whom sent last packet
688 # so we don't need to specify target address
689 $self->logger($dhcpresp->toString());
690 $self->logger("Sending $result tr=".$dhcpresp->comment(), INFO
);
691 $self->{_sock_out_ip4
}->send($dhcpresp->serialize()) || die "Error sending ACK/NAK: $!\n";
695 my ($self, $dhcpreq) = @_;
697 $self->logger($dhcpreq->toString());
698 $self->write_lease_file();
702 my ($self, $addr, $dhcpreq) = @_;
704 $self->logger("IPv6 request from [$addr]: $dhcpreq", INFO
);
705 $self->{_sock_out_ip6
} = IO
::Socket
::IP
->new(
714 $self->logger("[excuse_me_ip6] Socket creation error: $err", ERROR
);
715 die "[excuse_me_ip6] Socket creation error: $err\n";
717 $self->logger("$addr: Not implemented here", INFO
);
718 $self->{_sock_out_ip6
}->send("Not implemented here") || die "Error sending excuse: $!\n";