#!@PERL@  
#######################################################################
#
# LCFG DHCPD Component in Perl
#
# @AUTHOR@
# Version @VERSION@ : @DATE@
#
#@MSG@
#
#######################################################################

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

use strict;
use LCFG::Component;
use File::Copy;
use File::Path;
use Net::Netmask;
use Net::Ifconfig::Wrapper;
use Socket;
use Tie::RefHash;
use Data::Dumper;
use Mail::Mailer;
use Sys::Hostname;
##########################################################################
# Resource variables
##########################################################################

my $server = undef;
my $dhcpdbin="/usr/sbin/dhcpd";
my $pidfile="/var/run/dhcpd.pid";
my $dhcpdinitscript="/etc/rc.d/init.d/dhcpd";
my $dhcpdconfigfile="/etc/dhcpd.conf";
my $olddhcpdconfigfile="/etc/dhcpd.conf.old";

##########################################################################
sub Configure($$@) {
##########################################################################
 no strict 'refs'; 

  my $self = shift;
  my $res = shift;
  my $mailer = Mail::Mailer->new("sendmail");
  my $line;
  my $dhcpmailaddr=$res->{'dhcpdmailaddr'}->{VALUE};
  my @args = @_;
  my $host;
  my @hostlist;
  my @interfaces;
  my %subnets;
#  my %hostlistfiles;
  my %hostlists;
  my %hwinterfaces;
  my @subnetfiles;
  my $file;
  my @problemkeys;
  my $pid;
  my $tmpconf="@TMPDIR@/dhcpd.conf";
  my $manager;
  my $dhcpdmanager;
  my $testtmpconf="/tmp/dhcpd.conf";
  my @bin;
  my $hostname;
  my $hostmanager;
 my $subject="DHCPd component report "; 
  my %logofproblems;
  my $test;
  my $configfilehandle;
  my $confchanged;
  my $status;
  my @undefinedhosts;
  ######remove the follwoing line as soon as possible
  my $aiaihackfile="/etc/dhcpd.aiai.additions";
  ($hostname,@bin)=split(/\./, hostname());

 
  $server = $res->{'server'}->{VALUE};
  ########################################################################
  # Firstly we do some tidying up
  ########################################################################
  
  if (-f "$res->{'leasesdbdir'}/dhcpd.leases") {
      createleasefile($self,$res,@args); 
  }
  if ( ! -d "@TMPDIR@") {
	mkpath( "@TMPDIR@");
  }

  tidyconf($self,$res,@args);
  ########################################################################
  # Create the "global" chunk of the dhcpd.conf file and stash it in the 
  # tmp directory. 
  ########################################################################
  $status = LCFG::Template::Substitute( '@TEMPLATE@/dhcpd.conf.main',
      '@TMPDIR@/dhcpd.conf.global', 0, $res );
	unless (defined($status)) {
	  $self->LogMessage($@);
	  $self->Fail( "failed to create config file fragment @TMPDIR@/dhcpd.conf.global (see logfile)");
        }
  ########################################################################
  # Create the "subnet" chunks of the dhcpd.conf file and stash them in the 
  # tmp directory. 
  ########################################################################

  # we need to generate the details of the subnets we're using
 
  workoutnetmasks($self,$res,\%subnets);

  # generate a set of hashes that will hold details about the hosts
  genhostlisthashes($self,$res,\%hostlists);
  
  # get our list of hosts
  @hostlist=split / /,$res->{'hosts'}->{VALUE};
  
  # fill the hash with data
  buildhostlists($self,$res,\%hostlists,\%subnets,\%logofproblems,\@hostlist);
  gethwints($self,$res,\%hwinterfaces); 
 
  #now we've dealt with the hosts we need to start to build the dhcpd.conf file
  @interfaces=split /\s+/,$res->{'interfaces'}->{VALUE};
  foreach my $int (@interfaces){
    processsubnet($self,$res,$int,\%hwinterfaces,\%hostlists,\%logofproblems,\%subnets,\@undefinedhosts);
  }
 #Ok, now assemble the full dhcpd.conf file from all the fragments 
  copy('@TMPDIR@/dhcpd.conf.global',$tmpconf) || $self->Warn(" could not copy file to $tmpconf");
  $configfilehandle=IO::File->new("+>> @TMPDIR@/dhcpd.conf");
  opendir(DIR, '@TMPDIR@');
  @subnetfiles=grep { /\.conf.subnet/} readdir(DIR);
  foreach $file (@subnetfiles){
	open (TMPCONF, "< @TMPDIR@/$file")or die "can't open tmp file";
	while(<TMPCONF>){
		print $configfilehandle $_;
	}
	if ($file eq "dhcpd.conf.subnet.AIAI2" ){
          #munge in the aiaihack file, I really need to bin this stuff
          if ( -f $aiaihackfile){ 
	      $self->Info("found aiaihack file");
	      open (AIAIHACK, $aiaihackfile) or die "can't find file ";
  	      while( <AIAIHACK>){
 	        if ( $_ !~ m/^#/){ 
	          print $configfilehandle $_;
	        }
	      }
	   }
   	}else{
           print $configfilehandle "}";
        }	
  }

  close $configfilehandle;
  
#now test the file that we've just generated  
  testconfigfile($self,$res,$confchanged,$tmpconf);

#restart the daemon vi rc scripts
  $status = system($dhcpdinitscript,"start",">> /dev/null");
  $self->Error("daemon was not restarted: $?") unless $status == 0;


#####mail out fault reports
mailprobs($self,$res,\@hostlist,\%logofproblems,\@undefinedhosts);
  ########################################################################
  # (2) Secondly, if we are writing our own daemon which runs as
  # a fork of this component code, then we use this routine to signal
  # the daemon to reload its resources
  ########################################################################

  $self->ConfigureDaemon($res,@args);
}

##########################################################################
sub Start($$@) {
##########################################################################

  my $self = shift;
  my $res = shift;
  my @args = @_;
  my $status;
  ########################################################################
  # If they don't exist then we create the files and directories we need.
  ########################################################################
  ########################################################################
  # Use this routine to start a daemon running as a fork of the
  # current code. This invokes the DaemonStart() routine.
  ########################################################################

  #$self->StartDaemon($res,@args);

  ########################################################################
  # If you want to run an external daemon program, you should start
  # it here and record the PID somewhere so you can stop it later
  ########################################################################
  
  ########################################################################
  # If you don't have a daemon, you don't need a Start() routine
  # at all.
  ########################################################################
}

##########################################################################
sub Stop($$@) {
##########################################################################

  my $self = shift;
  my $res = shift;
  my @args = @_;
  my $status;
  ########################################################################
  # Use this routine to signal a daemon running as a fork of the
  # current code. This invokes the DaemonStop() routine.
  ########################################################################

  #$self->StopDaemon($res,@args);

  ########################################################################
  # If you want to run an external daemon program, you should have
  # saved the PID in the Start() routine, so you can kill it here.
  # You probably want to wait here until you are satisfied that the
  # daemon really has stopped.
  ########################################################################
  $status = system($dhcpdinitscript,"stop");
  $self->Error("daemon was not stopped: $?") unless $status == 0; 


  ########################################################################
  # If you don't have a daemon, you don't need a Stop() routine
  # at all.
  ########################################################################
}

#######################################################################
sub DaemonConfigure($$@) {
#######################################################################
  
  my $self = shift;  
  my $res = shift;
  my @args = @_;

  # This gets called * AT INTERRUPT TIME * in the daemon process
  # when any resources have changed. Only use this if you are
  # writing your daemon code as a fork of this component code.

  $self->LogMessage("daemon reconfigured: @args");

  $server = $res->{'server'}->{VALUE};
}

#######################################################################
sub DaemonStop($$@) {
#######################################################################
  
  my $self = shift;  
  my $res = shift;
  my @args = @_;

  # This gets called * AT INTERRUPT TIME * in the daemon process
  # when the component is stopped. Only use this if you are
  # writing your daemon code as a fork of this component code.

  $self->LogMessage("daemon stopped: @args");
  exit(0);
}

#######################################################################
sub DaemonStart($$@) {
#######################################################################
  
  my $self = shift;  
  my $res = shift;
  my @args = @_;
  
  # This is the main daemon loop.
  # Normally, this will not exit. It will be terminated by
  # an INT signal which invokes a call to DaemonStop().
  
  $self->LogMessage("daemon started: version @V@ - @args");
  
  while (1) {
    $self->LogMessage("Hello World: server=$server");
    sleep(10);
  }
}
#######################################################################
sub createleasefile($$@) {
#######################################################################

  my $self = shift;  
  my $res = shift;
  my @args = @_;
  if ( ! -d $res->{'leasesdbdir'}->{VALUE} ) {
     mkpath($res->{'leasesdbdir'}->{VALUE});
  }
  if ( ! -f "$res->{'leasesdbdir'}/dhcpd.leases") {
      copy ('/dev/null', "$res->{'leasesdbdir'}/dhcpd.leases");
  }

}


#######################################################################
sub tidyconf($$@) {
#######################################################################
  my $self = shift;  
  my $res = shift;
  my @args = @_;
  my $file;
  if ( -d '@TMPDIR@' ){
     opendir (DIR, "@TMPDIR@");
     while (defined($file = readdir(DIR))){
       unlink("@TMPDIR@/$file");
     }
   }
}
#######################################################################
sub workoutnetmasks($$@) {
#######################################################################
  my $self = shift;  
  my $res = shift;
  my $subnets=shift;
  my $subnet;
# iterate round all the subnet definitions working out the network config

 foreach $subnet ((split / /,$res->{'subnets'}->{VALUE})) {

     $$subnets{$subnet}=new2 Net::Netmask($res->{"netnum_$subnet"}->{VALUE},$res->{"netmask_$subnet"}->{VALUE}) or $self->Info("INVALID SUBNET::".$Net::Netmask::error); 
 }


}
#######################################################################
sub genhostlisthashes($$@) {
#######################################################################
  my $self = shift;  
  my $res = shift;
  my $hostlists=shift;
  my $subnets=shift;
  my $subnet;
  my $subnetaddr;
  #iterate round all the subnet definitions creating files for the hostlists
  foreach $subnet (keys %$subnets) {
    $$hostlists{$subnet}={};
 
  }

}
#######################################################################
sub buildhostlists($$@) {
#######################################################################
  my $self = shift;  
  my $res = shift;
  my $hostlists=shift;
  my $subnets=shift;
  my $logofproblems=shift;
  my $hostlist=shift;
  my $host;
  my $lookuphostname;
  my $hostaddr;
  my $hostip;
  foreach $host (@$hostlist) {
    $self->Debug("processing $host") if ($self->{_DEBUG});
    if ( $res->{"hostname_".$host}->{VALUE}) {
       $lookuphostname=$res->{"hostname_".$host}->{VALUE};
   $self->Debug("Found alternative hostname $lookuphostname") if ($self->{_DEBUG});
    } else {
         $lookuphostname=$host;
    }
    $hostaddr=gethostbyname($lookuphostname);
    if ( defined($hostaddr)){
       $hostip=inet_ntoa($hostaddr);
       foreach my $key (keys %$subnets){
          if ( $subnets->{$key}->match($hostip)){
		$hostlists->{$key}->{$host}=$hostip;
          }
       }
       
    } else {
       $self->Warn("could not find ip address for $lookuphostname, contact host manager");
       $logofproblems->{$lookuphostname."ipaddr"}="could not find ip address for $lookuphostname\n";	
    }
  }
  
}
#######################################################################
sub gethwints($$@) {
#######################################################################
  my $self = shift;  
  my $res = shift;
  my $hwinterfaces = shift;
  my $hwints=Net::Ifconfig::Wrapper::Ifconfig('list', '', '', '');

  foreach my $key (keys %$hwints){
    my ($intaddr, $mask)=each(%{$hwints->{$key}{'inet'}});
    $hwinterfaces->{$key}=$intaddr;
  }  
}
#######################################################################
sub validatehost($$@) {
#######################################################################
  my $self = shift;  
  my $res = shift;
  my $maclist = shift;
  my $host= shift;
  my $logofproblems = shift;
  my $hostlists = shift;
  my $net = shift;
  my $nethosts = shift;
  my $args = shift;
  my $undefinedhosts = shift;
  my $hostname=hostname();
  my $clashhost="";
  #convert MAC address to 01:23:AB... format
  my %badmacs;
  my $mac=unimac($self,$host,$res->{"mac_".$host}->{VALUE});
  $res->{"mac_".$host}->{VALUE}=$mac;
  #Validate MAC address
  if ( $mac eq "INVALID"){
     $self->Info("Invalid binary mac address:too many bits");
  }elsif ( $mac =~ /^([0-9A-Fa-f]{1,2}(:|-)){5}[0-9A-Fa-f]{2}$/){
    if ($mac eq "00:00:00:00:00:00") {
      $self->Info("Host $host has undefined mac address defaulting to 00:00:00:00:00:00");
      push(@$undefinedhosts,$host);
    }elsif ($clashhost=$maclist->{$mac}){
      $self->Warn("Duplicate mac addresses $mac->$host and $mac->$clashhost defined on wire $net");
      #Ok, we won't put the second profile with the duplicate
      #mac address in, but we also need to remove the first one
      #from the list of hosts in this subnet.
      $nethosts =~ s/\s$clashhost\s/ /g;
      $logofproblems->{$clashhost."dupmac"}="Duplicate mac addresses $mac->$host and $mac->$clashhost defined on wire $net\nNeither host will be included in the dhcpd.conf file on ".$hostname."\n\n";
      $logofproblems->{$host."dupmac"}="Duplicate mac addresses $mac->$host and $mac->$clashhost defined on wire $net\nNeither host will be included in the dhcpd.conf file on ".$hostname."\n\n";
      $badmacs{$mac}=$host;
         
    } else {
      $maclist->{$mac}=$host;
      push(@$args,$host."_ipaddr=".$hostlists->{$net}->{$host});
      $$nethosts=$$nethosts." ".$host;
    }
  } else{
    $self->Warn("Invalid mac address $mac for host $host");
    $logofproblems->{$host."invalidmac"}="Invalid mac address $mac for host $host\n Dropping host from dhcpd.conf file on ".$hostname."\n";
  }
}
#######################################################################
sub unimac($$@) {
#######################################################################
  my $self = shift;
  my $host = shift;
  my $mac = shift;
  my $tmpmac;
  my $colon;
  my $pad;
  my $padding;
  my $size;

  #converting from binary just cos we can
  if ($mac =~ m/^[01]{1,48}$/){
    $self->Info("MAC address for $host is $mac\n");
    $self->Info("ok, who's the smart alec that's submitting mac addresses in binary");
    $size=length $mac;
    $padding=48 - $size;
    if ($size <49){
      for ($pad=0;$pad<$padding;$pad++){
        substr($mac,0,0) = "0";
      }
      $tmpmac= unpack("H*",pack("B*",$mac));
      for ($colon=2; $colon<15; $colon+=3){
        substr($tmpmac,$colon,0) = ":";
      }
    }else{
        $tmpmac="INVALID";
    } 
    $self->Info("$mac converted to $tmpmac");
    $mac=$tmpmac;
  }
  # convert to upperCASE
  $mac=uc($mac);
  # convert to : format
  $mac=~ s/-/:/g;
  
 return $mac;
    

}
#######################################################################
sub processsubnet($$@) {
#######################################################################
  my $self = shift;  
  my $res = shift;
  my $int = shift;
  my $hwinterfaces = shift;
  my $hostlists = shift;
  my $logofproblems = shift;
  my $subnets = shift;
  my $undefinedhosts = shift;
  my %maclist;
  my $intaddr=$hwinterfaces->{$int};
  my @args;
  my $nethosts="";
  my $hosts;
  my $host;
  my $res1;
  my $tmpres;
  my $status;
  my $nethosts;
  my $net;
  my $thingy=$hwinterfaces->{"eth0"};
  if (defined $hwinterfaces->{$int}){
    foreach $net (keys %$subnets){
      if ($subnets->{$net}->match($intaddr)){
        $nethosts="";
	$hosts=$hostlists->{$net};
	foreach $host (sort keys %$hosts){
          validatehost($self,$res,\%maclist,$host,$logofproblems,$hostlists,$net,\$nethosts,\@args,$undefinedhosts);
 	}

        $res1=LCFG::Resources::Parse('dhcpd',"s=".$net,"nethosts=".$nethosts,@args);

		
        $tmpres=LCFG::Resources::Merge({'dhcpd'=>$res},$res1);
        $status=LCFG::Template::Substitute ('@TEMPLATE@/dhcpd.conf.subnet',"@TMPDIR@/dhcpd.conf.subnet.".$net, 0, $tmpres->{'dhcpd'});
	unless (defined($status)) {
	  $self->LogMessage($@);
	  $self->Fail( "failed to create config file fragment @TMPDIR@/dhcpd.conf.subnet.$net (see logfile)");
  	}

      } 
    }
  }   
}

#######################################################################
sub testconfigfile($$@) {
#######################################################################
  my $self = shift;
  my $res = shift;
  my $confchanged = shift;
  my $tmpconf = shift;
  my $pid;
  my $status;
 $self->LogMessage("configuration changed") if ($confchanged==1);

  $status = system($dhcpdbin,"-t","-cf",$tmpconf);
  if ($status){
    $self->Info("$dhcpdbin configuration failure: $?") unless $status == 0;
    $self->Info("Falling back to last known good config") unless $status ==0;	
   }else{
    unlink $olddhcpdconfigfile;
    copy($dhcpdconfigfile,$olddhcpdconfigfile);
    copy($tmpconf,$dhcpdconfigfile);
   }

  if ( -f $pidfile ){
    (open(PIDFILE,"<$pidfile")) || ($self->Info("can't open pidfile: $?"));
    while(<PIDFILE>){
      chomp;
      $pid=$_;
    } 
    if ( -d "/proc/".$pid ){

      $status = system($dhcpdinitscript,"stop");
      $self->Error("can't stop the daemon: $?") unless $status == 0;
    }
  }
}

#######################################################################
sub mailprobs($$@) {
#######################################################################
  my $self = shift;
  my $res = shift;
  my $hostlist = shift;
  my $mailer = Mail::Mailer->new("sendmail");
  my $logofproblems = shift;
  my $undefinedhosts = shift;
  my @problemkeys;
  my $probhost;
  my $foundprob=0;
  my @problems;
  my $hostname=hostname();
  my $dhcpdmanager;
  my $line;
  my $hostmanager;
  my $subject="DHCPd component report ";
  @problemkeys=keys %$logofproblems;
  # mail log of problems to dhcpd bloke.
  if ( @problemkeys || @$undefinedhosts){
    ($dhcpdmanager=$res->{"dhcpdadmin"}->{VALUE}) || ($dhcpdmanager="root\@".$res->{"lcfgdomain"}->{VALUE});
    $self->Info("sending list of problems to $dhcpdmanager");
    $mailer->open({ From    => "root\@".$res->{"lcfgdomain"}->{VALUE},
                To      => $dhcpdmanager,
                Subject => "DHCPD Report from server $hostname",
              }) or die "Can't open: $!\n";
    foreach $line (@problemkeys) {      
      print $mailer $logofproblems->{$line};
    }
    print $mailer "\n\n---------------Undefined hosts----------------------------------------------\n";
    foreach $line (@$undefinedhosts){
      print $mailer "Undefined mac address for host ".$line." defaulting to 00:00:00:00:00:00\n";
    }

    foreach $probhost (@$hostlist) {
      $foundprob=0;
      @problems=();
 

      if ($res->{"mailmanager_".$probhost}->{VALUE} eq "true"){
        foreach my $problem ( @problemkeys ){
          if ( $problem =~ m/^$probhost/) {
            $foundprob=1;
            push (@problems,$logofproblems->{$problem});
          }
	} 
        if ($foundprob){
	  $hostmanager=$res->{"manageremail_".$probhost}->{VALUE};
$self->Info("sending email to $hostmanager for host $probhost");
	$hostmanager || ($hostmanager="root");
          $mailer->open({ From    => "root\@".$res->{"lcfgdomain"}->{VALUE},
            To      => $hostmanager,
            Subject => $subject." for host ".$probhost,
          }) or die "Can't open: $!\n";
          foreach $line (@problems) {
            print $mailer $line;
          }
        
        }
      }
    }
  }
}

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

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