Prevent TIdTcpServer Stuck Connections

Question

how are you? I come here ask for a solution, how prevent TIdTcpServer stuck connections?

Version of indy 10.6.2.5341 and Rad Studio 10.1 Berlin

On both images show the number of connections on TIdTcpServer, these numbers are retrieved from this function:

var
  NumClients: Integer;
begin
  with Form1.IdTCPServer1.Contexts.LockList do
  try
    NumClients := Count;
  finally
    Form1.IdTCPServer1.Contexts.UnlockList;
  end;

  Result := NumClients;

What happen is, in almost cases this numbers only increase and not decrease. so i believe connections are being stucked on TIdTcpServer.

I use a IdSchedulerOfThreadDefault1 on Scheduler, i don't know if that change something or no but i added.

For manage connections i use ContextClass:

IdTCPServer1.ContextClass := TClientContext;

Who definition is:

    type
  TCommand = (
    cmdConnect,
    cmdDisconnect,
    cmdHWID,
    cmdScreenShotData,
    cmdMensagem);

type
  TClient = record
    HWID  : String[40];
    Tempo : TDateTime;
    Msg   : String[100];
end;

const
  szClient = SizeOf(TClient);

type
  TProtocol = record
    Command: TCommand;
    Sender: TClient;
    DataSize: Integer;
end;

const
  szProtocol = SizeOf(TProtocol);

type
  TClientContext = class(TIdServerContext)
  private
    FCriticalSection  : TCriticalSection;
    FClient           : TClient;
  public
    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
    destructor Destroy; override;
  public
    procedure Lock;
    procedure Unlock;
  public
    property Client: TClient read FClient write FClient;
end;

Others functions who are used:

procedure InitProtocol(var AProtocol: TProtocol);
begin
  FillChar(AProtocol, szProtocol, 0);
end;

function ProtocolToBytes(const AProtocol: TProtocol): TBytes;
begin
  SetLength(Result, szProtocol);
  Move(AProtocol, Result[0], szProtocol);
end;

constructor TClientContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
  inherited Create(AConnection, AYarn, AList);
  FCriticalSection := TCriticalSection.Create;
end;

destructor TClientContext.Destroy;
begin
  FreeAndNil(FCriticalSection);
  inherited;
end;

procedure TClientContext.Lock;
begin
  FCriticalSection.Enter;
end;

procedure TClientContext.Unlock;
begin
  FCriticalSection.Leave;
end;

function BytesToProtocol(const ABytes: TBytes): TProtocol;
begin
  Move(ABytes[0], Result, szProtocol);
end;

procedure ClearBuffer(var ABuffer: TBytes);
begin
  SetLength(ABuffer, 0);
end;

procedure ClearBufferId(var ABuffer: TIdBytes);
begin
  SetLength(ABuffer, 0);
end;

All events (connect/disconnect) i manage on IdTCPServer1Execute like this example above:

    type
  PTBytes   = ^TBytes;
  PTIdBytes = ^TIdBytes;
var
  LBuffer     : TIdBytes;
  LProtocol   : TProtocol;
  FTempBuffer : TIdBytes;

  Enviar    : TBytes;
  Protocolo : TProtocol;

  Conexao   : TClientContext;

  //

  Queue: TStringList;
  List: TStringList;
  x : Integer;

  //

  procedure AddToMemo(const AStr: string);
  begin
    TThread.Synchronize(nil,
      procedure
      begin
        Memo1.Lines.Add(AStr);
        Form1.StatusBar1.Panels[0].Text := Format('Connections [%d]', [RetornaOn]);
      end
    );
  end;
begin
  Conexao := TClientContext(AContext);

  // QUEUE

  List := nil;
  try
    Queue := Conexao.Queue.Lock;
    try
      if Queue.Count > 0 then
      begin
        List := TStringList.Create;
        List.Assign(Queue);
        Queue.Clear;
      end;
    finally
      Conexao.Queue.Unlock;
    end;

    if List <> nil then
    begin
      for x := 0 to List.Count-1 do
      begin
        InitProtocol(Protocolo);

        Protocolo.Command     := cmdMensagem;
        Protocolo.Sender.Msg  := Edit2.Text;
        Enviar                := ProtocolToBytes(Protocolo);

        Conexao.Connection.IOHandler.Write(PTIdBytes(@Enviar)^);

        ClearBuffer(Enviar);
      end;

      // Delete Queue

      for x := 0 to List.Count-1 do
      begin
        List.Delete(x);
      end;
    end;
  finally
    List.Free;
  end;

  // QUEUE

  if AContext.Connection.IOHandler.InputBufferIsEmpty then
  begin
    //AddToMemo(Format('[%s] Running 1 ...', [TimeToStr(Now)]));

    AContext.Connection.IOHandler.CheckForDataOnSource(100);
    AContext.Connection.IOHandler.CheckForDisconnect;
    if AContext.Connection.IOHandler.InputBufferIsEmpty then
    begin
      {AddToMemo(Format('[%s] Running 2 ...', [TimeToStr(Now)]));

      if GetTickDiff(Conexao.Client.Tick, Ticks) >= 10000 then
      begin
        AddToMemo(Format('[%s] Running 3 [%d] ...', [TimeToStr(Now), Conexao.Client.Tick]));

        AContext.Connection.Disconnect;
        Exit;
      end;}

      Exit;
    end;
  end;

  AContext.Connection.IOHandler.ReadBytes(LBuffer, szProtocol, False);

  LProtocol := BytesToProtocol(PTBytes(@LBuffer)^);

  case LProtocol.Command of
    cmdConnect: begin
      Conexao.Client := LProtocol.Sender;
      Conexao.FClient.Tick := Ticks;


        AddToMemo(Format('[%s] : [%s][%s]', ['Connect', AContext.Connection.Socket.Binding.PeerIP, Protocolo.Sender.HWID]));
    end;

    cmdMensagem: begin
      AddToMemo(Format('[%s] : [%s][%s][%s]', ['Msg', AContext.Connection.Socket.Binding.PeerIP, Conexao.Client.HWID, LProtocol.Sender.Msg]));
    end;

    cmdDisconnect: begin
      AddToMemo(Format('[%s] : [%s][%s]', ['Disconnect', AContext.Connection.Socket.Binding.PeerIP, Conexao.Client.HWID]));
    end;
  end;

In next code i show how client side connect to TIdTcpServer:

type
  PTIdBytes = ^TIdBytes;
var
  LBuffer   : TBytes;
  LProtocol : TProtocol;
begin
  ClientThread := TClientThread.Create(False);

  InitProtocol(LProtocol);
  LProtocol.Command       := cmdConnect;
  LProtocol.Sender.HWID   := Edit1.Text;
  LProtocol.Sender.Tempo  := Now;
  LBuffer                 := ProtocolToBytes(LProtocol);
  IdTCPClient1.IOHandler.Write(PTIdBytes(@LBuffer)^);
  ClearBuffer(LBuffer);

  AddToMemo('IdTCPClient1 connected to server');

ClientThread on client:

procedure TClientThread.Execute;
type
  PTBytes   = ^TBytes;
  PTIdBytes = ^TIdBytes;
var
  LBuffer     : TIdBytes;
  LDataSize   : Integer;
  LProtocol   : TProtocol;

  procedure AddToMemo(const AStr: string);
  begin
    TThread.Synchronize(nil,
      procedure
      begin
        Form1.Memo1.Lines.Add('Received From Server: ' + AStr);
      end
    );
  end;
begin
  inherited;
  while NOT Terminated and Form1.IdTCPClient1.Connected do begin
    //LDataSize := Form1.IdTCPClient1.IOHandler.InputBuffer.Size;

    //if LDataSize >= szProtocol then begin
      try
        Form1.IdTCPClient1.IOHandler.ReadBytes(LBuffer, szProtocol);

        LProtocol := BytesToProtocol(PTBytes(@LBuffer)^);

        case LProtocol.Command of
          cmdHWID:
          begin
            HWID := LProtocol.Sender.HWID;
            AddToMemo('HWID > ' + LProtocol.Sender.HWID);
          end;

          cmdDisconnect:
          begin
            AddToMemo('DC > ' + LProtocol.Sender.HWID);
          end;

          cmdMensagem:
          begin
            AddToMemo('MSG > ' + LProtocol.Sender.Msg);
          end;
        end;
      finally
        ClearBufferId(LBuffer);
      end;
    //end;

    Sleep(50);
  end;
end;

Anybody know why these connections are being stucked on TIdTcpServer? Maybe if i loop all conenctions and try send a single text will disconnect they if don't are really connected to IdTcpServer no ?

Thanks.

What you have shown is not enough the diagnose your problem. Please provide a [mcve] that reproduces the problem. Typical reasons for connections getting stuck in the `Contexts` list include 1) catching and discarding Indy exceptions, preventing the server from processing them. 2) using loops that don't generate exceptions and don't exit event handlers. 3) deadlocking the `Contexts` list by locking it and not unlocking it — Remy Lebeau, Oct 28 '18 at 19:40
Posted completed to a complete example. so maybe the problem is on function who retrieve the number of connecteds? because i don't use any try except on OnExecute event from TIdTcpServer so i believe i'm not cathing any exception of indy. About loops i don't use it too. — Pâmella Douglas, Oct 29 '18 at 17:24
I read this example from you Remy http://codeverge.com/embarcadero.delphi.winsock/how-to-implement-an-idtcpserver-he/1074605 about a heartbeat. But i tested here and only work if client don't send nothing for a while, and on next send he are disconnected. But the solution here i believe it's a loop/time who try send a message to connections and if fire any exception indy will automatically drop the context no? if is, how you recommend do these checks? like function who retrieve number of connected users? — Pâmella Douglas, Oct 29 '18 at 22:45
What you have shown is neither minimal nor complete. For instance, you didn't show what `TClientThread` actually does. Please provide a [mcve] can people can actually copy/paste into their compilers and actually run the code to reproduce the issue of connections getting "stuck". — Remy Lebeau, Oct 29 '18 at 23:10
Stuck don't happen on a single test 1 connection, occour running with more than 100+ connections like you see on picture. Post updated with ClientThread code. — Pâmella Douglas, Oct 30 '18 at 00:30
So far, I haven't seen anything that can be causing the behavior you describe. So what's stopping you from writing a test app that makes 100+ connections to the server? Then you can watch the server activity and debug your server code under load. You have a thread class, tweak it to have its own local `TIdTCPClient` instead of using one from the Form, and then create 100+ instances of that class — Remy Lebeau, Oct 30 '18 at 03:23
Already tried and don't generated the same problem, just see these case on running ambient. — Pâmella Douglas, Oct 30 '18 at 03:54
if you can't reproduce the problem in a simple test environment, how do you expect anyone else here to be able to? — Remy Lebeau, Oct 30 '18 at 05:08
how is the better way to loop all contexts and send a simple command to see if TIdTcpServer will generate a exception? if he generate it's because client don't are connected right? so just need call Disconnect. — Pâmella Douglas, Oct 30 '18 at 16:48
like I said, there is nothing obvious in the code you have shown that should cause the issue. So either the issue is in code you haven't shown yet, or the issue is environmental. — Remy Lebeau, Oct 30 '18 at 16:49
I strongly recommend handling that in the `OnExecute` event and not in a manual loop. Sending commands outside of the event is a good way to corrupt your communications, if you send commands that overlap others being sent by the event at the same time. I've posted examples many times before of queuing unsolicited commands from outside the event and delegate their sending to inside the event. That way, everything is handled inside the event only and it can decide when it is safe to send which commands in which order that makes sense for your protocol. Let the server handle exceptions for you — Remy Lebeau, Oct 30 '18 at 17:19
Understand, so i'll implement a Queue to my protocol. Another question OnExecute run in a infinite loop or just when TIdTcpServer receive some request from client side? because i added a log on OnExecute event and it only run when Client side send something to server side. — Pâmella Douglas, Oct 30 '18 at 18:27
`OnExecute` is looped for the lifetime of the connection. It is the event handler's responsibility to block between requests as needed. In your example, `ReadBytes()` blocks until `szProtocol` number of bytes are received. — Remy Lebeau, Oct 30 '18 at 19:59
That is up to you to decide based on your protocol's needs. But see [my answer](https://stackoverflow.com/a/31042871/65863) to [this earlier question](https://stackoverflow.com/questions/31039580/) for an example — Remy Lebeau, Oct 30 '18 at 20:35
I updated my post with a queue who i added and appear be working fine, can you just see the code to check if are right? — Pâmella Douglas, Oct 30 '18 at 20:58
after send some commands to TIdTcpClient, TIdTcpServer disconnect the client for some reason. — Pâmella Douglas, Nov 02 '18 at 19:25

Prevent TIdTcpServer Stuck Connections

0 Answers0

Linked