Manual Merge 4.1 - Improved memory management on NetProtection (auto clean memory)

src/core/UNetProtection.pas

@@ -33,7 +33,7 @@ unit UNetProtection;
 
 interface
 
-Uses SysUtils, Classes, UJSONFunctions, UThread, ULog, UTime,
+Uses SysUtils, Classes, UJSONFunctions, UThread, ULog, UTime, UBaseTypes,
   {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF};
 
 
@@ -57,6 +57,7 @@ Type
     FMaxStatsLifetime: Integer;
     FMaxStatsCount: Integer;
     FDeletedStatsCount: Int64;
+    FLastCleanedTC : TTickCount;
     function Find(lockedList : TList<Pointer>; const ip : String; var Index: Integer): Boolean;
     procedure SetMaxStatsLifetime(const Value: Integer);
     procedure CleanLastStatsByUpdatedTimestamp(minTimestamp : Integer);
@@ -75,6 +76,7 @@ Type
     function Count : Integer;
     property MaxStatsLifetime : Integer read FMaxStatsLifetime write SetMaxStatsLifetime;
     property MaxStatsCount : Integer read FMaxStatsCount write SetMaxStatsCount;
+    function CleanLastStats : Integer;
   End;
 
 implementation
@@ -83,6 +85,19 @@ implementation
 
 Type PIpInfo = ^TIpInfo;
 
+function TIpInfos.CleanLastStats : Integer;
+var LLastCleanedCount : Integer;
+  LCurrTimestamp : Integer;
+begin
+  LCurrTimestamp := UnivDateTimeToUnix( DateTime2UnivDateTime(now) );
+  LLastCleanedCount := FDeletedStatsCount;
+  CleanLastStatsByUpdatedTimestamp(LCurrTimestamp - FMaxStatsLifetime);
+  Result := FDeletedStatsCount-LLastCleanedCount;
+  if (LLastCleanedCount<>FDeletedStatsCount) then begin
+    TLog.NewLog(ltInfo,ClassName,Format('Cleaned %d old stats',[(FDeletedStatsCount-LLastCleanedCount)]));
+  end;
+end;
+
 procedure TIpInfos.CleanLastStatsByUpdatedTimestamp(minTimestamp: Integer);
 var jsonOpType, relJsonOpType, relJsonNetTransferType : TPCJSONObject;
   lasts : TPCJSONArray;
@@ -118,6 +133,7 @@ begin
         end;
       end;
     end;
+    FLastCleanedTC := TPlatform.GetTickCount;
   Finally
     FThreadList.UnlockList;
   End;
@@ -137,6 +153,7 @@ begin
     end;
     FDeletedStatsCount := 0;
     list.Clear;
+    FLastCleanedTC := TPlatform.GetTickCount;
   Finally
     FThreadList.UnlockList;
   End;
@@ -154,6 +171,7 @@ begin
   FMaxStatsLifetime := 60*60*24; // Last values by 24 hours by default
   FMaxStatsCount := 1000; // Max 1000 last stats by default
   FDeletedStatsCount := 0;
+  FLastCleanedTC := TPlatform.GetTickCount;
 end;
 
 destructor TIpInfos.Destroy;
@@ -356,6 +374,9 @@ begin
         end;
       end;
     end;
+    if TPlatform.GetElapsedMilliseconds( FLastCleanedTC ) > (FMaxStatsLifetime * 1000) then begin ///  Clean stats auto
+      CleanLastStats;
+    end;
   Finally
     Unlock;
   End;

src/core/URPC.pas

@@ -1095,14 +1095,27 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
     json, newJson : TPCJSONObject;
     ipInfo : TIpInfo;
     aDisconnectedOnly : Boolean;
+    LShowDetailedStats : Boolean;
   begin
+    if params.AsBoolean('clean',False) then begin
+      GetResultObject.GetAsVariant('cleaned').Value := TNetData.NetData.IpInfos.CleanLastStats;
+      Exit;
+    end;
+    if params.AsBoolean('clear',False) then begin
+      GetResultObject.GetAsVariant('cleared').Value := TNetData.NetData.IpInfos.Count;
+      TNetData.NetData.IpInfos.Clear;
+      Exit;
+    end;
+    LShowDetailedStats := params.AsBoolean('detailed-stats',False);
     aip := Trim(params.AsString('ip',''));
     if aip<>'' then begin
       json := TNetData.NetData.IpInfos.Lock(aip,False);
       Try
         newJson := TPCJSONObject.Create;
         newJson.GetAsVariant('ip').Value := aip;
-        newJson.GetAsObject('values').Assign(json);
+        if LShowDetailedStats then begin
+          newJson.GetAsObject('values').Assign(json);
+        end;
         GetResultArray.Insert(GetResultArray.Count,newJson);
       Finally
         TNetData.NetData.IpInfos.Unlock;
@@ -1115,7 +1128,9 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
           if (Not aDisconnectedOnly) Or (Assigned(ipInfo.json.FindName('disconnect'))) then begin
             newJson := TPCJSONObject.Create;
             newJson.GetAsVariant('ip').Value := ipInfo.ip;
-            newJson.GetAsObject('values').Assign(ipInfo.json);
+            if LShowDetailedStats then begin
+              newJson.GetAsObject('values').Assign(ipInfo.json);
+            end;
             GetResultArray.Insert(GetResultArray.Count,newJson);
           end;
         Finally
@@ -1123,9 +1138,6 @@ function TRPCProcess.ProcessMethod(const method: String; params: TPCJSONObject;
         End;
       end;
     end;
-    if params.AsBoolean('clear',False) then begin
-      TNetData.NetData.IpInfos.Clear;
-    end;
   end;
 
   // This function creates a TOpTransaction without looking for balance/private key of sender account