diff --git a/packages/fppkg/src/pkgcommands.pp b/packages/fppkg/src/pkgcommands.pp index cc4f3843a0..442430e7ec 100644 --- a/packages/fppkg/src/pkgcommands.pp +++ b/packages/fppkg/src/pkgcommands.pp @@ -250,13 +250,13 @@ begin (PackageManager.Options.GlobalSection.RemoteRepository='auto') then begin Log(llCommands,SLogDownloading,[PackageManager.Options.GlobalSection.RemoteMirrorsURL,PackageManager.Options.GlobalSection.LocalMirrorsFile]); - DownloadFile(PackageManager.Options.GlobalSection.RemoteMirrorsURL,PackageManager.Options.GlobalSection.LocalMirrorsFile); + DownloadFile(PackageManager.Options.GlobalSection.RemoteMirrorsURL,PackageManager.Options.GlobalSection.LocalMirrorsFile, PackageManager); LoadLocalAvailableMirrors; end; // Download packages.xml - PackagesURL:=GetRemoteRepositoryURL(PackagesFileName); + PackagesURL:=PackageManager.GetRemoteRepositoryURL(PackagesFileName); Log(llCommands,SLogDownloading,[PackagesURL,PackageManager.Options.GlobalSection.LocalPackagesFile]); - DownloadFile(PackagesURL,PackageManager.Options.GlobalSection.LocalPackagesFile); + DownloadFile(PackagesURL,PackageManager.Options.GlobalSection.LocalPackagesFile,PackageManager); // Read the repository again PackageManager.ScanAvailablePackages; // no need to log errors again @@ -284,7 +284,7 @@ begin if PackageName='' then Error(SErrNoPackageSpecified); P:=PackageManager.PackageByName(PackageName, pkgpkAvailable); - if not FileExists(PackageLocalArchive(P)) then + if not FileExists(PackageManager.PackageLocalArchive(P)) then ExecuteAction(PackageName,'downloadpackage'); end; @@ -298,8 +298,8 @@ begin if PackageName='' then Error(SErrNoPackageSpecified); P:=PackageManager.PackageByName(PackageName, pkgpkAvailable); - BuildDir:=PackageBuildPath(P); - ArchiveFile:=PackageLocalArchive(P); + BuildDir:=PackageManager.PackageBuildPath(P); + ArchiveFile:=PackageManager.PackageLocalArchive(P); if not FileExists(ArchiveFile) then ExecuteAction(PackageName,'downloadpackage'); { Create builddir, remove it first if needed } @@ -311,7 +311,7 @@ begin With TUnZipper.Create do try Log(llCommands,SLogUnzippping,[ArchiveFile]); - OutputPath:=PackageBuildPath(P); + OutputPath:=PackageManager.PackageBuildPath(P); UnZipAllFiles(ArchiveFile); Finally Free; @@ -562,7 +562,7 @@ begin end else begin - if InstalledP.IsPackageBroken then + if PackageManager.PackageIsBroken(InstalledP, InstalledP.Repository) then begin status:='Broken, recompiling'; L.Add(D.PackageName); diff --git a/packages/fppkg/src/pkgdownload.pp b/packages/fppkg/src/pkgdownload.pp index 3a9f612136..f8cb280874 100644 --- a/packages/fppkg/src/pkgdownload.pp +++ b/packages/fppkg/src/pkgdownload.pp @@ -5,7 +5,7 @@ unit pkgDownload; interface uses - Classes, SysUtils, pkghandler; + Classes, SysUtils, pkghandler, pkgFppkg; Type @@ -36,7 +36,7 @@ Type procedure RegisterDownloader(const AName:string;Downloaderclass:TBaseDownloaderClass); function GetDownloader(const AName:string):TBaseDownloaderClass; -procedure DownloadFile(const RemoteFile,LocalFile:String); +procedure DownloadFile(const RemoteFile,LocalFile:String; PackageManager: TpkgFPpkg); implementation @@ -48,8 +48,7 @@ uses pkgglobals, pkgoptions, pkgmessages, - pkgrepos, - pkgFppkg; + pkgrepos; var DownloaderList : TFPHashList; @@ -73,11 +72,11 @@ begin end; -procedure DownloadFile(const RemoteFile,LocalFile:String); +procedure DownloadFile(const RemoteFile,LocalFile:String; PackageManager: TpkgFPpkg); var DownloaderClass : TBaseDownloaderClass; begin - DownloaderClass:=GetDownloader(GFPpkg.Options.GlobalSection.Downloader); + DownloaderClass:=GetDownloader(PackageManager.Options.GlobalSection.Downloader); with DownloaderClass.Create(nil) do try Download(RemoteFile,LocalFile); @@ -164,21 +163,31 @@ procedure TDownloadPackage.Execute; var DownloaderClass : TBaseDownloaderClass; P : TFPPackage; + RemoteArchive: string; begin - P:=GFPpkg.PackageByName(PackageName, pkgpkAvailable); - DownloaderClass:=GetDownloader(GFPpkg.Options.GlobalSection.Downloader); - with DownloaderClass.Create(nil) do - try - Log(llCommands,SLogDownloading,[PackageRemoteArchive(P),PackageLocalArchive(P)]); - pkgglobals.log(llProgres,SProgrDownloadPackage,[P.Name, P.Version.AsString]); + P:=PackageManager.PackageByName(PackageName, pkgpkAvailable); + DownloaderClass:=GetDownloader(PackageManager.Options.GlobalSection.Downloader); + if Assigned(DownloaderClass) then + begin + with DownloaderClass.Create(nil) do + try + RemoteArchive := PackageManager.PackageRemoteArchive(P); + if RemoteArchive <> '' then + begin + Log(llCommands,SLogDownloading,[RemoteArchive,PackageManager.PackageLocalArchive(P)]); + pkgglobals.log(llProgres,SProgrDownloadPackage,[P.Name, P.Version.AsString]); - // Force the existing of the archives-directory if it is being used - if (P.Name<>CurrentDirPackageName) and (P.Name<>CmdLinePackageName) then - ForceDirectories(GFPpkg.Options.GlobalSection.ArchivesDir); + // Force the existing of the archives-directory if it is being used + if (P.Name<>CurrentDirPackageName) and (P.Name<>CmdLinePackageName) then + ForceDirectories(PackageManager.Options.GlobalSection.ArchivesDir); - Download(PackageRemoteArchive(P),PackageLocalArchive(P)); - finally - Free; + Download(RemoteArchive,PackageManager.PackageLocalArchive(P)); + end + else + Error(SErrDownloadPackageFailed); + finally + Free; + end; end; end; diff --git a/packages/fppkg/src/pkgfpmake.pp b/packages/fppkg/src/pkgfpmake.pp index 4633c0c7cb..616897ffc4 100644 --- a/packages/fppkg/src/pkgfpmake.pp +++ b/packages/fppkg/src/pkgfpmake.pp @@ -306,7 +306,7 @@ begin // Does the current package support this CPU-OS? if PackageName<>'' then begin - P:=GFPpkg.PackageByName(PackageName, pkgpkAvailable); + P:=PackageManager.PackageByName(PackageName, pkgpkAvailable); if (PackageName=CurrentDirPackageName) and (FileExists(ManifestFileName)) then ObtainSupportedTargetsFromManifest(p); end @@ -315,9 +315,9 @@ begin if assigned(P) then begin if (command<>'archive') and (command<>'manifest') and - (not(GFPpkg.CompilerOptions.CompilerOS in P.OSes) or - not(GFPpkg.CompilerOptions.CompilerCPU in P.CPUs)) then - Error(SErrPackageDoesNotSupportTarget,[P.Name,MakeTargetString(GFPpkg.CompilerOptions.CompilerCPU,GFPpkg.CompilerOptions.CompilerOS)]); + (not(PackageManager.CompilerOptions.CompilerOS in P.OSes) or + not(PackageManager.CompilerOptions.CompilerCPU in P.CPUs)) then + Error(SErrPackageDoesNotSupportTarget,[P.Name,MakeTargetString(PackageManager.CompilerOptions.CompilerCPU,GFPpkg.CompilerOptions.CompilerOS)]); end; { Maybe compile fpmake executable? } ExecuteAction(PackageName,'compilefpmake'); @@ -334,13 +334,13 @@ begin end else begin - if GFPpkg.CompilerOptions.HasOptions then + if PackageManager.CompilerOptions.HasOptions then AddOption('--options='+GFPpkg.CompilerOptions.Options.DelimitedText); - if GFPpkg.Options.GlobalSection.CustomFPMakeOptions<>'' then + if PackageManager.Options.GlobalSection.CustomFPMakeOptions<>'' then begin AddOption('--ignoreinvalidoption'); - AddOption(GFPpkg.Options.GlobalSection.CustomFPMakeOptions); + AddOption(PackageManager.Options.GlobalSection.CustomFPMakeOptions); end; end; @@ -354,7 +354,7 @@ begin // manifest command does not use the --prefix and --baseinstalldir parameters. if (command<>'manifest') then begin - InstallRepo := GFPpkg.RepositoryByName(GFPpkg.Options.CommandLineSection.InstallRepository); + InstallRepo := PackageManager.RepositoryByName(PackageManager.Options.CommandLineSection.InstallRepository); if not Assigned(InstallRepo.DefaultPackagesStructure) then begin @@ -365,11 +365,11 @@ begin CondAddOption('--baseinstalldir',InstallRepo.DefaultPackagesStructure.GetBaseInstallDir); end; - for i := GFPpkg.RepositoryList.Count-1 downto 0 do + for i := PackageManager.RepositoryList.Count-1 downto 0 do begin - if GFPpkg.RepositoryList[i] is TFPRepository then + if PackageManager.RepositoryList[i] is TFPRepository then begin - InstallRepo := TFPRepository(GFPpkg.RepositoryList[i]); + InstallRepo := TFPRepository(PackageManager.RepositoryList[i]); if (InstallRepo.RepositoryType = fprtInstalled) and Assigned(InstallRepo.DefaultPackagesStructure) then begin BaseInstDir := InstallRepo.DefaultPackagesStructure.GetBaseInstallDir; diff --git a/packages/fppkg/src/pkgfppkg.pp b/packages/fppkg/src/pkgfppkg.pp index 79a760f6b4..2a6734c856 100644 --- a/packages/fppkg/src/pkgfppkg.pp +++ b/packages/fppkg/src/pkgfppkg.pp @@ -26,10 +26,13 @@ type FOptions: TFppkgOptions; FCompilerOptions: TCompilerOptions; FFpmakeCompilerOptions: TCompilerOptions; + FCurrentRemoteRepositoryURL: String; function IncludeRepositoryTypeForPackageKind(ARepositoryType: TFPRepositoryType; APackageKind: TpkgPackageKind): Boolean; procedure ScanPackagesOnDisk(ACompilerOptions: TCompilerOptions; APackageKind: TpkgPackageKind; ARepositoryList: TComponentList); function FindPackage(ARepositoryList: TComponentList; APackageName: string; APackageKind: TpkgPackageKind): TFPPackage; + + function SelectRemoteMirror:string; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -39,6 +42,8 @@ type procedure ScanAvailablePackages; procedure ScanPackages; + function PackageIsBroken(APackage: TFPPackage; ARepository: TFPRepository): Boolean; + function FPMakeRepoFindPackage(APackageName: string; APackageKind: TpkgPackageKind): TFPPackage; function FindPackage(APackageName: string; APackageKind: TpkgPackageKind): TFPPackage; function PackageByName(APackageName: string; APackageKind: TpkgPackageKind): TFPPackage; @@ -47,6 +52,11 @@ type function RepositoryByName(ARepositoryName: string): TFPRepository; function GetInstallRepository(APackage: TFPPackage): TFPRepository; + function PackageLocalArchive(APackage:TFPPackage): String; + function PackageBuildPath(APackage:TFPPackage):String; + + function GetRemoteRepositoryURL(const AFileName:string):string; + function PackageRemoteArchive(APackage:TFPPackage): String; procedure ScanInstalledPackagesForAvailablePackages; @@ -259,6 +269,57 @@ begin ScanAvailablePackages; end; +function TpkgFPpkg.PackageIsBroken(APackage: TFPPackage; ARepository: TFPRepository): Boolean; +var + j, i, ThisRepositoryIndex: Integer; + Dependency: TFPDependency; + Repository: TFPRepository; + DepPackage: TFPPackage; +begin + result:=false; + + // We should only check for dependencies in this repository, or repositories + // with a lower priority. + ThisRepositoryIndex := -1; + for i := RepositoryList.Count -1 downto 0 do + begin + if RepositoryList.Items[i] = ARepository then + ThisRepositoryIndex := i; + end; + + for j:=0 to APackage.Dependencies.Count-1 do + begin + Dependency:=APackage.Dependencies[j]; + if (CompilerOptions.CompilerOS in Dependency.OSes) and + (CompilerOptions.CompilerCPU in Dependency.CPUs) then + begin + for i := ThisRepositoryIndex downto 0 do + begin + Repository := RepositoryList.Items[i] as TFPRepository; + DepPackage := Repository.FindPackage(Dependency.PackageName); + if Assigned(DepPackage) then + Break; + end; + + if assigned(DepPackage) then + begin + if (Dependency.RequireChecksum<>$ffffffff) and (DepPackage.Checksum<>Dependency.RequireChecksum) then + begin + log(llInfo,SLogPackageChecksumChanged,[APackage.Name,ARepository.RepositoryName,Dependency.PackageName,Repository.RepositoryName]); + result:=true; + exit; + end; + end + else + begin + log(llDebug,SDbgObsoleteDependency,[APackage.Name,Dependency.PackageName]); + result:=true; + exit; + end; + end; + end; +end; + function TpkgFPpkg.FPMakeRepoFindPackage(APackageName: string; APackageKind: TpkgPackageKind): TFPPackage; begin @@ -289,6 +350,48 @@ begin end; end; +function TpkgFPpkg.SelectRemoteMirror: string; +var + i,j : Integer; + Bucket, + BucketCnt : Integer; + M : TFPMirror; +begin + Result:=''; + M:=nil; + if assigned(AvailableMirrors) then + begin + // Create array for selection + BucketCnt:=0; + for i:=0 to AvailableMirrors.Count-1 do + inc(BucketCnt,AvailableMirrors[i].Weight); + // Select random entry + Bucket:=Random(BucketCnt); + M:=nil; + for i:=0 to AvailableMirrors.Count-1 do + begin + for j:=0 to AvailableMirrors[i].Weight-1 do + begin + if Bucket=0 then + begin + M:=AvailableMirrors[i]; + break; + end; + Dec(Bucket); + end; + if assigned(M) then + break; + end; + end; + if assigned(M) then + begin + log(llInfo,SLogSelectedMirror,[M.Name]); + Result:=M.URL; + end + else + Error(SErrFailedToSelectMirror); +end; + function TpkgFPpkg.PackageByName(APackageName: string; APackageKind: TpkgPackageKind): TFPPackage; var ErrStr: string; @@ -347,6 +450,16 @@ begin end; end; +function TpkgFPpkg.PackageLocalArchive(APackage: TFPPackage): String; +begin + if APackage.Name=CurrentDirPackageName then + Error(SErrNoPackageSpecified) + else if APackage.Name=CmdLinePackageName then + Result:=APackage.LocalFileName + else + Result:=Options.GlobalSection.ArchivesDir+APackage.FileName; +end; + procedure TpkgFPpkg.ScanInstalledPackagesForAvailablePackages; var i: Integer; @@ -368,5 +481,45 @@ begin end; end; +function TpkgFPpkg.PackageBuildPath(APackage: TFPPackage): String; +begin + if (APackage.Name=CmdLinePackageName) or (APackage.Name=URLPackageName) then + Result:=Options.GlobalSection.BuildDir+ChangeFileExt(ExtractFileName(APackage.LocalFileName),'') + else if Assigned(APackage.PackagesStructure) and (APackage.PackagesStructure.GetBuildPathDirectory(APackage)<>'') then + Result:=APackage.PackagesStructure.GetBuildPathDirectory(APackage) + else + Result:=Options.GlobalSection.BuildDir+APackage.Name; +end; + +function TpkgFPpkg.GetRemoteRepositoryURL(const AFileName: string): string; +begin + if FCurrentRemoteRepositoryURL='' then + begin + if Options.GlobalSection.RemoteRepository='auto' then + FCurrentRemoteRepositoryURL:=SelectRemoteMirror + else + FCurrentRemoteRepositoryURL:=Options.GlobalSection.RemoteRepository; + end; + result := FCurrentRemoteRepositoryURL; + if result <> '' then + begin + if result[length(result)]<>'/' then + result := result + '/'; + Result:=Result+CompilerOptions.CompilerVersion+'/'+AFileName; + end; +end; + +function TpkgFPpkg.PackageRemoteArchive(APackage: TFPPackage): String; +begin + if APackage.Name=CurrentDirPackageName then + Error(SErrNoPackageSpecified) + else if APackage.Name=CmdLinePackageName then + Error(SErrPackageIsLocal); + if APackage.DownloadURL<>'' then + Result:=APackage.DownloadURL + else + Result:=GetRemoteRepositoryURL(APackage.FileName); +end; + end. diff --git a/packages/fppkg/src/pkghandler.pp b/packages/fppkg/src/pkghandler.pp index 59f20c636a..6d2f8832cf 100644 --- a/packages/fppkg/src/pkghandler.pp +++ b/packages/fppkg/src/pkghandler.pp @@ -58,7 +58,6 @@ function GetPkgHandler(const AAction:string):TPackageHandlerClass; procedure ExecuteAction(const APackageName,AAction:string; PackageManager: TpkgFPpkg); function PackageBuildPath(APackage:TFPPackage):String; -function PackageRemoteArchive(APackage:TFPPackage): String; function PackageLocalArchive(APackage:TFPPackage): String; function PackageManifestFile(APackage:TFPPackage): String; procedure ClearExecutedAction; @@ -127,36 +126,13 @@ end; function PackageBuildPath(APackage:TFPPackage):String; begin - if (APackage.Name=CmdLinePackageName) or (APackage.Name=URLPackageName) then - Result:=GFPpkg.Options.GlobalSection.BuildDir+ChangeFileExt(ExtractFileName(APackage.LocalFileName),'') - else if Assigned(APackage.PackagesStructure) and (APackage.PackagesStructure.GetBuildPathDirectory(APackage)<>'') then - Result:=APackage.PackagesStructure.GetBuildPathDirectory(APackage) - else - Result:=GFPpkg.Options.GlobalSection.BuildDir+APackage.Name; -end; - - -function PackageRemoteArchive(APackage:TFPPackage): String; -begin - if APackage.Name=CurrentDirPackageName then - Error(SErrNoPackageSpecified) - else if APackage.Name=CmdLinePackageName then - Error(SErrPackageIsLocal); - if APackage.DownloadURL<>'' then - Result:=APackage.DownloadURL - else - Result:=GetRemoteRepositoryURL(APackage.FileName); + GFPpkg.PackageBuildPath(APackage); end; function PackageLocalArchive(APackage:TFPPackage): String; begin - if APackage.Name=CurrentDirPackageName then - Error(SErrNoPackageSpecified) - else if APackage.Name=CmdLinePackageName then - Result:=APackage.LocalFileName - else - Result:=GFPpkg.Options.GlobalSection.ArchivesDir+APackage.FileName; + GFPpkg.PackageLocalArchive(APackage); end; diff --git a/packages/fppkg/src/pkgmessages.pp b/packages/fppkg/src/pkgmessages.pp index 53546b9ee4..824c7c0a50 100644 --- a/packages/fppkg/src/pkgmessages.pp +++ b/packages/fppkg/src/pkgmessages.pp @@ -38,6 +38,7 @@ Resourcestring SErrUnknownProtocol = 'Unknown download protocol "%s" in url "%s"'; SErrNoSuchFile = 'File "%s" does not exist.'; SErrDownloadFailed = '%s Download of "%s" failed: %s'; + SErrDownloadPackageFailed = 'Download of package failed.'; SErrInvalidLogLevels = 'Invalid verbosity string: "%s"'; SErrInvalidCommand = 'Invalid command: %s'; SErrChangeDirFailed = 'Could not change directory to "%s"'; diff --git a/packages/fppkg/src/pkgrepos.pp b/packages/fppkg/src/pkgrepos.pp index c1163d7777..402db3304f 100644 --- a/packages/fppkg/src/pkgrepos.pp +++ b/packages/fppkg/src/pkgrepos.pp @@ -10,8 +10,6 @@ uses pkgFppkg, fpmkunit; -function GetRemoteRepositoryURL(const AFileName:string):string; - procedure LoadLocalAvailableMirrors; function LoadManifestFromFile(const AManifestFN:string):TFPPackage; procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boolean=true); @@ -21,8 +19,6 @@ procedure CheckFPMakeDependencies; procedure ListPackages(const ShowGlobalAndLocal: boolean); procedure InitializeFppkg; -procedure ClearRemoteRepository; - procedure SetDefaultRepositoryClass(ARepositoryClass: TFPRepositoryClass); var @@ -43,7 +39,6 @@ resourcestring SErrRepositoryClassAlreadyAssigned = 'Default repository class is already assigned.'; var - CurrentRemoteRepositoryURL : String; RepositoryClass : TFPRepositoryClass; procedure SetDefaultRepositoryClass(ARepositoryClass: TFPRepositoryClass); @@ -138,23 +133,6 @@ begin Error(SErrFailedToSelectMirror); end; - -function GetRemoteRepositoryURL(const AFileName:string):string; -begin - if CurrentRemoteRepositoryURL='' then - begin - if GFPpkg.Options.GlobalSection.RemoteRepository='auto' then - CurrentRemoteRepositoryURL:=SelectRemoteMirror - else - CurrentRemoteRepositoryURL:=GFPpkg.Options.GlobalSection.RemoteRepository; - end; - result := CurrentRemoteRepositoryURL; - if result[length(result)]<>'/' then - result := result + '/'; - Result:=Result+GFPpkg.CompilerOptions.CompilerVersion+'/'+AFileName; -end; - - {***************************************************************************** Local Repository *****************************************************************************} @@ -365,11 +343,6 @@ begin GFPpkg := TpkgFPpkg.Create(nil); end; -procedure ClearRemoteRepository; -begin - CurrentRemoteRepositoryURL := ''; -end; - initialization GFPpkg := nil; AvailableMirrors := nil;