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

* detect broken packages, give an error if broken packages are found and the user

Browse Source 
needs to run 'fppkg fixbroken' first
  * add --broken option to skip the broken package detection at startup
  * call fixbroken implicitly after an install command from the commandline has been processed.
    This will make sure that all packages depending on the installed package will also be recompiled
    and reinstalled.
    Warning: Installing a new rtl will recompile everything. Currently this will
    give a broken installation because not all packages compile yet.

git-svn-id: trunk@10595 -
This commit is contained in:
peter 2008-04-01 22:39:20 +00:00
parent fe9035bcdf
commit a4c852d729
6 changed files with 217 additions and 71 deletions

17
utils/fppkg/fppkg.pp
View File

@ -245,6 +245,8 @@ begin
GlobalOptions.InstallGlobal:=true
else if CheckOption(I,'r','recovery') then
GlobalOptions.RecoveryMode:=true
else if CheckOption(I,'b','broken') then
GlobalOptions.AllowBroken:=true
else if CheckOption(I,'h','help') then
begin
ShowUsage;
@ -275,6 +277,7 @@ var
OldCurrDir : String;
Res : Boolean;
i : Integer;
SL : TStringList;
begin
OldCurrDir:=GetCurrentDir;
Try
@ -304,6 +307,16 @@ begin
if GlobalOptions.CompilerConfig<>GlobalOptions.FPMakeCompilerConfig then
FindInstalledPackages(CompilerOptions,true);
// Check for broken dependencies
if not GlobalOptions.AllowBroken and
not((ParaPackages.Count=0) and (ParaAction='fixbroken')) then
begin
SL:=TStringList.Create;
if FindBrokenPackages(SL) then
Error(SErrBrokenPackagesFound);
FreeAndNil(SL);
end;
if ParaPackages.Count=0 then
begin
Log(vlDebug,SLogCommandLineAction,['[<currentdir>]',ParaAction]);
@ -333,6 +346,10 @@ begin
end;
end;
// Recompile all packages dependent on this package
if res and (ParaAction='install') then
pkghandler.ExecuteAction(nil,'fixbroken');
Terminate;
except

54
utils/fppkg/pkgcommands.pp
View File

@ -110,6 +110,13 @@ type
Function Execute(const Args:TActionArgs):boolean;override;
end;
{ TCommandFixBroken }
TCommandFixBroken = Class(TPackagehandler)
Public
Function Execute(const Args:TActionArgs):boolean;override;
end;
function TCommandAddConfig.Execute(const Args:TActionArgs):boolean;
begin
@ -249,13 +256,22 @@ end;
function TCommandInstall.Execute(const Args:TActionArgs):boolean;
var
S : String;
begin
if assigned(CurrentPackage) then
ExecuteAction(CurrentPackage,'build',Args);
ExecuteAction(CurrentPackage,'fpmakeinstall',Args);
// Update local status file
// Update version information from generated fpunits.conf
if assigned(CurrentPackage) then
CurrentPackage.InstalledVersion.Assign(CurrentPackage.Version);
begin
if GlobalOptions.InstallGlobal then
S:=CompilerOptions.GlobalUnitDir
else
S:=CompilerOptions.LocalUnitDir;
S:=IncludeTrailingPathDelimiter(S)+CurrentPackage.Name+PathDelim+UnitConfigFileName;
LoadUnitConfigFromFile(CurrentPackage,S);
end;
Result:=true;
end;
@ -321,7 +337,15 @@ begin
end;
end
else
status:='OK';
begin
if PackageIsBroken(DepPackage) then
begin
status:='Broken, recompiling';
L.Add(DepPackage.Name);
end
else
status:='OK';
end;
Log(vlInfo,SLogPackageDependency,
[D.PackageName,D.MinVersion.AsString,DepPackage.InstalledVersion.AsString,DepPackage.Version.AsString,status]);
end
@ -342,6 +366,29 @@ begin
end;
function TCommandFixBroken.Execute(const Args:TActionArgs):boolean;
var
i : integer;
P : TFPPackage;
SL : TStringList;
begin
SL:=TStringList.Create;
repeat
FindBrokenPackages(SL);
if SL.Count=0 then
break;
for i:=0 to SL.Count-1 do
begin
P:=CurrentRepository.PackageByName(SL[i]);
ExecuteAction(P,'build');
ExecuteAction(P,'install');
end;
until false;
FreeAndNil(SL);
Result:=true;
end;
initialization
RegisterPkgHandler('update',TCommandUpdate);
RegisterPkgHandler('showall',TCommandShowAll);
@ -355,4 +402,5 @@ initialization
RegisterPkgHandler('clean',TCommandClean);
RegisterPkgHandler('archive',TCommandArchive);
RegisterPkgHandler('installdependencies',TCommandInstallDependencies);
RegisterPkgHandler('fixbroken',TCommandFixBroken);
end.

7
utils/fppkg/pkgfpmake.pp
View File

@ -222,7 +222,12 @@ begin
CreateFPMKUnitSource(TempBuildDir+PathDelim+'fpmkunit.pp');
// Call compiler
If ExecuteProcess(FPMakeCompilerOptions.Compiler,OOptions+' '+FPmakeSrc)<>0 then
Error(SErrFailedToCompileFPCMake);
begin
if not GlobalOptions.RecoveryMode then
Error(SErrCompileFailureFPMakeTryRecovery)
else
Error(SErrCompileFailureFPMake);
end;
// Cleanup units
DeleteDir(TempBuildDir);
end

7
utils/fppkg/pkgmessages.pp
View File

@ -26,7 +26,8 @@ Resourcestring
SErrException = 'The FPC Package tool encountered the following error:';
SErrActionAlreadyRegistered= 'Action "%s" is already registered';
SErrActionNotFound = 'Action "%s" is not supported';
SErrFailedToCompileFPCMake = 'Could not compile fpmake driver program';
SErrCompileFailureFPMake = 'Could not compile fpmake driver program';
SErrCompileFailureFPMakeTryRecovery = 'Could not compile fpmake driver program, try adding "--recovery"';
SErrNoFTPDownload = 'This binary has no support for FTP downloads.';
SErrNoHTTPDownload = 'This binary has no support for HTTP downloads.';
SErrBackupFailed = 'Backup of file "%s" to file "%s" failed.';
@ -47,6 +48,7 @@ Resourcestring
SErrLoginFailed = 'FTP LOGIN command failed.';
SErrCWDFailed = 'FTP CWD "%s" command failed.';
SErrGETFailed = 'FTP GET "%s" command failed.';
SErrBrokenPackagesFound = 'Found broken packages, run "fppkg fixbroken" first';
SLogGeneratingFPMake = 'Generating fpmake.pp';
SLogNotCompilingFPMake = 'Skipping compiling of fpmake.pp, fpmake executable already exists';
@ -73,6 +75,7 @@ Resourcestring
SLogSelectedMirror = 'Selected mirror "%s"';
SLogUpgradingConfig = 'Configuration file "%s" is updated with new configuration settings';
SLogPackageDependency = 'Dependency on package %s %s, installed %s, available %s (%s)';
SLogPackageChecksumChanged = 'Package %s needs to be rebuild, dependency %s is modified';
SDbgFound = 'Found';
SDbgNotFound = 'Not Found';
@ -81,6 +84,8 @@ Resourcestring
SDbgBackupFile = 'Creating Backup File "%s"';
SDbgPackageMultipleLocations = 'Multiple installations found for package %s, using installation "%s"';
SDbgPackageDependencyOtherTarget = 'Dependency on package %s is not for %s';
SDbgObsoleteDependency = 'Obsolete dependency found on package %s';
implementation

3
utils/fppkg/pkgoptions.pp
View File

@ -45,6 +45,7 @@ Type
FFPMakeCompilerConfig : String;
// Parameter options
FCompilerConfig : String;
FAllowBroken,
FInstallGlobal,
FRecoveryMode : Boolean;
function GetOptString(Index: integer): String;
@ -74,6 +75,7 @@ Type
Property CompilerConfig : String Read FCompilerConfig Write FCompilerConfig;
Property InstallGlobal : Boolean Read FInstallGlobal Write FInstallGlobal;
Property RecoveryMode : Boolean Read FRecoveryMode Write FRecoveryMode;
Property AllowBroken : Boolean Read FAllowBroken Write FAllowBroken;
end;
@ -261,6 +263,7 @@ begin
FCompilerConfig:=FDefaultCompilerConfig;
FInstallGlobal:=False;
FRecoveryMode:=False;
FAllowBroken:=False;
end;

200
utils/fppkg/pkgrepos.pp
View File

@ -13,8 +13,11 @@ function GetRemoteRepositoryURL(const AFileName:string):string;
procedure LoadLocalMirrors;
procedure LoadLocalRepository;
function LoadOrCreatePackage(const AName:string):TFPPackage;
procedure LoadUnitConfigFromFile(APackage:TFPPackage;const AFileName: String);
function LoadPackageManifest(const AManifestFN:string):TFPPackage;
procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boolean=true);
function PackageIsBroken(APackage:TFPPackage):boolean;
function FindBrokenPackages(SL:TStrings):Boolean;
procedure CheckFPMakeDependencies;
procedure ListLocalRepository(all:boolean=false);
@ -244,66 +247,71 @@ begin
end;
procedure LoadUnitConfigFromFile(APackage:TFPPackage;const AFileName: String);
Var
L,DepSL : TStrings;
DepName,
V : String;
DepChecksum : Cardinal;
i,j,k : integer;
D : TFPDependency;
begin
L:=TStringList.Create;
Try
ReadIniFile(AFileName,L);
{$warning TODO Maybe check also CPU-OS}
// Read fpunits.conf
V:=L.Values['version'];
APackage.InstalledVersion.AsString:=V;
V:=L.Values['checksum'];
if V<>'' then
APackage.InstalledChecksum:=StrToInt(V)
else
APackage.InstalledChecksum:=$ffffffff;
// Load dependencies
V:=L.Values['depends'];
DepSL:=TStringList.Create;
DepSL.CommaText:=V;
for i:=0 to DepSL.Count-1 do
begin
DepName:=DepSL[i];
k:=Pos('|',DepName);
if k>0 then
begin
DepChecksum:=StrToInt(Copy(DepName,k+1,Length(DepName)-k));
DepName:=Copy(DepName,1,k-1);
end
else
DepChecksum:=$ffffffff;
D:=nil;
for j:=0 to APackage.Dependencies.Count-1 do
begin
D:=APackage.Dependencies[j];
if D.PackageName=DepName then
break;
D:=nil;
end;
if not assigned(D) then
D:=APackage.AddDependency(DepName,'');
D.RequireChecksum:=DepChecksum;
end;
DepSL.Free;
Finally
L.Free;
end;
end;
procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boolean=true);
procedure LoadUnitConfigFromFile(APackage:TFPPackage;const AFileName: String);
Var
L,DepSL : TStrings;
DepName,
V : String;
DepChecksum : Cardinal;
i,j,k : integer;
D : TFPDependency;
procedure LogDuplicatePackages(APackage:TFPPackage;const AFileName: String);
begin
L:=TStringList.Create;
Try
ReadIniFile(AFileName,L);
// Log packages found in multiple locations (local and global) ?
if not APackage.InstalledVersion.Empty then
begin
if showdups then
Log(vlDebug,SDbgPackageMultipleLocations,[APackage.Name,ExtractFilePath(AFileName)]);
end;
{$warning TODO Maybe check also CPU-OS}
// Read fpunits.conf
V:=L.Values['version'];
APackage.InstalledVersion.AsString:=V;
V:=L.Values['checksum'];
if V<>'' then
APackage.InstalledChecksum:=StrToInt(V)
else
APackage.InstalledChecksum:=$ffffffff;
// Load dependencies
V:=L.Values['depends'];
DepSL:=TStringList.Create;
DepSL.CommaText:=V;
for i:=0 to DepSL.Count-1 do
begin
DepName:=DepSL[i];
k:=Pos('|',DepName);
if k>0 then
begin
DepChecksum:=StrToInt(Copy(DepName,k+1,Length(DepName)-k));
DepName:=Copy(DepName,1,k-1);
end
else
DepChecksum:=$ffffffff;
D:=nil;
for j:=0 to APackage.Dependencies.Count-1 do
begin
D:=APackage.Dependencies[j];
if D.PackageName=DepName then
break;
D:=nil;
end;
if not assigned(D) then
D:=APackage.AddDependency(DepName,'');
D.RequireChecksum:=DepChecksum;
end;
DepSL.Free;
Finally
L.Free;
end;
// Log packages found in multiple locations (local and global) ?
if not APackage.InstalledVersion.Empty then
begin
if showdups then
Log(vlDebug,SDbgPackageMultipleLocations,[APackage.Name,ExtractFilePath(AFileName)]);
end;
end;
procedure LoadPackagefpcFromFile(APackage:TFPPackage;const AFileName: String);
@ -340,6 +348,7 @@ procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boole
if FileExistsLog(UF) then
begin
P:=LoadOrCreatePackage(SR.Name);
LogDuplicatePackages(P,UF);
LoadUnitConfigFromFile(P,UF)
end
else
@ -349,6 +358,7 @@ procedure FindInstalledPackages(ACompilerOptions:TCompilerOptions;showdups:boole
if FileExistsLog(UF) then
begin
P:=LoadOrCreatePackage(SR.Name);
LogDuplicatePackages(P,UF);
LoadPackagefpcFromFile(P,UF);
end;
end;
@ -368,6 +378,57 @@ begin
end;
function PackageIsBroken(APackage:TFPPackage):boolean;
var
j : integer;
D : TFPDependency;
DepPackage : TFPPackage;
begin
result:=false;
for j:=0 to APackage.Dependencies.Count-1 do
begin
D:=APackage.Dependencies[j];
if (CompilerOptions.CompilerOS in D.OSes) and
(CompilerOptions.CompilerCPU in D.CPUs) then
begin
DepPackage:=CurrentRepository.FindPackage(D.PackageName);
// Don't stop on missing dependencies
if assigned(DepPackage) then
begin
if (DepPackage.InstalledChecksum<>D.RequireChecksum) then
begin
Log(vlInfo,SLogPackageChecksumChanged,[APackage.Name,D.PackageName]);
result:=true;
exit;
end;
end
else
Log(vlDebug,SDbgObsoleteDependency,[D.PackageName]);
end;
end;
end;
function FindBrokenPackages(SL:TStrings):Boolean;
var
i : integer;
P : TFPPackage;
begin
SL.Clear;
for i:=0 to CurrentRepository.PackageCount-1 do
begin
P:=CurrentRepository.Packages[i];
// Process only installed packages
if not P.InstalledVersion.Empty then
begin
if PackageIsBroken(P) then
SL.Add(P.Name);
end;
end;
Result:=(SL.Count>0);
end;
procedure CheckFPMakeDependencies;
var
i : Integer;
@ -405,16 +466,20 @@ procedure ListLocalRepository(all:boolean=false);
var
P : TFPPackage;
i : integer;
SL : TStringList;
begin
Writeln(Format('%-20s %-12s %-12s',['Name','Installed','Available']));
SL:=TStringList.Create;
SL.Sorted:=true;
for i:=0 to CurrentRepository.PackageCount-1 do
begin
P:=CurrentRepository.Packages[i];
if all or (P.Version.CompareVersion(P.InstalledVersion)>0) then
begin
Writeln(Format('%-20s %-12s %-12s',[P.Name,P.InstalledVersion.AsString,P.Version.AsString]));
end;
SL.Add(Format('%-20s %-12s %-12s',[P.Name,P.InstalledVersion.AsString,P.Version.AsString]));
end;
Writeln(Format('%-20s %-12s %-12s',['Name','Installed','Available']));
for i:=0 to SL.Count-1 do
Writeln(SL[i]);
FreeAndNil(SL);
end;
@ -426,13 +491,19 @@ procedure ListRemoteRepository;
var
P : TFPPackage;
i : integer;
SL : TStringList;
begin
Writeln(Format('%-20s %-12s %-20s',['Name','Available','FileName']));
SL:=TStringList.Create;
SL.Sorted:=true;
for i:=0 to CurrentRepository.PackageCount-1 do
begin
P:=CurrentRepository.Packages[i];
Writeln(Format('%-20s %-12s %-20s',[P.Name,P.Version.AsString,P.FileName]));
SL.Add(Format('%-20s %-12s %-20s',[P.Name,P.Version.AsString,P.FileName]));
end;
Writeln(Format('%-20s %-12s %-20s',['Name','Available','FileName']));
for i:=0 to SL.Count-1 do
Writeln(SL[i]);
FreeAndNil(SL);
end;
@ -499,7 +570,4 @@ begin
end;
end;
initialization
end.