From 8436768144337736b54e15387b156f9b58e78dbc Mon Sep 17 00:00:00 2001 From: Adam Spiers Date: Wed, 11 Nov 2020 19:43:25 +0000 Subject: [PATCH] Eliminate erroneous warning when unstowing (#65) When unstowing a package, cleanup_invalid_links() is invoked to remove any invalid links owned by Stow. It was invoking link_owned_by_package() to check whether each existing link is owned by Stow. This in turn called find_stowed_path() which since 40a080718505 was not allowing for the possibility that it could be passed a symlink *not* owned by Stow with an absolute target and consequently emitting an erroneous warning. So remove this erroneous warning, and refactor find_stowed_path() to use two new helper functions for detecting stow directories: link_dest_within_stow_dir() and find_containing_marked_stow_dir(). Also refactor the logic within each to be simpler and more accurate, and add more test cases to the corresponding parts of the test suite. Fixes #65. Closes #103. https://github.com/aspiers/stow/issues/65 --- NEWS | 9 ++ lib/Stow.pm.in | 193 ++++++++++++++++++++++------------ t/find_stowed_path.t | 155 +++++++++++++++++++-------- t/link_dest_within_stow_dir.t | 88 ++++++++++++++++ 4 files changed, 331 insertions(+), 114 deletions(-) create mode 100755 t/link_dest_within_stow_dir.t diff --git a/NEWS b/NEWS index f14d101..d95c164 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,15 @@ News file for Stow. * Changes in version 2.3.2 +*** Eliminated a spurious warning on unstowing + + 2.3.1 introduced a benign but annoying warning when unstowing + in certain circumstances. It looked like: + + BUG in find_stowed_path? Absolute/relative mismatch between Stow dir X and path Y + + This was caused by erroneous logic, and has now been fixed. + *** Improved debug output Extra output resulting from use of the -v / --verbose flag diff --git a/lib/Stow.pm.in b/lib/Stow.pm.in index e5f105d..297bf9f 100755 --- a/lib/Stow.pm.in +++ b/lib/Stow.pm.in @@ -936,80 +936,129 @@ sub link_owned_by_package { #===== METHOD =============================================================== # Name : find_stowed_path() -# Purpose : determine whether the given link within the target directory +# Purpose : determine whether the given symlink within the target directory # : is a stowed path pointing to a member of a package under the # : stow dir, and if so, obtain a breakdown of information about # : this stowed path. -# Parameters: $target => path to a symbolic link under current directory. -# : Must share a common prefix with $self->{stow_path} -# : $source => where that link points to (needed because link +# Parameters: $target => path to a symbolic link somewhere under +# : the target directory, relative to the +# : top-level target directory (which is also +# : expected to be the current directory). +# : $ldest => where that link points to (needed because link # : might not exist yet due to two-phase approach, -# : so we can't just call readlink()). This must be -# : expressed relative to (the directory containing) -# : $target. -# Returns : ($path, $stow_path, $package) where $path and $stow_path are -# : relative from the current (i.e. target) directory. $path -# : is the full relative path, $stow_path is the relative path -# : to the stow directory, and $package is the name of the package. -# : or ('', '', '') if link is not owned by stow +# : so we can't just call readlink()). If this is +# : owned by Stow, it will be expressed relative to +# : (the directory containing) $target. However if +# : it's not, it could of course be relative or absolute, +# : point absolutely anywhere, and could even be +# : dangling. +# Returns : ($path, $stow_path, $package) where $path and $stow_path +# : are relative from the top-level target directory. $path +# : is the full relative path to the member of the package +# : pointed to by $ldest; $stow_path is the relative path +# : to the stow directory; and $package is the name of the +# : package; or ('', '', '') if link is not owned by stow. # Throws : n/a -# Comments : Allow for stow dir not being under target dir. -# : We could put more logic under here for multiple stow dirs. +# Comments : cwd must be the top-level target directory, otherwise +# : find_containing_marked_stow_dir() won't work. +# : Allow for stow dir not being under target dir. #============================================================================ sub find_stowed_path { my $self = shift; - my ($target, $source) = @_; + my ($target, $ldest) = @_; - # Evaluate softlink relative to its target - my $path = join_paths(parent($target), $source); - debug(4, 2, "is path $path owned by stow?"); - - # Search for .stow files - this allows us to detect links - # owned by stow directories other than the current one. - my $dir = ''; - my @path = split m{/+}, $path; - for my $i (0 .. $#path) { - my $part = $path[$i]; - $dir = join_paths($dir, $part); - if ($self->marked_stow_dir($dir)) { - # FIXME - not sure if this can ever happen - internal_error("find_stowed_path() called directly on stow dir") - if $i == $#path; - - debug(4, 3, "yes - $dir was marked as a stow dir"); - my $package = $path[$i + 1]; - return ($path, $dir, $package); - } - } - - # If no .stow file was found, we need to find out whether it's - # owned by the current stow directory, in which case $path will be - # a prefix of $self->{stow_path}. - if (substr($path, 0, 1) eq '/' xor substr($self->{stow_path}, 0, 1) eq '/') - { - warn "BUG in find_stowed_path? Absolute/relative mismatch between " . - "Stow dir $self->{stow_path} and path $path"; - } - - my @stow_path = split m{/+}, $self->{stow_path}; - - # Strip off common prefixes until one is empty - while (@path && @stow_path) { - if ((shift @path) ne (shift @stow_path)) { - debug(4, 3, "no - either $path not under $self->{stow_path} or vice-versa"); - return ('', '', ''); - } - } - - if (@stow_path) { # @path must be empty - debug(4, 3, "no - $path is not under $self->{stow_path}"); + if (substr($ldest, 0, 1) eq '/') { + # Symlink points to an absolute path, therefore it cannot be + # owned by Stow. return ('', '', ''); } - my $package = shift @path; + # Evaluate softlink relative to its target, without relying on + # what's actually on the filesystem, since the link might not + # exist yet. + debug(4, 2, "find_stowed_path(target=$target; source=$ldest)"); + my $dest = join_paths(parent($target), $ldest); + debug(4, 3, "is symlink destination $dest owned by stow?"); - debug(4, 3, "yes - by $package in " . join_paths(@path)); - return ($path, $self->{stow_path}, $package); + # First check whether the link is owned by the current stow + # directory, in which case $dest will be a prefix of + # $self->{stow_path}. + my ($package, $path) = $self->link_dest_within_stow_dir($dest); + if (length $package) { + debug(4, 3, "yes - package $package in $self->{stow_path} may contain $path"); + return ($dest, $self->{stow_path}, $package); + } + + # If no .stow file was found, we need to find out whether it's + my ($stow_path, $ext_package) = $self->find_containing_marked_stow_dir($dest); + if (length $stow_path) { + debug(5, 5, "yes - $stow_path in $dest was marked as a stow dir; package=$ext_package"); + return ($dest, $stow_path, $ext_package); + } + + return ('', '', ''); +} + +#===== METHOD ================================================================ +# Name : link_dest_within_stow_dir +# Purpose : detect whether symlink destination is within current stow dir +# Parameters: $ldest - destination of the symlink relative +# Returns : ($package, $path) - package within the current stow dir +# : and subpath within that package which the symlink points to +#============================================================================= +sub link_dest_within_stow_dir { + my $self = shift; + my ($ldest) = @_; + + debug(4, 4, "common prefix? ldest=$ldest; stow_path=$self->{stow_path}"); + + my $removed = $ldest =~ s,^\Q$self->{stow_path}/,,; + if (! $removed) { + debug(4, 3, "no - $ldest not under $self->{stow_path}"); + return ('', ''); + } + + debug(4, 4, "remaining after removing $self->{stow_path}: $ldest"); + my @dirs = File::Spec->splitdir($ldest); + my $package = shift @dirs; + my $path = File::Spec->catdir(@dirs); + return ($package, $path); +} + +#===== METHOD ================================================================ +# Name : find_containing_marked_stow_dir +# Purpose : detect whether path is within a marked stow directory +# Parameters: $path => path to directory to check +# Returns : ($stow_path, $package) where $stow_path is the highest directory +# : (relative from the top-level target directory) which is marked +# : as a Stow directory, and $package is the containing package; +# : or ('', '') if no containing directory is marked as a stow +# : directory. +# Comments : cwd must be the top-level target directory, otherwise +# : marked_stow_dir() won't work. +#============================================================================= +sub find_containing_marked_stow_dir { + my $self = shift; + my ($path) = @_; + + # Search for .stow files - this allows us to detect links + # owned by stow directories other than the current one. + my @segments = File::Spec->splitdir($path); + for my $last_segment (0 .. $#segments) { + my $path = join_paths(@segments[0 .. $last_segment]); + debug(5, 5, "is $path marked stow dir?"); + if ($self->marked_stow_dir($path)) { + if ($last_segment == $#segments) { + # This should probably never happen. Even if it did, + # there would be no way of calculating $package. + internal_error("find_stowed_path() called directly on stow dir"); + } + + my $package = $segments[$last_segment + 1]; + return ($path, $package); + } + } + return ('', ''); } #===== METHOD ================================================================ @@ -1066,24 +1115,30 @@ sub cleanup_invalid_links { # Where is the link pointing? # (don't use read_a_link() here) - my $source = readlink($node_path); - if (not $source) { + my $ldest = readlink($node_path); + if (not $ldest) { error("Could not read link $node_path"); } - if (-e join_paths($dir, $source)) { - debug(4, 2, "Link target $source exists; skipping clean up"); + my $target = join_paths($dir, $ldest); + debug(4, 2, "join $dir $ldest"); + if (-e $target) { + debug(4, 2, "Link target $ldest exists at $target; skipping clean up"); next; } + else { + debug(4, 2, "Link target $ldest doesn't exist at $target"); + } debug(3, 1, - "Checking whether valid link $node_path -> $source is " . + "Checking whether valid link $node_path -> $ldest is " . "owned by stow"); - if ($self->link_owned_by_package($node_path, $source)) { + my $owner = $self->link_owned_by_package($node_path, $ldest); + if ($owner) { # owned by stow - debug(2, 0, "--- removing stale link: $node_path => " . - join_paths($dir, $source)); + debug(2, 0, "--- removing link owned by $owner: $node_path => " . + join_paths($dir, $ldest)); $self->do_unlink($node_path); } } diff --git a/t/find_stowed_path.t b/t/find_stowed_path.t index d723e66..8ae4fca 100755 --- a/t/find_stowed_path.t +++ b/t/find_stowed_path.t @@ -16,68 +16,133 @@ # along with this program. If not, see https://www.gnu.org/licenses/. # -# Testing find_stowed_path() +# Testing Stow:: find_stowed_path() # use strict; use warnings; -use Test::More tests => 18; +use Test::More tests => 10; use testutil; use Stow::Util qw(set_debug_level); init_test_dirs(); -my $stow = new_Stow(dir => "$TEST_DIR/stow"); -#set_debug_level(4); +subtest("find link to a stowed path with relative target" => sub { + plan tests => 3; -my ($path, $stow_path, $package) = - $stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../../stow/a/b/c"); -is($path, "$TEST_DIR/stow/a/b/c", "path"); -is($stow_path, "$TEST_DIR/stow", "stow path"); -is($package, "a", "package"); + # This is a relative path, unlike $ABS_TEST_DIR below. + my $target = "$TEST_DIR/target"; -cd("$TEST_DIR/target"); -$stow->set_stow_dir("../stow"); -($path, $stow_path, $package) = - $stow->find_stowed_path("a/b/c", "../../../stow/a/b/c"); -is($path, "../stow/a/b/c", "path from target directory"); -is($stow_path, "../stow", "stow path from target directory"); -is($package, "a", "from target directory"); + my $stow = new_Stow(dir => "$TEST_DIR/stow", target => $target); + my ($path, $stow_path, $package) = + $stow->find_stowed_path("a/b/c", "../../../stow/a/b/c"); + is($path, "../stow/a/b/c", "path"); + is($stow_path, "../stow", "stow path"); + is($package, "a", "package"); +}); -make_path("stow"); -cd("../.."); -$stow->set_stow_dir("$TEST_DIR/target/stow"); +my $stow = new_Stow(dir => "$ABS_TEST_DIR/stow", target => "$ABS_TEST_DIR/target"); -($path, $stow_path, $package) = - $stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../stow/a/b/c"); -is($path, "$TEST_DIR/target/stow/a/b/c", "path"); -is($stow_path, "$TEST_DIR/target/stow", "stow path"); -is($package, "a", "stow is subdir of target directory"); +# Required by creation of stow2 and stow2/.stow below +cd("$ABS_TEST_DIR/target"); -($path, $stow_path, $package) = - $stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../empty"); -is($path, "", "empty path"); -is($stow_path, "", "empty stow path"); -is($package, "", "target is not stowed"); +subtest("find link to a stowed path" => sub { + plan tests => 3; + my ($path, $stow_path, $package) = + $stow->find_stowed_path("a/b/c", "../../../stow/a/b/c"); + is($path, "../stow/a/b/c", "path from target directory"); + is($stow_path, "../stow", "stow path from target directory"); + is($package, "a", "from target directory"); +}); + +subtest("find link to alien path not owned by Stow" => sub { + plan tests => 3; + my ($path, $stow_path, $package) = + $stow->find_stowed_path("a/b/c", "../../alien"); + is($path, "", "alien is not stowed, so path is empty"); + is($stow_path, "", "alien, so stow path is empty"); + is($package, "", "alien is not stowed in any package"); +}); # Make a second stow directory within the target directory, so that we -# can check that links to package files within that second stow -# directory are detected correctly. -make_path("$TEST_DIR/target/stow2"); -make_file("$TEST_DIR/target/stow2/.stow"); +# can check that links to package files within that stow directory are +# detected correctly. +make_path("stow2"); -($path, $stow_path, $package) = - $stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../stow2/a/b/c"); -is($path, "$TEST_DIR/target/stow2/a/b/c", "path"); -is($stow_path, "$TEST_DIR/target/stow2", "stow path"); -is($package, "a", "detect alternate stow directory"); +# However this second stow directory is still "alien" to stow until we +# put a .stow file in it. So first test a symlink pointing to a path +# within this second stow directory +subtest("second stow dir still alien without .stow" => sub { + plan tests => 3; + my ($path, $stow_path, $package) = + $stow->find_stowed_path("a/b/c", "../../stow2/a/b/c"); + is($path, "", "stow2 not a stow dir yet, so path is empty"); + is($stow_path, "", "stow2 not a stow dir yet so stow path is empty"); + is($package, "", "not stowed in any recognised package yet"); +}); -# Possible corner case with rogue symlink pointing to ancestor of -# stow dir. -($path, $stow_path, $package) = - $stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../.."); -is($path, "", "path"); -is($stow_path, "", "stow path"); -is($package, "", "corner case - link points to ancestor of stow dir"); +# Now make stow2 a secondary stow directory and test that +make_file("stow2/.stow"); + +subtest(".stow makes second stow dir owned by Stow" => sub { + plan tests => 3; + my ($path, $stow_path, $package) = + $stow->find_stowed_path("a/b/c", "../../stow2/a/b/c"); + is($path, "stow2/a/b/c", "path"); + is($stow_path, "stow2", "stow path"); + is($package, "a", "detect alternate stow directory"); +}); + +subtest("relative symlink pointing to target dir" => sub { + plan tests => 3; + my ($path, $stow_path, $package) = + $stow->find_stowed_path("a/b/c", "../../.."); + # Technically the target dir is not owned by Stow, since + # Stow won't touch the target dir itself, only its contents. + is($path, "", "path"); + is($stow_path, "", "stow path"); + is($package, "", "corner case - link points to target dir"); +}); + +subtest("relative symlink pointing to parent of target dir" => sub { + plan tests => 3; + my ($path, $stow_path, $package) = + $stow->find_stowed_path("a/b/c", "../../../.."); + is($path, "", "path"); + is($stow_path, "", "stow path"); + is($package, "", "corner case - link points to parent of target dir"); +}); + +subtest("unowned symlink pointing to absolute path inside target" => sub { + plan tests => 3; + my ($path, $stow_path, $package) = + $stow->find_stowed_path("a/b/c", "$ABS_TEST_DIR/target/d"); + is($path, "", "path"); + is($stow_path, "", "stow path"); + is($package, "", "symlink unowned by Stow points to absolute path outside target directory"); +}); + +subtest("unowned symlink pointing to absolute path outside target" => sub { + plan tests => 3; + my ($path, $stow_path, $package) = + $stow->find_stowed_path("a/b/c", "/dev/null"); + is($path, "", "path"); + is($stow_path, "", "stow path"); + is($package, "", "symlink unowned by Stow points to absolute path outside target directory"); +}); + +# Now make stow2 the primary stow directory and test that it still +# works when the stow directory is under the target directory +$stow->set_stow_dir("$ABS_TEST_DIR/target/stow2"); + +subtest("stow2 becomes the primary stow directory" => sub { + plan tests => 3; + + my ($path, $stow_path, $package) = + $stow->find_stowed_path("a/b/c", "../../stow2/a/b/c"); + is($path, "stow2/a/b/c", "path in stow2"); + is($stow_path, "stow2", "stow path for stow2"); + is($package, "a", "stow2 is subdir of target directory"); +}); diff --git a/t/link_dest_within_stow_dir.t b/t/link_dest_within_stow_dir.t new file mode 100755 index 0000000..01ec2f4 --- /dev/null +++ b/t/link_dest_within_stow_dir.t @@ -0,0 +1,88 @@ +#!/usr/bin/perl +# +# This file is part of GNU Stow. +# +# GNU Stow is free software: you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# GNU Stow is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see https://www.gnu.org/licenses/. + +# +# Testing Stow::link_dest_within_stow_dir() +# + +use strict; +use warnings; + +use Test::More tests => 6; + +use testutil; +use Stow::Util; + +init_test_dirs(); + +# This is a relative path, unlike $ABS_TEST_DIR below. +my $stow = new_Stow(dir => "$TEST_DIR/stow", + target => "$TEST_DIR/target"); + +subtest("relative stow dir, link to top-level package file" => sub { + plan tests => 2; + my ($package, $path) = + $stow->link_dest_within_stow_dir("../stow/pkg/dir/file"); + is($package, "pkg", "package"); + is($path, "dir/file", "path"); +}); + +subtest("relative stow dir, link to second-level package file" => sub { + plan tests => 2; + my ($package, $path) = + $stow->link_dest_within_stow_dir("../stow/pkg/dir/subdir/file"); + is($package, "pkg", "package"); + is($path, "dir/subdir/file", "path"); +}); + +# This is an absolute path, unlike $TEST_DIR above. +$stow = new_Stow(dir => "$ABS_TEST_DIR/stow", + target => "$ABS_TEST_DIR/target"); + +subtest("relative stow dir, link to second-level package file" => sub { + plan tests => 2; + my ($package, $path) = + $stow->link_dest_within_stow_dir("../stow/pkg/dir/file"); + is($package, "pkg", "package"); + is($path, "dir/file", "path"); +}); + +subtest("absolute stow dir, link to top-level package file" => sub { + plan tests => 2; + my ($package, $path) = + $stow->link_dest_within_stow_dir("../stow/pkg/dir/subdir/file"); + is($package, "pkg", "package"); + is($path, "dir/subdir/file", "path"); +}); + +# Links with destination in the target are not pointing within +# the stow dir, so they're not owned by stow. +subtest("link to path in target" => sub { + plan tests => 2; + my ($package, $path) = + $stow->link_dest_within_stow_dir("./alien"); + is($path, "", "alien is in target, so path is empty"); + is($package, "", "alien is in target, so package is empty"); +}); + +subtest("link to path outside target and stow dir" => sub { + plan tests => 2; + my ($package, $path) = + $stow->link_dest_within_stow_dir("../alien"); + is($path, "", "alien is outside, so path is empty"); + is($package, "", "alien is outside, so package is empty"); +});