具有400多个连接的Indy TCP Server

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.

PS: 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;