Internet server Simba 1.4 | Experimental async

program new;
{$I SRL/osr.simba}

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;


// GLOBAL 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 '[email protected] ' + {$IFDEF CPU386}'stdcall'{$ELSE}'win64'{$ENDIF};
{$ENDIF}{$ENDIF}


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

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

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



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

function TInternetClient.ReadStr(): string;
begin
  Result := RecvSocketStr(Self.ID);
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
  try CloseSocket(Self.ID); except end;
  FreeSocket(Self.ID);
  Self.ID := -1;
end;


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

procedure AsyncAcceptClient(Sender: TObject);
var
  client,i: Int32;
begin
  while True do
    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(ID);

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

      Sleep(1);
    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(1000); //not needed, we loop in the thread
  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
  tmp, header: string;
  content: string;
  t: Double;
begin
  t := PerformanceTimer();

  if Client.ID <= 0 then Exit;
  try
    Client.SetTimeout(2000); // 2 sec before we release without ping | cant keep it open for no reason
  except
    Client.CloseAndFree();
    Exit;
  end;

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

  Writeln('>>> Connection from: ', Client.IP, ':', Client.port);

  (* Get headers *)
  repeat
    try
      tmp := Client.ReadStr();
      header += tmp;
    except
      AcquireLock(critical);
      Client.CloseAndFree();
      ReleaseLock(critical);
      Exit;
    end;
  until tmp = '';

  try
    (* Reply with OK *)
    Content := '<b>Welcome to my simba webserver</b><br \><br \> Result produced in '+ ToStr(Round(PerformanceTimer() - t,6))+ 'ms';
    Client.WriteString('HTTP/1.1 200 OK'+#13#10);
    Client.WriteString('Content-Type: text/html'+#13#10);
    Client.WriteString('Connection: close'+#13#10);
    Client.WriteString('Content-Length: ' + IntToStr(Length(Content))+#13#10#13#10);
    Client.WriteString(Content);
    WriteLn('>>> Content data sent!');
  except
    Client.CloseAndFree();
    Exit; // client is DC'ed.
  end;

  AcquireLock(critical);
  try
    Client.CloseAndFree();
  except end;
  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(1);
  end;

  Server.CloseAndFree();
end;

begin
  Main;
end.