From b19b2dd190feaeecc1fdb7081993a731b166ba79 Mon Sep 17 00:00:00 2001
From: "Alejandro R. Mosteo" <amosteo@unizar.es>
Date: Tue, 22 Aug 2023 00:17:32 +0200
Subject: [PATCH] WIP: new Force_Delete

---
 src/alire/alire-directories.adb | 102 ++++++++++++++++++++------------
 src/alr/alr-main.adb            |  12 +++-
 2 files changed, 73 insertions(+), 41 deletions(-)

diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb
index e79fd77ac..33e65cbe9 100644
--- a/src/alire/alire-directories.adb
+++ b/src/alire/alire-directories.adb
@@ -240,6 +240,67 @@ package body Alire.Directories is
 
    procedure Force_Delete (Path : Absolute_Path) is
       use Ada.Directories;
+
+      ---------------
+      -- Enumerate --
+      ---------------
+      --  Find all entries at/below Path, even [broken] links
+      function Enumerate return AAA.Strings.Set is
+         Result : AAA.Strings.Set;
+
+         procedure Enumerate (Path : Absolute_Path) is
+         begin
+            --  Remember to skip . / .., normalize/canonalize and not revisit
+         end Enumerate;
+
+      begin
+      end Enumerate;
+
+      ----------------
+      -- Delete_Dir --
+      ----------------
+
+      procedure Delete_Dir is
+         Success : Boolean := False;
+      begin
+         --  Attempt first an ordinary deletion, which will be faster and cover
+         --  99% of cases.
+         GNATCOLL.VFS.Remove_Dir
+           (Dir       => Virtual_File,
+            Recursive => True,
+            Success   => Success);
+
+         if Success then
+            return;
+         else
+            Trace.Debug ("Unable to use regular removal on " & Path);
+         end if;
+
+         --  Otherwise, do our exhaustive deletion guaranteed to succeed even
+         --  with broken links and recursive links. There's no better way as
+         --  broken links are invisible to and break Ada.Directories, and dir
+         --  links break GNATCOLL.VFS.
+
+         loop
+            declare
+               Remain  : constant AAA.Strings.Set := Enumerate;
+               Success : Boolean := False;
+            begin
+               exit when Remain.Is_Empty;
+               for Path of Remain loop
+                  declare
+                     VF : Virtual_File := Create (+Path);
+                  begin
+                     if VF.Is_Softlink then
+                        VF.Delete;
+                     elsif ...
+                     end if;
+                  end;
+               end loop;
+            end;
+         end loop;
+      end Delete_Dir;
+
    begin
 
       --  Given that we never delete anything outside one of our folders, the
@@ -255,10 +316,10 @@ package body Alire.Directories is
             Delete_File (Path);
          elsif Kind (Path) = Directory then
             Trace.Debug ("Deleting folder " & Path & "...");
-
             Ensure_Deletable (Path);
-            Remove_Softlinks (Path, Recursive => True);
-            Adirs.Delete_Tree (Path);
+            Delete_Dir;
+         else
+            Raise_Checked_Error ("Cannot delete special file:" & Path);
          end if;
       end if;
    exception
@@ -780,41 +841,6 @@ package body Alire.Directories is
                      Recurse => True);
    end Merge_Contents;
 
-   ------------------------------
-   -- Remove_Softlinks_In_Tree --
-   ------------------------------
-
-   procedure Remove_Softlinks (Path      : Any_Path;
-                                       Recursive : Boolean)
-   is
-      use GNATCOLL.VFS;
-
-      Success : Boolean := False;
-
-      Contents : File_Array_Access :=
-                   (if Recursive
-                    then Read_Dir_Recursive (Create (+Path))
-                    else Read_Dir (Create (+Path)));
-
-   begin
-      Trace.Debug ("Looking for softlinks in: " & Path);
-
-      for VF of Contents.all loop
-         if VF.Is_Symbolic_Link then
-            Trace.Debug ("Deleting softlink: " & VF.Display_Full_Name);
-            VF.Delete (Success);
-            --  Uses unlink under the hood so it should delete just the link
-
-            if not Success then
-               Raise_Checked_Error ("Failed to delete softlink: "
-                                    & VF.Display_Full_Name);
-            end if;
-         end if;
-      end loop;
-
-      Unchecked_Free (Contents);
-   end Remove_Softlinks;
-
    -------------------
    -- Traverse_Tree --
    -------------------
diff --git a/src/alr/alr-main.adb b/src/alr/alr-main.adb
index b7519169f..22fa27429 100644
--- a/src/alr/alr-main.adb
+++ b/src/alr/alr-main.adb
@@ -1,13 +1,19 @@
-with Alire_Early_Elaboration; pragma Elaborate_All (Alire_Early_Elaboration);
+--  with Alire_Early_Elaboration;
+--  pragma Elaborate_All (Alire_Early_Elaboration);
 
-with Alr.Commands;
+--  with Alr.Commands;
 with Alr.Last_Chance_Handler;
 
+with Ada.Directories;
+with Alire.Directories;
+
 procedure Alr.Main is
 begin
    Trace.Debug ("alr platform configured");
 
-   Commands.Execute;
+   Alire.Directories.Force_Delete (Ada.Directories.Full_Name ("x"));
+
+   --  Commands.Execute;
 exception
    when E : others =>
       Last_Chance_Handler (E);