diff --git a/components/onlinepackagemanager/opkman_common.pas b/components/onlinepackagemanager/opkman_common.pas index e7528ad8d1..30512f9a05 100644 --- a/components/onlinepackagemanager/opkman_common.pas +++ b/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; diff --git a/components/onlinepackagemanager/opkman_intf.pas b/components/onlinepackagemanager/opkman_intf.pas index 556332fe9c..9c8f53e5c4 100644 --- a/components/onlinepackagemanager/opkman_intf.pas +++ b/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); - FileName := Format(LocalRepositoryUpdatesFile, [MD5Print(MD5String(Options.RemoteRepository[Options.ActiveRepositoryIndex]))]); - Updates := TUpdates.Create(FileName); - Updates.StartUpdate; + LazarusIDE.AddHandlerOnIDEClose(@DoOnIDEClose); + Updates := TUpdates.Create; + Updates.StartUpdate; + end; end; end; end; diff --git a/components/onlinepackagemanager/opkman_mainfrm.pas b/components/onlinepackagemanager/opkman_mainfrm.pas index 2458f21d57..5429dfdf76 100644 --- a/components/onlinepackagemanager/opkman_mainfrm.pas +++ b/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; diff --git a/components/onlinepackagemanager/opkman_serializablepackages.pas b/components/onlinepackagemanager/opkman_serializablepackages.pas index 07072b6c4f..d78ff2bac2 100644 --- a/components/onlinepackagemanager/opkman_serializablepackages.pas +++ b/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; diff --git a/components/onlinepackagemanager/opkman_updates.pas b/components/onlinepackagemanager/opkman_updates.pas index 8d59d7c189..7cb6760cf0 100644 --- a/components/onlinepackagemanager/opkman_updates.pas +++ b/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 - (not FBusyUpdating) and (not FNeedToBreak); + Result := (FOpenSSLAvailable) and (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; - if (not FNeedToBreak) and Assigned(VisualTree) then - Synchronize(@VisualTree.UpdatePackageUStatus) + GetSerializablePackages; + CheckForUpdates; + 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;