Delphi: Memory leak

Question

i have been stuck with this problem like forever, i dont know what am i doing wrong. I am using indy10 for a messaging server, now it works fine for sometime and cant seem to generate any leak reports but when i run the server live and user count goes up my server starts eating up memory, it eats upto 500mb in a day. I dont know if anyone here will have time to read the code out and point out what i am doing wrong, i am going crazy because of this problem. any help will be really appreciated. i am posting the code for how i handle the data.

Class for IdTcpServer Context

TRoomContext = class(TIdServerContext)
  private
    Procedure ProcessPacket(Buffer: Pointer; BufSize: Integer; Context: Pointer);
    Procedure AddToPacketBuffer(Buffer: Pointer; Size: Integer);
    Procedure CheckAndProcessPacket(Context: Pointer);
    Procedure DropInvalidPacket;
  public
    Username: TIdThreadSafeString;
    RoomName: TIdThreadSafeString;
    Stat: TIdThreadSafeCardinal;
    Color: TIdThreadSafeCardinal;
    Mute: TIdThreadSafeBoolean;
    ClientSubscription: TIdThreadSafeInteger;
    ClientPrivilege: TIdThreadSafeInteger;
    Room: Pointer;
    RoomUser: Pointer;
    Queue: TIdThreadSafeList;
    FPacketBuffer: Pointer;
    PacketBufferPtr: Integer;
    LastReadTime: TIdThreadSafeDateTime;
    LastMessagesReadTime: TIdThreadSafeDateTime;
    TimeOut: TIdThreadSafeInteger;
    Bounded: TIdThreadSafeBoolean;
    NumberOfPackets: TIdThreadSafeInteger;

    constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil); override;
    destructor Destroy; override;
  End;

The Constructor and Destructor

constructor TRoomContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TThreadList = nil);
begin
  inherited;
  Queue     := TIdThreadSafeList.Create;
  Username  := TIdThreadSafeString.Create;
  RoomName  := TIdThreadSafeString.Create;
  Stat      := TIdThreadSafeCardinal.Create;
  Color     := TIdThreadSafeCardinal.Create;
  Mute      := TIdThreadSafeBoolean.Create;
  ClientSubscription := TIdThreadSafeInteger.Create;
  NumberOfPackets := TIdThreadSafeInteger.Create;
  ClientPrivilege := TIdThreadSafeInteger.Create;
  TimeOut   := TIdThreadSafeInteger.Create;
  Bounded   := TIdThreadSafeBoolean.Create;
  LastReadTime := TIdThreadSafeDateTime.Create;
  LastMessagesReadTime := TIdThreadSafeDateTime.Create;
  GetMem(FPacketBuffer,65536);

  Queue.Clear;
  Username.Value  := '';
  RoomName.Value  := '';
  Stat.Value      := 0;
  Color.Value     := 0;
  Mute.Value      := False;
  ClientSubscription.Value := 0;
  NumberOfPackets.Value := 0;
  ClientPrivilege.Value := 0;
  TimeOut.Value := 0;
  Bounded.Value := False;
  LastReadTime.Value := Now;
  LastMessagesReadTime.Value := Now;

  Room := Nil;
  RoomUser := Nil;
end;

destructor TRoomContext.Destroy;
Var tmpQueue: TList;
    outBuffer: Pointer;
begin
// Incase the user gets disconnected and there is leftover packets in the queue
  tmpQueue := Queue.LockList;
  Try
    While tmpQueue.Count > 0 Do Begin
      outBuffer := tmpQueue.items[0];
      If outBuffer <> Nil Then Begin
        FreeMemAndNil(outBuffer);
      End;
      tmpQueue.Delete(0);
    End;
    tmpQueue.Clear;
  Finally
    Queue.UnlockList;
  End;
  FreeAndNil(Queue);

  Username.Value := '';
  FreeAndNil(Username);

  RoomName.Value := '';
  FreeAndNil(RoomName);

  Stat.Value := 0;
  FreeAndNil(Stat);

  Color.Value := 0;
  FreeAndNil(Color);

  FreeAndNil(Mute);
  FreeAndNil(ClientSubscription);
  FreeAndNil(NumberOfPackets);
  FreeAndNil(ClientPrivilege);
  FreeAndNil(TimeOut);
  FreeAndNil(Bounded);
  FreeAndNil(LastReadTime);
  FreeAndNil(LastMessagesReadTime);
  FreeMemAndNil(FPacketBuffer, 65536);
  inherited;
end;

OnExecute Event

    Procedure TMainFrm.RoomSckExecute(AContext: TIdContext);
    Var Buf, outBuf: TIdBytes;
        Len, outLen: Integer;
        Buffer, outBuffer: Pointer;

        tmpQueue, tmpList: TList;
        Connected: Boolean;
    Begin
      Sleep(10);
      Try
        Connected := AContext.Connection.Connected;
      Except
        Connected := False;
      End;

      If Not Connected Then AContext.Connection.Disconnect;

        Len := AContext.Connection.IOHandler.InputBuffer.Size;
        If Len>0 then
        begin
          AContext.Connection.IOHandler.ReadBytes(Buf,Len,False);
          Try
            if Len<65536 then
            begin
              GetMem(Buffer,Len);
              Try
                CopyMemory(Buffer,@Buf[0],Len);
                TRoomContext(AContext).ProcessPacket(Buffer,Len, AContext);
              Finally
                  FreeMemAndNil(Buffer, Len);
              End;
              Sleep(10);
            end
            else
            begin     // Packet is to long: disconnect user and log event
            end;
          Finally
            SetLength(Buf,0);
          End;
        end;



      If Not TRoomContext(AContext).Queue.IsEmpty Then Begin
        tmpList := TList.Create;
        Try
          tmpQueue := TRoomContext(AContext).Queue.LockList;
          Try
            If tmpQueue.Count > 0 Then Begin
              tmpList.Assign(tmpQueue);
              tmpQueue.Clear;
            End;
          Finally
            TRoomContext(AContext).Queue.UnlockList;
          End;

          While tmpList.Count > 0 Do Begin
            outBuffer := tmpList.items[0];
            outLen := PCommunicatorPacket(outBuffer).BufferSize;
            SetLength(outBuf,outLen);
            Try
              CopyMemory(@outBuf[0],outBuffer,outLen);
              tmpList.Delete(0);
            Finally
              If outBuffer <> Nil Then Begin
                FreeMemAndNil(outBuffer);
              End;
            End;

            Try
              If Connected Then
                AContext.Connection.IOHandler.Write(outBuf)
            Finally
              SetLength(outBuf,0);
            End;
          End;
        Finally
          Try
            While tmpList.Count > 0 Do Begin
              outBuffer := tmpList.items[0];
              If outBuffer <> Nil Then Begin
                FreeMemAndNil(outBuffer);
              End;
              tmpList.Delete(0);
            End;
          Finally
            FreeAndNil(tmpList);
          End;
        End;
      End;

      If (MilliSecondsBetween(Now,TRoomContext(AContext).LastReadTime.Value)>RoomTimeOutVal) Then
        AContext.Connection.Disconnect;
    End;

ProcessPacket & related functions which is called from OnExecute Event

procedure TRoomContext.ProcessPacket(Buffer: Pointer; BufSize: Integer; Context: Pointer);
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: Pointer);
var
  DestPtr: Pointer;
  NewPacketBufferLen: Integer;
  SharedBuff: Pointer;
begin
  while PCommunicatorPacket(FPacketBuffer).BufferSize <= PacketBufferPtr do
  begin
    if PCommunicatorPacket(FPacketBuffer).Signature = PACKET_SIGNATURE then
    begin
      GetMem(SharedBuff,PCommunicatorPacket(FPacketBuffer).BufferSize);
      Try
        CopyMemory(SharedBuff,FPacketBuffer,PCommunicatorPacket(FPacketBuffer).BufferSize);
        MainFrm.ExecuteRoomPacket(SharedBuff, Context);
      Finally
        If SharedBuff <> Nil Then FreeMemAndNil(SharedBuff);
      End;
    end
    else
    begin
      DropInvalidPacket;
      Exit;  //we can not continue here because if there is no valid header signature found user thread will hang.
    end;
    NewPacketBufferLen := PacketBufferPtr - PCommunicatorPacket(FPacketBuffer).BufferSize;
    DestPtr := Pointer(Cardinal(FPacketBuffer)+PCommunicatorPacket(FPacketBuffer).BufferSize);
    Move(DestPtr^, FPacketBuffer^, NewPacketBufferLen);
    PacketBufferPtr := NewPacketBufferLen;
  end;
end;

procedure TRoomContext.DropInvalidPacket;
var
  i: Integer;
  DestPtr: Pointer;
  NewPacketBufferLen: Integer;
  Location: Integer;
begin
  Location := -1;
  for i := 0 to PacketBufferPtr - 2 do
    if PCommunicatorPacket(Cardinal(FPacketBuffer)+Cardinal(i)).Signature = PACKET_SIGNATURE then
    begin
      Location := i;
      break;
    end;
  If Location=-1 Then Location := PacketBufferPtr;
  if Location>0 then
  begin
    NewPacketBufferLen := PacketBufferPtr - Location;
    DestPtr := Pointer(Cardinal(FPacketBuffer)+Cardinal(Location));
    Move(DestPtr^, FPacketBuffer^, NewPacketBufferLen);
    PacketBufferPtr := NewPacketBufferLen;
  end;
end;


Procedure TMainFrm.ExecuteRoomPacket(Packet: PCommunicatorPacket; Context: Pointer);
Begin
  TRoomContext(Context).LastReadTime.Value := Now;
  Case Packet.DataType Of
    pdtGroupMessage: ProcessGroupMessagePacket(PGroupMessagePacket(Packet), Context);
    pdtGroupVoicePacket: ProcessGroupVoicePacket(PGroupVoicePacket(Packet), Context);
  end;
End;

Procedure TMainFrm.ProcessGroupMessagePacket(Packet: PGroupMessagePacket; Context: Pointer);
Var Username: String;
    Status: Cardinal;
    Room: TRoom;
    TmpStr: String;
Begin
If Context = Nil Then Exit;
If TRoomContext(Context).Username.Value = '' Then Exit;
  Username := Packet.UserName;
If LowerCase(Username) = LowerCase(TRoomContext(Context).Username.Value) Then Begin
  Status := TRoomContext(Context).Stat.Value;
  If Get_a_Bit(Status, 6) = False Then Begin
    TmpStr := PChar(Cardinal(Packet)+SizeOf(TGroupMessagePacket));
    If Length(TmpStr) > 2048 Then Begin
      TRoomContext(Context).Connection.Disconnect;
      Exit;
    End;
    Room := TRoom(TRoomContext(Context).Room);
    Try
      ForwardToRoomUsers(Username, Room, False, Packet, Packet.BufferSize);
    Finally
      Room := Nil;
    End;
    Sleep(10);
  End;
End;
End;

A Sample Packet

TGroupMessagePacket = packed record
    Signature: Word;
    Version: Cardinal;
    DataType: Byte;
    BufferSize: Word;
    RoomCode: Cardinal;
    UserName: array[0..32] of char;
  end;
  PGroupMessagePacket = ^TGroupMessagePacket;

Finally this is how a packet is sent

Procedure SendMessagePacket(Msg: string);
Var Packet: PGroupMessagePacket;
    PacketSize: Cardinal;
Begin
  PacketSize := SizeOf(TGroupMessagePacket)+Length(Msg)+1;
  GetMem(Packet,PacketSize);
  Try
    ZeroMemory(Packet,PacketSize);
    Packet.Signature := PACKET_SIGNATURE;
    Packet.Version := PACKET_VERSION;
    Packet.DataType := pdtGroupMessage;
    Packet.BufferSize := PacketSize;
    Packet.RoomCode := RoomCode;
    StrCopy(Packet.UserName,PChar(MainForm.MyNickName));
    StrCopy(PChar(Cardinal(Packet)+SizeOf(TGroupMessagePacket)),PChar(Msg));
    PByte(Cardinal(Packet)+PacketSize-1)^ := 0;
    SendBuffer(Packet^,PacketSize);
  Finally
    FreeMem(Packet);
  End;
End;

This is one huge code for anyone to look at, i know no one have that much time to look it up for free, but if someone do help me out, i will really appreciate it, i cant figure out what the error is and its been a few months, i have tried AqTime but still no luck

Thanks

Tried FastMM and AQTime but i have no clue, also i hired a guy from a freelancing website to look into my code, but he took the code and then never contacted me back. i am actually a novice in multithreaded and server apps, so i dont know much — Junaid Noor, Sep 18 '13 at 10:36
Can you look into running a version on a server with enabled FastMM leak reporting to a log file? I doubt anyone will debug your code for you. — Kromster, Sep 18 '13 at 12:24
Actually i tried AQTime memory profiler, and the result i got was really inconclusive, i disconnected all the users and check if there is any leak but all the objects that were still live were supposed to be live, i wasnt able to see any clear leaks, yet the server was showing 50mb usage in task manager, The total size of the objects that AQTime showed was barely upto 10mb, which i know isnt good too but task manager was showing upto 57mb of ram usage in just 2-3 hours of server uptime — Junaid Noor, Sep 18 '13 at 12:31
See also: http://stackoverflow.com/questions/7806262/strategy-or-tools-to-find-non-leak-memory-usage-problems-in-delphi/17365483#17365483 about the new `LogMemoryManagerStateToFile` method in FastMM4 — mjn, Sep 25 '13 at 10:08

score 2 · Answer 1 · answered Sep 18 '13 at 12:38

2

Since you say the leak presents itself only on a live server, look into FastMM leak reporting into a log file. See if you can build the server with leaks reporting into a log file and leave it running.

There's one trick you may find useful if you create and free a lot of objects. To each object add a string with it's name. Now run the server for prolonged period of time. When you get a lot of memory leaked, get a big memdump which is 95% filled with leaked objects. Inspect few random places in the dump and see which objects formed it.

answered Sep 18 '13 at 12:38

Kromster

7,181
7
63
111

Ok, i was doing similar testing, i was sending 8 kb chunk of data continuously on my local server and saw that the server memory usage climbed upto 30mb. so does this mean FreeMem isnt clearing the memory? – Junaid Noor Sep 18 '13 at 12:48
Plus a note: A Programmer once told me that memory allocated in one thread cant be freed from another thread, is it true? can this be the reason of the issue? – Junaid Noor Sep 18 '13 at 12:53
http://stackoverflow.com/questions/18753386/is-memory-allocated-by-delphis-new-globally-accessible-for-dispose suggests it is okay. See the answers details, maybe that helps you. – Kromster Sep 18 '13 at 13:34
2

@JunaidNoor: it is perfectly fine to allocate memory in one thread and free it in another thread (provided you are using a thread-safe memory manager, which Delphi's default memory manager is). – Remy Lebeau Sep 18 '13 at 20:24

Delphi: Memory leak

1 Answers1