Internet server Simba 1.4 | Experimental async

program new;

type
  TClientAcceptTimer = type TMMLTimer;

  TInternetClient = record
    ID: Int32;
    IP, Port: string;
  end;

  PInternetServer = ^TInternetServer;
  TInternetServer = record
    ID: Int32;
    IP, Port: string;
    AcceptTimer: TClientAcceptTimer;
    ClientQueue: array of TInternetClient;
    Requests: Int32;
  end;


var
  Server: TInternetServer;


// SPINLOCK
var
  critical: Int32;

{$IFDEF LINUX}
function CAS(x: ^Int32; y, z: Int32): Int32; static; external '__sync_val_compare_and_swap@libgcc_s.so.1 cdecl';
{$ELSE}{$IFDEF WINDOWS}
function CAS(x: ^Int32; y,z: Int32): Int32; static; external 'InterlockedCompareExchange@Kernel32.dll ' + {$IFDEF CPU386}'stdcall'{$ELSE}'win64'{$ENDIF};
{$ENDIF}{$ENDIF}

procedure AcquireLock(Lock: Int32);
begin
  repeat
    if CAS(@Lock, 1, 0) = 0 then Exit;
  until False;
end;

procedure ReleaseLock(Lock: Int32);
begin
  Lock := 0;
end;

// ------------------------------------



procedure TInternetClient.WriteString(s: string);
begin
  SendSocket(Self.ID, s);
end;

function TInternetClient.Read(bytes: Int32): string;
begin
  Result := RecvSocketEx(Self.ID, bytes);
end;

procedure TInternetClient.SetTimeout(Time: Int32);
begin
  SetSocketTimeout(Self.ID, Time);
end;

procedure TInternetClient.CloseAndFree();
begin
  CloseSocket(Self.ID);
  FreeSocket(Self.ID);
  Self.ID := -1;
end;


// -----------------------------------

procedure AsyncAcceptClient(Sender: TObject);
var
  client,i: Int32;
begin
  with Server do
  begin
    AcquireLock(critical);
    begin
      for i:=High(clientQueue) downto 0 do
        if clientQueue[i].ID = -1 then
          Delete(clientQueue, i, 1);
    end;
    ReleaseLock(critical);

    client := AcceptSocket(Server.ID);

    AcquireLock(critical);
    begin
      clientQueue += [client,'',''];
      SocketInfo(client, clientQueue[High(clientQueue)].IP, clientQueue[High(clientQueue)].Port);
      Requests += 1;
    end;
    ReleaseLock(critical);
  end;
end;

function TInternetServer.Create(IP: string; Port: string): TInternetServer; static;
var f: Int32;
begin
  Result.ID   := CreateSocket();
  Result.IP   := IP;
  Result.Port := Port;
  BindSocket(Result.ID, Result.IP, Result.Port);
  ListenSocket(Result.ID);
end;

function TInternetServer.AcceptClients(): TInternetClient;
begin
  Self.AcceptTimer.Init();
  Self.AcceptTimer.SetInterval(128);
  Self.AcceptTimer.SetOnTimer(@AsyncAcceptClient);
  Self.AcceptTimer.SetEnabled(True);
end;

procedure TInternetServer.CloseAndFree();
begin
  CloseSocket(Self.ID);
  FreeSocket(Self.ID);
end;

procedure TInternetServer.HandleClient(var Client: TInternetClient);
var
  Data,IP, port: string;
begin
  if Client.ID <= 0 then Exit;
  Client.SetTimeout(1000*30); // 30 sec before we release without ping | cant keep it open for no reason

  AcquireLock(critical);
  Self.Requests -= 1;         // We are handling one of the requests, reduce
  ReleaseLock(critical);

  Writeln('Connection from: ', Client.IP, ':', Client.port);
  while True do
  begin
    try
      Data += Client.Read(1);

      if Pos('GET', Data) <> 0  then // Some expected string
      begin
        WriteLn('<<< ', Data);
        Client.WriteString('TAKE THAT BACK!');
        Data := '';
      end;

      if Pos('EXIT', Data) <> 0  then // Some expected string
      begin
        break;
      end;

    except
      AcquireLock(critical);
      Self.ID := -1; // so the thread clears it
      ReleaseLock(critical);

      Exit;          // socket auto closed and free'd on timeout
    end;
  end;

  AcquireLock(critical);
  Client.CloseAndFree();
  ReleaseLock(critical);
end;

procedure Main;
var
  client: TInternetClient;
begin
  Server := TInternetServer.Create('127.0.0.1', '27015'); // Example IP and Port
  Server.AcceptClients();

  while True do
  begin
    client := [];

    AcquireLock(critical);
    begin
      if Server.Requests <> 0 then
        client := Server.ClientQueue[High(Server.ClientQueue)];
    end;
    ReleaseLock(critical);


    if client <> [] then
      Server.HandleClient(client);

    Sleep(1000);
  end;

  Server.CloseAndFree();
end;

begin
  Main;
end.