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

    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 -

utils/fppkg/fppkg.pp

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

utils/fppkg/pkgcommands.pp

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

utils/fppkg/pkgfpmake.pp

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

utils/fppkg/pkgmessages.pp

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

utils/fppkg/pkgoptions.pp

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

utils/fppkg/pkgrepos.pp

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