#!/usr/bin/perl -T
#####################################################
#  gdips.pl             Part of GnuDIP 2.1.1        #
#                                                   #
#    This is the GnuDIP server daemon               #
#                                                   #
#    See COPYING for licensing information          #
#                                                   #
#       Mike Machado <mike@innercite.com>           #
#                                                   #
#####################################################



use DBI;
use MD5;
use Socket;
use Symbol;
use POSIX;
use Getopt::Std;
use strict;
my ($i, $sth, $sqldatetime);
require '/usr/share/gnudip/gnudip-lib.pl';

my $VER = "2.1.1";

my $gnudip2user = readconf('gnudipuser');
my $gnudip2pass = readconf('gnudippassword');
my $gnudip2server = readconf('gnudipserver');
my $runasuser = readconf('runasuser');
my $runasgroup = readconf('runasgroup');
my $pidfile = readconf('pidfile');
my $tmpdir = readconf('tmpdir');
my $queueinterval = readconf('queueinterval');

my $PORT = "3495";    # tcp port to listen


my %opts;
getopts('hl:', \%opts);
my $TIMEOUT = 5;

my $logging = 0;
my $log = '';
if (exists $opts{'l'}) {
  $logging = 1;
  $log = $opts{'l'};
}

if (exists $opts{'h'}) {
  print " gdips.pl [-l [logfile]]\n";
  exit(0);
}

if ($> != 0) {
  print "Must run as root!\n";
  exit 0;
}


open (PID, ">$pidfile");
print PID "$$\n";
close PID;

my $dbh = DBI->connect("DBI:mysql:gnudip2:$gnudip2server", $gnudip2user, $gnudip2pass);

my $prefref = getprefs();
my $ndc = $$prefref{'NDC_PATH'};

my @paths = split(/\//, $ndc);
my $path = '';
for (my $i = 1; $i < @paths - 1; $i++) {
  $path .= '/'.$paths[$i];
}
$ENV{PATH} = $path;
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

preparelog();

my $queuepid;
die "fork: $!" unless defined ($queuepid = fork);
if ($queuepid == 0) {
   watchqueue();
}
 

# Drop root priviledges....
my @grent = getgrnam($runasgroup);
($( = $) = $grent[2]) || die "Cannot drop root group permissions!";
my @pwent = getpwnam($runasuser);
($< = $> = $pwent[2]) || die "Cannot drop root permissions!";
    

my @chars = ( "A" .. "Z", "a" .. "z", 0 .. 9);

socket(SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, 1);

my $my_addr = sockaddr_in($PORT, INADDR_ANY);
bind(SERVER, $my_addr);

listen(SERVER, 10);

my $PREFORK = 3;
my $MAX_CLIENTS_PER_CHILD = 5;
my %children = ();
my $children = 0;

sub REAPER {
  $SIG{CHLD} = \&REAPER;
  my $pid = wait;
  $children--;
  delete $children{$pid};
}

sub HUNTSMAN {
  local($SIG{CHLD}) = 'IGNORE';
  kill 'INT' => keys %children;
  closelog();
  exit;
}

for (1 .. $PREFORK) {
  make_new_child();
}

$SIG{CHLD} = \&REAPER;
$SIG{INT} = \&HUNTSMAN;
$SIG{TERM} = \&HUNTSMAN;
$SIG{KILL} = \&HUNTSMAN; 

#print STDERR "GnuDIP daemon $VER started\n";
while (1) {
  sleep;
  for ($i = $children; $i < $PREFORK; $i++) {
   make_new_child();
  }
}

sub make_new_child {
  my $pid;
  my $sigset;
  my $response;

  $sigset = POSIX::SigSet->new(SIGINT);
  sigprocmask(SIG_BLOCK, $sigset) or die "Cannot block SIGINT for fork: $!\n";
  
  die "fork: $!" unless defined ($pid = fork);

  if ($pid) {
 
     sigprocmask(SIG_UNBLOCK, $sigset) or die "Cannot unblock SIGINT after fork $!\n";
     $children{$pid} = 1;
     $children++;
     return;

  } else {
    
     $SIG{INT} = 'DEFAULT';
     sigprocmask(SIG_UNBLOCK, $sigset) or die "Cannot unblock SIGINT after fork $!\n";

     for ($i = 0; $i < $MAX_CLIENTS_PER_CHILD; $i++) {
       my $client_addr = accept(CLIENT, SERVER);
       next if $client_addr eq '';
       my ($port, $packed_ip) = sockaddr_in($client_addr);
       my $ip = inet_ntoa($packed_ip);

       $sqldatetime = getdatetime();

       # print temp salt.
       select(CLIENT);
       $| = 1;
       select(STDOUT);

       # make 10 charator random digest
       my $sharedsecret = '';
       for (my $charcount = 0; $charcount < 10; $charcount++) {
        $sharedsecret .= $chars[ rand @chars ];
       }
       print CLIENT "$sharedsecret\n";

       my ($clientuser, $clientpass, $clientdomain, $clientaction);
       my $rin = '';
       vec($rin, fileno(CLIENT), 1) = 1;
       # only wait $TIMEOUT seconds for data, or else disconnect this session
       my $found = select($rin, undef, undef, $TIMEOUT);

       my $data;
       if ($found) {
          chomp($data = <CLIENT>);
          ($clientuser, $clientpass, $clientdomain, $clientaction) = split(/:/, $data);
       } else {
          $clientaction = "-1";
       }

       
       # a modify request
       if ($clientaction eq '0') {
          if ($$prefref{'DOMAIN_TYPE'} eq 'GLOBAL') {
              $sth = $dbh->prepare("select * from users where username = \"$clientuser\"");
          } elsif ($$prefref{'DOMAIN_TYPE'} eq 'INDIVIDUAL') {
              $sth = $dbh->prepare("select * from users where username = \"$clientuser\" and domain = \"$clientdomain\"");
          }
          $sth->execute;
          my @checkinfo = $sth->fetchrow_array;
          my $md5 = new MD5;
          $md5->add($checkinfo[2].'.'.$sharedsecret);
          my $digest = $md5->digest();
          my $checkpass = unpack("H*", $digest);

          if ($checkinfo[0] eq '') {
              print CLIENT "1\n";
              writelog("Invalid login attemp from $ip: user $clientuser.$clientdomain");
          } elsif (!($checkinfo[1] eq $clientuser && $checkpass eq $clientpass)) {
              print CLIENT "1\n";
              writelog("Invalid login attempt from $ip: user $clientuser.$clientdomain");
          } else {
              print CLIENT "0\n";
              if ($$prefref{'DOMAIN_TYPE'} eq 'GLOBAL') {
                  $sth = $dbh->do("update users set currentip = \"$ip\", updated = \"$sqldatetime\" where username = \"$clientuser\"");
	          $sth = $dbh->do("lock table queue write");
                  $sth = $dbh->do("delete from queue where hostname = \"$clientuser\"");
                  $sth = $dbh->do("insert into queue values \(\"\",\"$clientuser\",\"\",\"$ip\",\"MODIFY\"\)");


              } elsif ($$prefref{'DOMAIN_TYPE'} eq 'INDIVIDUAL') {
                  $sth = $dbh->do("update users set currentip = \"$ip\", updated = \"$sqldatetime\" where username = \"$clientuser\" and domain = \"$clientdomain\"");
	          $sth = $dbh->do("lock table queue write");
                  $sth = $dbh->do("delete from queue where hostname = \"$clientuser\" and domain = \"$clientdomain\"");
                  $sth = $dbh->do("insert into queue values \(\"\",\"$clientuser\",\"$clientdomain\",\"$ip\",\"MODIFY\"\)");
              }

	      $sth = $dbh->do("unlock tables");
              writelog("User $clientuser.$clientdomain successful update to ip $ip");
          } 

       # a offline request
       } elsif ($clientaction eq '1') {
          if ($$prefref{'DOMAIN_TYPE'} eq 'GLOBAL') {
              $sth = $dbh->prepare("select * from users where username = \"$clientuser\"");
          } elsif ($$prefref{'DOMAIN_TYPE'} eq 'INDIVIDUAL') {
              $sth = $dbh->prepare("select * from users where username = \"$clientuser\" and domain = \"$clientdomain\"");
          }
          $sth->execute;
          my @checkinfo = $sth->fetchrow_array;
          my $md5 = new MD5;
          $md5->add($checkinfo[2].'.'.$sharedsecret);
          my $digest = $md5->digest();
          my $checkpass = unpack("H*", $digest);

          if ($checkinfo[0] eq '') {
              print CLIENT "1\n";
              writelog("Invalid login attemp from $ip: user $clientuser.$clientdomain");
          } elsif (!($checkinfo[1] eq $clientuser && $checkpass eq $clientpass)) {
              print CLIENT "1\n";
              writelog("Invalid login attempt from $ip: user $clientuser.$clientdomain");
          } else {
              print CLIENT "2\n";
              if ($$prefref{'DOMAIN_TYPE'} eq 'GLOBAL') {
                  $sth = $dbh->do("update users set currentip = \"0.0.0.0\", updated = \"$sqldatetime\" where username = \"$clientuser\"");
	          $sth = $dbh->do("lock table queue write");
                  $sth = $dbh->do("delete from queue where hostname = \"$clientuser\"");
                  $sth = $dbh->do("insert into queue values \(\"\",\"$clientuser\",\"\",\"0.0.0.0\",\"REMOVE\"\)");
              } elsif ($$prefref{'DOMAIN_TYPE'} eq 'INDIVIDUAL') {
                  $sth = $dbh->do("update users set currentip = \"0.0.0.0\", updated = \"$sqldatetime\" where username = \"$clientuser\" and domain = \"$clientdomain\"");
	          $sth = $dbh->do("lock table queue write");
                  $sth = $dbh->do("delete from queue where hostname = \"$clientuser\" and domain = \"$clientdomain\"");
                  $sth = $dbh->do("insert into queue values \(\"\",\"$clientuser\",\"$clientdomain\",\"0.0.0.0\",\"REMOVE\"\)");
              }
	      $sth = $dbh->do("unlock tables");
              writelog("User $clientuser.$clientdomain successful remove from ip $ip");
          } 
       } elsif ($clientaction eq '-1') {
          writelog("Timed out receiving session data from $ip");
          print CLIENT "-1\n";
       } elsif ($clientaction eq '-2') {
          writelog("Expected readlen too large from $ip");
          print CLIENT "-1\n";
       } else {
          writelog("Unknown response from $ip");
          print CLIENT "-1\n";
       }
     }

     exit;
  }
}


#### Get prefs
sub getprefs {
 my %PREF;
 $sth = $dbh->prepare("select * from globalprefs");
 $sth->execute;
 while (my @prefs = $sth->fetchrow_array) {
   $PREF{$prefs[1]} = $prefs[2];
 }
 return \%PREF;

}           


### Prepare log
sub preparelog {

  if ($logging && $log ne '') {
      if ($log =~ /^([-\@\w\.\/.]+)$/) {
          $log = $1;                     # $log now untainted
      } else {
          die "Bad log file name $log";
      } 
    open(LOG,">> $log") || warn "Could not open $log for append $!";
    select(LOG);
    $| = 1;
    select(STDOUT);
  }

}

### Write to the log, syslog or stdout
sub writelog {

  my $logstr = shift;
  my $today = getdatetime();

  if ($logging) {
    if ($log ne '') {
       print LOG "[$today] $logstr\n" || print "cannot write to log";
    } else {
       print STDOUT "[$today] $logstr\n";
    }
  }

}


# close open log file
sub closelog {

  if ($logging && $log ne '') {
    close(LOG);
  }

}

# call readqueue $queueint seconds to edit the zonefiles
sub watchqueue {

 while (1) {
  readqueue();
  sleep $queueinterval;
 }
}


# reads the queue and writes the entries to the zone files and reloads named
sub readqueue {

  my $sth;

  #### load all domain configurations
  my %DOM;
  $DOM{$$prefref{'GNUDIP_DOMAIN'}} = [$$prefref{'ZONEFILE'}, $$prefref{'ZONETYPE'}, $$prefref{'ALLOW_CHANGE_PASS'}, $$prefref{'ADD_SELF'}, $$prefref{'ALLOW_CHANGE_HOSTNAME'}];

  $sth = $dbh->prepare("select * from domains");
  $sth->execute;
  while (my @domains = $sth->fetchrow_array) {
    $DOM{$domains[1]} = [$domains[2], $domains[3], $domains[4], $domains[5], $domains[6]];
  }
  $sth->finish;


  #### Get queued entries
  $sth = $dbh->do("lock tables queue write") || die "Unable to lock table queue $!\n";
  $sth = $dbh->prepare("select * from queue");
  $sth->execute;

  #### Get all the queued entries and store them in a hash
  my %NEWRECS;
  while (my @zonerecs = $sth->fetchrow_array) {
    if ($zonerecs[2] eq '') {
       my $idx = 0;
       foreach my $key (keys %DOM) {
         $NEWRECS{$zonerecs[0].'.'.$idx} = [$zonerecs[1], $key, $zonerecs[3], $zonerecs[4]];
         $idx++;
       }
    } else {
       $NEWRECS{$zonerecs[0]} = [$zonerecs[1], $zonerecs[2], $zonerecs[3], $zonerecs[4]];
    }
  }
  $sth->finish;

  $sth = $dbh->do("delete from queue");
  $sth = $dbh->do("unlock tables");

  my %SORTDOM;
  foreach my $key (keys %NEWRECS) {
     push (@{$SORTDOM{$NEWRECS{$key}->[1]}}, $key);
  }

  my $needsreload = 0;
  foreach my $key (keys %SORTDOM) {
    $needsreload = 1;

    next if !$DOM{$key};

    die "Encountered symbolic link\n" if -l "$tmpdir/gnudip2.$$";

    open(ZONE,"$DOM{$key}->[0]") || warn "Could not open zone file $DOM{$key}->[0]\n";
    open(TEMP,">$tmpdir/gnudip2.$$") || die "Could not open temp file for writing\n";
    my $x = 1;
    my $serial = 0;
    while (<ZONE>) {
      if ($x eq '2' && $DOM{$key}->[1] eq "STANDALONE") {
         my ($space,$serial) = split(/\t+/);
         $serial++;
         print TEMP "\t\t$serial\t; serial  \n";
      } else {
         my ($host,$rec,$addr) = split(/\t+/);  
         my $dup = "NO";
         foreach my $newhost (@{$SORTDOM{$key}}) {
           if ($host eq @{$NEWRECS{$newhost}}->[0]) {
              $dup = "YES";
           }
         }
         if ($dup ne "YES") {
           print TEMP $_;
         }
      }
      $x++;
     }
    foreach my $newrec (@{$SORTDOM{$key}}) {
       my @printrecs = @{$NEWRECS{$newrec}};
        # just dont print the line if its a REMOVE. do a split and and then an if for a REMOVE
       print TEMP "$printrecs[0]\tIN\tA\t$printrecs[2]\n" if $printrecs[3] eq 'MODIFY';

    }
    close(TEMP);
    close(ZONE);          
    system("/bin/cp","$tmpdir/gnudip2.$$","$DOM{$key}->[0]");
    unlink("$tmpdir/gnudip2.$$");
  
  }

  system("$ndc reload 1>/dev/null 2>/dev/null") if $needsreload;

}