Fix enumeration of files with troublesome softlinks

.gitmodules

@@ -60,3 +60,9 @@
 [submodule "deps/dirty_booleans"]
 	path = deps/dirty_booleans
 	url = https://github.com/mosteo/dirty_booleans
+[submodule "deps/den"]
+	path = deps/den
+	url = https://github.com/mosteo/den
+[submodule "deps/cstrings"]
+	path = deps/cstrings
+	url = https://github.com/mosteo/cstrings

alire.gpr

@@ -3,7 +3,9 @@ with "ada_toml";
 with "alire_common";
 with "ajunitgen";
 with "ansiada";
+with "c_strings";
 with "clic";
+with "den";
 with "dirty_booleans";
 with "diskflags";
 with "gnatcoll";

alire.toml

@@ -19,7 +19,9 @@ aaa = "~0.3.0"
 ada_toml = "~0.3"
 ajunitgen = "^1.0.1"
 ansiada = "^1.0"
+c_strings = "^1.0"
 clic = "~0.3"
+den = "~0.1"
 dirty_booleans = "~0.1"
 diskflags = "~0.1"
 gnatcoll = "^21"
@@ -50,16 +52,24 @@ windows = { ALIRE_OS = "windows" }
 [[pins]]
 [pins.aaa]
 url    = "https://github.com/mosteo/aaa"
-commit = "dff61d2615cc6332fa6205267bae19b4d044b9da"
+commit = "0c3b440ac183c450345d4a67d407785678779aae"
 
 [pins.ada_toml]
 url    = "https://github.com/mosteo/ada-toml"
 commit = "da4e59c382ceb0de6733d571ecbab7ea4919b33d"
 
+[pins.c_strings]
+url    = "https://github.com/mosteo/cstrings"
+commit = "e5b1931d47b9fee273177773fb5e3f8979bc6076"
+
 [pins.clic]
 url    = "https://github.com/alire-project/clic"
 commit = "56bbdc008e16996b6f76e443fd0165a240de1b13"
 
+[pins.den]
+url    = "https://github.com/mosteo/den"
+commit = "1f0fe7df0e479e1bf86edd607ffea6bfddb9352e"
+
 [pins.dirty_booleans]
 url    = "https://github.com/mosteo/dirty_booleans"
 commit = "05c40d88ecfe109e575ec8b21dd6ffa2e61df1dc"

alr_env.gpr

@@ -14,6 +14,8 @@ aggregate project Alr_Env is
                          "deps/ajunitgen",
                          "deps/ansi",
                          "deps/clic",
+                         "deps/cstrings",
+                         "deps/den",
                          "deps/dirty_booleans",
                          "deps/diskflags",
                          "deps/gnatcoll-slim",

src/alire/alire-directories.adb

@@ -13,6 +13,8 @@ with Alire.Platforms.Folders;
 with Alire.VFS;
 with Alire.Utils;
 
+with Den.Walk;
+
 with GNAT.String_Hash;
 
 with GNATCOLL.VFS;
@@ -392,51 +394,35 @@ package body Alire.Directories is
                               Max_Depth : Natural := Natural'Last)
                               return AAA.Strings.Vector
    is
+      use all type Den.Kinds;
       Found : AAA.Strings.Vector;
 
-      procedure Locate (Folder        : String;
-                        Current_Depth : Natural;
-                        Max_Depth     : Natural)
+      -----------
+      -- Check --
+      -----------
+
+      procedure Check (Item  : Den.Walk.Item;
+                       Enter : in out Boolean;
+                       Stop  : in out Boolean)
       is
-         use Ada.Directories;
-         Search : Search_Type;
       begin
-         Start_Search (Search, Folder, "",
-                       Filter => (Ordinary_File => True,
-                                  Directory     => True,
-                                  others        => False));
-
-         while More_Entries (Search) loop
-            declare
-               Current : Directory_Entry_Type;
-            begin
-               Get_Next_Entry (Search, Current);
-               if Kind (Current) = Directory then
-                  if Simple_Name (Current) /= "."
-                    and then
-                     Simple_Name (Current) /= ".."
-                    and then
-                     Current_Depth < Max_Depth
-                  then
-                     Locate (Folder / Simple_Name (Current),
-                             Current_Depth + 1,
-                             Max_Depth);
-                  end if;
-               elsif Kind (Current) = Ordinary_File
-                 and then Simple_Name (Current) = Simple_Name (Name)
-               then
-                  Found.Append (Folder / Name);
-               end if;
-            end;
-         end loop;
+         Stop := False;
 
-         End_Search (Search);
-      end Locate;
+         if Max_Depth < Natural'Last and then Item.Depth > Max_Depth then
+            Enter := False;
+         end if;
+
+         if Den.Kind (Item.Path) = File
+           and then Den.Name (Item.Path) = Den.Name (Name)
+         then
+            Found.Append (Item.Path);
+         end if;
+      end Check;
 
-      use Ada.Directories;
    begin
-      if Exists (Folder) and then Kind (Folder) = Directory then
-         Locate (Folder, 0, Max_Depth);
+      if Den.Exists (Folder) and then Den.Kind (Folder) = Den.Directory then
+         Den.Walk.Find (Folder,
+                        Check'Access);
       end if;
 
       return Found;
@@ -828,25 +814,24 @@ package body Alire.Directories is
       -----------
 
       procedure Merge
-        (Item : Ada.Directories.Directory_Entry_Type;
+        (Item : Any_Path;
          Stop : in out Boolean)
       is
-         use all type Adirs.File_Kind;
-
+         use all type Den.Kinds;
          Rel_Path : constant Relative_Path :=
-                      Find_Relative_Path (Base, Adirs.Full_Name (Item));
+                      Find_Relative_Path (Base, Den.Absolute (Item));
          --  If this proves to be too slow, we should do our own recursion,
          --  building the relative path along the way, as this is recomputing
          --  it for every file needlessly.
 
          Dst : constant Absolute_Path := Target / Rel_Path;
-         Src : constant Absolute_Path := Adirs.Full_Name (Item);
+         Src : constant Absolute_Path := Den.Absolute (Item);
       begin
          Stop := False;
 
          --  Check if we must skip (we delete source file)
 
-         if Adirs.Kind (Item) = Ordinary_File
+         if Den.Kind (Item) /= Directory
            and then Skip_Top_Level_Files
            and then Base = Parent (Src)
          then
@@ -856,7 +841,7 @@ package body Alire.Directories is
 
          --  Create a new dir if necessary
 
-         if Adirs.Kind (Item) = Directory then
+         if Den.Kind (Item) = Directory then
             if not Is_Directory (Dst) then
                Trace.Debug ("   Merge: Creating destination dir " & Dst);
                Create_Tree (Dst);
@@ -870,15 +855,15 @@ package body Alire.Directories is
          --  Copy file into place
 
          Trace.Debug ("   Merge: copying "
-                     & Adirs.Full_Name (Item)
+                     & Den.Absolute (Item)
                      & " into " & Dst);
 
-         if Adirs.Exists (Dst) then
+         if Den.Exists (Dst) then
             if Fail_On_Existing_File then
                Recoverable_User_Error ("Cannot copy " & TTY.URL (Src)
                                   & " into place, file already exists: "
                                   & TTY.URL (Dst));
-            elsif Adirs.Kind (Dst) /= Ordinary_File then
+            elsif Den.Kind (Dst) /= File then
                Raise_Checked_Error ("Cannot overwrite " & TTY.URL (Dst)
                                     & " as it is not a regular file");
             else
@@ -912,7 +897,11 @@ package body Alire.Directories is
             exception
                when E : others =>
                   Trace.Error
-                    ("When copying " & Src & " --> " & Dst & ": ");
+                    ("When copying " & Src & " (" & Den.Kind (Src)'Image
+                     & ") --> " & Dst & ": ");
+                  Trace.Error
+                    ("Src item was: "
+                     & Item & " (" & Den.Kind (Item)'Image & ")");
                   Log_Exception (E, Error);
                   raise;
             end;
@@ -941,112 +930,60 @@ package body Alire.Directories is
 
    procedure Traverse_Tree (Start   : Any_Path;
                             Doing   : access procedure
-                              (Item : Ada.Directories.Directory_Entry_Type;
+                              (Item : Any_Path;
                                Stop : in out Boolean);
                             Recurse : Boolean := False;
                             Spinner : Boolean := False)
    is
       use Ada.Directories;
 
-      Visited : AAA.Strings.Set;
-      --  To avoid infinite recursion in case of softlinks pointed to parent
-      --  folders
-
       Progress : Simple_Logging.Ongoing :=
                    Simple_Logging.Activity (Text  => "Exploring " & Start,
                                             Level => (if Spinner
                                                       then Info
                                                       else Debug));
 
-      procedure Go_Down (Item : Directory_Entry_Type);
-
-      ----------------------------
-      -- Traverse_Tree_Internal --
-      ----------------------------
-
-      procedure Traverse_Tree_Internal
-        (Start   : Any_Path;
-         Doing   : access procedure
-           (Item : Ada.Directories.Directory_Entry_Type;
-            Stop : in out Boolean);
-         Recurse : Boolean := False)
-      is
-         pragma Unreferenced (Doing, Recurse);
-      begin
-         Search (Start,
-                 "",
-                 (Directory => True, Ordinary_File => True, others => False),
-                 Go_Down'Access);
-      end Traverse_Tree_Internal;
-
       -------------
       -- Go_Down --
       -------------
 
-      procedure Go_Down (Item : Directory_Entry_Type) is
-         Stop  : Boolean := False;
-         Prune : Boolean := False;
-         VF    : constant VFS.Virtual_File :=
-                   VFS.New_Virtual_File (VFS.From_FS (Full_Name (Item)));
-         --  We use this later to check whether this is a soft link
+      procedure Go_Down (This  : Den.Walk.Item;
+                         Enter : in out Boolean;
+                         Stop  : in out Boolean)
+      is
+         use all type Den.Kinds;
+         Path : constant Any_Path := This.Path;
       begin
+         Enter := True;
+         Stop  := False;
 
-         --  Ada.Directories reports softlinks not as special files but as the
-         --  target of the link. This confuses users of Traverse_Tree that may
-         --  see files within a folder that has never been visited before.
-
-         --  Short of introducing new file kinds for softlinks and reporting
-         --  them to clients, for now we just ignore softlinks to dirs, and
-         --  this way only actual folders are traversed.
-
-         if VF.Is_Symbolic_Link and then Kind (Item) = Directory then
-            Trace.Warning ("Skipping softlink dir during tree traversal: "
-                           & Full_Name (Item));
+         begin
+            Doing (This.Path, Stop);
+         exception
+            when Traverse_Tree_Prune_Dir =>
+               Enter := False;
+         end;
+         if Stop then
             return;
          end if;
 
-         if Simple_Name (Item) /= "." and then Simple_Name (Item) /= ".." then
-            begin
-               Doing (Item, Stop);
-            exception
-               when Traverse_Tree_Prune_Dir =>
-                  Prune := True;
-            end;
-            if Stop then
-               return;
-            end if;
-
-            if not Prune and then Recurse and then Kind (Item) = Directory then
-               declare
-                  Normal_Name : constant Absolute_Path
-                    :=
-                      String (GNATCOLL.VFS.Full_Name
-                              (VFS.New_Virtual_File (Full_Name (Item)),
-                                   Normalize        => True,
-                                   Resolve_Links    => True).all);
-               begin
-                  if Visited.Contains (Normal_Name) then
-                     Trace.Debug ("Not revisiting " & Normal_Name);
-                  else
-                     Visited.Insert (Normal_Name);
-                     if Spinner then
-                        Progress.Step ("Exploring .../" & Simple_Name (Item));
-                     end if;
-                     Traverse_Tree_Internal (Normal_Name, Doing, Recurse);
-                  end if;
-               end;
-            elsif Prune and then Kind (Item) = Directory then
-               Trace.Debug ("Skipping dir: " & Full_Name (Item));
-            elsif Prune and then Kind (Item) /= Directory then
-               Trace.Warning ("Pruning of non-dir entry has no effect: "
-                              & Full_Name (Item));
+         if Enter and then Recurse and then Den.Kind (Path) = Directory then
+            if Spinner then
+               Progress.Step ("Exploring .../" & Simple_Name (Path));
             end if;
+         elsif not Enter and then Den.Kind (Path) = Directory then
+            Trace.Debug ("Skipping dir: " & Full_Name (Path));
+         elsif not Enter and then Den.Kind (Path) /= Directory then
+            Trace.Warning ("Pruning of non-dir entry has no effect: "
+                           & Full_Name (Path));
          end if;
       end Go_Down;
 
    begin
       Trace.Debug ("Traversing folder: " & Adirs.Full_Name (Start));
-      Traverse_Tree_Internal (Start, Doing, Recurse);
+      Den.Walk.Find (Start,
+                     Action => Go_Down'Access,
+                     Options => (Enter_Regular_Dirs => Recurse, others => <>));
    end Traverse_Tree;
 
    ---------------
@@ -1062,7 +999,7 @@ package body Alire.Directories is
       -- Accumulate --
       ----------------
 
-      procedure Accumulate (Item : Directory_Entry_Type;
+      procedure Accumulate (Item : Any_Path;
                             Stop : in out Boolean)
       is
       begin

src/alire/alire-directories.ads

@@ -114,7 +114,7 @@ package Alire.Directories is
 
    procedure Traverse_Tree (Start   : Any_Path;
                             Doing   : access procedure
-                              (Item : Ada.Directories.Directory_Entry_Type;
+                              (Item : Any_Path;
                                Stop : in out Boolean);
                             Recurse : Boolean := False;
                             Spinner : Boolean := False);

src/alire/alire-install.adb

@@ -395,7 +395,7 @@ package body Alire.Install is
       Result : Installed_Milestones;
 
       procedure Find
-        (Item : Ada.Directories.Directory_Entry_Type;
+        (Item : Any_Path;
          Stop : in out Boolean)
       is
          Name : constant String := Adirs.Simple_Name (Item);