From 5e8f4b5efd958ba69978bdf8f73162eb17e54812 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Thu, 24 Aug 2023 14:34:08 +0200 Subject: [PATCH] New Force_Delete (#1426) --- src/alire/alire-directories.adb | 149 +++++++++++------- src/alire/alire-directories.ads | 5 - .../softlinks/my_index/crate-0.1.0.tgz | Bin 10240 -> 349 bytes .../my_index/index/cr/crate/crate-0.1.0.toml | 2 +- testsuite/tests/install/softlinks/test.py | 13 +- 5 files changed, 107 insertions(+), 62 deletions(-) diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb index 51717150..a2f0906f 100644 --- a/src/alire/alire-directories.adb +++ b/src/alire/alire-directories.adb @@ -240,11 +240,91 @@ package body Alire.Directories is procedure Force_Delete (Path : Absolute_Path) is use Ada.Directories; + use GNATCOLL.VFS; + + procedure Delete_Links is + procedure Delete_Links (Path : Absolute_Path) is + Contents : File_Array_Access := + VFS.New_Virtual_File (Path).Read_Dir; + begin + for Item of Contents.all loop + if Item.Is_Symbolic_Link then + -- Delete it here and now before normalization, as after + -- normalization links are resolved and the original link + -- name is lost. + declare + Deleted : Boolean := False; + Target : constant Virtual_File := + VFS.New_Virtual_File (+Item.Full_Name); + begin + Target.Normalize_Path (Resolve_Symlinks => True); + Item.Delete (Deleted); + if Deleted then + Trace.Debug ("Deleted softlink: " + & Item.Display_Full_Name + & " --> " + & Target.Display_Full_Name); + else + -- Not deleting a link is unsafe, as it may point + -- outside the target tree. Fail in this case. + Raise_Checked_Error + ("Failed to delete softlink: " + & Item.Display_Full_Name); + end if; + end; + elsif Item.Is_Directory + and then Item.Display_Base_Name not in "." | ".." + then + Delete_Links (+Item.Full_Name); + end if; + end loop; + + Unchecked_Free (Contents); + end Delete_Links; + + begin + if Adirs.Exists (Path) then + Delete_Links (Path); + end if; + end Delete_Links; + + ---------------------- + -- Report_Remaining -- + ---------------------- + + procedure Report_Remaining is + begin + Trace.Warning ("Could not completely remove " & Path); + Trace.Debug ("Remains follow: "); + declare + use AAA.Strings; + use Platforms.Current; + Output : Vector; + Code : constant Integer := + OS_Lib.Subprocess.Unchecked_Spawn_And_Capture + ((if On_Windows then "dir" else "ls"), + (if On_Windows + then To_Vector ("/a/o/q/r/s") + else To_Vector ("-alRF")) + & Path, + Output, + Err_To_Out => True); + begin + if Code = 0 then + Trace.Debug (Output.Flatten (New_Line)); + else + Trace.Warning ("Contents listing failed with code: " + & Code'Image); + end if; + end; + end Report_Remaining; + begin -- Given that we never delete anything outside one of our folders, the -- conservatively shortest thing we can be asked to delete is something -- like "/c/alire". This is for peace of mind. + if Path'Length < 8 then Recoverable_Error ("Suspicious deletion request for path: " & Path); end if; @@ -254,13 +334,24 @@ package body Alire.Directories is Trace.Debug ("Deleting file " & Path & "..."); Delete_File (Path); elsif Kind (Path) = Directory then - Trace.Debug ("Deleting temporary folder " & Path & "..."); - + Trace.Debug ("Deleting folder " & Path & "..."); Ensure_Deletable (Path); - Remove_Softlinks (Path, Recursive => True); + Delete_Links; + -- By first deleting any softlinks, we ensure that the remaining + -- tree is safe to delete, that no malicious link is followed + -- outside the target tree, and that broken/recursive links + -- confuse the tree removal procedure. Adirs.Delete_Tree (Path); + else + Raise_Checked_Error ("Cannot delete special file:" & Path); end if; end if; + exception + when E : others => + Trace.Debug ("Exception attempting deletion of " & Path); + Log_Exception (E); + Report_Remaining; + raise; end Force_Delete; ---------------------- @@ -753,58 +844,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; - - --------------------- - -- Remove_Internal -- - --------------------- - - procedure Remove_Internal (Target : Adirs.Directory_Entry_Type) is - use Ada.Directories; - VF : constant VFS.Virtual_File := - VFS.New_Virtual_File - (VFS.From_FS (Full_Name (Target))); - begin - 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; - else - if Kind (Target) = Directory and then Recursive - and then Simple_Name (Target) not in "." | ".." - then - Search (Full_Name (Target), - Pattern => "", - Process => Remove_Internal'Access); - end if; - end if; - end Remove_Internal; - - begin - -- GNATCOLL's read_dir returns softlinks as the target kind, so we are - -- forced to iterate using Ada.Directories but using GC to check for - -- softlinks. - - Ada.Directories.Search (Path, - Pattern => "", - Process => Remove_Internal'Access); - end Remove_Softlinks; - ------------------- -- Traverse_Tree -- ------------------- diff --git a/src/alire/alire-directories.ads b/src/alire/alire-directories.ads index bf830694..b0f2ae09 100644 --- a/src/alire/alire-directories.ads +++ b/src/alire/alire-directories.ads @@ -98,11 +98,6 @@ package Alire.Directories is -- the top-level only contains "doinstall", "README" and so on that -- are unusable and would be confusing in a binary prefix. - procedure Remove_Softlinks (Path : Any_Path; - Recursive : Boolean); - -- Remove softlinks only (not their targets) at Path and subdirs when - -- Recursive. - procedure Touch (File : File_Path) with Pre => Is_Directory (Parent (File)); -- If the file exists, update last edition time; otherwise create it. diff --git a/testsuite/tests/install/softlinks/my_index/crate-0.1.0.tgz b/testsuite/tests/install/softlinks/my_index/crate-0.1.0.tgz index 50b40e1f52976905a0b7ece37c17180b3be51fc1..11effa04cedfa0880e3d5fefb46130889b860442 100644 GIT binary patch literal 349 zcmV-j0iymNiwFP!000001MQcAYJ)HkhVv-Cz-%ri=6P)Aid&~eE$s1ku`Nhjox-KC z?f(!A7`VePmrHhS(U&herBrWJBsAl_3vcpHkKb1mS({}>8_IH}iHyxv;$kH<=G65? zn_+~FafDT{(7z`l>vhKdO~#+${|Vgt-&VD7jI)2gr2a`;o=1)! zm6-0deXZIE8I6Gd8~>M|E*N7){kt&M+ysnA{Xc_A|6FuZYhcy>Z$kgKHq<}-$7k06 zmrRTxIM40E{hxw==lJ}mWx~$`|I_{tO>-28v9SM->fiGU;QpVc8-C6S3FPq*_a1wr6M{pA`2{k5?k`hVjNz3N|X_Y-g2>F?vb@9RKt1?%&lNrWeM@~BK7 zn{vIaSJR&;`a$IXt^RlUe}x_)8aoXFr{+Hy=@Zff3?u)?a!>jGHUIBPH&rY6NPo+s zzcn8HKSjRL?+ogH9v!|75cJP;n^^x_{hbs2X`1baqx^aOABF=j2!H?xfB*=900@8p i2!H?xfB*=900@8p2!H?xfB*=900@8p2!OyZ5x4+d)Qy7x diff --git a/testsuite/tests/install/softlinks/my_index/index/cr/crate/crate-0.1.0.toml b/testsuite/tests/install/softlinks/my_index/index/cr/crate/crate-0.1.0.toml index 64f0a36f..dd47659f 100644 --- a/testsuite/tests/install/softlinks/my_index/index/cr/crate/crate-0.1.0.toml +++ b/testsuite/tests/install/softlinks/my_index/index/cr/crate/crate-0.1.0.toml @@ -8,4 +8,4 @@ executables=['main'] [origin.'case(os)'.'...'] url = "file:../../../crate-0.1.0.tgz" -hashes = ["sha256:35cc9636468031e1874fe142a6f40557d3befc6dd26cdded0401f440534f4bd6"] +hashes = ["sha256:73d1455dd4b49ea598faa939557c15046db6c689552db03fd6a49c57d3cbc1b2"] diff --git a/testsuite/tests/install/softlinks/test.py b/testsuite/tests/install/softlinks/test.py index 64b8b8dc..43e3bafe 100644 --- a/testsuite/tests/install/softlinks/test.py +++ b/testsuite/tests/install/softlinks/test.py @@ -1,5 +1,16 @@ """ -Test that binary files containing softlinks can be installed properly +Test that binary files containing softlinks can be installed properly. The test +crate contains all kinds of pernicious links (broken, recursive, etc.): + +crate +├── bin -> subdir/bin +├── broken -> missing +└── subdir + ├── bin + │ ├── loop -> ../../subdir + │ └── x + ├── parent -> .. + └── self -> ../subdir """ import sys -- 2.39.5