1 package PVE
::DHCPServer
;
14 use Fcntl
qw(:DEFAULT :flock SEEK_END);
15 use POSIX
qw(EINTR setsid strftime);
19 use Net
::DHCP
::Packet
;
20 use Net
::DHCP
::Constants
;
34 our @ISA = qw(Exporter);
47 our $VERSION = '0.01';
48 our $NAME = 'PVE::DHCPServer';
49 our $DEFAULT_LEASE = 7200;
50 our $DEFAULT_LEASE_RENEW = 5400;
53 #########################################################################
55 #########################################################################
58 my ($self, $message, $level) = @_;
61 return unless ($level >= $self->{LOG_LEVEL
});
63 $level = "debug" if $level eq DEBUG
;
64 $level = "info" if $level eq INFO
;
65 $level = "notice" if $level eq NOTICE
;
66 $level = "warning" if $level eq WARNING
;
67 $level = "err" if $level eq ERROR
;
68 $level = "crit" if $level eq CRITICAL
;
69 $level = "alert" if $level eq ALERT
;
70 $level = "emerg" if $level eq EMERGENCY
;
73 print STDOUT strftime
"[%d/%b/%Y:%H:%M:%S] ", localtime;
74 print STDOUT
"$level: " . ($message ?
$message : 'No message') . "\n";
75 } elsif ($self->{log_file
} eq 'syslog') {
76 openlog
($NAME, 'ndelay,pid', 'user');
77 syslog
($level, $message);
80 my $fh = new IO
::File
;
81 if (! $fh->open("> $self->{log_file}")) {
82 croak
"$self->{log_file}: $!";
84 print $fh strftime
"[%d/%b/%Y:%H:%M:%S] ", localtime;
85 print $fh "$level: $message\n";
90 my $run_with_timeout = sub {
91 my ($self, $code, @param) = @_;
93 die "got timeout" if $self->{timeout
} <= 0;
101 local $SIG{ALRM
} = sub { $sigcount++; }; # catch alarm outside eval
104 local $SIG{ALRM
} = sub { $sigcount++; die "got timeout"; };
105 local $SIG{PIPE
} = sub { $sigcount++; die "broken pipe" };
106 local $SIG{__DIE__
}; # see SA bug 4631
108 $prev_alarm = alarm($self->{timeout
});
110 $res = &$code(@param);
112 alarm(0); # avoid race conditions
117 alarm($prev_alarm) if defined($prev_alarm);
119 die "unknown error" if $sigcount && !$err; # seems to happen sometimes
127 my ($self, $file, $shared) = @_;
129 my $mode = $shared ? LOCK_SH
: LOCK_EX
;
131 my $lock_func = sub {
132 if ($mode == LOCK_SH
) {
133 $self->{file_handle
} = new IO
::File
("<$file") ||
134 die "can't open file '$file' for read - $!";
136 $self->{file_handle
} = new IO
::File
(">$file") ||
137 die "can't open file '$file' for write - $!";
139 $self->$logger("trying to aquire lock on '$file'...");
140 if (!flock ($self->{file_handle
}, $mode|LOCK_NB
)) {
143 $success = flock($self->{file_handle
}, $mode);
144 # try again on EINTR (see bug #273)
145 if ($success || ($! != EINTR
)) {
149 if ($mode == LOCK_SH
) {
150 seek($self->{file_handle
}, 0, SEEK_END
) or $success = 0;
153 $self->$logger(" failed");
154 die "can't aquire lock - $!";
157 $self->$logger(" OK");
164 $res = $self->$run_with_timeout($lock_func);
167 $self->$logger("can't lock file '$file' - $@", ERROR
);
168 $self->{file_handle
} = undef;
176 my ($self, $file) = @_;
178 return '' unless($self->{file_handle
});
179 my $unlock_func = sub {
180 $self->$logger("trying to unlock '$file'...");
181 if (!flock($self->{file_handle
}, LOCK_UN
)) {
185 $success = flock($self->{file_handle
}, LOCK_UN
);
186 # try again on EINTR (see bug #273)
187 if ($success || ($! != EINTR
)) {
192 $self->$logger(" failed");
193 die "can't unlock - $!";
196 $self->$logger(" OK");
203 $res = $self->$run_with_timeout($unlock_func);
206 $self->$logger("can't lock file '$file' - $@", ERROR
);
207 $self->{file_handle
} = undef;
214 my $convert_timestamp = sub {
215 my ($self, $timestamp, $strtotime) = @_;
216 my ($res, $mday, $mon, $year, $hour, $min, $sec);
218 $self->$logger("Timestamp: $timestamp");
220 if ($timestamp !~ /^\d{4}\/\d
{2}\
/\d{2}\s+\d{2}:\d{2}:\d{2}$/) {
221 $self->$logger("$timestamp: (strtotime) Bad format", ERROR
);
224 ($year,$mon,$mday,$hour,$min,$sec) = split(/[\s\/:]+/, $timestamp);
225 $res = timelocal
($sec,$min,$hour,$mday,$mon-1,$year);
228 $self->$logger($timestamp);
229 if ($timestamp !~ /^\d+$/) {
230 $self->$logger("$timestamp: (timetostr) Bad format", ERROR
);
233 ($sec,$min,$hour,$mday,$mon,$year) = localtime($timestamp);
234 $self->$logger("Timestamp: $sec,$min,$hour,$mday,$mon,$year");
235 $res = sprintf("%d/%02d/%02d %02d:%02d:%02d", ($year+1900),($mon+1),$mday,$hour,$min,$sec);
236 $self->$logger("Timestamp: $res");
244 my $add_lease = sub {
245 my ($self, $ip, $lease) = @_;
248 my $mac = $lease->{'hardware ethernet'};
250 $lease->{'hardware ethernet'} = $mac;
251 $ts = $self->$convert_timestamp($lease->{starts
}, 1);
253 $lease->{starts
} = $ts;
254 $ts = $self->$convert_timestamp($lease->{ends
}, 1);
256 $lease->{ends
} = $ts;
258 $self->{_leases
}->{$ip} = $lease;
259 $self->$logger(Dumper
($self->{_leases
}->{$ip}));
260 $self->{_reverse
}->{$mac} = $ip;
261 $self->$logger("$mac => $self->{_reverse}->{$mac}");
264 #lease vvv.xxx.yyy.zzz {
265 # starts yyyy/mm/dd hh:mm:ss;
266 # ends yyyy/mm/dd hh:mm:ss;
267 # binding state active|free;
268 # hardware ethernet MAC;
269 # client-hostname "name"
271 my $read_lease_file = sub {
273 my ($res, $key, $lease);
276 # Start with empty leases file?
277 if (! -e
$self->{lease_file
}) {
281 $self->$lock($self->{lease_file
}, 1);
282 if ($self->{file_handle
}) {
283 my $fh = $self->{file_handle
};
286 $self->$logger("Read: $_");
287 if ($_ =~ /^\s*lease\s+([\d\.]+)\s+{\s*/) {
288 $self->$add_lease($key, $lease) if $lease;
292 $self->$logger("Key: $key");
295 next if ($_ =~ /^\s*}\s*/ || $_ =~ /^\s*$/ || $_ =~ /^\s*#.*/);
296 if ($_ =~ /^\s*(starts|ends|binding state|hardware ethernet|client-hostname)\s+(.+)\s*;/) {
298 $self->$logger("Key: $1 Value: $2");
300 $key = 'UNDEF' unless $key;
301 $self->$logger("$key: Bad format", ERROR
);
308 if ($lease && !$error) {
309 $self->$logger("Key: $key");
310 $self->$add_lease($key, $lease);
312 $self->$logger("Leases data structure: \n" . Dumper
($self->{_leases
}));
313 $self->$unlock($self->{lease_file
});
316 $self->$logger("Could not read leases file", ERROR
);
323 my $write_lease_file = sub {
327 $res = $self->$lock($self->{lease_file
}, 0);
328 if ($self->{file_handle
}) {
329 if ($self->{_leases
}) {
330 my $fh = $self->{file_handle
};
331 my %leases = %{$self->{_leases
}};
332 while ((my $lease, my $elems) = each (%leases)) {
333 $self->$logger("Writing: $lease");
334 print $fh "lease $lease {\n";
335 while ((my $key, my $val) = each %$elems) {
336 if ($key =~ /^(starts|ends)$/) {
337 $val = $self->$convert_timestamp($val, 0);
339 $self->$logger("Writing: $key $val");
340 print $fh "\t$key $val;\n";
345 $self->$unlock($self->{lease_file
});
348 $self->$logger("Could not write leases file", ERROR
);
355 #subnet 192.168.9.0 netmask 255.255.255.0 {
356 # range 192.168.9.2 192.168.9.100;
359 # router 192.168.9.254;
360 # dns-servers 192.168.2.201;
361 # ntp-servers 192.168.9.254;
362 # broadcast 192.168.9.255;
363 # domain-name "foo.bar";
365 # allow 001cc0c33317,001cc0c33318,001cc0c33319,001cc0c33320;
366 # static 001cc0c33317 192.168.9.100,001cc0c33318 192.168.9.200;
369 my $read_config = sub {
371 my ($res, $key, $netmask, $config, $subopt);
373 $self->$lock($self->{conf_file
}, 1);
374 if ($self->{file_handle
}) {
375 my $fh = $self->{file_handle
};
379 $self->$logger("Read: $_");
380 if ($_ =~ /^\s*subnet\s+([\d\.]+)\s+netmask\s+([\d\.]+)\s+{\s*/) {
381 $self->{_config
}->{$key} = $config if $config;
384 $config->{netmask
} = $2;
385 $self->$logger("Key: $key Netmask: $config->{netmask}");
387 next if (($_ =~ /^\s*}\s*/ && ! $subopt) || $_ =~ /^\s*$/ || $_ =~ /^\s*#.*/);
388 if (! $subopt && $_ =~ /^\s*(range|ttl|rttl|router|dns-servers|ntp-servers|broadcast|domain-name)\s+(.+)\s*;/) {
390 $self->$logger("Key: $1 Value: $2");
391 } elsif ($subopt &&$_ =~ /^\s*}\s*/) {
393 } elsif ($subopt || $_ =~ /^\s*{\s*/) {
395 if ($_ =~ /^\s*(allow|static)\s+(.+)\s*;/) {
396 my @vals = split(/\s*,\s*/, $2);
397 $config->{$1} = [@vals];
398 $self->$logger("Key: $1 Value: $2");
400 $key = 'UNDEF' unless $key;
401 my $err = "$key: 'suboptions' Bad format";
402 $self->$logger($err, ERROR
);
411 $key = 'UNDEF' unless $key;
412 my $err = "$key: Bad format";
413 $self->$logger($err, ERROR
);
421 $self->{_config
}->{$key} = $config;
423 $self->$logger("Config data structure: \n" . Dumper
($self->{_config
}));
424 $self->$unlock($self->{conf_file
});
425 if (!$self->{_config
}) {
426 die "Empty config file";
429 die "Could not read config file";
433 #########################################################################
434 # Private methods which handle DHCP4 requests
435 #########################################################################
437 my $get_mac_ip4 = sub {
438 my ($self, $dhcpreq) = @_;
441 $mac = $dhcpreq->chaddr();
447 my $can_client_use_net_ip4 = sub {
448 my ($self, $dhcpreq, $network) = @_;
451 # Is client allowed to request IP?
453 if ($self->{_config
}->{$network}->{allow
}) {
454 @allow = $self->{_config
}->{$network}->{allow
};
455 $self->$logger("Allow: " . Dumper
(@allow));
457 if ($_ eq $self->$get_mac_ip4($dhcpreq)) {
469 my $create_new_lease_ip4 = sub {
470 my ($self, $dhcpreq, $network, $lease) = @_;
474 $lease->{'hardware ethernet'} = $self->$get_mac_ip4($dhcpreq);
476 my $client = $dhcpreq->getOptionValue(DHO_HOST_NAME
());
477 $lease->{'client-hostname'} = $client ?
$client : $self->$get_mac_ip4($dhcpreq);
478 $lease->{'binding state'} = 'active';
480 my $end = $start + $self->{_config
}->{$network}->{ttl
};
481 $lease->{starts
} = $self->$convert_timestamp($start, 0);
482 $lease->{ends
} = $self->$convert_timestamp($end, 0);
487 my $add_options_ip4 = sub {
488 my ($self, $dhcpreq) = @_;
490 if ($self->{lease_time
}) {
491 $dhcpreq->addOptionValue(DHO_DHCP_LEASE_TIME
, $self->{lease_time
});
493 if ($self->{lease_time_renew
}) {
494 $dhcpreq->addOptionValue(DHO_DHCP_RENEWAL_TIME
, $self->{lease_time_renew
});
496 if ($self->{subnet_mask
}) {
497 $dhcpreq->addOptionValue(DHO_SUBNET_MASK
, $self->{subnet_mask
});
499 if ($self->{routers
}) {
500 $dhcpreq->addOptionValue(DHO_ROUTERS
, $self->{routers
});
502 if ($self->{broadcast_addr
}) {
503 $dhcpreq->addOptionValue(DHO_BROADCAST_ADDRESS
, $self->{broadcast_addr
});
505 if ($self->{domain_name
}) {
506 $dhcpreq->addOptionValue(DHO_DOMAIN_NAME
, $self->{domain_name
});
508 if ($self->{ntp_servers
}) {
509 $dhcpreq->addOptionValue(DHO_NTP_SERVERS
, $self->{ntp_servers
});
511 if ($self->{dns_servers
}) {
512 $dhcpreq->addOptionValue(DHO_DOMAIN_NAME_SERVERS
, $self->{dns_servers
});
516 my $calculate_net_ip4 = sub {
517 my ($self, $dhcpreq) = @_;
518 my ($req_addr, $network);
520 $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS
());
521 $self->$logger("Req IP: " . ($req_addr ?
$req_addr : 'None'));
524 my %config = %{$self->{_config
}};
525 while (my ($net, $opt) = each (%config)) {
526 $self->$logger("Network: $net/$opt->{netmask}\n" . Dumper
($opt));
527 $space = NetAddr
::IP
->new($net, $opt->{netmask
});
528 $test = NetAddr
::IP
->new($req_addr);
529 if ($space->contains($test)) {
530 $network = $net if ($self->$can_client_use_net_ip4($dhcpreq, $net));
536 my %config = %{$self->{_config
}};
537 while (my ($net, $opt) = each (%config)) {
538 $self->$logger("Network: $net/$opt->{netmask}\n" . Dumper
($opt));
539 my $can = $self->$can_client_use_net_ip4($dhcpreq, $net);
540 $self->$logger("Network usable: $can");
548 $self->$logger("Network: " . ($network ?
$network : 'None'));
553 my $renew_lease_ip4 = sub {
554 my ($self, $dhcpreq, $network, $req_addr) = @_;
555 my ($start, $end, $test, $ip, $lease);
557 my $find_ip_and_lease = sub {
560 my @range_str = split(/\s+/, $self->{_config
}->{$network}->{range
});
561 $self->$logger("Range: " . $range_str[0] . " - " . $range_str[1]);
562 $start = NetAddr
::IP
->new($range_str[0]);
563 $end = NetAddr
::IP
->new($range_str[1]);
564 $self->$logger(Dumper
($start) . Dumper
($end));
567 my $request = NetAddr
::IP
->new($reqaddr);
568 if ($start <= $request && $request <= $start) {
569 my $nip = $start->addr();
570 $self->$logger("IP: $nip");
571 if ($self->{_leases
}->{$nip}) {
572 $lease = $self->{_leases
}->{$nip};
573 if ($lease->{'binding state'} eq 'free') {
575 $lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
581 for (; $start <= $end; $start++) {
582 my $nip = $start->addr();
583 $self->$logger("IP: $nip");
584 if ($self->{_leases
}->{$nip} && ! $free) {
585 $lease = $self->{_leases
}->{$nip};
586 if ($lease->{'binding state'} eq 'free') {
588 $free->{$nip} = $lease;
591 $lease = $self->$create_new_lease_ip4($dhcpreq, $network);
596 if (! $ip && $free) {
597 ($ip, $lease) = each($free);
598 $lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
602 return ($ip, $lease);
606 if ($self->{_leases
}) {
607 $lease = $self->{_leases
}->{$req_addr};
608 return undef if ($lease && $lease->{'hardware ethernet'} ne $self->$get_mac_ip4($dhcpreq));
609 $lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
612 ($ip, $lease) = $find_ip_and_lease->($req_addr);
615 my $mac = $self->$get_mac_ip4($dhcpreq);
616 $self->$logger("MAC: $mac");
617 if ($self->{_reverse
}->{$mac}) {
618 $self->$logger("MAC: $mac IP: " . $self->{_reverse
}->{$mac});
619 $ip = $self->{_reverse
}->{$mac};
620 $lease = $self->{_leases
}->{$ip};
621 $lease = $self->$create_new_lease_ip4($dhcpreq, $network, $lease);
623 ($ip, $lease) = $find_ip_and_lease->($req_addr);
627 $self->$logger("IP: $ip lease:\n" . Dumper
($lease));
629 $self->$add_lease($ip, $lease);
630 if ($self->{_leases
}->{$ip} && $self->{_leases
}->{$ip}->{starts
} == $lease->{starts
}) {
631 $self->{lease_time
} = $DEFAULT_LEASE;
632 if ($self->{_config
}->{$network}->{ttl
}) {
633 $self->{lease_time
} = $self->{_config
}->{$network}->{ttl
};
635 $self->{lease_time_renew
} = $DEFAULT_LEASE_RENEW;
636 if ($self->{_config
}->{$network}->{rttl
}) {
637 $self->{lease_time_renew
} = $self->{_config
}->{$network}->{rttl
};
639 if ($self->{_config
}->{$network}->{netmask
}) {
640 $self->{subnet_mask
} = $self->{_config
}->{$network}->{netmask
};
642 if ($self->{_config
}->{$network}->{router
}) {
643 $self->{routers
} = $self->{_config
}->{$network}->{router
};
645 if ($self->{_config
}->{$network}->{broadcast
}) {
646 $self->{broadcast_addr
} = $self->{_config
}->{$network}->{broadcast
};
648 if ($self->{_config
}->{$network}->{'domain-name'}) {
649 $self->{domain_name
} = $self->{_config
}->{$network}->{'domain-name'};
651 if ($self->{_config
}->{$network}->{'dns-servers'}) {
652 $self->{dns_servers
} = $self->{_config
}->{$network}->{'dns-servers'};
654 if ($self->{_config
}->{$network}->{'ntp-servers'}) {
655 $self->{ntp_servers
} = $self->{_config
}->{$network}->{'ntp-servers'};
665 my $calculate_ip_ip4 = sub {
666 my ($self, $dhcpreq) = @_;
667 my ($req_addr, $calc_ip, $network);
669 return undef unless $dhcpreq->chaddr();
670 $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS
());
671 $network = $self->$calculate_net_ip4($dhcpreq);
672 return undef unless $network;
674 if ($self->{_config
}->{$network}->{static
}) {
675 my @static = $self->{_config
}->{$network}->{static
};
677 my @mac = split(/\s+/, $_);
678 if ($mac[0] == $self->$get_mac_ip4($dhcpreq)) {
685 if ($calc_ip && $req_addr != $calc_ip) {
688 $calc_ip = $self->$renew_lease_ip4($dhcpreq, $network, $req_addr);
691 $calc_ip = $self->$renew_lease_ip4($dhcpreq, $network);
697 my $discover_ip4 = sub {
698 my ($self, $dhcpreq) = @_;
699 my ($res, $dhcpresp, $calc_ip, $req_addr);
702 # $calc_ip = "192.168.9.2";
704 $self->$logger("Got request\n".$dhcpreq->toString());
706 $self->{_sock_out_ip4
} = IO
::Socket
::IP
->new(
709 PeerAddr
=> inet_ntoa
(INADDR_BROADCAST
),
713 $self->$logger("[discover_ip4] Socket creation error: $err", ERROR
);
714 die "[discover_ip4] Socket creation error: $err\n";
717 $res = $self->$read_lease_file();#$self->read_lease_file();
719 if ($self->{LOG_LEVEL
} <= INFO
) {
720 $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS
());
722 $self->$logger("Requested IP: $req_addr", INFO
);
724 $self->$logger("Requested IP: None", INFO
);
727 $calc_ip = $self->$calculate_ip_ip4($dhcpreq);
728 $self->$logger("Offer: $calc_ip");
730 $self->$logger("Creating lease for $calc_ip");
731 $res = $self->$write_lease_file();
733 if ($res && $calc_ip) {
734 $dhcpresp = new Net
::DHCP
::Packet
(
735 Comment
=> $dhcpreq->comment(),
737 Hops
=> $dhcpreq->hops(),
738 Xid
=> $dhcpreq->xid(),
739 Flags
=> $dhcpreq->flags(),
740 Ciaddr
=> $dhcpreq->ciaddr(),
742 Siaddr
=> $dhcpreq->siaddr(),
743 Giaddr
=> $dhcpreq->giaddr(),
744 Chaddr
=> $dhcpreq->chaddr(),
745 DHO_DHCP_MESSAGE_TYPE
() => DHCPOFFER
(),
746 DHO_DHCP_SERVER_IDENTIFIER
() => $self->{_sock_out_ip4
}->sockhost
748 $self->$add_options_ip4($dhcpreq);
750 # bad request, we send a NAK
751 $dhcpresp = new Net
::DHCP
::Packet
(
752 Comment
=> $dhcpreq->comment(),
754 Hops
=> $dhcpreq->hops(),
755 Xid
=> $dhcpreq->xid(),
756 Flags
=> $dhcpreq->flags(),
757 Ciaddr
=> $dhcpreq->ciaddr(),
759 Siaddr
=> $dhcpreq->siaddr(),
760 Giaddr
=> $dhcpreq->giaddr(),
761 Chaddr
=> $dhcpreq->chaddr(),
762 DHO_DHCP_MESSAGE_TYPE
() => DHCPNAK
(),
763 DHO_DHCP_MESSAGE
(), "Bad request...",
767 $self->$logger("Sending response to " .
768 $self->{_sock_out_ip4
}->peerhost . ':' .
769 $self->{_sock_out_ip4
}->peerport, INFO
);
771 # Socket object keeps track of whom sent last packet
772 # so we don't need to specify target address
773 $self->$logger($dhcpresp->toString());
774 $self->$logger("Sending OFFER tr=".$dhcpresp->comment(), INFO
);
775 $self->{_sock_out_ip4
}->send($dhcpresp->serialize()) || die "Error sending OFFER: $!\n";
778 my $request_ip4 = sub {
779 my ($self, $dhcpreq) = @_;
780 my ($calc_ip, $dhcpresp, $peeraddr, $result);
782 $self->$logger("Got request\n".$dhcpreq->toString());
784 $peeraddr = $dhcpreq->ciaddr() ?
$dhcpreq->ciaddr() : inet_ntoa
(INADDR_BROADCAST
);
785 $self->{_sock_out_ip4
} = IO
::Socket
::IP
->new(
788 PeerAddr
=> $peeraddr,
792 $self->$logger("[request_ip4] Socket creation error: $err", ERROR
);
793 die "[request_ip4] Socket creation error: $err\n";
796 my $network = $self->$calculate_net_ip4($dhcpreq);
798 my $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS
());
799 $calc_ip = $self->$renew_lease_ip4($dhcpreq, $network, $req_addr);
802 # compare calculated address with requested address
804 # address is correct, we send an ACK
805 $dhcpresp = new Net
::DHCP
::Packet
(
806 Comment
=> $dhcpreq->comment(),
808 Hops
=> $dhcpreq->hops(),
809 Xid
=> $dhcpreq->xid(),
810 Flags
=> $dhcpreq->flags(),
811 Ciaddr
=> $dhcpreq->ciaddr(),
813 Siaddr
=> $dhcpreq->siaddr(),
814 Giaddr
=> $dhcpreq->giaddr(),
815 Chaddr
=> $dhcpreq->chaddr(),
816 DHO_DHCP_MESSAGE_TYPE
() => DHCPACK
(),
817 DHO_DHCP_SERVER_IDENTIFIER
() => $self->{_sock_out_ip4
}->sockhost,
819 $self->$add_options_ip4($dhcpreq);
822 # bad request, we send a NAK
823 $dhcpresp = new Net
::DHCP
::Packet
(
824 Comment
=> $dhcpreq->comment(),
826 Hops
=> $dhcpreq->hops(),
827 Xid
=> $dhcpreq->xid(),
828 Flags
=> $dhcpreq->flags(),
829 Ciaddr
=> $dhcpreq->ciaddr(),
831 Siaddr
=> $dhcpreq->siaddr(),
832 Giaddr
=> $dhcpreq->giaddr(),
833 Chaddr
=> $dhcpreq->chaddr(),
834 DHO_DHCP_MESSAGE_TYPE
() => DHCPNAK
(),
835 DHO_DHCP_MESSAGE
(), "Bad request...",
840 $self->$logger("Sending response to " .
841 $self->{_sock_out_ip4
}->peerhost . ':' .
842 $self->{_sock_out_ip4
}->peerport, INFO
);
844 # Socket object keeps track of whom sent last packet
845 # so we don't need to specify target address
846 $self->$logger($dhcpresp->toString());
847 $self->$logger("Sending $result tr=".$dhcpresp->comment(), INFO
);
848 $self->{_sock_out_ip4
}->send($dhcpresp->serialize()) || die "Error sending ACK/NAK: $!\n";
851 my $release_ip4 = sub {
852 my ($self, $dhcpreq) = @_;
855 $self->$logger($dhcpreq->toString());
856 $ip = $dhcpreq->ciaddr();
857 $mac = $self->$get_mac_ip4($dhcpreq);
858 $self->$logger("Release request for IP: $ip MAC: $mac", INFO
);
860 if ($self->{_leases
}->{$ip}) {
861 my $lease = $self->{_leases
}->{$ip};
862 if ($lease->{'hardware ethernet'} eq $mac) {
863 $lease->{'binding state'} = 'free';
865 $self->$write_lease_file();
869 #########################################################################
870 # Private methods which handle DHCP6 requests
871 #########################################################################
873 my $excuse_me_ip6 = sub {
874 my ($self, $addr, $dhcpreq) = @_;
876 $self->$logger("IPv6 request from [$addr]: $dhcpreq", INFO
);
877 $self->{_sock_out_ip6
} = IO
::Socket
::IP
->new(
886 $self->$logger("[excuse_me_ip6] Socket creation error: $err", ERROR
);
887 die "[excuse_me_ip6] Socket creation error: $err\n";
889 $self->$logger("$addr: Not implemented here", INFO
);
890 $self->{_sock_out_ip6
}->send("Not implemented here") || die "Error sending excuse: $!\n";
893 #########################################################################
895 #########################################################################
897 # generic signal handler to cause daemon to stop
901 $SIG{INT
} = $SIG{TERM
} = $SIG{HUP
} = \
&signal_handler
;
903 # ignore any PIPE signal: standard behaviour is to quit process
904 $SIG{PIPE
} = 'IGNORE';
907 my ($class, %self) = @_;
910 $class = ref($class) || $class;
915 $self->{_sock_in_ip4
} = undef;
916 $self->{_sock_out_ip4
} = undef;
917 $self->{_sock_in_ip6
} = undef;
918 $self->{_sock_out_ip6
} = undef;
919 $self->{_leases
} = undef;
920 $self->{_reverse
} = undef;
921 $self->{_config
} = undef;
922 $self->{_transaction_ip4
} = 0;
923 $self->{_transaction_ip6
} = 0;
924 $self->{_dhpcp_ip4
} = undef;
927 $self->{log_file
} ||= 'syslog';
928 $self->{lease_time
} ||= $DEFAULT_LEASE;
929 $self->{lease_time_renew
} ||= $DEFAULT_LEASE_RENEW;
930 $self->{subnet_mask
} ||= undef;
931 $self->{routers
} ||= undef;
932 $self->{broadcast_addr
} ||= undef;
933 $self->{domain_name
} ||= undef;
934 $self->{dns_servers
} ||= undef;
935 $self->{ntp_servers
} ||= undef;
936 $self->{LOG_LEVEL
} = ERROR
unless defined $self->{LOG_LEVEL
};
937 $self->{NODAEMON
} ||= 0;
938 $self->{DEBUG
} ||= 0;
939 $self->{timeout
} ||= 10;
940 $self->{lease_file
} ||= '/tmp/dhcpd.leases';
941 $self->{conf_file
} ||= '/tmp/dhcpd.cfg';
948 my ($sel, @ready, $socket, $res);
951 $self->$read_config();
955 $self->$logger($err, ERROR
);
958 $self->$logger("Starting dhcpd", INFO
);
959 if ($self->{NODAEMON
} < 1) {
960 $self->$logger("Entering Daemon mode");
961 chdir '/' or die "Can't chdir to /: $!";
964 open STDIN
, '/dev/null' or die "Can't read /dev/null: $!";
965 open STDOUT
, '>/dev/null' or die "Can't write to /dev/null: $!";
966 open STDERR
, '>/dev/null' or die "Can't write to /dev/null: $!";
972 $self->$logger("Couldn't fork: $err", ERROR
);
973 die "Couldn't fork: $err";
974 } unless defined($pid);
976 POSIX
::setsid
() || do {
978 $self->$logger("Can't start a new session: $err", ERROR
);
979 die "Can't start a new session: $err";
981 $self->$logger("Now in Daemon mode", INFO
);
984 $res = $self->$read_lease_file();
985 $self->$logger("Starting with empty leases file '$self->{lease_file}'", INFO
)
986 if (! $res || ! $self->{_leases
});
988 $self->$logger("Initialization complete", INFO
);
990 # open listening socket
991 $self->{_sock_in_ip4
} = IO
::Socket
::IP
->new(
994 LocalAddr
=> inet_ntoa
(INADDR_ANY
),
998 $self->$logger("IP4 Socket creation error: $err", ERROR
);
999 die "IP4 Socket creation error: $err\n";
1001 $self->{_sock_in_ip6
} = IO
::Socket
::IP
->new(
1009 $self->$logger("IP6 Socket creation error: $err", ERROR
);
1010 die "IP6 Socket creation error: $err\n";
1013 $sel = IO
::Select
->new($self->{_sock_in_ip4
});
1014 $sel->add($self->{_sock_in_ip6
});
1016 until ($time_to_die) {
1021 eval { # catch fatal errors
1022 while (@ready = $sel->can_read) {
1023 $self->$logger("Waiting for incoming packet", INFO
);
1024 foreach $socket (@ready) {
1025 if ($socket == $self->{_sock_in_ip4
}) {
1026 # receive ipv4 packet
1027 $fromaddr = $self->{_sock_in_ip4
}->recv($buf, 4096)
1028 || $self->$logger("recv: $!", ERROR
);
1029 next if ($!); # continue loop if an error occured
1030 $self->{_transaction_ip4
}++; # transaction counter
1034 my ($port,$addr) = unpack_sockaddr_in
($fromaddr);
1035 my $ipaddr = inet_ntoa
($addr);
1036 $self->$logger("Got a packet tr=$self->{_transaction_ip4} src=$ipaddr:$port length=".length($buf), INFO
);
1039 $dhcpreq = new Net
::DHCP
::Packet
($buf);
1040 $dhcpreq->comment($self->{_transaction_ip4
});
1042 my $messagetype = $dhcpreq->getOptionValue(DHO_DHCP_MESSAGE_TYPE
());
1044 if ($messagetype eq DHCPDISCOVER
()) {
1045 $self->$discover_ip4($dhcpreq);
1046 } elsif ($messagetype eq DHCPREQUEST
()) {
1047 $self->$request_ip4($dhcpreq);
1048 } elsif ($messagetype eq DHCPINFORM
()) {
1049 $self->$logger("Not implemented: DHCPINFORM", WARNING
);
1050 } elsif ($messagetype eq DHCPRELEASE
()) {
1051 $self->$release_ip4($dhcpreq);
1053 $self->$logger("Packet dropped", WARNING
);
1054 # bad messagetype, we drop it
1057 # Receive ipv6 packet
1058 my $myaddr = $self->{_sock_in_ip6
}->sockhost;
1060 $fromaddr = $self->{_sock_in_ip6
}->recv($buf, 4096)
1061 || $self->$logger("recv: $!", ERROR
);
1062 next if ($!); # continue loop if an error occured
1063 $self->{_transaction_ip6
}++; # transaction counter
1064 $self->$logger("recv: $buf", INFO
);
1067 my ($port,$addr) = unpack_sockaddr_in6
($fromaddr);
1068 my $ipaddr = inet_ntop
(AF_INET6
, $addr);
1069 $self->$logger("Got a packet tr=$self->{_transaction_ip6} src=$ipaddr:$port length=".length($buf), INFO
);
1071 $self->$excuse_me_ip6($myaddr, $buf);
1075 }; # end of 'eval' blocks
1077 $self->$logger("Caught error in main loop: $@", ERROR
);
1080 $self->{_sock_in_ip4
}->close;
1081 $self->{_sock_in_ip6
}->close;
1082 $self->$logger("Exiting dhcpd", INFO
);