#!/usr/bin/perl

###################################################
#                                                 #
#       EUREKA GENERAL SERVER 1.0.1               #
#       Round Robin Version                       #
#       (C) Domero, Groningen NL                  #
#       (C) Michel Kuipers, Ceres van Rijn        #
#          chaosje@gmail.com                      #
#                                                 #
###################################################

package cleanserver_roundrobin;

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

my $QUIT=0;
$SIG{INT} = \&quitme;

1;

sub quitme {
  $QUIT=1
}

sub start {
  my $self = {
    version => '1.0.1',                      # Current version
    password => 'h4ckm3',                    # Password to connect
    verbose => 1,                            # Output messages to console
    logfile => '/var/log/dbms.log',          # Create a logfile, leave undef for none
    server => {
      loopwait => 1000,                      # Main wait-time if idle in microsec
      port => 12345,                         # port to connect to
      clienttimeout => 20,                   # time the server will respond to clients
    },
    client => [],                            # connected clients for round robin
    current => 0,                            # current executing process
    numclients => 0,                         # number of connected clients
  };
  bless($self);
  if ($self->{logfile}) {
    open($self->{loghandle},">>$self->{logfile}") || die "Can't open logfile '$self->{logfile}'"
  }
  $self->run();
  $self->kernel();
}

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

sub run {
  my ($self) = @_;
  # Auto flush and select Console
  select(STDOUT); $|=1;

  # Setup TCP/IP 
  my $proto = getprotobyname('tcp'); 

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

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

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

  # set autoflush on
  $self->{server}{socket}->autoflush(1);

  # set server accept to non-blocking, otherwise the server will block waiting
  IO::Handle::blocking($self->{server}{socket},0);

  $self->message("Eureka Server $self->{version} (C) 2012 Chaosje\@gmail.com");

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

sub kernel {
  my ($self) = @_;
  while (!$QUIT) {
    my $client;
    my $client_addr = accept($client, $self->{server}{socket});
    if ($client_addr) {
      # :) Let's help the patient

      # make sure binmode
      binmode($client);

      # Autoflush must be on
      $client->autoflush(1);

      # Non-blocking for UNIX. Won't harm other systems
      $client->blocking(0);
      if ($^O eq 'MSWin32') {
        # Non-blocking for Windows.
        my $nonblocking = 1;
        ioctl($client, 0x8004667e, \$nonblocking);
      }
      # And just to make sure it is non-blocking a third method (nobody knows all systems)
      my $flags = fcntl($client, F_GETFL, 0) or die "Can't get flags for the socket: $!\n";
      $flags = fcntl($client, F_SETFL, $flags | O_NONBLOCK) or die "Can't set flags for the socket: $!\n";

      # find out who connected 
      my ($port,$iph) = sockaddr_in($client_addr); 
      my $ip = inet_ntoa($iph);
# enable to resolve hosts (SLOW!)
#     my $host = gethostbyaddr($iph, AF_INET);
      my $tm=gettimeofday();
      push @{$self->{client}}, {
        socket => $client,
        handle => $client_addr,
        ip => $ip,
        iphandle => $iph,
        port => $port,
        flags => $flags,
        start => $tm,
        last => $tm,
        keepalive => 0,
        loggedin => 0,
        httpmode => 0,
        httpreadheader => 0,
        httpheader => [],
        passtry => 0,
        killme => 0,
        buffer => "",
        init => 1,
        curline => "",
#       host => $host,
      };
      $self->message("START $ip\:$port");
      $self->{numclients}++;
    }
    if ($self->{numclients}) {
      # We got work to do!
      $self->handleclient;
      $self->{current}++;
      if ($self->{current}>=$self->{numclients}) {
        $self->{current}=0
      }
    } else {
      # Get some sleep
      usleep($self->{server}{loopwait})
    }
  }
  $self->message("Server quit!")
}

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

sub deleteclient {
  my ($self,$client) = @_;
  my $last=$self->{numclients}-1;
  my $ip=$client->{ip}; my $port=$client->{port}; my $sock=$client->{socket};
  if ($client->{keepalive}) {
    $self->out($client,"Goodbye!");
    usleep(3000000)
  }
  close($sock);
  if ($self->{numclients}==1) {
    $self->{client}=[]
  } elsif ($self->{current}==0) {
    $self->{client}=[ @{$self->{client}}[1..$last] ]
  } elsif ($self->{current}==$last) {
    $self->{client}=[ @{$self->{client}}[0..$last-1] ]
  } else {
    $self->{client}=[ @{$self->{client}}[0..$self->{current}-1],@{$self->{client}}[$self->{current}+1..$last] ]
  }
  $self->message("QUIT $ip\:$port");
  $self->{numclients}--
}

sub telnetmessage {
  my ($self,$client,$txt) = @_;
  if (!$txt) {
    $self->out($client,("*"x34))
  } elsif ($txt eq ' ') {
    $self->out($client)
  } else {
    my $r=30-length($txt); my $d=$r>>1;
    my $m="* ".(" "x$d).$txt.(" "x$d);
    if ($r % 2) { $m.=" " } $m.=" *";
    $self->out($client,$m)
  }
}    

sub handleclient {
  my ($self) = @_;
  my $client=$self->{client}[$self->{current}];
  my $sock=$client->{socket};
  my $inbuf;
  recv($sock,$inbuf,512,0);
  if (!$inbuf) {
    if (($! != EAGAIN) && ($! != EBUSY)) {
      if ($!) { $self->message("ERR $self->{ip}\:$self->{client} $!") }
      $self->deleteclient($client)
    }
  }
  if ($inbuf) {
#    $self->message("INBUF $inbuf ".length($inbuf));
    if ($client->{init}) {
      if (ord(substr($inbuf,0,1))==255) {
        # negate Telnet ident string
        $inbuf="";
        # Output human message
        $self->telnetmessage($client);
        $self->telnetmessage($client,"Eureka Server $self->{version}");
        $self->telnetmessage($client);
        $self->telnetmessage($client," ");
        $client->{keepalive}=1
      }
      $client->{init}=0
    }
    $client->{last}=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]=$client->{curline}.$lines[0];
      $client->{curline}=pop @lines;
    }
    if ((ord(substr($client->{curline},length($client->{curline})-1,1)) == 13) || (ord(substr($client->{curline},length($client->{curline})-1,1)) == 10)) {
      # We read the full line, so mark to process
      push @lines,$client->{curline}; $client->{curline}="";
    }
    # process all full lines
    foreach my $line (@lines) {
      $line =~ s/[\r\n]//g;
      if ($line || $self->{httpmode}) {
        $self->processinput($client,$line);
      }
      if ($client->{killme}) { $self->deleteclient($client); last }
    }
  } elsif (!$client->{keepalive} && (gettimeofday()-$client->{last}>=$self->{server}{clienttimeout})) {
    $self->out($client,"TIMEOUT");
    $self->deleteclient($client)
  }
}

sub processinput {
  my ($self,$client,$data) = @_;
  my $sock=$client->{socket};
  if (($data =~ /^quit/i) || ($data =~ /^exit/i)) {
    $client->{killme}=1;
    return
  }
  if ($data =~ /^hello/i) {
    my $tm=gettimeofday();
    $self->out($client,"HELLO $client->{ip} $client->{port} $client->{start} $tm");
    return 
  }
  if ($data =~ /^(GET|POST)\sHTTP\/[0-9]\.[0-9]/) {
    $client->{httpmode}=1; $self->{httpreadheader}=1
  }
  if ($client->{httpreadheader}) {
    if (!$data) {
      $client->{httpreadheader}=0
    } else {
      push @{$client->{httpheader}},$data
    }
    return
  }
  if ($data =~ /^login\s(.+)$/i) {
    if ($1 eq $self->{password}) {
      $client->{loggedin}=1
    } elsif ($client->{keepalive}) {
      # human connection on telnet probably, but if computer... so allow 3 logins
      $client->{passtry}++;
      if ($client->{passtry}==3) {
        $client->{killme}=1;
        $self->out($client,"Too many tries, sorry my friend.")
      } else {
        $self->out($client,"Illegal password. Try again.")
      }
    } else {
      # computers should have the password!
      $client->{killme}=1
    }
    return
  }
  if ($client->{loggedin}) {
    # And here you go! No thanks, just enjoy, chaosje@gmail.com for comments
    if ($client->{httpmode}) {
      # parse http
    } elsif ($client->{keepalive}) {
      # parse telnet
    } else {
      # parse raw 
    }
    # add at will and mail me please :)
  }
}
