paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 13:09:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Removed the usage of the global GFppkg at multiple locations

Browse Source 
* Fixed AV when there is no download-class available
 * Moved more global-functions into TPkgFppkg

git-svn-id: trunk@35323 -
This commit is contained in:
joost 2017-01-21 10:48:43 +00:00
parent 3b1ae57844
commit ec98e63741
7 changed files with 202 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
packages/fppkg/src/pkgcommands.pp
View File

@ -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);

45
packages/fppkg/src/pkgdownload.pp
View File

@ -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;

22
packages/fppkg/src/pkgfpmake.pp
View File

@ -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;

153
packages/fppkg/src/pkgfppkg.pp
View File

@ -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.

28
packages/fppkg/src/pkghandler.pp
View File

@ -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;

1
packages/fppkg/src/pkgmessages.pp
View File

@ -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"';

27
packages/fppkg/src/pkgrepos.pp
View File

@ -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;