procedure TForm1.IdTCPServer1Connect(AContext: TIdContext);
var
List : TIdContextList;
begin
ListBox1.Items.BeginUpdate;
try
ListBox1.Items.Add(AContext.Binding.PeerIP +':'+ AContext.Binding.PeerPort.ToString);
finally
ListBox1.Items.EndUpdate;
end;
if IdTCPServer1.Active then
begin
List := IdTCPServer1.Contexts.LockList;
try
Form1.Caption := 'Server - Client : ' + List.Count.ToString;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
IdTCPServer1.Active := True;
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
var
n1: Integer;
begin
n1 := ListBox1.Items.IndexOf(AContext.Binding.PeerIP +':'+ AContext.Binding.PeerPort.ToString);
if n1 > -1 then
ListBox1.Items.Delete(n1);
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
data: string;
begin
data := AContext.Connection.IOHandler.ReadLn;
if data= 'E' then
AContext.Connection.Disconnect;
end;
04-18-2020, 09:37 PM (This post was last modified: 04-20-2020, 06:57 PM by 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:
// 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...
procedure TForm1.HandleClientDisconnected(AContext: TIdContext);
var
n1: Integer;
begin
n1 := ListBox1.Items.IndexOfObject(AContext);
if n1 > -1 then
ListBox1.Items.Delete(n1);
UpdateClientsCount;
end;
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;
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.IdTCPServer1Connect(AContext: TIdContext);
var
PeerIP: string;
PeerPort: Integer;
begin
PeerIP := AContext.Binding.PeerIP;
PeerPort := AContext.Binding.PeerPort;
TThread.Queue(nil,
procedure
begin
Form1.HandleClientConnected(AContext, PeerIP, PeerPort);
end
);
end;
procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext);
begin
TThread.Queue(nil,
procedure
begin
Form1.HandleClientDisconnected(AContext);
end
);
end;
procedure TForm1.IdTCPServer1Execute(AContext: TIdContext);
var
data: string;
begin
data := AContext.Connection.IOHandler.ReadLn;
if data = 'E' then
AContext.Connection.Disconnect;
end;
procedure TForm1.UpdateClientsCount;
var
List : TIdContextList;
begin
List := IdTCPServer1.Contexts.LockList;
try
Caption := 'Server - Client : ' + List.Count.ToString;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
procedure TSocketServer.HandleClientDisconnected(AContext: TIdContext);
begin
UpdateClientsCount;
end;
procedure TSocketServer.IdTCPServer1Connect(AContext: TIdContext);
var
PeerIP: string;
PeerPort: Integer;
begin
PeerIP := AContext.Binding.PeerIP;
PeerPort := AContext.Binding.PeerPort;
TThread.Queue(nil,
procedure
begin
HandleClientConnected(AContext, PeerIP, PeerPort);
end
);
end;
procedure TSocketServer.IdTCPServer1Disconnect(AContext: TIdContext);
begin
TThread.Queue(nil,
procedure
begin
HandleClientDisconnected(AContext);
end
);
end;
procedure TSocketServer.IdTCPServer1Execute(AContext: TIdContext);
var
data: string;
begin
data := AContext.Connection.IOHandler.ReadLn;
if data= 'E' then
AContext.Connection.Disconnect;
end;
procedure TSocketServer.UpdateClientsCount;
var
List : TIdContextList;
begin
if IdTCPServer1.Active then
begin
List := IdTCPServer1.Contexts.LockList;
try
Writeln('Server - Client : ' + List.Count.ToString);
finally
IdTCPServer1.Contexts.UnlockList;
end;
end;
end;
begin
Server := TSocketServer.Create;
try
while True do
begin
try
Sleep(1);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end;
finally
Server.Free;
end;
end.
(04-19-2020, 11:48 AM)3ddark Wrote: I edited and tested the code with your suggestion. The result is the same for Delphi.
The VCL code looks fine. There should be no freezing.
(04-19-2020, 11:48 AM)3ddark Wrote: I test on Ubuntu(18.04) Console app. I got the same result on Linux
Your Linux code is not servicing the TThread.Queue() requests, so they never execute your handlers. Since you are not using a UI message loop, you need a manual loop that calls the RTL's CheckSynchronize() function periodically.
It is also important NOT to access the members of TIdContext asynchronously, especially after a disconnect, since the TIdContext object will be destroyed after the OnDisconnect handler exits, and will likely not exist anymore before (or worse, while) your TThread.Queue() handler is run. That is why in the code I provided you, I use the TIdContext pointer only as a lookup key in the TListBox, nothing more. In your Linux code, you don't need the TIdContext pointer at all.
procedure TSocketServer.HandleClientDisconnected();
begin
UpdateClientsCount;
end;
procedure TSocketServer.IdTCPServer1Connect(AContext: TIdContext);
var
PeerIP: string;
PeerPort: Integer;
begin
PeerIP := AContext.Binding.PeerIP;
PeerPort := AContext.Binding.PeerPort;
TThread.Queue(nil,
procedure
begin
HandleClientConnected(PeerIP, PeerPort);
end
);
end;
procedure TSocketServer.IdTCPServer1Disconnect(AContext: TIdContext);
begin
TThread.Queue(nil,
procedure
begin
HandleClientDisconnected();
end
);
end;
procedure TSocketServer.IdTCPServer1Execute(AContext: TIdContext);
var
data: string;
begin
data := AContext.Connection.IOHandler.ReadLn;
if data = 'E' then
AContext.Connection.Disconnect;
end;
procedure TSocketServer.UpdateClientsCount;
var
List : TIdContextList;
Count: Integer;
begin
if IdTCPServer1.Active then
begin
List := IdTCPServer1.Contexts.LockList;
try
Count := List.Count;
finally
IdTCPServer1.Contexts.UnlockList;
end;
end else begin
Count := 0;
end;
Writeln('Server - Client : ' + Count.ToString);
end;
begin
Server := TSocketServer.Create;
try
while True do
begin
try
CheckSynchronize(100);
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end;
finally
Server.Free;
end;
end.
(04-21-2020, 08:39 AM)3ddark Wrote: when the number of clients exceeds 1500, the server freezes.
1500 *simultaneous* clients? Because that would mean your process is running 1500 concurrent threads (1 thread per client), which is likely to take up way too much memory. The default thread stack size is 1-4MB, depending on project settings, so 1500 simultaneous clients would be using 1.5-6GB of memory. Indy is not designed for that kind of load. You would need to reduce the number of simultaneous clients, or lower the default stack size. But, on Windows at least, you really need to use Overlapped I/O or I/O Completion Ports to handle that kind of load efficiently, and that is not supported by Indy at this time.
(04-21-2020, 08:39 AM)3ddark Wrote: If you test it, you will see that it is frozen
04-23-2020, 04:48 PM (This post was last modified: 04-23-2020, 04:48 PM by rlebeau.)
(04-23-2020, 01:57 PM)3ddark Wrote: Max Stack Size reduce the 1048576(default) to 65536
I tested for 5000 Clients. Result is excellent
Lowering the stack size from 1MB to 64K lowers the memory usage from 1GB for 1500 clients down to 312MB for 5000 clients. Much more manageable for the system.
(04-23-2020, 01:57 PM)3ddark Wrote: But I still don't know the stack size unit.
bytes, kb or any ???
(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):
... 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
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...
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.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:
// 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...
procedure TForm1.HandleClientDisconnected(AContext: TIdContext);
var
n1: Integer;
begin
n1 := ListBox1.Items.IndexOfObject(AContext);
if n1 > -1 then
ListBox1.Items.Delete(n1);
UpdateClientsCount;
end;
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;
