From 15dc7938b8e4c2010c16915553ae158dce5d78ef Mon Sep 17 00:00:00 2001
From: wlandau <will.landau.oss@gmail.com>
Date: Fri, 6 Sep 2024 09:28:22 -0400
Subject: [PATCH] use ps_fs_mount_point() and ps_disk_partitions()

---
 NAMESPACE         |  2 ++
 R/class_runtime.R | 22 ++++++++++++++++------
 R/tar_package.R   |  3 ++-
 R/utils_files.R   | 15 +++++++++++----
 4 files changed, 31 insertions(+), 11 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 58b0063d..a0c4355c 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -575,6 +575,8 @@ importFrom(igraph,topo_sort)
 importFrom(knitr,engine_output)
 importFrom(knitr,knit_engines)
 importFrom(ps,ps_create_time)
+importFrom(ps,ps_disk_partitions)
+importFrom(ps,ps_fs_mount_point)
 importFrom(ps,ps_handle)
 importFrom(rlang,abort)
 importFrom(rlang,as_function)
diff --git a/R/class_runtime.R b/R/class_runtime.R
index 7282f6b0..923dc411 100644
--- a/R/class_runtime.R
+++ b/R/class_runtime.R
@@ -13,7 +13,8 @@ runtime_new <- function(
   nanonext = NULL,
   inventories = NULL,
   traceback = NULL,
-  pid_parent = NULL
+  pid_parent = NULL,
+  file_systems = NULL
 ) {
   force(target)
   force(frames)
@@ -30,6 +31,7 @@ runtime_new <- function(
   force(inventories)
   force(traceback)
   force(pid_parent)
+  force(file_systems)
   environment()
 }
 
@@ -104,6 +106,9 @@ runtime_validate_extras <- function(x) {
     tar_assert_none_na(x$pid_parent)
     tar_assert_ge(x$pid_parent, 0L)
   }
+  if (!is.null(x$file_systems)) {
+    tar_assert_chr(x$file_systems)
+  }
 }
 
 runtime_set_file_info <- function(runtime, store) {
@@ -113,11 +118,9 @@ runtime_set_file_info <- function(runtime, store) {
     full.names = TRUE,
     no.. = TRUE
   )
-  file_info <- as.list(file_info(objects)[, c("size", "mtime_numeric")])
-  file_info$trust_timestamps <- rep(
-    trust_timestamps(path_objects_dir(store)),
-    length(objects)
-  )
+  runtime$file_systems <- runtime_file_systems()
+  columns <- c("size", "mtime_numeric", "trust_timestamps")
+  file_info <- as.list(file_info(objects)[, columns])
   names(file_info$size) <- objects
   names(file_info$mtime_numeric) <- objects
   names(file_info$trust_timestamps) <- objects
@@ -126,6 +129,13 @@ runtime_set_file_info <- function(runtime, store) {
   runtime$file_info_exist <- tar_counter(names = objects)
 }
 
+runtime_file_systems <- function() {
+  info <- ps::ps_disk_partitions()
+  out <- .subset2(info, "fstype")
+  names(out) <- .subset2(info, "mountpoint")
+  out
+}
+
 runtime_reset <- function(x) {
   for (field in names(x)) {
     x[[field]] <- NULL
diff --git a/R/tar_package.R b/R/tar_package.R
index fdbc2a3d..a7e3480d 100644
--- a/R/tar_package.R
+++ b/R/tar_package.R
@@ -22,7 +22,8 @@
 #'   graph_from_data_frame igraph_opt igraph_options is_dag simplify topo_sort
 #'   V
 #' @importFrom knitr engine_output knit_engines
-#' @importFrom ps ps_create_time ps_handle
+#' @importFrom ps ps_create_time ps_disk_partitions ps_fs_mount_point
+#'   ps_handle
 #' @importFrom R6 R6Class
 #' @importFrom rlang abort as_function check_installed enquo inform
 #'   is_installed quo_squash warn
diff --git a/R/utils_files.R b/R/utils_files.R
index 42c0b51a..b6dc42fe 100644
--- a/R/utils_files.R
+++ b/R/utils_files.R
@@ -73,7 +73,7 @@ file_copy <- function(from, to) {
 }
 
 trust_timestamps <- function(path) {
-  out <- rep(FALSE, length(path))
+  trust <- rep(FALSE, length(path))
   exists <- file.exists(path)
   unsafe <- c(
     "adfs",
@@ -98,8 +98,15 @@ trust_timestamps <- function(path) {
     "tux3"
   )
   if (any(exists)) {
-    types <- tolower(ps::ps_fs_info(path = path[exists])$type)
-    out[exists] <- !(types %in% unsafe)
+    existing <- path[exists]
+    file_systems <- .subset2(tar_runtime, "file_systems")
+    if (is.null(file_systems)) {
+      file_systems <- runtime_file_systems()
+      tar_runtime$file_systems <- file_systems
+    }
+    mounts <- ps::ps_fs_mount_point(existing)
+    types <- as.character(file_systems[mounts])
+    trust[exists] <- !(types %in% unsafe)
   }
-  out
+  trust
 }