DHCPServer.pm

   1 package PVE::DHCPServer;
   2
   3 use strict;
   4 use warnings;
   5 use Carp qw(croak);
   6 use Sys::Hostname;
   7 use Socket;
   8 use Socket6;
   9 use Net::DHCP::Packet;
  10 use Net::DHCP::Constants;
  11 use IO::Socket::IP;
  12 use IO::File;
  13 use IO::Select;
  14 use Sys::Syslog;
  15 use Fcntl qw(:DEFAULT :flock SEEK_END);
  16 use POSIX qw(EINTR setsid strftime);
  17 use Data::Dumper;
  18 use Time::Local;
  19
  20 use constant {
  21         DEBUG => 0,
  22         INFO => 1,
  23         NOTICE => 2,
  24         WARNING => 3,
  25         ERROR => 4,
  26         CRITICAL => 5,
  27         ALERT => 6,
  28         EMERGENCY => 7,
  29 };
  30
  31 use Exporter;
  32 our @ISA = qw(Exporter);
  33 our @EXPORT = qw(run);
  34
  35 our @EXPORT_OK = (
  36         'DEBUG',
  37         'INFO',
  38         'NOTICE',
  39         'WARNING',
  40         'ERROR',
  41         'CRITICAL',
  42         'ALERT',
  43         'EMERGENCY'
  44 );
  45
  46 our %EXPORT_TAGS = ( constants => [
  47         'DEBUG',
  48         'INFO',
  49         'NOTICE',
  50         'WARNING',
  51         'ERROR',
  52         'CRITICAL',
  53         'ALERT',
  54         'EMERGENCY'
  55 ]);
  56
  57 our $VERSION = '0.01';
  58 our $NAME = 'PVE::DHCPServer';
  59 my $time_to_die = 0;
  60
  61 # generic signal handler to cause daemon to stop
  62 sub signal_handler {
  63     $time_to_die = 1;
  64 }
  65 $SIG{INT} = $SIG{TERM} = $SIG{HUP} = \&signal_handler;
  66
  67 # ignore any PIPE signal: standard behaviour is to quit process
  68 $SIG{PIPE} = 'IGNORE';
  69
  70 sub new {
  71     my ($class, %self) = @_;
  72
  73     # OOP stuff
  74     $class = ref($class) || $class;
  75     my $self = \%self;
  76     bless $self, $class;
  77
  78         # private
  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->{_config}              = undef;
  86         $self->{_transaction_ip4} = 0;
  87         $self->{_transaction_ip6} = 0;
  88
  89         # public
  90         $self->{log_file}               ||= 'syslog';
  91     $self->{lease_time}         ||= 7200;
  92     $self->{subnet_mask}        ||= undef;
  93     $self->{routers}            ||= undef;
  94     $self->{broadcast_addr}     ||= undef;
  95     $self->{domain_name}        ||= undef;
  96     $self->{dns_servers}        ||= undef;
  97         $self->{ntp_servers}    ||= undef;
  98         $self->{LOG_LEVEL}              = ERROR unless defined $self->{LOG_LEVEL};
  99         $self->{NODAEMON}               ||= 0;
 100         $self->{DEBUG}                  ||= 0;
 101         $self->{timeout}                ||= 10;
 102         $self->{lease_file}             ||= '/tmp/dhcpd.leases';
 103         $self->{conf_file}              ||= '/tmp/dhcpd.cfg';
 104
 105     return $self;
 106 }
 107
 108 sub run {
 109         my ($self) = @_;
 110         my ($sel, @ready, $socket, $res);
 111
 112         eval {
 113                 $self->read_config();
 114         };
 115         if ($@) {
 116                 my $err = $@;
 117                 $self->logger($err, ERROR);
 118                 die $err;
 119         }
 120         $self->logger("Starting dhcpd", INFO);
 121         if ($self->{NODAEMON} < 1) {
 122                 $self->logger("Entering Daemon mode");
 123                 chdir '/'                 or die "Can't chdir to /: $!";
 124                 umask 0;
 125
 126                 open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
 127                 open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
 128                 open STDERR, '>/dev/null' or die "Can't write to /dev/null: $!";
 129
 130                 my $pid = fork;
 131                 exit if $pid;
 132                 do {
 133                         my $err = $!;
 134                         $self->logger("Couldn't fork: $err", ERROR);
 135                         die "Couldn't fork: $err";
 136                 } unless defined($pid);
 137
 138                 POSIX::setsid() || do {
 139                         my $err = $!;
 140                         $self->logger("Can't start a new session: $err", ERROR);
 141                         die "Can't start a new session: $err";
 142                 };
 143                 $self->logger("Now in Daemon mode", INFO);
 144         }
 145
 146         $res = $self->read_lease_file();
 147         $self->logger("Starting with empty leases file '$self->{lease_file}'", INFO) unless $res;
 148
 149         $self->logger("Initialization complete", INFO);
 150
 151         # open listening socket
 152         $self->{_sock_in_ip4} = IO::Socket::IP->new(
 153                 Domain          => PF_INET,
 154                 LocalPort       => 67,
 155                 LocalAddr       => inet_ntoa(INADDR_ANY),
 156                 Proto           => 'udp'
 157         ) || do {
 158                 my $err = $@;
 159                 $self->logger("IP4 Socket creation error: $err", ERROR);
 160                 die "IP4 Socket creation error: $err\n";
 161         };
 162         $self->{_sock_in_ip6} = IO::Socket::IP->new(
 163                 Domain          => PF_INET6,
 164                 V6Only          => 1,
 165                 LocalPort       => 547,
 166                 LocalAddr       => '::',
 167                 Proto           => 'udp'
 168         ) || do {
 169                 my $err = $@;
 170                 $self->logger("IP6 Socket creation error: $err", ERROR);
 171                 die "IP6 Socket creation error: $err\n";
 172         };
 173
 174         $sel = IO::Select->new($self->{_sock_in_ip4});
 175         $sel->add($self->{_sock_in_ip6});
 176
 177         until ($time_to_die) {
 178                 my $buf = undef;
 179                 my $fromaddr;
 180                 my $dhcpreq;
 181
 182                 eval {  # catch fatal errors
 183                         while (@ready = $sel->can_read) {
 184                                 $self->logger("Waiting for incoming packet", INFO);
 185                                 foreach $socket (@ready) {
 186                                         if ($socket == $self->{_sock_in_ip4}) {
 187                                                 # receive ipv4 packet
 188                                                 $fromaddr = $self->{_sock_in_ip4}->recv($buf, 4096)
 189                                                         || $self->logger("recv: $!", ERROR);
 190                                                 next if ($!);   # continue loop if an error occured
 191                                                 $self->{_transaction_ip4}++;    # transaction counter
 192
 193                                                 {
 194                                                         use bytes;
 195                                                         my ($port,$addr) = unpack_sockaddr_in($fromaddr);
 196                                                         my $ipaddr = inet_ntoa($addr);
 197                                                         $self->logger("Got a packet tr=$self->{_transaction_ip4} src=$ipaddr:$port length=".length($buf), INFO);
 198                                                 }
 199
 200
 201                                                 my $dhcpreq = new Net::DHCP::Packet($buf);
 202                                                 $dhcpreq->comment($self->{_transaction_ip4});
 203
 204                                                 my $messagetype = $dhcpreq->getOptionValue(DHO_DHCP_MESSAGE_TYPE());
 205
 206                                                 if ($messagetype eq DHCPDISCOVER()) {
 207                                                                 $self->discover_ip4($dhcpreq);
 208                                                 } elsif ($messagetype eq DHCPREQUEST()) {
 209                                                                 $self->request_ip4($dhcpreq);
 210                                                 } elsif ($messagetype eq DHCPINFORM()) {
 211                                                         $self->logger("Not implemented: DHCPINFORM", WARNING);
 212                                                 } elsif ($messagetype eq DHCPRELEASE()) {
 213                                                                 $self->release_ip4($dhcpreq);
 214                                                 } else {
 215                                                         $self->logger("Packet dropped", WARNING);
 216                                                         # bad messagetype, we drop it
 217                                                 }
 218                                         } else {
 219                                                 # Receive ipv6 packet
 220                                                 my $ipaddr;
 221
 222                                                 $fromaddr = $self->{_sock_in_ip6}->recv($buf, 4096)
 223                                                         || $self->logger("recv: $!", ERROR);
 224                                                 next if ($!);   # continue loop if an error occured
 225                                                 $self->{_transaction_ip6}++;    # transaction counter
 226                                                 $self->logger("recv: $buf", INFO);
 227                                                 {
 228                                                         use bytes;
 229                                                         my ($port,$addr) = unpack_sockaddr_in6($fromaddr);
 230                                                         $ipaddr = inet_ntop(AF_INET6, $addr);
 231                                                         $self->logger("Got a packet tr=$self->{_transaction_ip6} src=$ipaddr:$port length=".length($buf), INFO);
 232                                                 }
 233                                                 $self->excuse_me_ip6($ipaddr, $buf);
 234                                         }
 235                                 }
 236                         }
 237                 };      # end of 'eval' blocks
 238                 if ($@) {
 239                         $self->logger("Caught error in main loop: $@", ERROR);
 240                 }
 241         }
 242         $self->{_sock_in_ip4}->close;
 243         $self->{_sock_in_ip6}->close;
 244         $self->logger("Exiting dhcpd", INFO);
 245 }
 246
 247 sub run_with_timeout {
 248     my ($self, $code, @param) = @_;
 249
 250     die "got timeout" if $self->{timeout} <= 0;
 251
 252     my $prev_alarm;
 253
 254     my $sigcount = 0;
 255
 256     my $res;
 257
 258     local $SIG{ALRM} = sub { $sigcount++; }; # catch alarm outside eval
 259
 260     eval {
 261                 local $SIG{ALRM} = sub { $sigcount++; die "got timeout"; };
 262                 local $SIG{PIPE} = sub { $sigcount++; die "broken pipe" };
 263                 local $SIG{__DIE__};   # see SA bug 4631
 264
 265                 $prev_alarm = alarm($self->{timeout});
 266
 267                 $res = &$code(@param);
 268
 269                 alarm(0); # avoid race conditions
 270     };
 271
 272     my $err = $@;
 273
 274     alarm($prev_alarm) if defined($prev_alarm);
 275
 276     die "unknown error" if $sigcount && !$err; # seems to happen sometimes
 277
 278     die $err if $err;
 279
 280     return $res;
 281 }
 282
 283 sub lock {
 284         my ($self, $file, $shared) = @_;
 285
 286         my $mode = $shared ? LOCK_SH : LOCK_EX;
 287
 288         my $lock_func = sub {
 289                 if ($mode == LOCK_SH) {
 290                         $self->{file_handle} = new IO::File ("<$file") ||
 291                 die "can't open file '$file' for read - $!";
 292                 } else {
 293                         $self->{file_handle} = new IO::File (">$file") ||
 294                 die "can't open file '$file' for write - $!";
 295                 }
 296         $self->logger("trying to aquire lock on '$file'...");
 297         if (!flock ($self->{file_handle}, $mode|LOCK_NB)) {
 298                         my $success;
 299                         while(1) {
 300                                 $success = flock($self->{file_handle}, $mode);
 301                                 # try again on EINTR (see bug #273)
 302                                 if ($success || ($! != EINTR)) {
 303                                         last;
 304                                 }
 305                         }
 306                         if ($mode == LOCK_SH) {
 307                                 seek($self->{file_handle}, 0, SEEK_END) or $success = 0;
 308                         }
 309                         if (!$success) {
 310                                 $self->logger(" failed");
 311                                 die "can't aquire lock - $!";
 312                         }
 313         }
 314                 $self->logger(" OK");
 315     };
 316
 317     my $res;
 318     my $err = undef;
 319
 320     eval {
 321                 $res = $self->run_with_timeout($lock_func);
 322         };
 323     if ($@) {
 324                 $self->logger("can't lock file '$file' - $@", ERROR);
 325                 $self->{file_handle} = undef;
 326                 return undef;
 327     }
 328
 329     return $res;
 330 }
 331
 332 sub unlock {
 333         my ($self, $file) = @_;
 334
 335         return '' unless($self->{file_handle});
 336         my $unlock_func = sub {
 337         $self->logger("trying to unlock '$file'...");
 338         if (!flock($self->{file_handle}, LOCK_UN)) {
 339
 340                         my $success;
 341                         while(1) {
 342                                 $success = flock($self->{file_handle}, LOCK_UN);
 343                                 # try again on EINTR (see bug #273)
 344                                 if ($success || ($! != EINTR)) {
 345                                         last;
 346                                 }
 347                         }
 348                         if (!$success) {
 349                                 $self->logger(" failed");
 350                                 die "can't unlock - $!";
 351                         }
 352         }
 353                 $self->logger(" OK");
 354     };
 355
 356     my $res;
 357     my $err = undef;
 358
 359     eval {
 360                 $res = $self->run_with_timeout($unlock_func);
 361         };
 362     if ($@) {
 363                 $self->logger("can't lock file '$file' - $@", ERROR);
 364                 $self->{file_handle} = undef;
 365                 $res = undef;
 366     }
 367
 368     return $res;
 369 }
 370
 371 sub convert_timestamp {
 372         my ($self, $timestamp, $strtotime) = @_;
 373         my ($res, $mday, $mon, $year, $hour, $min, $sec);
 374
 375         $self->logger("Timestamp: $timestamp");
 376         if ($strtotime) {
 377                 if ($timestamp !~ /^\d{4}\/\d{2}\/\d{2}\s+\d{2}:\d{2}:\d{2}$/) {
 378                         $self->logger("$timestamp: Bad format", ERROR);
 379                         $res = undef;
 380                 } else {
 381                         ($year,$mon,$mday,$hour,$min,$sec) = split(/[\s\/:]+/, $timestamp);
 382                         $res = timelocal($sec,$min,$hour,$mday,$mon-1,$year);
 383                 }
 384         } else{
 385                 if ($timestamp !~ /^\d+$/) {
 386                         $self->logger("$timestamp: Bad format", ERROR);
 387                         $res = undef;
 388                 } else {
 389                         ($sec,$min,$hour,$mday,$mon,$year) = localtime($timestamp);
 390                         $self->logger("Timestamp: $sec,$min,$hour,$mday,$mon,$year");
 391                         $res = sprintf("%d/%02d/%02d %02d:%02d:%02d", ($year+1900),($mon+1),$mday,$hour,$min,$sec);
 392                         $self->logger("Timestamp: $res");
 393                 }
 394         }
 395
 396         return $res;
 397 }
 398
 399
 400 sub add_lease {
 401         my ($self, $ip, $lease) = @_;
 402         my $ts;
 403
 404         my $mac = $lease->{'hardware ethernet'};
 405         $mac =~ tr/://d;
 406         $lease->{'hardware ethernet'} = $mac;
 407         $ts = $self->convert_timestamp($lease->{starts}, 1);
 408         return unless $ts;
 409         $lease->{starts} = $ts;
 410         $ts = $self->convert_timestamp($lease->{ends}, 1);
 411         return unless $ts;
 412         $lease->{ends} = $ts;
 413
 414         $self->{_leases}->{$ip} = $lease;
 415         $self->{_reverse}->{$mac} = $ip;
 416         $self->logger("$mac =>\n" . Dumper($self->{_reverse}->{$mac}));
 417 }
 418
 419 #lease vvv.xxx.yyy.zzz {
 420 #       starts yyyy/mm/dd hh:mm:ss;
 421 #       ends yyyy/mm/dd hh:mm:ss;
 422 #       binding state active|free;
 423 #       hardware ethernet MAC;
 424 #       client-hostname "name"
 425 #}
 426 sub read_lease_file {
 427         my ($self) = @_;
 428         my ($res, $key, $lease);
 429         my $error = 0;
 430
 431         $self->lock($self->{lease_file}, 1);
 432         if ($self->{file_handle}) {
 433                 my $fh = $self->{file_handle};
 434                 my @lines = <$fh>;
 435                 foreach (@lines) {
 436                         $self->logger("Read: $_");
 437                         if ($_ =~ /^\s*lease\s+([\d\.]+)\s+{\s*/) {
 438                                 $self->add_lease($key, $lease) if $lease;
 439                                 $key = $1;
 440                                 $lease = undef;
 441                                 $error = 0;
 442                                 $self->logger("Key: $key");
 443                         } else {
 444                                 next if $error;
 445                                 next if ($_ =~ /^\s*}\s*/ || $_ =~ /^\s*$/ || $_ =~ /^\s*#.*/);
 446                                 if ($_ =~ /^\s*(starts|ends|binding state|hardware ethernet|client-hostname)\s+(.+)\s*;/) {
 447                                         $lease->{$1} = $2;
 448                                         $self->logger("Key: $1 Value: $2");
 449                                 } else {
 450                                         $key = 'UNDEF' unless $key;
 451                                         $self->logger("$key: Bad format", ERROR);
 452                                         $key = undef;
 453                                         $lease = undef;
 454                                         $error = 1;
 455                                 }
 456                         }
 457                 }
 458                 if ($lease && !$error) {
 459                         $self->logger("Key: $key");
 460                         $self->add_lease($key, $lease);
 461                 }
 462                 $self->logger("Leases data structure: \n" . Dumper($self->{_leases}));
 463                 $self->unlock($self->{lease_file});
 464                 $res = 1;
 465         } else {
 466                 $self->logger("Could not read leases file", ERROR);
 467                 $res = 0;
 468         }
 469
 470         return $res;
 471 }
 472
 473 sub write_lease_file {
 474         my ($self) = @_;
 475         my $res;
 476
 477         $res = $self->lock($self->{lease_file}, 0);
 478         if ($self->{file_handle}) {
 479                 my $fh = $self->{file_handle};
 480                 while ((my $lease, my $elems) = each $self->{_leases}) {
 481                         $self->logger("Writing: $lease");
 482                         print $fh "lease $lease {\n";
 483                         while ((my $key, my $val) = each %$elems) {
 484                                 if ($key =~ /^(starts|ends)$/) {
 485                                         $val = $self->convert_timestamp($val, 0);
 486                                 }
 487                                 $self->logger("Writing: $key $val");
 488                                 print $fh "\t$key $val;\n";
 489                         }
 490                         print $fh "}\n";
 491                 }
 492                 $self->unlock($self->{lease_file});
 493                 $res = 1;
 494         } else {
 495                 $self->logger("Could not write leases file", ERROR);
 496                 $res = 0;
 497         }
 498
 499         return $res;
 500 }
 501
 502 #subnet 192.168.9.0 netmask 255.255.255.0 {
 503 #       range 192.168.9.2 192.168.9.100;
 504 #       ttl 7200;
 505 #       rttl 3600;
 506 #       router 192.168.9.254;
 507 #       dns-servers 192.168.2.201;
 508 #       ntp-servers 192.168.9.254;
 509 #       broadcast 192.168.9.255;
 510 #       domain-name "foo.bar";
 511 #       {
 512 #               allow 001cc0c33317,001cc0c33318,001cc0c33319,001cc0c33320;
 513 #               static 001cc0c33317 192.168.9.100,001cc0c33318 192.168.9.200;
 514 #       }
 515 #}
 516 sub read_config {
 517         my ($self) = @_;
 518         my ($res, $key, $netmask, $config, $subopt);
 519
 520         $self->lock($self->{conf_file}, 1);
 521         if ($self->{file_handle}) {
 522                 my $fh = $self->{file_handle};
 523                 my @lines = <$fh>;
 524                 $subopt = 0;
 525                 foreach (@lines) {
 526                         $self->logger("Read: $_");
 527                         if ($_ =~ /^\s*subnet\s+([\d\.]+)\s+netmask\s+([\d\.]+)\s+{\s*/) {
 528                                 $self->{_config}->{$key} = $config if $config;
 529                                 $key = $1;
 530                                 $config = undef;
 531                                 $config->{netmask} = $2;
 532                                 $self->logger("Key: $key Netmask: $config->{netmask}");
 533                         } else {
 534                                 next if (($_ =~ /^\s*}\s*/ && ! $subopt) || $_ =~ /^\s*$/ || $_ =~ /^\s*#.*/);
 535                                 if (! $subopt && $_ =~ /^\s*(range|ttl|rttl|router|dns-servers|ntp-servers|broadcast|domain-name)\s+(.+)\s*;/) {
 536                                         $config->{$1} = $2;
 537                                         $self->logger("Key: $1 Value: $2");
 538                                 } elsif ($subopt &&$_ =~ /^\s*}\s*/) {
 539                                         $subopt = 0;
 540                                 } elsif ($subopt || $_ =~ /^\s*{\s*/) {
 541                                         if ($subopt) {
 542                                                 if ($_ =~ /^\s*(allow|static)\s+(.+)\s*;/) {
 543                                                         my @vals = split(/\s*,\s*/, $2);
 544                                                         $config->{$1} = [@vals];
 545                                                         $self->logger("Key: $1 Value: $2");
 546                                                 } else {
 547                                                         $key = 'UNDEF' unless $key;
 548                                                         my $err = "$key: 'suboptions' Bad format";
 549                                                         $self->logger($err, ERROR);
 550                                                         $key = undef;
 551                                                         $config = undef;
 552                                                         die $err;
 553                                                 }
 554                                         } else {
 555                                                 $subopt = 1;
 556                                         }
 557                                 } else {
 558                                         $key = 'UNDEF' unless $key;
 559                                         my $err = "$key: Bad format";
 560                                         $self->logger($err, ERROR);
 561                                         $key = undef;
 562                                         $config = undef;
 563                                         die $err;
 564                                 }
 565                         }
 566                 }
 567                 if ($config) {
 568                         $self->{_config}->{$key} = $config;
 569                 }
 570                 $self->logger("Config data structure: \n" . Dumper($self->{_config}));
 571                 $self->unlock($self->{conf_file});
 572                 if (!$self->{_config}) {
 573                         die "Empty config file";
 574                 }
 575         } else {
 576                 die "Could not read config file";
 577         }
 578 }
 579
 580 sub logger {
 581         my ($self, $message, $level) = @_;
 582
 583         $level = DEBUG unless ($level);
 584         return unless ($level >= $self->{LOG_LEVEL});
 585
 586         $level = "debug" if $level eq DEBUG;
 587         $level = "info" if $level eq INFO;
 588         $level = "notice" if $level eq NOTICE;
 589         $level = "warning" if $level eq WARNING;
 590         $level = "err" if $level eq ERROR;
 591         $level = "crit" if $level eq CRITICAL;
 592         $level = "alert" if $level eq ALERT;
 593         $level = "emerg" if $level eq EMERGENCY;
 594
 595         if ($self->{DEBUG}) {
 596                 print STDOUT strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
 597                 print STDOUT "$level: $message\n";
 598         } elsif ($self->{log_file} eq 'syslog') {
 599                 openlog($NAME, 'ndelay,pid', 'user');
 600                 syslog($level, $message);
 601                 closelog();
 602         } else {
 603                 my $fh = new IO::File;
 604                 if (! $fh->open("> $self->{log_file}")) {
 605                         croak "$self->{log_file}: $!";
 606                 }
 607                 print $fh strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
 608                 print $fh "$level: $message\n";
 609                 undef $fh;
 610         }
 611 }
 612
 613 sub add_options {
 614         my ($self, $dhcpresp) = @_;
 615
 616         if ($self->{lease_time}) {
 617                 $dhcpresp->addOptionValue(DHO_DHCP_LEASE_TIME, $self->{lease_time});
 618         }
 619         if ($self->{subnet_mask}) {
 620                 $dhcpresp->addOptionValue(DHO_SUBNET_MASK, $self->{subnet_mask});
 621         }
 622         if ($self->{routers}) {
 623                 $dhcpresp->addOptionValue(DHO_ROUTERS, $self->{routers});
 624         }
 625         if ($self->{broadcast_addr}) {
 626                 $dhcpresp->addOptionValue(DHO_BROADCAST_ADDRESS, $self->{broadcast_addr});
 627         }
 628         if ($self->{domain_name}) {
 629                 $dhcpresp->addOptionValue(DHO_DOMAIN_NAME, $self->{domain_name});
 630         }
 631         if ($self->{ntp_servers}) {
 632                 $dhcpresp->addOptionValue(DHO_NTP_SERVERS, $self->{ntp_servers});
 633         }
 634         if ($self->{dns_servers}) {
 635                 $dhcpresp->addOptionValue(DHO_DOMAIN_NAME_SERVERS, $self->{dns_servers});
 636         }
 637 }
 638
 639 sub discover_ip4 {
 640         my ($self, $dhcpreq) = @_;
 641         my ($calc_ip, $req_addr, $dhcpresp);
 642         my $res;
 643
 644         # calculate address
 645         $calc_ip = "192.168.9.2";
 646
 647         $self->logger("Got request\n".$dhcpreq->toString());
 648
 649         $self->{_sock_out_ip4} = IO::Socket::IP->new(
 650                 Broadcast => 1,
 651                 PeerPort => 68,
 652                 PeerAddr => inet_ntoa(INADDR_BROADCAST),
 653                 Proto    => 'udp'
 654         ) || do {
 655                 my $err = $@;
 656                 $self->logger("[discover_ip4] Socket creation error: $err", ERROR);
 657                 die "[discover_ip4] Socket creation error: $err\n";
 658         };
 659
 660         $req_addr = $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS());
 661         $req_addr = '' unless $req_addr;
 662         $self->logger("Requested IP: $req_addr", INFO);
 663
 664         $res = $self->read_lease_file();
 665         $res = $self->write_lease_file();
 666         if ($res && ($req_addr =~ /^$/ || $calc_ip eq $req_addr)) {
 667                 $dhcpresp = new Net::DHCP::Packet(
 668                         Comment => $dhcpreq->comment(),
 669                         Op => BOOTREPLY(),
 670                         Hops => $dhcpreq->hops(),
 671                         Xid => $dhcpreq->xid(),
 672                         Flags => $dhcpreq->flags(),
 673                         Ciaddr => $dhcpreq->ciaddr(),
 674                         Yiaddr => $calc_ip,
 675                         Siaddr => $dhcpreq->siaddr(),
 676                         Giaddr => $dhcpreq->giaddr(),
 677                         Chaddr => $dhcpreq->chaddr(),
 678                         DHO_DHCP_MESSAGE_TYPE() => DHCPOFFER(),
 679                         DHO_DHCP_SERVER_IDENTIFIER() => $self->{_sock_out_ip4}->sockhost
 680                 );
 681                 $self->add_options($dhcpresp);
 682         } else {
 683                 # bad request, we send a NAK
 684                 $dhcpresp = new Net::DHCP::Packet(
 685                         Comment => $dhcpreq->comment(),
 686                         Op => BOOTREPLY(),
 687                         Hops => $dhcpreq->hops(),
 688                         Xid => $dhcpreq->xid(),
 689                         Flags => $dhcpreq->flags(),
 690                         Ciaddr => $dhcpreq->ciaddr(),
 691                         Yiaddr => "0.0.0.0",
 692                         Siaddr => $dhcpreq->siaddr(),
 693                         Giaddr => $dhcpreq->giaddr(),
 694                         Chaddr => $dhcpreq->chaddr(),
 695                         DHO_DHCP_MESSAGE_TYPE() => DHCPNAK(),
 696                         DHO_DHCP_MESSAGE(), "Bad request...",
 697                 );
 698         }
 699
 700         $self->logger("Sending response to " .
 701                 $self->{_sock_out_ip4}->peerhost . ':' .
 702                 $self->{_sock_out_ip4}->peerport, INFO);
 703
 704         # Socket object keeps track of whom sent last packet
 705         # so we don't need to specify target address
 706         $self->logger($dhcpresp->toString());
 707         $self->logger("Sending OFFER tr=".$dhcpresp->comment(), INFO);
 708         $self->{_sock_out_ip4}->send($dhcpresp->serialize()) || die "Error sending OFFER: $!\n";
 709 }
 710
 711 sub request_ip4 {
 712         my ($self, $dhcpreq) = @_;
 713         my ($calc_ip, $dhcpresp, $peeraddr, $result);
 714
 715         $calc_ip = "192.168.9.2";
 716
 717         $peeraddr = $dhcpreq->ciaddr() ? $dhcpreq->ciaddr() : inet_ntoa(INADDR_BROADCAST);
 718         $self->{_sock_out_ip4} = IO::Socket::IP->new(
 719                 Broadcast => 1,
 720                 PeerPort => 68,
 721                 PeerAddr => $peeraddr,
 722                 Proto    => 'udp',
 723         ) || do {
 724                 my $err = $@;
 725                 $self->logger("[request_ip4] Socket creation error: $err", ERROR);
 726                 die "[request_ip4] Socket creation error: $err\n";
 727         };
 728
 729         # compare calculated address with requested address
 730         if ($calc_ip eq $dhcpreq->getOptionValue(DHO_DHCP_REQUESTED_ADDRESS())) {
 731                 # address is correct, we send an ACK
 732                 $dhcpresp = new Net::DHCP::Packet(
 733                         Comment => $dhcpreq->comment(),
 734                         Op => BOOTREPLY(),
 735                         Hops => $dhcpreq->hops(),
 736                         Xid => $dhcpreq->xid(),
 737                         Flags => $dhcpreq->flags(),
 738                         Ciaddr => $dhcpreq->ciaddr(),
 739                         Yiaddr => $calc_ip,
 740                         Siaddr => $dhcpreq->siaddr(),
 741                         Giaddr => $dhcpreq->giaddr(),
 742                         Chaddr => $dhcpreq->chaddr(),
 743                         DHO_DHCP_MESSAGE_TYPE() => DHCPACK(),
 744                         DHO_DHCP_SERVER_IDENTIFIER() => $self->{_sock_out_ip4}->sockhost,
 745                 );
 746                 $self->add_options($dhcpresp);
 747                 $result = 'ACK';
 748         } else {
 749                 # bad request, we send a NAK
 750                 $self->write_lease_file();
 751                 $dhcpresp = new Net::DHCP::Packet(
 752                         Comment => $dhcpreq->comment(),
 753                         Op => BOOTREPLY(),
 754                         Hops => $dhcpreq->hops(),
 755                         Xid => $dhcpreq->xid(),
 756                         Flags => $dhcpreq->flags(),
 757                         Ciaddr => $dhcpreq->ciaddr(),
 758                         Yiaddr => "0.0.0.0",
 759                         Siaddr => $dhcpreq->siaddr(),
 760                         Giaddr => $dhcpreq->giaddr(),
 761                         Chaddr => $dhcpreq->chaddr(),
 762                         DHO_DHCP_MESSAGE_TYPE() => DHCPNAK(),
 763                         DHO_DHCP_MESSAGE(), "Bad request...",
 764                 );
 765                 $result = 'NAK';
 766         }
 767
 768         $self->logger("Sending response to " .
 769                 $self->{_sock_out_ip4}->peerhost . ':' .
 770                 $self->{_sock_out_ip4}->peerport, INFO);
 771
 772         # Socket object keeps track of whom sent last packet
 773         # so we don't need to specify target address
 774         $self->logger($dhcpresp->toString());
 775         $self->logger("Sending $result tr=".$dhcpresp->comment(), INFO);
 776         $self->{_sock_out_ip4}->send($dhcpresp->serialize()) || die "Error sending ACK/NAK: $!\n";
 777 }
 778
 779 sub release_ip4 {
 780         my ($self, $dhcpreq) = @_;
 781
 782         $self->logger($dhcpreq->toString());
 783         $self->write_lease_file();
 784 }
 785
 786 sub excuse_me_ip6 {
 787         my ($self, $addr, $dhcpreq) = @_;
 788
 789         $self->logger("IPv6 request from [$addr]: $dhcpreq", INFO);
 790         $self->{_sock_out_ip6} = IO::Socket::IP->new(
 791                 Domain    => PF_INET6,
 792                 V6Only    => 1,
 793                 Broadcast => 1,
 794                 PeerPort  => 546,
 795                 PeerAddr  => $addr,
 796                 Proto     => 'udp',
 797         ) || do {
 798                 my $err = $@;
 799                 $self->logger("[excuse_me_ip6] Socket creation error: $err", ERROR);
 800                 die "[excuse_me_ip6] Socket creation error: $err\n";
 801         };
 802         $self->logger("$addr: Not implemented here", INFO);
 803         $self->{_sock_out_ip6}->send("Not implemented here") || die "Error sending excuse: $!\n";
 804 }
 805
 806 1;