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 40a0807185 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
This commit is contained in:
Adam Spiers 2020-11-11 19:43:25 +00:00
parent 877fc0ce7e
commit 8436768144
4 changed files with 331 additions and 114 deletions

9
NEWS
View file

@ -2,6 +2,15 @@ News file for Stow.
* Changes in version 2.3.2 * 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 *** Improved debug output
Extra output resulting from use of the -v / --verbose flag Extra output resulting from use of the -v / --verbose flag

View file

@ -936,80 +936,129 @@ sub link_owned_by_package {
#===== METHOD =============================================================== #===== METHOD ===============================================================
# Name : find_stowed_path() # 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 # : is a stowed path pointing to a member of a package under the
# : stow dir, and if so, obtain a breakdown of information about # : stow dir, and if so, obtain a breakdown of information about
# : this stowed path. # : this stowed path.
# Parameters: $target => path to a symbolic link under current directory. # Parameters: $target => path to a symbolic link somewhere under
# : Must share a common prefix with $self->{stow_path} # : the target directory, relative to the
# : $source => where that link points to (needed because link # : 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, # : might not exist yet due to two-phase approach,
# : so we can't just call readlink()). This must be # : so we can't just call readlink()). If this is
# : expressed relative to (the directory containing) # : owned by Stow, it will be expressed relative to
# : $target. # : (the directory containing) $target. However if
# Returns : ($path, $stow_path, $package) where $path and $stow_path are # : it's not, it could of course be relative or absolute,
# : relative from the current (i.e. target) directory. $path # : point absolutely anywhere, and could even be
# : is the full relative path, $stow_path is the relative path # : dangling.
# : to the stow directory, and $package is the name of the package. # Returns : ($path, $stow_path, $package) where $path and $stow_path
# : or ('', '', '') if link is not owned by stow # : 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 # Throws : n/a
# Comments : Allow for stow dir not being under target dir. # Comments : cwd must be the top-level target directory, otherwise
# : We could put more logic under here for multiple stow dirs. # : find_containing_marked_stow_dir() won't work.
# : Allow for stow dir not being under target dir.
#============================================================================ #============================================================================
sub find_stowed_path { sub find_stowed_path {
my $self = shift; my $self = shift;
my ($target, $source) = @_; my ($target, $ldest) = @_;
# Evaluate softlink relative to its target if (substr($ldest, 0, 1) eq '/') {
my $path = join_paths(parent($target), $source); # Symlink points to an absolute path, therefore it cannot be
debug(4, 2, "is path $path owned by stow?"); # owned by Stow.
return ('', '', '');
# 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);
} }
# 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?");
# 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 # 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 my ($stow_path, $ext_package) = $self->find_containing_marked_stow_dir($dest);
# a prefix of $self->{stow_path}. if (length $stow_path) {
if (substr($path, 0, 1) eq '/' xor substr($self->{stow_path}, 0, 1) eq '/') debug(5, 5, "yes - $stow_path in $dest was marked as a stow dir; package=$ext_package");
{ return ($dest, $stow_path, $ext_package);
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 ('', '', ''); 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 ('', '');
} }
if (@stow_path) { # @path must be empty debug(4, 4, "remaining after removing $self->{stow_path}: $ldest");
debug(4, 3, "no - $path is not under $self->{stow_path}"); my @dirs = File::Spec->splitdir($ldest);
return ('', '', ''); 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 = shift @path; my $package = $segments[$last_segment + 1];
return ($path, $package);
debug(4, 3, "yes - by $package in " . join_paths(@path)); }
return ($path, $self->{stow_path}, $package); }
return ('', '');
} }
#===== METHOD ================================================================ #===== METHOD ================================================================
@ -1066,24 +1115,30 @@ sub cleanup_invalid_links {
# Where is the link pointing? # Where is the link pointing?
# (don't use read_a_link() here) # (don't use read_a_link() here)
my $source = readlink($node_path); my $ldest = readlink($node_path);
if (not $source) { if (not $ldest) {
error("Could not read link $node_path"); error("Could not read link $node_path");
} }
if (-e join_paths($dir, $source)) { my $target = join_paths($dir, $ldest);
debug(4, 2, "Link target $source exists; skipping clean up"); debug(4, 2, "join $dir $ldest");
if (-e $target) {
debug(4, 2, "Link target $ldest exists at $target; skipping clean up");
next; next;
} }
else {
debug(4, 2, "Link target $ldest doesn't exist at $target");
}
debug(3, 1, debug(3, 1,
"Checking whether valid link $node_path -> $source is " . "Checking whether valid link $node_path -> $ldest is " .
"owned by stow"); "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 # owned by stow
debug(2, 0, "--- removing stale link: $node_path => " . debug(2, 0, "--- removing link owned by $owner: $node_path => " .
join_paths($dir, $source)); join_paths($dir, $ldest));
$self->do_unlink($node_path); $self->do_unlink($node_path);
} }
} }

View file

@ -16,68 +16,133 @@
# along with this program. If not, see https://www.gnu.org/licenses/. # along with this program. If not, see https://www.gnu.org/licenses/.
# #
# Testing find_stowed_path() # Testing Stow:: find_stowed_path()
# #
use strict; use strict;
use warnings; use warnings;
use Test::More tests => 18; use Test::More tests => 10;
use testutil; use testutil;
use Stow::Util qw(set_debug_level); use Stow::Util qw(set_debug_level);
init_test_dirs(); init_test_dirs();
my $stow = new_Stow(dir => "$TEST_DIR/stow"); subtest("find link to a stowed path with relative target" => sub {
#set_debug_level(4); plan tests => 3;
my ($path, $stow_path, $package) = # This is a relative path, unlike $ABS_TEST_DIR below.
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../../stow/a/b/c"); my $target = "$TEST_DIR/target";
is($path, "$TEST_DIR/stow/a/b/c", "path");
is($stow_path, "$TEST_DIR/stow", "stow path");
is($package, "a", "package");
cd("$TEST_DIR/target"); my $stow = new_Stow(dir => "$TEST_DIR/stow", target => $target);
$stow->set_stow_dir("../stow"); my ($path, $stow_path, $package) =
($path, $stow_path, $package) =
$stow->find_stowed_path("a/b/c", "../../../stow/a/b/c"); $stow->find_stowed_path("a/b/c", "../../../stow/a/b/c");
is($path, "../stow/a/b/c", "path from target directory"); is($path, "../stow/a/b/c", "path");
is($stow_path, "../stow", "stow path from target directory"); is($stow_path, "../stow", "stow path");
is($package, "a", "from target directory"); is($package, "a", "package");
});
make_path("stow"); my $stow = new_Stow(dir => "$ABS_TEST_DIR/stow", target => "$ABS_TEST_DIR/target");
cd("../..");
$stow->set_stow_dir("$TEST_DIR/target/stow");
($path, $stow_path, $package) = # Required by creation of stow2 and stow2/.stow below
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../stow/a/b/c"); cd("$ABS_TEST_DIR/target");
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");
($path, $stow_path, $package) = subtest("find link to a stowed path" => sub {
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../empty"); plan tests => 3;
is($path, "", "empty path"); my ($path, $stow_path, $package) =
is($stow_path, "", "empty stow path"); $stow->find_stowed_path("a/b/c", "../../../stow/a/b/c");
is($package, "", "target is not stowed"); 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 # Make a second stow directory within the target directory, so that we
# can check that links to package files within that second stow # can check that links to package files within that stow directory are
# directory are detected correctly. # detected correctly.
make_path("$TEST_DIR/target/stow2"); make_path("stow2");
make_file("$TEST_DIR/target/stow2/.stow");
($path, $stow_path, $package) = # However this second stow directory is still "alien" to stow until we
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../stow2/a/b/c"); # put a .stow file in it. So first test a symlink pointing to a path
is($path, "$TEST_DIR/target/stow2/a/b/c", "path"); # within this second stow directory
is($stow_path, "$TEST_DIR/target/stow2", "stow path"); subtest("second stow dir still alien without .stow" => sub {
is($package, "a", "detect alternate stow directory"); 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 # Now make stow2 a secondary stow directory and test that
# stow dir. make_file("stow2/.stow");
($path, $stow_path, $package) =
$stow->find_stowed_path("$TEST_DIR/target/a/b/c", "../../.."); subtest(".stow makes second stow dir owned by Stow" => sub {
is($path, "", "path"); plan tests => 3;
is($stow_path, "", "stow path"); my ($path, $stow_path, $package) =
is($package, "", "corner case - link points to ancestor of stow dir"); $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");
});

88
t/link_dest_within_stow_dir.t Executable file
View file

@ -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");
});