#!@PERL@  
#######################################################################
#
# LCFG dhcpd Component
#
# @AUTHOR@
# Version @VERSION@ : @DATE@
#
# @MSG@
#
#######################################################################

@ENCODING@
package LCFG::Dhcpd;
@ISA = qw(LCFG::Component);

use strict;
use warnings;

use LCFG::Component;

use Digest::MD5 qw(md5_hex);
use File::Copy;
use File::Path;
use Mail::Mailer;
use Net::Ifconfig::Wrapper;
use Net::Netmask;
use Socket;
use Sys::Hostname;

##########################################################################
# Globals
##########################################################################

my $tmpdir = '@TMPDIR@';

##########################################################################
sub Configure {
##########################################################################

  my ($self, $res, @args) = @_;

  my $problems = {};

  # Check for sane dhcpd daemon configuration

  my $dhcpdbin = $res->{'dhcpdbin'}->{VALUE};
  $self->Fail('dhcpdbin not specified') unless ($dhcpdbin);

  my $dhcpdconfigfile = $res->{'dhcpdconfigfile'}->{VALUE};
  $self->Fail('dhcpconfigfile not specified') unless ($dhcpdconfigfile);

  my $dhcpdinitscript = $res->{'dhcpdinitscript'}->{VALUE};
  $self->Fail('dhcpdinitscript not specified') unless ($dhcpdinitscript);

  my $pidfile = $res->{'pidfile'}->{VALUE};
  $self->Fail('pidfile not specified') unless ($pidfile);

  my $leasesdbdir = $res->{'leasesdbdir'}->{VALUE};
  $self->Fail('leasesdbdir not specified') unless ($leasesdbdir);

  # Create the DHCP leases file if it doesn't exist
  
  if ( ! -f "$leasesdbdir/dhcpd.leases" ) {
    mkpath($leasesdbdir) unless ( -d $leasesdbdir );
    open(LEASESFILE, ">$leasesdbdir/dhcpd.leases") or
      $self->Warn("failed to create $leasesdbdir/dhcpd.leases");
    close LEASESFILE;
  }

  # Delete all files from the temporary directory

  mkpath($tmpdir) unless ( -d $tmpdir );

  my $file;
  opendir (DIR, $tmpdir) or
    $self->Fail("failed to open tmp directory $tmpdir");
  while ( $file = readdir(DIR) ) {
    unlink("$tmpdir/$file");
  }
  closedir DIR;

  # Create the 'global' fragment of the dhcpd.conf file 

  my $status =
    LCFG::Template::Substitute('@TEMPLATE@/dhcpd.conf.main',
                               "$tmpdir/dhcpd.conf.global",
                               0,
                               $res);
  if ( ! defined($status) ) {
    $self->LogMessage($@);
    $self->Fail('failed to create config file fragment ' .
                "$tmpdir/dhcpd.conf.global (see logfile)");
  }

  # Create a subnet object for each of the subnets we're interested in

  my $subnets;
  foreach my $subnet ( split(' ', $res->{'subnets'}->{VALUE}) ) {
    $subnets->{$subnet} =
      new2 Net::Netmask($res->{"netnum_$subnet"}->{VALUE},
                        $res->{"netmask_$subnet"}->{VALUE}) or
      $self->Warn('Invalid subnet:' . $Net::Netmask::error);
  }

  # Deal with DHCP service for IPMI by folding BMC data (if any)
  # back into the hosts resource; after this, BMC 'hosts' are
  # processed in the same way as any other host

  foreach my $host ( split(' ', $res->{'hosts'}->{VALUE}) ) {
    my $bmchostname = $res->{"bmchostname_$host"}->{VALUE};
    my $bmcmac = $res->{"bmcmac_$host"}->{VALUE};
    if ( $bmchostname && $bmcmac ) {
      my $tag = 'BMC_' . md5_hex($bmchostname);

      $res->{'hosts'}->{VALUE} = join(' ', $res->{'hosts'}->{VALUE}, $tag);
      $res->{"hostname_$tag"}->{VALUE} = $bmchostname;
      $res->{"mac_$tag"}->{VALUE}      = $bmcmac;

      # Comment: need to nullify the following to avoid 'undefined resource'
      #          errors from LCFG::Template::Substitute
      $res->{"hostbootmenu_$tag"}->{VALUE}        = '';
      $res->{"hostfilename_$tag"}->{VALUE}        = '';
      $res->{"hostrootpath_$tag"}->{VALUE}        = '';
      $res->{"hostnetbiosservers_$tag"}->{VALUE}  = '';
      $res->{"hostnetbiosnodetype_$tag"}->{VALUE} = '';
    }
  }

  # Organise hosts by subnet (each host has a *single* IP address only)

  my $hostsbysubnet = {};
  foreach my $host ( split(' ', $res->{'hosts'}->{VALUE}) ) {
    sortHostBySubnet($self, $res, $host, $subnets, $hostsbysubnet, $problems);
  }

  # Get all interfaces currently configured on *this* machine ...

  my $allhostinterfaces = Net::Ifconfig::Wrapper::Ifconfig('list', '', '', '');
  
  # ... and organise all of those which are 'up' into a hash

  my $hostinterfaces;
  foreach my $name (keys %{$allhostinterfaces}) {
    if ( $allhostinterfaces->{$name}->{'status'} ) { # ie interface is up
      my ($ipaddress, $netmask) =
        each( %{$allhostinterfaces->{$name}->{'inet'}} );
      $hostinterfaces->{$name} = $ipaddress;
    }
  }
 
  # Now, for each interface declared in the resources, figure out what subnet 
  # it's on (this subnet must be different for each interface), and create the
  # corresponding 'subnet' fragment of the dhcpd.conf file 

  foreach my $interface ( split(' ', $res->{'interfaces'}->{VALUE}) ) {
    my $ipaddress = $hostinterfaces->{$interface};
    if ( ! $ipaddress ) {
      $self->Warn("resources specify non-existent interface $interface");
      next;
    }
    my $subnet = mapIPaddressToSubnet($self, $res, $ipaddress, $subnets);
    if ( ! $subnet ) {
      $self->Warn("could not locate $interface ($ipaddress) on any subnet");
      next;
    }
    processSubnet($self, $res, $subnet, $hostsbysubnet, $problems);
  }

  # Finally, assemble the final dhcpd.conf file from all the fragments

  opendir(DIR, "$tmpdir");
  my @subnetfiles = grep { /\.conf.subnet/ } readdir(DIR);
  closedir DIR;

  open(CONFFILE, ">$tmpdir/dhcpd.conf") or
    $self->Fail("can't write $tmpdir/dhcpd.conf");

  foreach my $fragment ('dhcpd.conf.global', @subnetfiles) {
    open (FRAGMENT, "<$tmpdir/$fragment") or
      $self->Fail("can't read $tmpdir/$fragment");
    while (<FRAGMENT>) {
      print CONFFILE;
    }
    close FRAGMENT;
  }

  close CONFFILE;
  
  # Test the file that we've just generated ...

  $status = system($dhcpdbin, '-t', '-cf', "$tmpdir/dhcpd.conf");

  # ... and, if it's okay, install it, and then stop (if necessary)
  #     and start the dhcpd daemon

  if ($status == 0) {
    copy($dhcpdconfigfile, "$dhcpdconfigfile.old") or
      $self->Warn("can't save old $dhcpdconfigfile");
    copy("$tmpdir/dhcpd.conf", $dhcpdconfigfile) or
      $self->Fail("can't write new $dhcpdconfigfile");

    if ( -f $pidfile ) {
      open(PIDFILE, "<$pidfile") || $self->Info("can't open pidfile: $?");
      my $pid;
      while (<PIDFILE>) {
        chomp;
        $pid = $_;
      }
      close PIDFILE;
      if ( -d "/proc/$pid" ) {
        $status = system($dhcpdinitscript, 'stop');
        $self->Error("can't stop the daemon: $?") unless $status == 0;
      }
    }

    $status = system($dhcpdinitscript, 'start');
    $self->Error("daemon was not restarted: $?") unless $status == 0;
  }
  else {
    $self->Info("$dhcpdbin configuration failure: $?");
    $self->Info("falling back to last known good config");
  }

  # Mail out any fault reports, if any

  if ( keys %{$problems} ) {
    mailProblems($self, $res, $problems);
  }

}

##########################################################################
sub Stop {
##########################################################################

  my ($self, $res, @args) = @_;

  my $dhcpdinitscript = $res->{'dhcpdinitscript'}->{VALUE};
  $self->Fail('dhcpdinitscript not specified') unless ($dhcpdinitscript);

  my $status = system($dhcpdinitscript, 'stop');
  $self->Error("daemon was not stopped: $?") unless $status == 0; 

}

#######################################################################
sub sortHostBySubnet {
#######################################################################

  my ($self, $res, $host, $subnets, $hostsbysubnet, $problems) = @_;

  my $lookuphostname = $res->{"hostname_$host"}->{VALUE} ?
    $res->{"hostname_$host"}->{VALUE} : $host;

  my $hostaddr = gethostbyname($lookuphostname);
  if ( ! $hostaddr ) {
    my $errmsg = "couldn't find IP address for $lookuphostname";
    $self->Warn($errmsg);
    $problems->{'IPADDR'}->{$lookuphostname} = $errmsg;
    return;
  }

  my $ipaddress = inet_ntoa($hostaddr);
  my $subnet = mapIPaddressToSubnet($self, $res, $ipaddress, $subnets);
  if ( ! $subnet ) {
    my $errmsg = "couldn't identify subnet for $lookuphostname ($ipaddress)";
    $self->Warn($errmsg);
    $problems->{'SUBNET'}->{$lookuphostname} = $errmsg;
    return;
  }
 
  $hostsbysubnet->{$subnet}->{$host} = $ipaddress;
}

#######################################################################
sub mapIPaddressToSubnet {
#######################################################################

  my ($self, $res, $ipaddress, $subnets) = @_;

  foreach my $subnet (keys %{$subnets}) {
    if ( $subnets->{$subnet}->match($ipaddress) ) {
      return $subnet;
    }
  }
 
  return undef;

}

#######################################################################
sub processSubnet {
#######################################################################

  my ($self, $res, $subnet, $hostsbysubnet, $problems) = @_;

  my $cachedmacs = {};
  my $subnethosts = {};
 
  foreach my $host (sort keys %{$hostsbysubnet->{$subnet}}) {
    my $mac = validateMAC($self, $res, $host, $subnet,
                          $cachedmacs, $subnethosts, $problems);
    if ($mac) {
      $subnethosts->{$host} = 1;
      $res->{"mac_$host"}->{VALUE} = $mac;
      $res->{"ipaddr_$host"}->{VALUE} = $hostsbysubnet->{$subnet}->{$host};
    }
  }

  my @nethosts = sort keys %{$subnethosts};
  $res->{'s'}->{VALUE} = $subnet;
  $res->{'nethosts'}->{VALUE} = "@nethosts";

  my $status =
    LCFG::Template::Substitute('@TEMPLATE@/dhcpd.conf.subnet',
                               "$tmpdir/dhcpd.conf.subnet.$subnet",
                               0,
                               $res);
  if ( ! defined($status) ) {
    $self->LogMessage($@);
    $self->Fail('failed to create config file fragment ' .
                "$tmpdir/dhcpd.conf.subnet.$subnet (see logfile)");
  }
 
}

#######################################################################
sub validateMAC {
#######################################################################

  my ($self, $res, $host, $subnet, $cachedmacs, $subnethosts, $problems) = @_;

  my $hostname = hostname();
  my $clashhost;

  my $mac = $res->{"mac_$host"}->{VALUE};
  $mac = uc($mac);
  $mac =~ s/-/:/g;

  if ( ! $mac =~ /^([0-9A-F]{2}:){5}[0-9A-F]{2}$/ ) {
    my $errmsg = "invalid mac address (" . $res->{"mac_$host"}->{VALUE} . ")" .
                 " for $host";
    $self->Warn($errmsg);
    $problems->{'INVALIDMAC'}->{$host} = "$errmsg: " .
      "won't be included in the dhcpd.conf file on $hostname";
    return;
  }
  elsif ( $mac eq '00:00:00:00:00:00' ) {
    my $errmsg = "undefined mac address for $host defaults to $mac";
    $self->Info($errmsg);
    $problems->{'UNDEFINEDMAC'}->{$host} = $errmsg;
    return;
  }
  elsif ( $clashhost = $cachedmacs->{$mac} ) {

    # Duplicate MAC addresses defined: don't include the second host with
    # the duplicate mac address; also remove the clashing one from the
    # list of hosts in this subnet. (Note that this code also works when
    # three - or more! - hosts have the same MAC address - the 'delete'
    # below just fails silently.)

    my $errmsg = "duplicate mac address ($mac) defined for " .
                 "$host and $clashhost on wire $subnet";
    my $logmsg = "$errmsg: " .
                 "neither will be included in the dhcpd.conf file on " .
                 "$hostname";
    $self->Warn($errmsg);

    delete $subnethosts->{$clashhost};

    $problems->{'DUPMAC'}->{$host} = $logmsg;
    $problems->{'DUPMAC'}->{$clashhost} = $logmsg;
    return;
  }
  else {
    $cachedmacs->{$mac} = $host;
    return $mac;
  }

}

#######################################################################
sub mailProblems {
#######################################################################

  my ($self, $res, $problems) = @_;

  my $hostname = hostname();
  my $mailer = Mail::Mailer->new('sendmail');

  my $dhcpdmanager = $res->{'dhcpdadmin'}->{VALUE} ?
    $res->{'dhcpdadmin'}->{VALUE} : 'root@'.$res->{'lcfgdomain'}->{VALUE};

  $mailer->open({ From    => 'root@' . $res->{"lcfgdomain"}->{VALUE},
                  To      => $dhcpdmanager,
                  Subject => "DHCPD report from server $hostname",
                }) or
    $self->Warn("can't open mailer for error report: $!");

  my %problemhosts;
  foreach my $key ( sort keys %{$problems} ) {
    foreach my $host ( sort keys %{$problems->{$key}} ) {
      $problemhosts{$host} = 1;
      print $mailer "$problems->{$key}->{$host}\n";
    }
    print $mailer "\n";
  }
  $mailer->close;

  foreach my $host (keys %problemhosts) {
    if ( $res->{"mailmanager_$host"}->{VALUE} ) { 
      my $hostmanager = $res->{"manageremail_$host"}->{VALUE} ?
        $res->{"manageremail_$host"}->{VALUE} : 'root';

      $mailer->open({ From    => 'root@' . $res->{"lcfgdomain"}->{VALUE},
                      To      => $hostmanager,
                      Subject => "DHCPD report for host $host",
                    }) or
        $self->Warn("can't open mailer for error report: $!");

      foreach my $key ( sort keys %{$problems} ) {
        if ( exists ($problems->{$key}->{$host}) ) {
          print $mailer "$problems->{$key}->{$host}\n";
        }
      }
      $mailer->close;
    }
  }

}

##########################################################################
# Dispatch methods
##########################################################################

new LCFG::Dhcpd(@TESTPERLV@) -> Dispatch();