IdTCPServer Freeze on Delphi

[rlebeau]

Your server's OnConnect and OnDisconnect event handlers are not thread-safe, which can easily cause deadlocks (among other problems).

The OnConnect, OnDisconnect, and OnExecute events are fired in the context of worker threads, so they MUST synchronize with the main UI thread when accessing UI controls.  Simply calling (Begin|End)Update on ListBox1, or locking the server's Contexts list, is NOT adequate synchronization.

Use the TThread.Synchronize() or TThread.Queue() methods, or Indy's TIdSync or TIdNotify classes.  For example:

Code:

//Server side code
unit Unit1;

{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  IdContext, IdTCPServer, IdCustomTCPServer;

type

  { TForm1 }

  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  private
    procedure HandleClientConnected(AContext: TIdContext; APeerIP: string; APeerPort: TIdPort);
    procedure HandleClientDisconnected(AContext: TIdContext);
    procedure UpdateClientsCount;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

// FreePascal does not implement overloads of TThread.Synchronize()
// and TThread.Queue() that take anonymous procedures as input, but
// Delphi does...

// for this example, I'm using asynchronous UI updates, because 1) the
// server logic is not dependent on waiting for the UI, and 2) asynchronous
// avoids a deadlock when deactivating the server and a client tries to
// update the UI...

{$IFDEF FPC}
uses
  IdSync;

type
  TClientConnectedNotify = class(TIdNotify)
  protected
    Context: TIdContext;
    PeerIP: string;
    PeerPort: TIdPort;
    procedure DoNotify; override;
  end;

  TClientDisconnectedNotify = class(TIdNotify)
  protected
    Context: TIdContext;
    procedure DoNotify; override;
  end;

procedure TClientConnectedNotify.DoNotify;
begin
  Form1.HandleClientConnected(Context, PeerIP, PeerPort);
end;

procedure TClientDisconnectedNotify.DoNotify;
begin
  Form1.HandleClientDisconnected(Context);
end;
{$ENDIF}

{ TForm1 }

procedure TForm1.HandleClientConnected(APeerIP: string; APeerPort: TIdPort; AContext: TIdContext);
begin
  ListBox1.Items.AddObject(APeerIP + ':' + APeerPort.ToString, AContext);
  UpdateClientsCount;
end;

procedure TForm1.HandleClientDisconnected(AContext: TIdContext);
var
  n1: Integer;
begin
  n1 := ListBox1.Items.IndexOfObject(AContext);
  if n1 > -1 then
    ListBox1.Items.Delete(n1);
  UpdateClientsCount;
end;

procedure TForm1.UpdateClientsCount;
begin
  Caption := 'Server - Client : ' + ListBox1.Items.Count.ToString;
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  PeerPort: TIdPort;
  {$IFDEF FPC}
  LNotify: TClientConnectedNotify;
  {$ENDIF}
begin
  PeerIP := AContext.Binding.PeerIP;
  PeerPort := AContext.Binding.PeerPort.ToString;

  {$IFDEF FPC}

  LNotify := TClientConnectedNotify.Create;
  LNotify.Context := AContext;
  LNotify.PeerIP := PeerIP;
  LNotify.PeerPort := PeerPort;
  LNotify.Notify;

  {$ELSE}

  TThread.Queue(nil,
    procedure
      Form1.HandleClientConnected(AContext, PeerIP, PeerPort);
    end
  );

  {$ENDIF}
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.Active := True;
end;

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
{$IFDEF FPC}
var
  LNotify: TClientDisconnectedNotify;
{$ENDIF}
begin
  {$IFDEF FPC}

  LNotify := TClientDisconnectedNotify.Create;
  LNotify.Context := AContext;
  LNotify.Notify;

  {$ELSE}

  TThread.Queue(nil,
    procedure
      Form1.HandleClientDisconnected(AContext);
    end
  );

  {$ENDIF}
end;

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  data: string;
begin
  data := AContext.Connection.IOHandler.ReadLn;
  if data = 'E' then
    AContext.Connection.Disconnect;
end;

end.