#!/usr/bin/perl -w

package gserv;

######################################################################
#                                                                    #
#          Round Robin Server                                        #
#           - websockets, telnet, http, raw                          #
#           - fully bidirectional non-blocking, all systems          #
#                                                                    #
#          (C) 2017 Domero                                           #
#          ALL RIGHTS RESERVED                                       #
#                                                                    #
#      Events:                                                       #
#                                                                    #
#      connect: an uninitialized client has connected on TCP/IP      #
#      handshake: a client has performed an initializing handshake   #
#      input: a client received a message from the server            #
#      quit: a client has quit the connection                        #
#      error: a client has encountered an error                      #
#      telnet: a client is running under telnet                      #
#      http: a client is running under HTTP                          #
#      websockets: a client is running under WebSockets              #
#      sent: a block data has finished sending to the server         #
#                                                                    #
#      Errors:                                                       #
#                                                                    #
#         1 Server has been terminated                               #
#         2 Ping Timeout                                             #
#       400 Bad request                                              #
#       408 Request timeout                                          #
#       426 Upgrade required                                         #
#      1002 Protocol error                                           #
#      1009 Insufficient storage                                     #
#                                                                    #
######################################################################

use strict;
use warnings;
use Socket;
use IO::Handle;
use IO::Select;
use POSIX qw(:sys_wait_h EAGAIN EBUSY);
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
use Time::HiRes qw(usleep gettimeofday);
use Digest::SHA1 qw(sha1);
use Digest::MD5 qw(md5);
use utf8;
use gutil;
use gpost;
use HTTP::Date;
use Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

$VERSION     = '1.5.3';
@ISA         = qw(Exporter);
@EXPORT      = ();
@EXPORT_OK   = qw();

my $CID = 0;

1;

sub init {
  my ($clienthandle,$clientloop) = @_;
  if (ref($clienthandle) ne 'CODE') {
    die "Eureka server could not initialize: No clienthandle given."
  }
  if (ref($clientloop) ne 'CODE') {
    die "Eureka server could not initialize: No clientloop-handle given."
  }
  my $self = {
    name => "Eureka Server $VERSION by Chaosje (C) 2017 Domero",      # Server name
    version => $VERSION,                     # server version
    verbose => 1,                            # Output to STDOUT
    debug => 0,                              # verbose everything
    websocketmode => 0,                      # Only allow websocket connections
    linemode => 0,                           # Split lines even in raw mode
    killhttp => 0,                           # kill http-clients automatically when done with output
    httpresponse => undef,                   # \&func($client): array (http-response lines without \r\n)
    maxdatasize => 52428800,                 # 50MB, Maximum data-size which may be received in one package (websockets) (must be more than 65534)
    pingtime => 30,                          # seconds on ilde to check we're still alive
    pingtimeout => 5,                        # seconds for clients to respond on ping with pong before ping-timeout
    verbosepingpong => 0,                    # Verbose ping/pong requests and responses
    verboseheader => 0,                      # Verbose the HTTP-header
    timeout => 10,                           # Seconds to connect to server before timeout (0=unlimited)
    buffersize => 1024,                      # Bytes to read from socket at loop-passes
    server => {
      loopwait => 1000,                      # Main wait-time if idle in nanoseconds (1000000/number of user to expect)
      port => 12345,                         # port to connect to
      clienttimeout => 20,                   # time the server will respond to clients, 0 = no timeout
      starttime => 0,                        # time in usec when server was started.
      running => 0,                          # Is the server running?
    },
    userlist => {},                          # allowed logins
    clients => [],                           # connected clients for round robin
    current => 0,                            # current executing process
    numclients => 0,                         # number of connected clients
    maxclients => 1000,                      # maximum connections allowed (0 = unlimited)
    allowedip => [
      '10.*',      
      '192.168.*',      
      '127.0.0.1',
    ],                                       # allowed IP's, leave empty ([]) for all.
    idletimeout => 0,                        # kills a client on X seconds of inactivity (0 = no timeout)
    clienthandle => $clienthandle,           # handle called whenever there is a client-method
    clientloop => $clientloop,               # handle called on every processing loop
    activeclient => undef,                   # set when a process is in active handling to signal from outside
  };
  bless($self);
  return $self
}

sub start {
  my ($self,$autoloop) = @_;
  if ($self->{debug}) { $self->{verbosepingpong}=1 }
  if ($self->{maxdatasize}<65535) { $self->{maxdatasize}=65535 } # (websockets) allow a minimum of 64Kb data packets.
  # 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, 1<<16) or die "Can't set socket's receive buffer: $!";
  setsockopt($self->{server}{socket}, SOL_SOCKET, SO_SNDBUF, 1<<18) or die "Can't set socket's send 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);
  if ($^O =~ /win/i) {
    my $nonblocking=1;
    ioctl($self->{server}{socket}, 0x8004667e, \$nonblocking);
  } 

  $self->{server}{running}=1;

  $self->{start}=gettimeofday();

  if ($self->{verbose}) {
    print STDOUT "Server '$self->{name}' started on port $self->{server}{port}\n"
  }
  if ($autoloop) {
    while ($self->{server}{running}) {
      $self->takeloop
    }
  }
  return $self
}

sub takeloop {
  my ($self) = @_;
  if (!$self->{server}{running}) { return }
  my $client;
  if (($self->{numclients}<$self->{maxclients}) || ($self->{maxclients} == 0)) {
    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);
      my ($port,$iph) = sockaddr_in($client_addr); 
      my $ip = inet_ntoa($iph);
      my $socketerr=0;
      if ($^O =~ /win/i) {
        # Non-blocking for Windows. _IOW('f', 126, u_long)
        my $nonblocking = 1; ioctl($client, 0x8004667e, \$nonblocking);
      } else {
        # And just to make sure it is non-blocking a third method (nobody knows all systems)
        my $flags = fcntl($client, F_GETFL, 0) or $socketerr=1;
        $flags = fcntl($client, F_SETFL, $flags | O_NONBLOCK) or $socketerr=1;
        if ($socketerr) {
          print STDOUT "ERROR [$ip\:$port] Cannot set non-blocking mode on socket!\n";
          close($client)
        }
      }    

      # find out who connected 
      my $valid=0;
      foreach my $aip (@{$self->{allowedip}}) {
        if ($aip eq '*') { $valid=1; last }
        if ($ip =~ /$aip/) { $valid=1 }
      }
      if (!$valid) {
        if ($self->{verbose}) {
          print STDOUT "ILLEGAL ACCESS: $ip\:$port\n"
        }  
        close($client)        
      } elsif (!$socketerr) {  
        my $tm=gettimeofday();
        my $host=gethostbyaddr($iph, AF_INET);
        $CID++;
        my $cdata = {
          id => $CID,
          socket => $client,
          handle => $client_addr,
          host => $host,
          ip => $ip,
          iphandle => $iph,
          port => $port,
          start => $tm,
          last => $tm,
          keepalive => 1,
          pingtime => $self->{pingtime},
          pingtimeout => $self->{pingtimeout},
          pings => {},
          telnet => 0,
          telnetfirst => 0,
          httpmode => 0,
          httpreadheader => 0,
          httpheader => {},
          websockets => 0,
          killme => 0,
          killafteroutput => 0,
          curline => "",
          init => 1,
          verbosepingpong => $self->{verbosepingpong},
          outputmode => 0,
          outputbuffer => "",
          outputpointer => 0,
          outputlength => 0,
          httpreadpost => 0,
          postdata => [],
          post => {},
          selector => IO::Select->new($client)
        };
        push @{$self->{clients}},$cdata;
        $self->{numclients}++;
        if ($self->{verbose}) {
          print STDOUT "JOIN $ip\:$port ($host)\n"
        }
        my $func=$self->{clienthandle};
        &$func('connect',$cdata)
      }  
    }
  }
  if ($self->{numclients}) {
    # We probably got work to do!
    my $start=gettimeofday();
    $self->{deleteflag}=0;
    $self->handleclient();
    $self->{activeclient}=undef;
    if (!$self->{deleteflag}) { $self->{current}++; }
    if ($self->{current}>=$self->{numclients}) {
      $self->{current}=0
    }
    my $end=gettimeofday();
    if (($end<$start) || ($end-$start<$self->{server}{loopwait})) {
      my $dtm=$self->{server}{loopwait}-($end-$start);
      usleep($dtm)
    }
  } else {
    # Get some sleep
    usleep($self->{server}{loopwait})
  }
}

sub removeclient {
  my ($self) = @_;
  my $last=$self->{numclients}-1;
  if ($self->{numclients}==1) {
    $self->{clients}=[]
  } elsif ($self->{current}==0) {
    $self->{clients}=[ @{$self->{clients}}[1..$last] ]
  } elsif ($self->{current}==$last) {
    $self->{clients}=[ @{$self->{clients}}[0..$last-1] ]
  } else {
    $self->{clients}=[ @{$self->{clients}}[0..$self->{current}-1],@{$self->{clients}}[$self->{current}+1..$last] ]
  }
  $self->{numclients}--;    
}

sub deleteclient {
  my ($self,$client) = @_;
  $self->{activeclient}=undef;
  if (!$client || $client->{closed}) { 
    print STDERR "!! ERROR - DELETE CLIENT ON CLOSED CLIENT !!\n";
    return
  }
  $client->{selector}->remove($client->{socket});
  my $func=$self->{clienthandle};
  # Signal WebSocket server to delete client and round things up.
  &$func('quit',$client);
  $client->{closed}=1;
  my $ip=$client->{ip}; my $port=$client->{port};
  if ($client->{socket}) { close($client->{socket}); }
  if ($self->{verbose}) {
    print STDOUT "QUIT $ip\:$port\n"
  }
  $self->removeclient();
  $self->{deleteflag}=1;
  $self->{dontsend}=1
}

sub wschardecode {
  my ($client,$key)=@_;
  my $pos=$client->{wsbufferread} & 3;
  return chr($key ^ $client->{wsmask}[$pos]);
}

sub wsmessage {
  my ($self,$client,$msg,$command) = @_;
  if (!defined($msg) && !defined($command)) { return }  
  if (!$command) { $command='text' }
  if (!$client || (ref($client) ne 'HASH') || $client->{killme} || $client->{closed} || $client->{dontsend}) { return }
  my $out=chr(129);
  if ($command eq 'binary') {
    $out=chr(130)
  } elsif ($command eq 'pong') {
    if ($client->{verbosepingpong}) {
      print STDOUT "*> PONG $client->{ip}\:$client->{port} $msg\n";
    }
    $out=chr(138);
  } elsif ($command eq 'ping') {
    if ($client->{verbosepingpong}) {
      print STDOUT "*> PING $client->{ip}\:$client->{port} $msg\n";
    }
    $out=chr(137)
  } elsif ($command eq 'close') {
    $out=chr(136);
    if ($msg =~ /^([0-9]+) (.+)/) {
      my $code=$1; my $txt=$2; utf8::encode($txt);
      $code=chr($code>>8).chr($code & 255);
      $msg=$code.$txt;
    } else {
      my $code=chr(1000>>8).chr(1000 & 255); utf8::encode($msg);
      $msg=$code.$msg
    }
  }
  my $len=length($msg);
  if ($len<126) {
    $out.=chr($len)
  } elsif ($len<65536) {
    $out.=chr(126);
    $out.=chr($len>>8).chr($len & 255)
  } else {
    $out.=chr(127);
    my $tout=chr(0)x8;
    my $p=7;
    while ($len>0) {
      my $val=$len & 255;
      substr($tout,$p,1)=chr($val);
      $len>>=8; $p--;
      if ($p<0) { last } # 128 bit computers ;)
    }
    $out.=$tout;
  }
  out($client,$out.$msg)
}

sub decbin {
  # 32 bit decimal->string
  my ($dn) = @_; my $bs=""; my $cnt=4;
  while ($dn>0) {
    my $sn=$dn % 256; 
    $bs=chr($sn).$bs; 
    $dn>>=8; $cnt--;
  }
  $bs=(chr(0)x$cnt).$bs; 
  return $bs
}

sub out {
  my ($client,$data) = @_;
  if ($client->{outputmode}) {
    $client->{outputbuffer}.=$data;
    $client->{outputlength}+=length($data);
  } else {
    $client->{outputmode}=1;
    $client->{outputbuffer}=$data;
    $client->{outputlength}=length($data);
    $client->{outputpointer}=0
  }
}

sub makewshandshake {
  my ($key1,$key2,$key3) = @_;
  my $sum=md5(decbin($key1).decbin($key2).$key3);
  return $sum;
}

sub handleclient {
  my ($self) = @_;
  my $client=$self->{clients}[$self->{current}];
  if ($client->{closed}) { return }
  $self->{activeclient}=$client;
  if ($client->{killme}) { $self->deleteclient($client); return }
  my $sock=$client->{socket};
  my $func=$self->{clienthandle};
  if (!$sock) { $self->deleteclient($client); return }
  if ($self->{timeout}) {
    if ($client->{init}) {
      if ($client->{httpreadheader}) {
        my $tm=gettimeofday();
        if ($tm-$client->{start}>$self->{timeout}) {
          if ($sock) { print $sock "HTTP/1.1 408 REQUEST TIMEOUT\r\n\r\n"; }
          &$func('error',$client,408);
          $self->deleteclient($client); return
        }
      } elsif (gettimeofday()-$client->{start}>=$self->{timeout}) {
        $client->{telnet}=1;
        $client->{telnetfirst}=1;
        my $func=$self->{clienthandle};
        &$func('telnet',$client);
        $client->{init}=0
      }
    }
  } else {
    $self->{timeout}=$client->{start}+20
  }
  my $loopfunc=$self->{clientloop};
  &$loopfunc($client);
  if ($client->{killme}) { $self->deleteclient($client); return }
  if ($client->{outputmode}) {
    # output max 64Kb data, if socket is ready

    my @ready = $client->{selector}->can_write(0);
    my $canwrite=0;
    foreach my $handle (@ready) {
      if ($handle == $sock) {
        $canwrite=1; last
      }
    }
    $client->{last}=gettimeofday();
    if ($canwrite) { 
      if ($client->{outputpointer} >= $client->{outputlength}) {
        # we're done
        if ($self->{killhttp} && $client->{httpmode}) {
          $self->deleteclient($client); return
        } else {
          &$func('sent',$client,$client->{outputlength})
        }
        $client->{outputmode}=0;
      }
      if ($client->{outputmode}) {
        my $sz=65536;
        if ($client->{outputpointer}+$sz > $client->{outputlength}) {
          $sz=$client->{outputlength}-$client->{outputpointer}      
        }
        print $sock substr($client->{outputbuffer},$client->{outputpointer},$sz);
        $client->{outputpointer}+=$sz
      }
    } elsif ($client->{httpmode}) {
      # HTTP only needs to output at this stage
      return
    }
    if ($client->{killafteroutput}) {
      $self->deleteclient($client); return
    }
  }
  my @ready = $client->{selector}->can_read(0);
  my $canread=0;
  foreach my $handle (@ready) {
    if ($handle == $sock) {
      $canread=1; last     
    }
  }
  my $inbuf="";
  if ($canread) {
    recv($sock,$inbuf,$self->{buffersize},0);
    if ($inbuf eq "") {
      if (($! != EAGAIN) && ($! != EBUSY) && ($! != 10035)) { 
        # 10035 = WSAEWOULDBLOCK (Windows sucking non-blocking sockets)
        if ($!) {
          if ($self->{verbose}) {
            my $err=0+$!;
            print STDOUT "ERROR $client->{ip}\:$client->{port} [$err] $!\n";
            $client->{dontsend}=1;
            &$func('error',$client,$err)
          }
          $self->deleteclient($client); return
        }  
      }
    }
  }  
  if (($inbuf eq "") && (length($client->{curline}))) {
    $inbuf=$client->{curline}; $client->{curline}=""
  }
  if ($inbuf ne "") {
    if ($self->{debug}) {
      print "INBUF: '$inbuf' (".length($inbuf).")\n";
    }
    if ($client->{init}) {
      if (ord(substr($inbuf,0,1))==255) {
        if ($self->{websocketmode}) {
          print STDOUT "ERROR $client->{ip}\:$client->{port} [TELNET = NO WEBSOCKET CLIENT]\n";
          if ($sock) { print $sock "HTTP/1.1 400 BAD REQUEST\r\n\r\n"; }
          &$func('error',$client,400);
          $self->deleteclient($client); return
        }
        $client->{telnet}=1;
        $client->{telnetfirst}=1;
        my $func=$self->{clienthandle};
        &$func('telnet',$client);
        # negate Telnet ident string
        $inbuf="";
        # Output human message
        $client->{keepalive}=1;
        $client->{init}=0;
        return
      } elsif ($inbuf =~ /^GET ([^\s]+) HTTP\/([0-1.]+)/i) {
        $client->{httpmode}=1;
        $client->{httpreadheader}=1;
        $client->{httpheader}{uri}=$1;
        $client->{httpheader}{version}=$2;
        $client->{httpheader}{method}='get';
        &$func('http',$client)
      } elsif ($inbuf =~ /^POST ([^\s]+) HTTP\/([0-1.]+)/i) {
        $client->{httpmode}=1;
        $client->{httpreadheader}=1;
        $client->{httpheader}{uri}=$1;
        $client->{httpheader}{version}=$2;
        $client->{httpheader}{method}='post';
        &$func('http',$client)
      } elsif ($self->{websocketmode}) {
        print STDOUT "ERROR $client->{ip}\:$client->{port} [RAW = NO WEBSOCKET CLIENT]\n";
        if ($sock) { print $sock "HTTP/1.1 400 BAD REQUEST\r\n\r\n"; }
        &$func('error',$client,400);
        $self->deleteclient($client); return
      }
      $client->{init}=0;
    }
    $client->{last}=gettimeofday();
    if ($client->{websockets}) {
      # WebSockets v13 - Not the easiest protocol ever..
      # RFC 6455
      my $len=length($inbuf);
      my $pos=0;
      while ($pos<$len) {
        my $byte=ord(substr($inbuf,$pos,1)); $pos++;
        if ($client->{wsreadheader}) {
          if (!$client->{wsreadmode}) {
            # get fin & opcode
            $client->{wsfinalframe}=$byte>>7;
            if (!$client->{wsopcode}) {
              my $opc=$byte & 15;
              if ($opc) { $client->{wsopcode}=$opc }
            }
            $client->{wsreadmode}=1
          } elsif ($client->{wsreadmode}==1) {
            # get length first byte
            $client->{wsmaskpresent}=$byte>>7;
            # RFC 6455: All frames sent from client to server have this bit set to 1.
            if (!$client->{wsmaskpresent}) {
              $self->wsmessage($client,"1002 Protocol Error",'close');
              $client->{dontsend}=1;
              &$func('error',$client,1002);
              $client->{killafteroutput}=1
            }
            $client->{wspayload}=$byte & 127;
            $client->{wsmask}=[];
            if ($client->{wspayload}==126) {
              $client->{wsreadmode}=2; $client->{wsreadlen}=0; $client->{wspayload}=0;
            } elsif ($client->{wspayload}==127) {
              $client->{wsreadmode}=3; $client->{wsreadlen}=0; $client->{wspayload}=0;
            } else {
              $client->{wsreadmode}=4
            }
          } elsif ($client->{wsreadmode}==2) {
            $client->{wspayload}=($client->{wspayload}<<8)+$byte;
            $client->{wsreadlen}++;
            if ($client->{wsreadlen}==2) {
              if ($client->{wspayload}<126) {
                # RFC 6455: Smallest datasize MUST be used!
                $self->wsmessage($client,"1002 Protocol Error",'close');
                $client->{dontsend}=1;
                &$func('error',$client,1002);
                $client->{killafteroutput}=1
              }
              $client->{wsreadmode}=4
            }
          } elsif ($client->{wsreadmode}==3) {
            my $var = 5000000000; $var++; 
            if ($var != 5000000001) {
              # not 64 bit!!!
              $self->wsmessage($client,"1009 Insufficient Storage",'close');
              &$func('error',$client,1009);
              $client->{killafteroutput}=1
            }
            $client->{wspayload}=($client->{wspayload}<<8)+$byte;
            $client->{wsreadlen}++;
            if ($client->{wspayload}>$self->{maxdatasize}) {
              # TOO LARGE DATA !!! COMPUTERS ARE ALWAYS LIMITED !!! READ TANENBAUM !!!
              $self->wsmessage($client,"1009 Insufficient Storage",'close');
              &$func('error',$client,1009);
              $client->{killafteroutput}=1
            }
            if ($client->{wsreadlen}==8) {
              if ($client->{wspayload}<65536) {
                # RFC 6455: Smallest datasize MUST be used!
                $self->wsmessage($client,"1002 Protocol Error",'close');
                $client->{dontsend}=1;
                &$func('error',$client,1002);
                $client->{killafteroutput}=1
              }
              $client->{wsreadmode}=4
            }
          } elsif ($client->{wsreadmode}==4) {
            # RFC 6455 Masking bytes MUST be present
            push @{$client->{wsmask}},$byte;
            if ($#{$client->{wsmask}}==3) {
              # Done reading header !!
              $client->{wsreadmode}=0; # reset for next run.
              if (!$client->{wspayload}) {
                # package with no data! so don't reset: we're ready to read a new header!
                if ($client->{wsopcode}==8) {
                  $self->deleteclient($client); return
                } elsif (($client->{wsopcode}==9) && $client->{wsfinalframe}) {
                  # Ping with no body..
                  if ($client->{verbosepingpong}) {
                    print STDOUT "*< PING $client->{ip}\:$client->{port}\n";
                  }
                  $self->wsmessage($client,"",'pong')
                } elsif (($client->{wsopcode}==10) && $client->{wsfinalframe}) {
                  if ($client->{verbosepingpong}) {
                    print STDOUT "*< PONG $client->{ip}\:$client->{port}\n";
                  }
                  $client->{pingtimeouttime}=0
                }
                # else nothing to do
              } else {
                $client->{wsreadheader}=0; # we're ready to read data!
                $client->{wsbuffer}="";
                $client->{wsbufferread}=0;
              }
            }
          }
        }
        else {
          # read websocket payload
          $client->{wsbuffer}.=gserv::wschardecode($client,$byte);
          $client->{wsbufferread}++;
          if ($client->{wsbufferread}==$client->{wspayload}) {
            $client->{wsreadheader}=1;
            $client->{wsdata}.=$client->{wsbuffer};
            $client->{wsbuffer}="";
            $client->{wsbufferread}=0;
            if ($client->{wsfinalframe}) {
              if ($client->{wsopcode}==10) {
                if ($client->{verbosepingpong}) {
                  print STDOUT "*< PONG $client->{ip}\:$client->{port} $client->{wsdata}\n";
                }
                if (!$client->{pings}{$client->{wsdata}}) {
                  #print STDOUT "*>! INVALID PONG $client->{ip}\:$client->{port} ($client->{wsdata})\n";
                  #&$func('error',$client,1008);
                  #$self->wsmessage($client,"1008 Invalid pong",'close');
                  #$self->deleteclient($client); return
                } else {
                  delete $client->{pings}{$client->{wsdata}};
                }
                $client->{pingtimeouttime}=0
              } elsif ($client->{wsopcode}==9) {
                if ($client->{verbosepingpong}) {
                  print STDOUT "*< PING $client->{ip}\:$client->{port} $client->{wsdata}\n";
                }
                $self->wsmessage($client,$client->{wsdata},'pong')
              } elsif ($client->{wsopcode}==8) {
                $client->{dontsend}=1;
                $self->deleteclient($client); return
              } else {
                # We've collected all data from 1 or more frames.. finally we can output!
                if (!$client->{telnetfirst}) {
                  &$func("input",$client,$client->{wsdata})
                } else {
                  $client->{telnetfirst}=0
                }
              }
              $client->{wsdata}=""; $client->{wsopcode}=0
            }
          }
        }        
      }
    } else {
      # process what we read, split on \n, and keep the rest to process next time
      # print "* PROCESS '$inbuf' *\n";
      if (!$client->{httpmode} && !$client->{telnet} && !$self->{linemode}) {
        # print "RAW: '$inbuf' (".length($inbuf).")\n";
        &$func('input',$client,$inbuf); return
      }
      my @lines=(); my $data=$client->{curline}.$inbuf; $data =~ s/\r\n/\n/g; $data =~ s/\n\r/\n/g; $data =~ s/\r/\n/g;
      my $line; my $ll=0; my $pos=0; my $len=length($data);
      while ($pos<$len) {
        my $c=substr($data,$pos,1);
        if (ord($c) == 10) {
          if ($ll || $client->{httpreadheader}) {
            push @lines,$line; $line=""; $ll=0
          }
        } else {
          $line.=$c; $ll++
        }
        $pos++
      }
      $client->{curline}=$line;
      foreach my $line (@lines) {
        if ($client->{httpreadpost}) {
          $client->{postdata}.=$line."\n"
        } elsif ($client->{httpreadheader}) {
          my ($key,$val) = split(/: /,$line);
          if (!$key && !$val) {
            $client->{httpreadheader}=0;
            if ($client->{httpheader}{method} eq 'post') {
              $client->{httpreadpost}=1
            } else {
              $self->httphandshake($client)
            }
          } else {
            $key=lc($key); # !!!!
            if ($key !~ /http\/[0-9.]/i) {
              $client->{httpheader}{$key}=$val;
              if ($self->{verboseheader}) {
                print "[HEADER] '$key' => '$val'\n"
              }
            }
          }
        } else {
          if (!$client->{killme}) {
            &$func('input',$client,$line);
          }
        }
      }  
      if ($client->{killme}) { $self->deleteclient($client); return }
    }
  } elsif ($self->{httpreadpost}) {
    $client->{post}=gpost::init($client->{httpheader}{'content-type'},$client->{postdata});
    $self->{httpreadpost}=0;
    $self->httphandshake($client)
  } elsif ($self->{idletimeout} && (gettimeofday()-$client->{last}>=$self->{server}{clienttimeout})) { 
    if ($sock) { print $sock "HTTP/1.1 408 REQUEST TIMEOUT\r\n\r\n"; }
    &$func('error',$client,408);
    $self->deleteclient($client); return
  } elsif ($self->{server}{clienttimeout} && (!$client->{keepalive} && (gettimeofday()-$client->{last}>=$self->{server}{clienttimeout}))) {
    if ($sock) { print $sock "HTTP/1.1 408 REQUEST TIMEOUT\r\n\r\n"; }
    &$func('error',$client,408);
    $self->deleteclient($client); return
  } elsif ($client->{websockets}) {
    if ($client->{pingtime}) {
      if (gettimeofday()-$client->{last}>$client->{pingtime}) {
        if (!$client->{pingtimeouttime}) {
          $client->{pingtimeouttime}=gettimeofday();
          my $pingmsg='eureka'.int(rand(1000000)+100000);
          $client->{pings}{$pingmsg}=1;
          $self->wsmessage($client,$pingmsg,'ping');
          if ($client->{verbosepingpong}) {
            print STDOUT "> PING $client->{ip} $client->{port} $pingmsg\n"
          }
        }
        elsif (gettimeofday()-$client->{pingtimeouttime}>$client->{pingtimeout}) {
          # ping timeout !!!
          $client->{pingtimeouttime}=0;
          $self->wsmessage($client,"2 PING TimeOut","close");
          print STDOUT ">! PING TIMEOUT $client->{ip}\:$client->{port}\n";
          $client->{killafteroutput}=1
        }
      }
    }
  }
  # I just so love it ;)
}

sub decode_websocket {
  my @k=@_;
  my @s=(0,0);
  my @n=("","");
  for (my $i=0;$i<=1;$i++) {
    for (my $c=0;$c<length($k[$i]);$c++) {
      my $cc=substr($k[$i],$c,1);
      if ($cc eq ' ') { $s[$i]++ }
      elsif ($cc =~ /[0-9]/) { $n[$i].=$cc }
      # else negate!!
    }
    if ($s[$i]==0) {
      # This may never be the case!
      return (0,0)
    } else {
      $k[$i]=int $n[$i]/$s[$i];
    }
  }
  return @k
}

sub httphandshake {
  my ($self,$client) = @_;
  my @out=();
  my $sock=$client->{socket};
  my $func=$self->{clienthandle};
  my $date=time2str();
  if ((defined $client->{httpheader}{upgrade}) && ($client->{httpheader}{upgrade} =~ /websocket/i)) {
#  print "#[-1]#\r\n";
    $client->{wsreadheader}=1;
    $client->{wsheadermode}=0;
    $client->{wsdata}="";
    # WebSockets connection, so do handshake!
    # VERSION HyBi 00
    if ($client->{httpheader}{'sec-websocket-key1'}) {

      # wybi00 is vulnerable!!!
      print STDOUT "[WEBSOCKET HyBi00]\n";
      if ($sock) { print $sock "HTTP/1.1 400 BAD REQUEST\r\nSec-WebSocket-Version: 13\r\n\r\n"; }
      $client->{killme}=1;
      return;
    }
    # VERSION HyBi 06
    $client->{websockets}=1;
    $client->{websocketprotocol}='hybi06';
    my $handshake=$client->{httpheader}{'sec-websocket-key'};    
    $handshake.="258EAFA5-E914-47DA-95CA-C5AB0DC85B11";
    $handshake = sha1($handshake);
    $handshake = gutil::encode_base64($handshake,1);
    $handshake = ${$handshake};
    push @out,"HTTP/1.1 101 Switching Protocols";
    push @out,"Upgrade: WebSocket";
    push @out,"Connection: Upgrade";
    push @out,"Sec-WebSocket-Accept: ".$handshake;
  } elsif ($self->{websocketmode}) {
    push @out,"HTTP/1.1 426 UPGRADE REQUIRED";
    &$func('error',$client,426);
    $client->{killme}=1
  } else {
    if ($self->{httpresponse}) {
      my $f=$self->{httpresponse};
      push @out,&$f($client)
    } else {
      push @out,"HTTP/1.1 200 OK";
      push @out,"Accept: text/plain";
      push @out,"Date: $date";
      push @out,"Server: Eureka $VERSION (C) 2017 Domero";
      push @out,"Connection: close";
      push @out,"Content-Type: text/plain; charset=UTF-8";
    }
  }
  my $data=join("\r\n",@out)."\r\n\r\n";
  if ($sock) { print $sock $data; }
  if (!$client->{killme}) {
    my $func=$self->{clienthandle};
    &$func('handshake',$client)
  }
}

sub broadcast {
  my ($self,$message)=@_;
  foreach my $c (@{$self->{clients}}) {
    if ($c && !$c->{killme} && !$c->{closed} && !$c->{dontsend}) {
      my $sock=$c->{socket};
      if ($sock) { print $sock $message }
    }
  }
}

sub wsbroadcast {
  my ($self,$message)=@_;
  foreach my $c (@{$self->{clients}}) {
    $self->wsmessage($c,$message)
  }
}

sub broadcastfunc {
  my ($self,$func)=@_;
  if (ref($func) ne 'CODE') { die "gserv.broadcastfunc: Not a code reference" }
  foreach my $c (@{$self->{clients}}) {
    if ($c && !$c->{killme} && !$c->{closed} && !$c->{dontsend}) {
      &$func($c)
    }
  }
}

sub quit {
  my ($self)=@_;  
  if (!$self->{server}{running}) { return }
  my $func=$self->{clienthandle};
  for (my $i=0;$i<$self->{numclients};$i++) {
    my $client=$self->{clients}[$i];
    &$func('error',$client,1);
    &$func('quit',$client);
    my $sock=$client->{socket};
    if ($sock) { close($sock) }
  }
  my $sock=$self->{server}{socket};
  if ($sock) { close($sock); }
  $self->{server}{running}=0;
  $self->{clients} = [];
  $self->{current} = 0;
  $self->{numclients} = 0;
  if ($self->{verbose}) {
    print STDOUT "Server $self->{name} stopped!\n"
  }
}

# EOF