Indy TCP Server at 400+ connections - multithreading

Question

I am trying to handle a few thousand users through Indy TCP servers but i always saw very high memory consumption even with a few hundred users... i just wrote a bot to test out the performance of the server handling the data. I connected 300 bots to the test server and started sending packets through. The memory usage climbed to a few hundred MB in matter of minutes...
After going through codes i noticed that the main issue was with using sender queue for each thread so each thread can transmit its messages in its Execute function. If 300 users are sending packets to each other and writing data to each thread's queue then it cause the memory to overload... Here is what i am doing and can anyone suggest any better way to handle this?
When a client is sending message to another client this function is called and is supplied with the context of that thread/client/conneciton
Procedure TMainFrm.SendRoomBuffer(Packet: Pointer; Size: Integer; Context: TIdContext);
Var
LocalBuffer: Pointer;
Connected: Boolean;
Begin
If Size < 1 then
Exit;
Try
If Context <> Nil Then
Connected := TRoomContext(Context).Connection.Connected
Else
Connected := False;
Except
Connected := False;
End;
If Connected = True Then Begin
GetMem(LocalBuffer,Size);
CopyMemory(LocalBuffer,Packet,Size);
TRoomContext(Context).Queue.Add(LocalBuffer);
End;
End;
Iterates through all the users present in the room and send them the packet
Lst := Room.UsersList.LockList;
Try
For I := 0 To Lst.Count -1 Do Begin
Try
Username := TRoomUserInfo(Lst.Items[I]).UserName.Value;
If IncludingMe = False Then Begin
If LowerCase(Username) <> LowerCase(MyNick) Then
SendRoomBuffer(Packet, PacketSize, TRoomUserInfo(Lst.Items[I]).Context)
End Else
SendRoomBuffer(Packet, PacketSize, TRoomUserInfo(Lst.Items[I]).Context);
Finally
Username := '';
End;
End;
Finally
Room.UsersList.UnlockList;
Lst := Nil;
End;
This is where the actual sending is done, in the Execute of IdTCPServer
If Not TRoomContext(AContext).Queue.IsEmpty Then Begin
tmpQueue := TRoomContext(AContext).Queue.LockList;
Try
While tmpQueue.Count > 0 Do Begin
outBuffer := tmpQueue.items[0];
Try
outLen := PCommunicatorPacket(outBuffer).BufferSize;
SetLength(outBuf,outLen);
Try
CopyMemory(#outBuf[0],outBuffer,outLen);
Try
If Connected Then
AContext.Connection.IOHandler.Write(outBuf)
Finally
tmpQueue.Delete(0);
End;
Finally
SetLength(outBuf,0);
outBuf := Nil;
End;
Finally
If outBuffer <> Nil Then Begin
FreeMem(outBuffer);
outBuffer := Nil;
End;
End;
End;
Finally
TRoomContext(AContext).Queue.UnlockList;
tmpQueue := Nil;
End;
End;
Complete OnExecute Function
Procedure TMainFrm.RoomSckExecute(AContext: TIdContext);
Var Buf: TIdBytes;
Len: Integer;
outBuffer: PIdBytes;
tmpQueue: TList;
Begin
AContext.Connection.IOHandler.CheckForDataOnSource(10);
if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
Len := AContext.Connection.IOHandler.InputBuffer.Size;
AContext.Connection.IOHandler.ReadBytes(Buf, Len, False);
TRoomContext(AContext).ProcessPacket(#Buf[0], Len, AContext);
SetLength(Buf, 0);
Buf := nil;
end;
tmpQueue := TRoomContext(AContext).Queue.LockList;
try
while tmpQueue.Count > 0 do begin
outBuffer := PIdBytes(tmpQueue.Items[0]);
try
tmpQueue.Delete(0);
AContext.Connection.IOHandler.Write(outBuffer^);
finally
Dispose(outBuffer);
end;
end;
finally
TRoomContext(AContext).Queue.UnlockList;
end;
End;
If a single client is sending to 300 clients present in the room then 300 copies of the packets are made and are freed only when the actual sending is done...
If i do the writing directly to each connection and not by using queues then the memory consumption is not as rogue as this method but server hangs after a few minutes
Sorry if i forgot to mention any more details.
P.S: I am using Delphi 7
EDIT: I just check, if i dont actually write to socket, and go with the whole process as is, then the issue doesn't happen... so it means the time it takes to write to the socket, there are over a few hundred more packets read...
EDIT 2 I copied your code for the OnExecute, if i don't prove a length to ReadBytes then it takes some time about 3-5 seconds to process each command, so i am providing it with the length to read... And i used madexcept it doesnt show any leaks, i am gonna try with FastMM too now... but if there was actually a leak and something was causing it then why would commenting out the actual Write command in OnExecute suppress the memory usage?
EDIT 3 To explain my question further, i am actually reading the bytes from the stream and then process them myself later to make distinct packets from them, here is the code of what happens further after the data is read from the socket.
...
FPacketBuffer: Pointer; // global memory upto 65kb for each client to store the incoming data
PacketBufferPtr: Integer; // the offset upto where the data is read from the global memory
...
procedure TRoomContext.ProcessPacket(Buffer: Pointer; BufSize: Integer; Context: TIdContext);
begin
AddToPacketBuffer(Buffer,BufSize);
CheckAndProcessPacket(Context);
end;
procedure TRoomContext.AddToPacketBuffer(Buffer: Pointer; Size: Integer);
var
DestPtr: Pointer;
begin
if PacketBufferPtr + Size<65536 then
begin
DestPtr := Pointer(Cardinal(FPacketBuffer)+Cardinal(PacketBufferPtr));
Move(Buffer^,DestPtr^,Size);
PacketBufferPtr := PacketBufferPtr + Size;
end
else
begin
end;
end;
procedure TRoomContext.CheckAndProcessPacket(Context: TIdContext);
var DestPtr: Pointer;
NewPacketBufferLen: Integer;
SharedBuff: Pointer;
begin
if PCommunicatorPacket(FPacketBuffer).Signature = PACKET_SIGNATURE then
begin
while PCommunicatorPacket(FPacketBuffer).BufferSize <= PacketBufferPtr do
begin
GetMem(SharedBuff,PCommunicatorPacket(FPacketBuffer).BufferSize);
Try
CopyMemory(SharedBuff,FPacketBuffer,PCommunicatorPacket(FPacketBuffer).BufferSize);
MainFrm.ExecuteRoomPacket(SharedBuff, Context);
Finally
If SharedBuff <> Nil Then FreeMem(SharedBuff);
End;
NewPacketBufferLen := PacketBufferPtr - PCommunicatorPacket(FPacketBuffer).BufferSize;
DestPtr := Pointer(Cardinal(FPacketBuffer)+PCommunicatorPacket(FPacketBuffer).BufferSize);
Move(DestPtr^, FPacketBuffer^, NewPacketBufferLen);
PacketBufferPtr := NewPacketBufferLen;
end;
end
else
begin
DropInvalidPacket;
Inc(InvalidPackets);
If InvalidPackets > 50 Then
Context.Connection.Disconnect;
Exit;
end;
end;
Apologies for thinking it was because of the writing, the writing actually just slowed deletion from queue which made me think so, if i even put a sleep of 10 milliseconds, the memory consumption go rogue. About the leaks... one other reason i think this is not a leak is because if i stop the bots from messaging further, then the used memory gets back to where it was, but if i leave it running for a few minutes then it goes to a point where the application hangs or i receive an out of memory message. I think the issue is with making copies, i tried using a global queue for the room to handle messages and so multiple copies aren't made of the data, but that cause the application to hang after sometime maybe too much thread contention or i am not playing it safe.

Answer 1

TCP does not support broadcasting, and directly writing to TIdTCPServer connections from outside the server's events is generally not thread-safe (although it can be done if you are careful). In your situation, using queues is a good idea.
However, don't call Connected() in SendRoomBuffer(). It performs a read operation, which can interfere with any reading the OnExecute event handler performs, and can corrupt the InputBuffer's content by reading socket data out of order. If Context is not nil then queue the data regardless of the socket state, and catch any errors.
Also, in the OnDisconnect event, make sure you are freeing any queued packets that were not sent, otherwise you will leak them.
Lastly, your OnExecute code is making another copy of the queued data and then sending that copy (I am assuming that outBuf is a TIdBytes). Try to avoid that. I would suggest you change your queue to store TMemoryStream or TIdBytes objects instead of raw memory blocks, then you can pass the queued items directly to IOHandler.Write() without having to make copies of them first.
Try something like this:
type
PIdBytes = ^TIdBytes;
procedure TMainFrm.SendRoomBuffer(Packet: Pointer; Size: Integer; Context: TIdContext);
var
LocalBuffer: PIdBytes;
begin
if (Packet = nil) or (Size < 1) or (Content = nil) then
Exit;
New(LocalBuffer);
try
LocalBuffer^ := RawToBytes(Packet^, Size);
TRoomContext(Context).Queue.Add(LocalBuffer);
except
Dispose(LocalBuffer);
end;
end;
Lst := Room.UsersList.LockList;
try
for i := 0 To Lst.Count -1 do begin
Username := TRoomUserInfo(Lst.Items[i]).UserName.Value;
if (not IncludingMe) and TextIsSame(Username, MyNick) then begin
Continue;
end;
SendRoomBuffer(Packet, PacketSize, TRoomUserInfo(Lst.Items[i]).Context);
end;
finally
Room.UsersList.UnlockList;
end;
procedure TMainFrm.RoomSckDisconnect(AContext: TIdContext);
var
tmpQueue: TList;
i: Integer;
begin
...
tmpQueue := TRoomContext(AContext).Queue.LockList;
try
for i := 0 to tmpQueue.Count-1 do begin
Dispose(PIdBytes(tmpQueue.Items[i]));
end;
tmpQueue.Clear;
finally
TRoomContext(AContext).Queue.UnlockList;
end;
...
end;
procedure TMainFrm.RoomSckExecute(AContext: TIdContext);
var
Buf: TIdBytes;
outBuffer: PIdBytes;
tmpQueue: TList;
begin
AContext.Connection.IOHandler.CheckForDataOnSource(10);
if not AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.ReadBytes(Buf, -1, False);
TRoomContext(AContext).ProcessPacket(#Buf[0], Len, AContext);
SetLength(Buf, 0);
Buf := nil;
end;
tmpQueue := TRoomContext(AContext).Queue.LockList;
try
while tmpQueue.Count > 0 do begin
outBuffer := PIdBytes(tmpQueue.Items[0]);
try
tmpQueue.Delete(0);
AContext.Connection.IOHandler.Write(outBuffer^);
finally
Dispose(outBuffer);
end;
end;
finally
TRoomContext(AContext).Queue.UnlockList;
end;
end;