Skip to content

Commit

Permalink
WIP: new Force_Delete
Browse files Browse the repository at this point in the history
  • Loading branch information
mosteo committed Aug 21, 2023
1 parent 90a6c28 commit b19b2dd
Show file tree
Hide file tree
Showing 2 changed files with 73 additions and 41 deletions.
102 changes: 64 additions & 38 deletions src/alire/alire-directories.adb
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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 --
-------------------
Expand Down
12 changes: 9 additions & 3 deletions src/alr/alr-main.adb
Original file line number Diff line number Diff line change
@@ -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);
Expand Down

0 comments on commit b19b2dd

Please sign in to comment.