#!/usr/bin/perl -w

# DBMS Server 
#-------------------- 

package dbmserver;

use strict; 
use Socket;
use IO::Handle;
use Carp; 
use Time::HiRes qw ( usleep gettimeofday );
use POSIX ":sys_wait_h";
use Errno;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);

sub spawn;  # forward declaration

use dbs;
my $dbms=dbs::init(); 

my $self={
  version => '1.0.1',                    # Current version
  logfile => '/var/log/dbms.log',        # Create a logfile
  pidfile => '/dbms/dbms.pid',           # Define PIDfile
  verbose => 1,                          # Output messages to console
  loopwait => 1000,                      # Main wait-time (usec)
  port => 10101,                         # port to connect to
  pid => $$,                             # our PID 
  keepalive => 0,                        # Timeout the client off/on
  httpmode => 0,                         # http mode on/off
  first => 1,                            # output intro-message
  clienttimeout => 20,                   # time the server will respond to clients
  iplist => {                            # List of allowed IPs or future other functions (like report abuse)
    '192.168.1.12' => 1,
    '192.168.1.7' => 1
  }  
};
if ($^O =~ /win/i) {
  # local development mode.. delete this later!
  $self->{logfile}='D:/Chaosje/projects/dbms/dbms.log';
  $self->{pidfile}='D:/Chaosje/projects/dbms/dbms.pid';
}  
bless($self);
if (-e $self->{pidfile}) {
  my $f=$self->{pidfile};
  open(F,"<$f"); my $p=<F>; close F; chomp($p);
  kill 9 => $p
}
`echo $self->{pid} > $self->{pidfile}`;
start();
exit 1;

sub message {
  my ($msg) = @_;
  my @tm=split(/ /,scalar localtime);
  my $tms=$tm[4]; if ($tms !~ /:/) { $tms=$tm[3] }
  if ($self->{logfile}) {
    my $fh=$self->{loghandle};
    print $fh $msg."\n"
  }
  if ($self->{verbose}) {
    print STDOUT "[".$tms."] ".$msg."\n"
  }
}

sub legalip {
  my ($ip) = @_;
  if ($self->{iplist}{$ip}) { return 1 }
  return 0
}  

sub REAPER {
  local $!;   # don't let waitpid() overwrite current error
  while ((my $waitedpid = waitpid(-1,WNOHANG)) > 0 && WIFEXITED($?)) {
    if ($self->{verbose}) {
      message("Reaped PID=$waitedpid" . ($? ? " with exit $?" : ''))
    }
  }
  $SIG{CHLD} = \&REAPER;  # loathe SysV  
}

sub quitme {
  $self->{quit}=1
}

sub start {
  if ($self->{logfile}) {
    open($self->{loghandle},">>$self->{logfile}") || die "Can't open logfile '$self->{logfile}'"
  }

  select(STDOUT); $|=1;

  my $proto = getprotobyname('tcp'); 

  # create a socket, make it reusable 
  socket($self->{server}, PF_INET, SOCK_STREAM, $proto) or die "Can't open socket: $!"; 
  setsockopt($self->{server}, SOL_SOCKET, SO_REUSEADDR, 1) or die "Can't set socket: $!";
  setsockopt($self->{server}, SOL_SOCKET, SO_RCVBUF, 512) or die "Can't set socket's receive buffer: $!";

  $self->{server}->autoflush(1);

  # grab a port on this machine 
  my $paddr = sockaddr_in($self->{port}, INADDR_ANY); 

  # bind to a port, then listen 
  bind($self->{server}, $paddr) or die "Can't bind to address $paddr: $!"; 
  listen($self->{server}, SOMAXCONN) or die "Server can't listen: $!";

  message("Eureka DBMS $self->{version}");

  my $t=scalar localtime; message($t);
  message("Server started on port $self->{port} PID=$self->{pid}\n"); 

  $self->{quit}=0;

  $SIG{CHLD} = \&REAPER;
  $SIG{INT} = \&quitme;

  # accepting a connection 
  while (!$self->{quit}) {
    $self->{client_addr} = accept($self->{client}, $self->{server}) || do {
    # try again if accept() returned because a signal was received
      next if $!{EINTR};
      die "Server could not accept client: $!";
    };
    if ($self->{client_addr}) {

      # make sure binmode
      binmode($self->{client});

      # Autoflush must be on
      my $s=$self->{client};
      $s->autoflush(1);

      # Non-blocking for UNIX. Always a harmless function but won't always work!      
      $self->{client}->blocking(0);

      if ($^O =~ /win/i) {
        # Non-blocking for Windows.
        my $nonblocking = 1;
        ioctl($self->{client}, 0x8004667e, \$nonblocking);
      } else {
	      # Old non-blocking for obsolete systems, won't work under Win32!
        my $flags = fcntl($self->{client}, F_GETFL, 0) or die "Can't get flags for the socket: $!\n";
        $flags = fcntl($self->{client}, F_SETFL, $flags | O_NONBLOCK) or die "Can't set flags for the socket: $!\n}";
      }		

      # find out who connected 
      ($self->{client_port}, $self->{client_ip}) = sockaddr_in($self->{client_addr}); 
      $self->{client_ipnum} = inet_ntoa($self->{client_ip});
#        $self->{client_host} = gethostbyaddr($self->{client_ip}, AF_INET)

      # activate client though a fork
      if (legalip($self->{client_ipnum})) {      
        spawn();
      } else {
        message("ILLIGAL ACCESS [ $self->{client_ipnum} ]")
      }        

      # All done, Close this client and reap the fork later.
      close $self->{client};
    } else {
      usleep($self->{loopwait})
    }
  }
  message("Server Quit. Goodbye!")
}

sub spawn {
  my $pid;
  if (! defined($pid = fork)) {
    message("Cannot fork server: $!");
    return;
  } 
  elsif ($pid) {
    message("SPAWN $self->{client_ipnum}\:$self->{client_port} PID=$pid");
    return; # I'm the parent
  }
  # Client
  handleclient();
  exit 1
}

sub out {
  my ($msg) = @_;
  my $sock=$self->{client};
  print $sock $msg."\r\n"
}

sub handleclient {
  # Read client and respond 
  my $sock=$self->{client};
  $dbms->setsocket($sock);
  $self->{start}=gettimeofday();
  my @lines=(); my $curline=""; my $init=1;
  while (!$self->{quit} && (gettimeofday()-$self->{start}<$self->{clienttimeout})) {
    my $inbuf;
    recv($sock,$inbuf,512,0);
    if ($inbuf) {
      message("INBUF ".chomp($inbuf)." ".length($inbuf));
      $self->{first}=0;
      if ($init) {
        if (ord(substr($inbuf,0,1))==255) {
          # negate Telnet ident string
          $inbuf="";
          out("Eureka DBMS $self->{version}");
        }
        $init=0
      }
      $self->{start}=gettimeofday();
      # process what we read, split on \n, and keep the rest to process next time
      my @lines=split(/\n/,$inbuf);
      if ($#lines>=0) {
        $lines[0]=$curline.$lines[0];
        $curline=pop @lines;
      }
      if ((ord(substr($curline,length($curline)-1,1)) == 13) || (ord(substr($curline,length($curline)-1,1)) == 10)) {
        # We read the full line, so mark to process
        push @lines,$curline; $curline="";
      }
      # process all full lines
      foreach my $line (@lines) {
        $line =~ s/[\r\n]//g;
        if ($line || $self->{httpmode}) {
          processinput($line)
        }
      }
    } elsif ($self->{first} && (gettimeofday()-$self->{start}>1)) {
      # Welcome for Raw human connection
      out("Eureka DBMS $self->{version}");
      $self->{first}=0
    }
    if ($self->{keepalive}) {
      $self->{start}=gettimeofday();
    }  
  }
  if (!$self->{quit} && (gettimeofday()-$self->{start}>3)) {
    if (!$self->{httpmode}) {
      out("Timed out.. Goodbye!");
      usleep(2000000);
    }
  }
}

sub processinput {
  my ($line) = @_;
  if (!$line) {
    if ($self->{httpmode}) {
      $self->{httpread}=0;
      eval("use dbms::http; dbms::http::init(\$self);");
      if($@){ out($@) }
      return;
    }
  }
  if ($self->{httpread}) {
    push @{$self->{httphead}},$line;
    return
  }
  if ($line =~ /HTTP\/[0-9]\.[0-9]/) {
    $self->{httphead}=[$line];
    $self->{httpmode}=1;
    $self->{httpread}=1;
    $self->{first}=0;
    return
  }
  if ($line =~ /^hello/i) { out("Hello $self->{client_ipnum}\:$self->{client_port}"); return }
  if ($line =~ /^quit/i) { exit 1 }
  if ($line =~ /^exit/i) { exit 1 }
  if ($line =~ /^ka/i) { $self->{keepalive}=1; out("OK"); return }
  if (!$dbms->{loggedin}) {
    if ($line =~ /^login\s(.+)$/i) {
      $dbms->login($1); return
    }
  } else {   
   if ($line =~ /^terminate/i) {
     # TODO: IP-filter switch! (admin mode)
     kill 9 => $self->{pid}; exit 1
    }
    $dbms->handleinput($line); return
  }
  out("ERR")
}