01-28-2022, 02:24 PM
(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.