From 9cac98b06d92af1d304005fb2681a2ab671cef56 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Wed, 31 May 2023 17:52:44 +0200 Subject: [PATCH] Fix unpacking of tarfiles with softlinks to subdirectories (#1382) * Fix Traverse_Tree for softlinked dirs Remains: GC.VFS.Remove_Dir fails because of the same reason, probably. * Manually delete softlinks prior to deleting a dir Otherwise, depending on the links' targets, both Ada.Directories and GNATCOLL.VFS had trouble with fully deleting a tree containing such links. * Test for tarballs containing softlinks * Self-review * Skip new test on Windows --- src/alire/alire-directories.adb | 121 +++++++++++++++--- src/alire/alire-directories.ads | 14 +- .../softlinks/my_index/crate-0.1.0.tgz | Bin 0 -> 10240 bytes .../my_index/index/cr/crate/crate-0.1.0.toml | 11 ++ .../softlinks/my_index/index/index.toml | 1 + testsuite/tests/install/softlinks/test.py | 20 +++ testsuite/tests/install/softlinks/test.yaml | 4 + 7 files changed, 147 insertions(+), 24 deletions(-) create mode 100644 testsuite/tests/install/softlinks/my_index/crate-0.1.0.tgz create mode 100644 testsuite/tests/install/softlinks/my_index/index/cr/crate/crate-0.1.0.toml create mode 100644 testsuite/tests/install/softlinks/my_index/index/index.toml create mode 100644 testsuite/tests/install/softlinks/test.py create mode 100644 testsuite/tests/install/softlinks/test.yaml diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb index 70106893..5eacd149 100644 --- a/src/alire/alire-directories.adb +++ b/src/alire/alire-directories.adb @@ -233,8 +233,6 @@ package body Alire.Directories is procedure Force_Delete (Path : Any_Path) is use Ada.Directories; - use GNATCOLL.VFS; - Success : Boolean := False; begin if Exists (Path) then if Kind (Path) = Ordinary_File then @@ -244,16 +242,8 @@ package body Alire.Directories is Trace.Debug ("Deleting temporary folder " & Path & "..."); Ensure_Deletable (Path); - - -- Ada.Directories fails when there are softlinks in a tree, so we - -- use GNATCOLL instead. - GNATCOLL.VFS.Remove_Dir (Create (+Path), - Recursive => True, - Success => Success); - if not Success then - raise Program_Error with - Errors.Set ("Could not delete: " & TTY.URL (Path)); - end if; + Remove_Softlinks (Path, Recursive => True); + Adirs.Delete_Tree (Path); end if; end if; end Force_Delete; @@ -618,6 +608,7 @@ package body Alire.Directories is & (if Remove_From_Source then " moving " else " copying ") & Adirs.Full_Name (Item) & " into " & Dst); + if Adirs.Exists (Dst) then if Fail_On_Existing_File then Recoverable_Error ("Cannot move " & TTY.URL (Src) @@ -655,14 +646,26 @@ package body Alire.Directories is & TTY.URL (Src)); end if; else - if Remove_From_Source then - Adirs.Rename (Old_Name => Src, - New_Name => Dst); - else - Adirs.Copy_File (Source_Name => Src, - Target_Name => Dst, - Form => "preserve=all_attributes"); - end if; + begin + if Remove_From_Source then + Adirs.Rename (Old_Name => Src, + New_Name => Dst); + else + Adirs.Copy_File (Source_Name => Src, + Target_Name => Dst, + Form => "preserve=all_attributes"); + end if; + exception + when E : others => + Trace.Error + ("When " & + (if Remove_From_Source + then "renaming " + else "copying ") + & Src & " --> " & Dst & ": "); + Log_Exception (E, Error); + raise; + end; end if; end; end Merge; @@ -673,6 +676,58 @@ 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 -- ------------------- @@ -698,6 +753,10 @@ package body Alire.Directories is procedure Go_Down (Item : Directory_Entry_Type); + ---------------------------- + -- Traverse_Tree_Internal -- + ---------------------------- + procedure Traverse_Tree_Internal (Start : Any_Path; Doing : access procedure @@ -713,10 +772,32 @@ package body Alire.Directories is 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 begin + + -- 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)); + return; + end if; + if Simple_Name (Item) /= "." and then Simple_Name (Item) /= ".." then begin Doing (Item, Stop); diff --git a/src/alire/alire-directories.ads b/src/alire/alire-directories.ads index 7fe05ba7..7534bfc0 100644 --- a/src/alire/alire-directories.ads +++ b/src/alire/alire-directories.ads @@ -89,6 +89,11 @@ 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); -- If the file exists, update last edition time; otherwise create it. If -- File denotes anything else than a regular file, raise. @@ -105,10 +110,11 @@ package Alire.Directories is Recurse : Boolean := False; Spinner : Boolean := False); -- Traverse all items in a folder, optionally recursively If recursively, - -- the directory entry is passed before entering it "." and ".." are - -- ignored. If Stop is set to True, traversal will not continue. See also - -- the comments in Traverse_Tree_Prune_Dir. If Spinner, show a busy spinner - -- with the current dir being explored. + -- the directory entry is passed before entering it. "." and ".." + -- are ignored. NOTE: Softlinks to directories are ignored. If Stop is set + -- to True, traversal will not continue. See also the comments in + -- Traverse_Tree_Prune_Dir. If Spinner, show a busy spinner with + -- the current dir being explored. function Tree_Size (Path : Any_Path) return Ada.Directories.File_Size; -- Size of files under a given point, in bytes. Will return 0 for an 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 new file mode 100644 index 0000000000000000000000000000000000000000..50b40e1f52976905a0b7ece37c17180b3be51fc1 GIT binary patch literal 10240 zcmeH|-422<42Ab7ynx#7hdmFV7kZ%yO5)?&f#}o(X8;r9X-KxE(2eh`ZB-Yi&4QM^ zq?MYa1wr6M{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 literal 0 HcmV?d00001 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 new file mode 100644 index 00000000..64f0a36f --- /dev/null +++ b/testsuite/tests/install/softlinks/my_index/index/cr/crate/crate-0.1.0.toml @@ -0,0 +1,11 @@ +description = "Example crate" +name = "crate" +version = "0.1.0" +licenses = "GPL-3.0-only" +maintainers = ["example@example.com"] +maintainers-logins = ["mylogin"] +executables=['main'] + +[origin.'case(os)'.'...'] +url = "file:../../../crate-0.1.0.tgz" +hashes = ["sha256:35cc9636468031e1874fe142a6f40557d3befc6dd26cdded0401f440534f4bd6"] diff --git a/testsuite/tests/install/softlinks/my_index/index/index.toml b/testsuite/tests/install/softlinks/my_index/index/index.toml new file mode 100644 index 00000000..bad265e4 --- /dev/null +++ b/testsuite/tests/install/softlinks/my_index/index/index.toml @@ -0,0 +1 @@ +version = "1.1" diff --git a/testsuite/tests/install/softlinks/test.py b/testsuite/tests/install/softlinks/test.py new file mode 100644 index 00000000..64b8b8dc --- /dev/null +++ b/testsuite/tests/install/softlinks/test.py @@ -0,0 +1,20 @@ +""" +Test that binary files containing softlinks can be installed properly +""" + +import sys + +from drivers.alr import run_alr +from drivers.helpers import on_windows + + +# Does not apply to Windows as it does not support softlinks +if on_windows(): + print('SKIP: on Windows, unapplicable') + sys.exit(0) + +# This command should succeed normally +run_alr("install", "--prefix=install", "crate") + + +print('SUCCESS') diff --git a/testsuite/tests/install/softlinks/test.yaml b/testsuite/tests/install/softlinks/test.yaml new file mode 100644 index 00000000..0a859639 --- /dev/null +++ b/testsuite/tests/install/softlinks/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + my_index: + in_fixtures: false -- 2.39.5