From 75ec703bf67ff85477a178899ec2f17e3553dfcc Mon Sep 17 00:00:00 2001 From: LTLA Date: Mon, 20 Jan 2025 02:58:57 -0800 Subject: [PATCH] Return a cleaned path in absolutizePath, added more tests and examples. Also updated the cloneDirectory symlink tests to use a cleaned path. --- R/absolutizePath.R | 41 ++++++++++++++++------------ R/cloneDirectory.R | 23 ++++++++++++++-- man/absolutizePath.Rd | 5 +++- tests/testthat/test-absolutizePath.R | 36 ++++++++++++++++++++++++ tests/testthat/test-cloneDirectory.R | 15 +++++----- 5 files changed, 93 insertions(+), 27 deletions(-) create mode 100644 tests/testthat/test-absolutizePath.R diff --git a/R/absolutizePath.R b/R/absolutizePath.R index b67664a..1744ee5 100644 --- a/R/absolutizePath.R +++ b/R/absolutizePath.R @@ -5,35 +5,42 @@ #' #' @param path String containing an absolute or relative file path. #' -#' @return An absolute file path corresponding to \code{path}, or \code{path} itself if it was already absolute. +#' @return An absolute file path corresponding to \code{path}. +#' This is cleaned to remove \code{..}, \code{.} and \code{~} components. #' #' @author Aaron Lun #' #' @examples #' absolutizePath("alpha") +#' absolutizePath("../alpha") +#' absolutizePath("../../alpha/./bravo") #' absolutizePath("/alpha/bravo") #' #' @export absolutizePath <- function(path) { - components <- path_components(path) - if (components[1] == ".") { - file.path(getwd(), path) + tmp <- path + decomposed <- decompose_path(path) + + if (decomposed$relative) { + # getwd() always returns an absolute path, + # so the combined components will also be absolute. + wd <- decompose_path(getwd()) + root <- wd$root + comp <- c(wd$components, decomposed$components) } else { - path + root <- decomposed$root + comp <- decomposed$components } -} -path_components <- function(path) { - output <- character() - while (TRUE) { - base <- basename(path) - dpath <- dirname(path) - output <- c(base, output) - if (dpath == path) { - break + # Cleaning the path. + cleaned <- character() + for (x in comp) { + if (x == "..") { + cleaned <- head(cleaned, -1) + } else if (x != ".") { + cleaned <- c(cleaned, x) } - path <- dpath } - output -} + paste0(root, do.call(file.path, as.list(cleaned))) +} diff --git a/R/cloneDirectory.R b/R/cloneDirectory.R index 41da576..331c106 100644 --- a/R/cloneDirectory.R +++ b/R/cloneDirectory.R @@ -107,11 +107,11 @@ cloneDirectory <- function(src, dest, action=c("link", "copy", "symlink", "relsy relative_path_to_src <- function(src, dest) { src <- normalizePath(src, mustWork=TRUE) - src.comp <- path_components(src) + src.comp <- decompose_path(src)$components src.len <- length(src.comp) dest <- normalizePath(dest, mustWork=TRUE) - dest.comp <- path_components(dest) + dest.comp <- decompose_path(dest)$components dest.len <- length(dest.comp) counter <- 0L @@ -125,3 +125,22 @@ relative_path_to_src <- function(src, dest) { components <- c(rep("..", dest.len - counter), src.comp[(counter+1):src.len]) do.call(file.path, as.list(components)) } + +decompose_path <- function(path) { + output <- character() + repeat { + base <- basename(path) + dpath <- dirname(path) + if (dpath == path) { + return(list(relative=FALSE, root=dpath, components=output)) + } + output <- c(base, output) + if (dpath == ".") { + if (path != base) { + output <- c(".", output) + } + return(list(relative=TRUE, root=NULL, components=output)) + } + path <- dpath + } +} diff --git a/man/absolutizePath.Rd b/man/absolutizePath.Rd index 9d23c8d..72f9c13 100644 --- a/man/absolutizePath.Rd +++ b/man/absolutizePath.Rd @@ -10,7 +10,8 @@ absolutizePath(path) \item{path}{String containing an absolute or relative file path.} } \value{ -An absolute file path corresponding to \code{path}, or \code{path} itself if it was already absolute. +An absolute file path corresponding to \code{path}. +This is cleaned to remove \code{..}, \code{.} and \code{~} components. } \description{ Create an absolute file path from a relative file path. @@ -18,6 +19,8 @@ All processing is purely lexical; the path itself does not have to exist on the } \examples{ absolutizePath("alpha") +absolutizePath("../alpha") +absolutizePath("../../alpha/./bravo") absolutizePath("/alpha/bravo") } diff --git a/tests/testthat/test-absolutizePath.R b/tests/testthat/test-absolutizePath.R new file mode 100644 index 0000000..689fadc --- /dev/null +++ b/tests/testthat/test-absolutizePath.R @@ -0,0 +1,36 @@ +# library(alabaster.base); library(testthat); source("test-absolutizePath.R") + +test_that("absolutizePath cleans the path", { + expect_false(grepl("~", absolutizePath("~"))) + + tmp <- tempfile() + write(file=tmp, letters) + + path <- absolutizePath(file.path(dirname(tmp), ".", basename(tmp))) + expect_false(grepl("/\\./", path)) + expect_identical(readLines(path), letters) + if (.Platform$OS.type == "unix") { + expect_true(startsWith(path, "/")) + } + + path <- absolutizePath(file.path(dirname(tmp), "super", "..", basename(tmp))) + expect_false(grepl("/\\.\\./", path)) + expect_identical(readLines(path), letters) + if (.Platform$OS.type == "unix") { + expect_true(startsWith(path, "/")) + } +}) + +test_that("absolutizePath resolves relative paths", { + pwd <- getwd() + on.exit(setwd(pwd)) + tmp <- tempfile() + setwd(dirname(tmp)) + + write(file=tmp, letters) + path <- absolutizePath(basename(tmp)) + expect_identical(readLines(path), letters) + if (.Platform$OS.type == "unix") { + expect_true(startsWith(path, "/")) + } +}) diff --git a/tests/testthat/test-cloneDirectory.R b/tests/testthat/test-cloneDirectory.R index dea5c34..7ecf298 100644 --- a/tests/testthat/test-cloneDirectory.R +++ b/tests/testthat/test-cloneDirectory.R @@ -53,9 +53,10 @@ test_that("cloneDirectory works with symlinks", { expect_identical(readLines(file.path(dest, "stuff", "whee.txt")), as.character(1:10)) expect_identical(readLines(file.path(dest, "stuff", "blah", "kanon.txt")), "air") - expect_identical(Sys.readlink(file.path(dest, "foobar.txt")), file.path(src, "foobar.txt")) - expect_identical(Sys.readlink(file.path(dest, "stuff", "whee.txt")), file.path(src, "stuff", "whee.txt")) - expect_identical(Sys.readlink(file.path(dest, "stuff", "blah", "kanon.txt")), file.path(src, "stuff", "blah", "kanon.txt")) + cleaned <- absolutizePath(src) + expect_identical(Sys.readlink(file.path(dest, "foobar.txt")), file.path(cleaned, "foobar.txt")) + expect_identical(Sys.readlink(file.path(dest, "stuff", "whee.txt")), file.path(cleaned, "stuff", "whee.txt")) + expect_identical(Sys.readlink(file.path(dest, "stuff", "blah", "kanon.txt")), file.path(cleaned, "stuff", "blah", "kanon.txt")) }) test_that("cloneDirectory symlinks are absolute", { @@ -73,10 +74,10 @@ test_that("cloneDirectory symlinks are absolute", { expect_identical(readLines(file.path(dest, "stuff", "whee.txt")), as.character(1:10)) expect_identical(readLines(file.path(dest, "stuff", "blah", "kanon.txt")), "air") - prefix <- file.path(getwd(), basename(src)) - expect_identical(Sys.readlink(file.path(dest, "foobar.txt")), file.path(prefix, "foobar.txt")) - expect_identical(Sys.readlink(file.path(dest, "stuff", "whee.txt")), file.path(prefix, "stuff", "whee.txt")) - expect_identical(Sys.readlink(file.path(dest, "stuff", "blah", "kanon.txt")), file.path(prefix, "stuff", "blah", "kanon.txt")) + cleaned <- absolutizePath(src) + expect_identical(Sys.readlink(file.path(dest, "foobar.txt")), file.path(cleaned, "foobar.txt")) + expect_identical(Sys.readlink(file.path(dest, "stuff", "whee.txt")), file.path(cleaned, "stuff", "whee.txt")) + expect_identical(Sys.readlink(file.path(dest, "stuff", "blah", "kanon.txt")), file.path(cleaned, "stuff", "blah", "kanon.txt")) }) test_that("cloneDirectory symlinks and copyies/hardlinks interact correctly", {