Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
IdTCPServer Freeze on Delphi
#10
(04-18-2020, 09:37 PM)Hello Remy, I admire your knowledge and presence in various forums.I am an oldtimer from TurboPascal, but a rookie in Lazarus and Indy. In Lazarus I used your example below for IdTCPserver after fighting for weeks with other non-working examples from the web. I added just a few buttons and a Memo to your code. Nevertheless, I can not make your example work right. It does establish connection and receive messages. However, when an active connection is terminated, the remote client is disconnected but the server does not respond to it by decrementing the client count. I did some tracing with Lazarus Debugger and found that TForm1.IdTCPServer1Disconnect LNotify.Notify does not activate TClientDisconnectedNotify.DoNotify. Below is the trace info. Did your code below actually run in Lazarus? If so, what do you think is my error? I am on Windows 10, Lazarus v2.0.10 r63526. Behaviour:-------------------------------Client application is Putty in raw mode Wrote: IdTCPServer ON CLIENT CONNECT (debugger tracing --- everything seems to go right through a series of breakpoints):

procedure TForm1.IdTCPServer1Connect  --> LNotify.Notify; --> TClientConnectedNotify.DoNotify;  --> TForm1.HandleClientConnected --> UpdateClientsCount;

--> Listbox1 correctly updated to 1 user & Putty connected

Server is receiveing messages right.



Now Putty is intentionally rudely closed by close window. From now on IdTCPserver behaves wrong.



IdTCPServer ON CLIENT DISCONNECT:

Lazarus Debugger correctly catches EIdConnClosedGracefully --> Continue

breakpoint triggered: TForm1.IdTCPServer1Disconnect --> trace to Lnotify.Notify

trace into: TIdCustomTCPServer.DoDisconnect

trace into: TIdCustomTCPServer.ContextDisconnected

trace into: TIdContext.AfterRun  --> FContextList.Remove(Self);

trace into: TIdTask.DoAfterRun;

trace into: TIdThreadWithTask.AfterRun;

trace into: TIdThread.Execute;  --> Exception: ConnectionClosedGracefully --> Terminate;



... and then Debugger stops tracing, server application is alive and client count has not been updated, Listbox1 still contains a connection that is supposed not to exist any more.



Why is the execution path between TForm1.IdTCPServer1Disconnect LNotify.Notify; --> TClientDisconnectedNotify.DoNotify;  lost ???



The same behaviour happens if disconnect is triggered from the server side by receiving 'E'.
In your code input 'E' from client is supposed to disconnect the remote client. Putty in my case is disconnected indeed, but UpdateClientsCount on the server side does not happen.


Code:
unit stringserverunit3;

// IdTCPserver code from rlebeau example at https://www.atozed.com/forums/printthread.php?tid=1625

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  IdGlobal,
  IdContext,
  IdSync,
  IdCustomTCPServer,
  IdBaseComponent,
  IdTCPConnection,
  IdTCPServer;

type

  { TForm1 }

  TForm1 = class(TForm)
    IdTCPServer1: TIdTCPServer;

    ListBox1: TListBox;
    btn_start: TButton;
    btn_stop: TButton;
    btn_clear: TButton;
    Memo1: TMemo;

    procedure btn_clearClick(Sender: TObject);
    procedure btn_startClick(Sender: TObject);
    procedure btn_stopClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
    function  GetNow():String;
  private
    procedure HandleClientConnected(AContext: TIdContext; APeerIP: string; APeerPort: TIdPort);
    procedure HandleClientDisconnected(AContext: TIdContext);
    procedure UpdateClientsCount;
  public

  end;


var
  Form1: TForm1;

// ... listening port
      const LISTENING_PORT = 6000;

implementation

{$R *.lfm}


Type

{ TMyMemoSync MessageToMemo Syncing Mechanism }
  TMyMemoSync = Class(TIDSync)
  private
    FContent: String;
    FDestination: Tmemo;
    Constructor Create(const Content: String; Destination: TMemo); overload;
  protected
    Procedure DoSynchronize; override;
  public
  end;

constructor TMyMemoSync.Create(const Content: String; Destination: TMemo);
begin
  inherited Create;
  FContent := Content;
  FDestination := Destination;
end;

procedure TMyMemoSync.DoSynchronize;
begin
  (* inherited;  compiler tega ne požre *)
  FDestination.Append(FContent);
end;


// 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...

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;


{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  IdTCPServer1.DefaultPort := LISTENING_PORT;
  IdTCPServer1.Active := False;
end;

procedure TForm1.btn_startClick(Sender: TObject);
begin
  IdTCPServer1.DefaultPort := LISTENING_PORT;
  IdTCPServer1.Active := True;
  Memo1.Append(getnow + 'server STARTED');
end;

procedure TForm1.btn_stopClick(Sender: TObject);
begin
  IdTCPServer1.Active   := false;
  Memo1.Append(getnow + 'server STOPPED');
end;

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
  PeerIP: string;
  PeerPort: TIdPort;
  LNotify: TClientConnectedNotify;

  msgToClient: string;
begin
  PeerIP := AContext.Binding.PeerIP;
  PeerPort := AContext.Binding.PeerPort;

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

  msgToClient := 'connected';
  AContext.Connection.IOHandler.WriteLn( msgToClient );

end;


procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
  LNotify: TClientDisconnectedNotify;
begin
  LNotify := TClientDisconnectedNotify.Create;
  LNotify.Context := AContext;
  LNotify.Notify;
end;


procedure TForm1.HandleClientConnected(AContext: TIdContext; APeerIP: string; APeerPort: TIdPort);
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.btn_clearClick(Sender: TObject);
begin
    Memo1.Clear;
end;


function TForm1.getNow(): String;
begin
    Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', Now) + ': ';
end;


procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
  data: string;
begin
  data := AContext.Connection.IOHandler.ReadLn;

  With TMyMemoSync.Create(data, Memo1) do
  begin
    Synchronize;
    Free;
  end;

  if data = 'E' then
    AContext.Connection.Disconnect;
end;


end.





rlebeauYour 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.


Attached Files
.zip   3TestTCPstringServer.zip (Size: 128.31 KB / Downloads: 11)
Reply


Messages In This Thread
IdTCPServer Freeze on Delphi - by 3ddark - 04-18-2020, 08:30 PM
RE: IdTCPServer Freeze on Delphi - by rlebeau - 04-18-2020, 09:37 PM
RE: IdTCPServer Freeze on Delphi - by 3ddark - 04-19-2020, 11:48 AM
RE: IdTCPServer Freeze on Delphi - by rlebeau - 04-20-2020, 07:11 PM
RE: IdTCPServer Freeze on Delphi - by TangoEcho - 01-28-2022, 02:24 PM
RE: IdTCPServer Freeze on Delphi - by 3ddark - 04-21-2020, 08:39 AM
RE: IdTCPServer Freeze on Delphi - by rlebeau - 04-21-2020, 06:05 PM
RE: IdTCPServer Freeze on Delphi - by 3ddark - 04-22-2020, 05:59 AM
RE: IdTCPServer Freeze on Delphi - by 3ddark - 04-23-2020, 01:57 PM
RE: IdTCPServer Freeze on Delphi - by rlebeau - 04-23-2020, 04:48 PM

Forum Jump:


Users browsing this thread: 1 Guest(s)