Opkman: In order to prevent memory leaks, the update of serializable packages are protected with critical sections.

git-svn-id: trunk@59719 -

components/onlinepackagemanager/opkman_common.pas

@@ -116,6 +116,7 @@ var
   LocalRepositoryUpdatesFile: String;
   PackageAction: TPackageAction;
   InstallPackageList: TObjectList;
+  CriticalSection: TRTLCriticalSection;
 
 function MessageDlgEx(const AMsg: String; ADlgType: TMsgDlgType;  AButtons:
   TMsgDlgButtons; AParent: TForm): TModalResult;

components/onlinepackagemanager/opkman_intf.pas

@@ -80,6 +80,7 @@ uses opkman_common, opkman_options, opkman_const, opkman_progressfrm, opkman_zip
 
 constructor TOPMInterfaceEx.Create;
 begin
+  InitCriticalSection(CriticalSection);
   Application.AddOnExceptionHandler(@DoHandleException);
   FPackageLinks := TObjectList.Create(False);
   FPackagesToDownload := TObjectList.Create(False);
@@ -107,23 +108,25 @@ begin
   SerializablePackages.Free;
   Options.Free;
   InstallPackageList.Free;
+  DoneCriticalsection(CriticalSection);
   inherited Destroy;
 end;
 
 procedure TOPMInterfaceEx.DoOnIDEClose(Sender: TObject);
 begin
+  if Assigned(PackageDownloader) then
+    if PackageDownloader.DownloadingJSON then
+      PackageDownloader.Cancel;
   if Assigned(Updates) then
   begin
     Updates.StopUpdate;
     Updates.Terminate;
-    Sleep(100);
+    Updates.WaitFor;
   end;
 end;
 
 
 procedure TOPMInterfaceEx.DoOnTimer(Sender: TObject);
-var
-  FileName: String;
 begin
   if Assigned(LazarusIDE) and Assigned(PackageEditingInterface) and (not LazarusIDE.IDEIsClosing) then
   begin
@@ -141,11 +144,12 @@ begin
       if (not LazarusIDE.IDEIsClosing) then
       begin
         if Options.CheckForUpdates <> 5 then
+        begin
           PackageDownloader.DownloadJSON(Options.ConTimeOut*1000, True);
-        LazarusIDE.AddHandlerOnIDEClose(@DoOnIDEClose);
+          LazarusIDE.AddHandlerOnIDEClose(@DoOnIDEClose);
-        FileName := Format(LocalRepositoryUpdatesFile, [MD5Print(MD5String(Options.RemoteRepository[Options.ActiveRepositoryIndex]))]);
+          Updates := TUpdates.Create;
-        Updates := TUpdates.Create(FileName);
+          Updates.StartUpdate;
-        Updates.StartUpdate;
+        end;
       end;
     end;
   end;

components/onlinepackagemanager/opkman_mainfrm.pas

@@ -38,7 +38,7 @@ uses
   // IdeIntf
   IDECommands, PackageIntf,
   // OpkMan
-  opkman_downloader, opkman_installer, opkman_updates,
+  opkman_downloader, opkman_installer,
   opkman_serializablepackages, opkman_visualtree, opkman_const, opkman_common,
   opkman_progressfrm, opkman_zipper, opkman_packagelistfrm, opkman_options,
   opkman_optionsfrm, opkman_createrepositorypackagefrm, opkman_maindm,
@@ -389,8 +389,6 @@ begin
           Exit;
         end;
         VisualTree.PopulateTree;
-        if Assigned (Updates) then
-          Updates.StartUpdate(True);
         VisualTree.UpdatePackageUStatus;
         EnableDisableControls(True);
         SetupMessage;

components/onlinepackagemanager/opkman_serializablepackages.pas

@@ -31,7 +31,7 @@ unit opkman_serializablepackages;
 interface
 
 uses
-  Classes, SysUtils, Variants, contnrs, dateutils, fpjson, jsonparser,
+  Classes, SysUtils, Variants, contnrs, dateutils, fpjson, jsonparser, md5,
   // LazUtils
   FileUtil, Laz2_XMLCfg, LazFileUtils,
   // IdeIntf
@@ -237,6 +237,7 @@ type
     FLastError: String;
     FOnProcessJSON: TNotifyEvent;
     FOnUpdatePackageLinks: TNotifyEvent;
+    FUpdates: String;
     function GetCount: Integer;
     function GetDownloadCount: Integer;
     function GetExtractCount: Integer;
@@ -255,6 +256,8 @@ type
     function GetPackageVersion(const APath: String): String;
     function GetPackageDescription(const APath: String): String;
     function GetPackageLicense(const APath: String): String;
+    procedure LoadUpdateInfo;
+    procedure SaveUpdateInfo;
   public
     constructor Create;
     destructor Destroy; override;
@@ -590,10 +593,13 @@ end;
 constructor TSerializablePackages.Create;
 begin
   FMetaPackages := TCollection.Create(TMetaPackage);
+  FUpdates := Format(LocalRepositoryUpdatesFile, [MD5Print(MD5String(Options.RemoteRepository[Options.ActiveRepositoryIndex]))]);
 end;
 
 destructor TSerializablePackages.Destroy;
 begin
+  if Count > 0 then
+    SaveUpdateInfo;
   Clear;
   FMetaPackages.Free;
   inherited Destroy;
@@ -968,8 +974,11 @@ begin
     Parser.Free;
   end;
   if Result then
+  begin
+    LoadUpdateInfo;
     if Assigned(FOnUpdatePackageLinks) then
       FOnUpdatePackageLinks(Self);
+  end;
 end;
 
 function TSerializablePackages.LazarusPackagesToJSON(AMetaPackage: TMetaPackage;
@@ -1115,6 +1124,97 @@ begin
   end;
 end;
 
+procedure TSerializablePackages.LoadUpdateInfo;
+var
+  PackageCount: Integer;
+  LazarusPkgCount: Integer;
+  I, J: Integer;
+  Path, SubPath: String;
+  PackageName: String;
+  LazarusPkgName: String;
+  MetaPkg: TMetaPackage;
+  LazarusPkg: TLazarusPackage;
+  HasUpdate: Boolean;
+  FXML: TXMLConfig;
+begin
+  if not FileExists(FUpdates) then
+    Exit;
+  FXML := TXMLConfig.Create(FUpdates);
+  try
+    PackageCount := FXML.GetValue('Count/Value', 0);
+    for I := 0 to PackageCount - 1 do
+    begin
+      Path := 'Package' + IntToStr(I) + '/';
+      PackageName := FXML.GetValue(Path + 'Name', '');
+      MetaPkg := FindMetaPackage(PackageName, fpbPackageName);
+      if MetaPkg <> nil then
+      begin
+        HasUpdate := False;
+        MetaPkg.DownloadZipURL := FXML.GetValue(Path + 'DownloadZipURL', '');
+        MetaPkg.DisableInOPM := FXML.GetValue(Path + 'DisableInOPM', False);
+        MetaPkg.Rating := FXML.GetValue(Path + 'Rating', 0);
+        LazarusPkgCount := FXML.GetValue(Path + 'Count', 0);
+        for J := 0 to LazarusPkgCount - 1 do
+        begin
+          SubPath := Path + 'PackageFile' +  IntToStr(J) + '/';
+          LazarusPkgName := FXML.GetValue(SubPath + 'Name', '');
+          LazarusPkg := MetaPkg.FindLazarusPackage(LazarusPkgName);
+          if LazarusPkg <> nil then
+          begin
+            LazarusPkg.UpdateVersion := FXML.GetValue(SubPath + 'UpdateVersion', '');
+            LazarusPkg.ForceNotify := FXML.GetValue(SubPath + 'ForceNotify', False);
+            LazarusPkg.InternalVersion := FXML.GetValue(SubPath + 'InternalVersion', 0);;
+            LazarusPkg.InternalVersionOld := FXML.GetValue(SubPath + 'InternalVersionOld', 0);
+            LazarusPkg.RefreshHasUpdate;
+            if not HasUpdate then
+              HasUpdate := (LazarusPkg.HasUpdate) and (LazarusPkg.InstalledFileVersion < LazarusPkg.UpdateVersion);
+          end;
+        end;
+        MetaPkg.HasUpdate := HasUpdate;
+      end;
+    end;
+  finally
+    FXML.Free;
+  end;
+end;
+
+procedure TSerializablePackages.SaveUpdateInfo;
+var
+  I, J: Integer;
+  Path, SubPath: String;
+  MetaPkg: TMetaPackage;
+  LazarusPkg: TLazarusPackage;
+  FXML: TXMLConfig;
+begin
+  FXML := TXMLConfig.CreateClean(FUpdates);
+  try
+    FXML.SetDeleteValue('Version/Value', OpkVersion, 0);
+    FXML.SetDeleteValue('Count/Value', Count, 0);
+    for I := 0 to Count - 1 do
+    begin
+      MetaPkg := Items[I];
+      Path := 'Package' + IntToStr(I) + '/';
+      FXML.SetDeleteValue(Path + 'Name', MetaPkg.Name, '');
+      FXML.SetDeleteValue(Path + 'DownloadZipURL', MetaPkg.DownloadZipURL, '');
+      FXML.SetDeleteValue(Path + 'DisableInOPM', MetaPkg.DisableInOPM, False);
+      FXML.SetDeleteValue(Path + 'Rating', MetaPkg.Rating, 0);
+      FXML.SetDeleteValue(Path + 'Count', Items[I].LazarusPackages.Count, 0);
+      for J := 0 to Items[I].LazarusPackages.Count - 1 do
+      begin
+        SubPath := Path + 'PackageFile' +  IntToStr(J) + '/';
+        LazarusPkg := TLazarusPackage(Items[I].LazarusPackages.Items[J]);
+        FXML.SetDeleteValue(SubPath + 'Name', LazarusPkg.Name, '');
+        FXML.SetDeleteValue(SubPath + 'UpdateVersion', LazarusPkg.UpdateVersion, '');
+        FXML.SetDeleteValue(SubPath + 'ForceNotify', LazarusPkg.ForceNotify, False);
+        FXML.SetDeleteValue(SubPath + 'InternalVersion', LazarusPkg.InternalVersion, 0);
+        FXML.SetDeleteValue(SubPath + 'InternalVersionOld', LazarusPkg.InternalVersionOld, 0);
+      end;
+    end;
+    FXML.Flush;
+  finally
+    FXML.Free;
+  end;
+end;
 
 function TSerializablePackages.IsPackageInstalled(const ALazarusPkg: TLazarusPackage;
   const APackageBaseDir: String): Boolean;

components/onlinepackagemanager/opkman_updates.pas

@@ -32,7 +32,7 @@ interface
 uses
   Classes, SysUtils, fpjson, fpjsonrtti, jsonparser, dateutils,
   // LazUtils
-  Laz2_XMLCfg, LazIDEIntf,
+  LazIDEIntf,
   // OpkMan
   opkman_serializablepackages, opkman_options, opkman_common, opkman_visualtree,
   {$IFDEF MSWINDOWS}
@@ -101,31 +101,29 @@ type
   { TUpdates }
   TUpdates = class(TThread)
   private
+    FSP_Temp: TSerializablePackages;
     FHTTPClient: TFPHTTPClient;
     FUpdatePackage: TUpdatePackage;
-    FVersion: Integer;
     FNeedToBreak: Boolean;
     FBusyUpdating: Boolean;
-    FBusySaving: Boolean;
     FOpenSSLAvailable: Boolean;
     FTime: QWORD;
     FInterval: Cardinal;
-    FFileName: String;
     FStarted: Boolean;
     function GetUpdateInfo(const AURL: String; var AJSON: TJSONStringType): Boolean;
-    procedure Load;
-    procedure Save;
     procedure AssignPackageData(AMetaPackage: TMetaPackage);
     procedure ResetPackageData(AMetaPackage: TMetaPackage);
     procedure CheckForOpenSSL;
     procedure CheckForUpdates;
+    procedure GetSerializablePackages;
+    procedure SetSerializablePackages;
     function IsTimeToUpdate: Boolean;
   protected
     procedure Execute; override;
   public
-    constructor Create(const AFileName: String);
+    constructor Create;
     destructor Destroy; override;
-    procedure StartUpdate(const AOnlyInit: Boolean = False);
+    procedure StartUpdate;
     procedure StopUpdate;
   end;
 
@@ -247,11 +245,11 @@ end;
 
 { TUpdates }
 
-constructor TUpdates.Create(const AFileName: String);
+constructor TUpdates.Create;
 begin
   inherited Create(True);
+  FSP_Temp := TSerializablePackages.Create;
   FreeOnTerminate := True;
-  FFileName := AFileName;
   FHTTPClient := TFPHTTPClient.Create(nil);
   {$IFDEF FPC311}
   FHTTPClient.IOTimeout := Options.ConTimeOut*1000;
@@ -270,107 +268,12 @@ destructor TUpdates.Destroy;
 begin
   FHTTPClient.Free;
   FUpdatePackage.Free;
+  FSP_Temp.Clear;
+  FSP_Temp.Free;
   Updates := nil;
   inherited Destroy;
 end;
 
-procedure TUpdates.Load;
-var
-  PackageCount: Integer;
-  LazarusPkgCount: Integer;
-  I, J: Integer;
-  Path, SubPath: String;
-  PackageName: String;
-  LazarusPkgName: String;
-  MetaPkg: TMetaPackage;
-  LazarusPkg: TLazarusPackage;
-  HasUpdate: Boolean;
-  FXML: TXMLConfig;
-begin
-  if (not Assigned(SerializablePackages)) or (SerializablePackages.Count = 0) then
-    Exit;
-  FXML := TXMLConfig.Create(FFileName);
-  try
-    FVersion := FXML.GetValue('Version/Value', 0);
-    PackageCount := FXML.GetValue('Count/Value', 0);
-    for I := 0 to PackageCount - 1 do
-    begin
-      Path := 'Package' + IntToStr(I) + '/';
-      PackageName := FXML.GetValue(Path + 'Name', '');
-      MetaPkg := SerializablePackages.FindMetaPackage(PackageName, fpbPackageName);
-      if MetaPkg <> nil then
-      begin
-        HasUpdate := False;
-        MetaPkg.DownloadZipURL := FXML.GetValue(Path + 'DownloadZipURL', '');
-        MetaPkg.DisableInOPM := FXML.GetValue(Path + 'DisableInOPM', False);
-        MetaPkg.Rating := FXML.GetValue(Path + 'Rating', 0);
-        LazarusPkgCount := FXML.GetValue(Path + 'Count', 0);
-        for J := 0 to LazarusPkgCount - 1 do
-        begin
-          SubPath := Path + 'PackageFile' +  IntToStr(J) + '/';
-          LazarusPkgName := FXML.GetValue(SubPath + 'Name', '');
-          LazarusPkg := MetaPkg.FindLazarusPackage(LazarusPkgName);
-          if LazarusPkg <> nil then
-          begin
-            LazarusPkg.UpdateVersion := FXML.GetValue(SubPath + 'UpdateVersion', '');
-            LazarusPkg.ForceNotify := FXML.GetValue(SubPath + 'ForceNotify', False);
-            LazarusPkg.InternalVersion := FXML.GetValue(SubPath + 'InternalVersion', 0);;
-            LazarusPkg.InternalVersionOld := FXML.GetValue(SubPath + 'InternalVersionOld', 0);
-            LazarusPkg.RefreshHasUpdate;
-            if not HasUpdate then
-              HasUpdate := (LazarusPkg.HasUpdate) and (LazarusPkg.InstalledFileVersion < LazarusPkg.UpdateVersion);
-          end;
-        end;
-        MetaPkg.HasUpdate := HasUpdate;
-      end;
-    end;
-  finally
-    FXML.Free;
-  end;
-end;
-
-procedure TUpdates.Save;
-var
-  I, J: Integer;
-  Path, SubPath: String;
-  MetaPkg: TMetaPackage;
-  LazarusPkg: TLazarusPackage;
-  FXML: TXMLConfig;
-begin
-  if (not Assigned(SerializablePackages)) or (SerializablePackages.Count = 0) or (FBusySaving) then
-    Exit;
-  FBusySaving := True;
-  FXML := TXMLConfig.CreateClean(FFileName);
-  try
-    FXML.SetDeleteValue('Version/Value', OpkVersion, 0);
-    FXML.SetDeleteValue('Count/Value', SerializablePackages.Count, 0);
-    for I := 0 to SerializablePackages.Count - 1 do
-    begin
-      MetaPkg := SerializablePackages.Items[I];
-      Path := 'Package' + IntToStr(I) + '/';
-      FXML.SetDeleteValue(Path + 'Name', MetaPkg.Name, '');
-      FXML.SetDeleteValue(Path + 'DownloadZipURL', MetaPkg.DownloadZipURL, '');
-      FXML.SetDeleteValue(Path + 'DisableInOPM', MetaPkg.DisableInOPM, False);
-      FXML.SetDeleteValue(Path + 'Rating', MetaPkg.Rating, 0);
-      FXML.SetDeleteValue(Path + 'Count', SerializablePackages.Items[I].LazarusPackages.Count, 0);
-      for J := 0 to SerializablePackages.Items[I].LazarusPackages.Count - 1 do
-      begin
-        SubPath := Path + 'PackageFile' +  IntToStr(J) + '/';
-        LazarusPkg := TLazarusPackage(SerializablePackages.Items[I].LazarusPackages.Items[J]);
-        FXML.SetDeleteValue(SubPath + 'Name', LazarusPkg.Name, '');
-        FXML.SetDeleteValue(SubPath + 'UpdateVersion', LazarusPkg.UpdateVersion, '');
-        FXML.SetDeleteValue(SubPath + 'ForceNotify', LazarusPkg.ForceNotify, False);
-        FXML.SetDeleteValue(SubPath + 'InternalVersion', LazarusPkg.InternalVersion, 0);
-        FXML.SetDeleteValue(SubPath + 'InternalVersionOld', LazarusPkg.InternalVersionOld, 0);
-      end;
-    end;
-    FXML.Flush;
-  finally
-    FXML.Free;
-    FBusySaving := False;
-  end;
-end;
-
 procedure TUpdates.AssignPackageData(AMetaPackage: TMetaPackage);
 var
   I: Integer;
@@ -378,8 +281,6 @@ var
   LazarusPkg: TLazarusPackage;
   UpdLazPkgs: TUpdateLazPackages;
 begin
-  if FBusySaving then
-    Exit;
   HasUpdate := False;
   AMetaPackage.DownloadZipURL := FUpdatePackage.FUpdatePackageData.DownloadZipURL;
   AMetaPackage.DisableInOPM := FUpdatePackage.FUpdatePackageData.DisableInOPM;
@@ -405,8 +306,6 @@ var
   I: Integer;
   LazarusPkg: TLazarusPackage;
 begin
-  if FBusySaving then
-    Exit;
   AMetaPackage.DownloadZipURL := '';
   AMetaPackage.DisableInOPM := False;
   AMetaPackage.HasUpdate := False;
@@ -467,10 +366,9 @@ end;
 
 function TUpdates.IsTimeToUpdate: Boolean;
 begin
-  Result := Assigned(SerializablePackages) and (FOpenSSLAvailable) and
+  Result := (FOpenSSLAvailable) and (not FBusyUpdating) and (not FNeedToBreak);
-            (not FBusyUpdating) and (not FNeedToBreak);
   case Options.CheckForUpdates of
-    0: Result := MinutesBetween(Now, Options.LastUpdate) >= 15;
+    0: Result := MinutesBetween(Now, Options.LastUpdate) >= 5;
     1: Result := HoursBetween(Now, Options.LastUpdate) >= 1;
     2: Result := DaysBetween(Now, Options.LastUpdate) >= 1;
     3: Result := WeeksBetween(Now, Options.LastUpdate) >= 1;
@@ -523,32 +421,96 @@ var
   I: Integer;
   JSON: TJSONStringType;
 begin
+  if FSP_Temp.Count = 0 then
+    Exit;
+
   FBusyUpdating := True;
   try
     Options.LastUpdate := Now;
     Options.Changed := True;
-    for I := 0 to SerializablePackages.Count - 1  do
+    for I := 0 to FSP_Temp.Count - 1  do
     begin
       if FNeedToBreak then
         Break;
       JSON := '';
       if (Assigned(LazarusIDE) and LazarusIDE.IDEIsClosing) then
         Break;
-      if GetUpdateInfo(Trim(SerializablePackages.Items[I].DownloadURL), JSON) then
+      if GetUpdateInfo(Trim(FSP_Temp.Items[I].DownloadURL), JSON) then
       begin
         if FUpdatePackage.LoadFromJSON(JSON) then
-          AssignPackageData(SerializablePackages.Items[I])
+          AssignPackageData(FSP_Temp.Items[I])
         else
-          ResetPackageData(SerializablePackages.Items[I]);
+          ResetPackageData(FSP_Temp.Items[I]);
       end
       else
-        ResetPackageData(SerializablePackages.Items[I]);
+        ResetPackageData(FSP_Temp.Items[I]);
     end;
   finally
     FBusyUpdating := False;
   end;
 end;
 
+procedure TUpdates.GetSerializablePackages;
+var
+  JSON: TJSONStringType;
+begin
+  if (FNeedToBreak) or (SerializablePackages.Count = 0) then
+    Exit;
+
+  EnterCriticalSection(CriticalSection);
+  try
+    FSP_Temp.Clear;
+    try
+      JSON := '';
+      SerializablePackages.PackagesToJSON(JSON);
+      FSP_Temp.JSONToPackages(JSON);
+    except
+    end;
+  finally
+    LeaveCriticalSection(CriticalSection);
+  end;
+end;
+
+procedure TUpdates.SetSerializablePackages;
+var
+  I, J: Integer;
+  MetaPackage: TMetaPackage;
+  HasUpdate: Boolean;
+  LazarusPackage: TLazarusPackage;
+begin
+  if (FNeedToBreak) or (SerializablePackages.Count = 0) or (FSP_Temp.Count = 0) then
+    Exit;
+  EnterCriticalSection(CriticalSection);
+  try
+    for I := 0 to FSP_Temp.Count - 1 do
+    begin
+      MetaPackage := SerializablePackages.FindMetaPackage(FSP_Temp.Items[I].Name, fpbPackageName);
+      if MetaPackage <> nil then
+      begin
+        MetaPackage.DownloadZipURL := FSP_Temp.Items[I].DownloadZipURL;
+        MetaPackage.DisableInOPM := FSP_Temp.Items[I].DisableInOPM;
+        HasUpdate := False;
+        for J := 0 to FSP_Temp.Items[I].LazarusPackages.Count - 1 do
+        begin
+          LazarusPackage := MetaPackage.FindLazarusPackage(TLazarusPackage(FSP_Temp.Items[I].LazarusPackages.Items[J]).Name);
+          if LazarusPackage <> nil then
+          begin
+            LazarusPackage.UpdateVersion := TLazarusPackage(FSP_Temp.Items[I].LazarusPackages.Items[J]).UpdateVersion;
+            LazarusPackage.ForceNotify := TLazarusPackage(FSP_Temp.Items[I].LazarusPackages.Items[J]).ForceNotify;
+            LazarusPackage.InternalVersion := TLazarusPackage(FSP_Temp.Items[I].LazarusPackages.Items[J]).InternalVersion;
+            LazarusPackage.RefreshHasUpdate;
+            if not HasUpdate then
+              HasUpdate := (LazarusPackage.HasUpdate) and (LazarusPackage.InstalledFileVersion < LazarusPackage.UpdateVersion);
+          end;
+        end;
+        MetaPackage.HasUpdate := HasUpdate;
+      end;
+    end;
+  finally
+    LeaveCriticalSection(CriticalSection);
+  end;
+end;
+
 procedure TUpdates.Execute;
 begin
   while not Terminated do
@@ -561,19 +523,18 @@ begin
       FTime := GetTickCount64;
       if (IsTimeToUpdate) then
       begin
-         CheckForUpdates;
+        GetSerializablePackages;
-         if (not FNeedToBreak) and Assigned(VisualTree) then
+        CheckForUpdates;
-           Synchronize(@VisualTree.UpdatePackageUStatus)
+        SetSerializablePackages;
+        if (not FNeedToBreak) and Assigned(VisualTree) then
+          Synchronize(@VisualTree.UpdatePackageUStatus);
       end;
     end;
   end;
 end;
 
-procedure TUpdates.StartUpdate(const AOnlyInit: Boolean = False);
+procedure TUpdates.StartUpdate;
 begin
-  Load;
-  if AOnlyInit then
-    Exit;
   FStarted := True;
   CheckForOpenSSL;
   FTime := GetTickCount64;
@@ -584,7 +545,6 @@ end;
 procedure TUpdates.StopUpdate;
 begin
   FStarted := False;
-  Save;
   FHTTPClient.Terminate;
   FNeedToBreak := True;
 end;