Set a default whitelist in the example SewerRat instance.

So that the examples work with any links in or to the temporary directory.

Author: LTLA

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: SewerRat
-Version: 0.4.0
-Date: 2025-06-09
+Version: 0.4.1
+Date: 2025-08-15
 Title: Client for the SewerRat API
 Description: 
     Search metadata files across a shared filesystem via the SewerRat API.

R/startSewerRat.R

@@ -7,6 +7,8 @@
 #' @param port Integer specifying the port to use for hosting the service.
 #' If \code{NULL}, a free port is randomly selected.
 #' @param wait Integer specifying the number of seconds to wait for service initialization.
+#' @param whitelist Character vector of users who are allowed to create symbolic links.
+#' If \code{NULL}, it defaults to the current user and all owners of \code{\link{tempdir}}.
 #' @param overwrite Logical scalar indicating whether to redownload the Gobbler binary.
 #' @param version String containing the desired version of the Gobbler binary.
 #'
@@ -25,7 +27,7 @@
 #' startSewerRat() # initialize a new instance.
 #' 
 #' @export
-startSewerRat <- function(db=tempfile(fileext=".sqlite3"), port=NULL, wait = 1, version = "1.2.0", overwrite = FALSE) {
+startSewerRat <- function(db=tempfile(fileext=".sqlite3"), port=NULL, wait = 1, version = "1.3.1", whitelist = NULL, overwrite = FALSE) {
     if (!is.null(running$active)) {
         return(list(new=FALSE, port=running$port, url=assemble_url(running$port)))
     }
@@ -73,9 +75,12 @@ startSewerRat <- function(db=tempfile(fileext=".sqlite3"), port=NULL, wait = 1,
     if (is.null(port)) {
         port <- choose_port()
     }
+    if (is.null(whitelist)) {
+        whitelist <- choose_whitelist()
+    }
 
     script <- system.file("scripts", "deploy.sh", package="SewerRat", mustWork=TRUE)
-    pid <- system2(script, c(shQuote(exe), shQuote(db), shQuote(port)), stdout=TRUE) 
+    pid <- system2(script, c(shQuote(exe), shQuote(db), shQuote(port), shQuote(paste(whitelist, collapse=","))), stdout=TRUE) 
     Sys.sleep(wait)
 
     process <- new.env()
@@ -103,6 +108,20 @@ choose_port <- function() {
     }
 }
 
+choose_whitelist <- function() {
+    whitelist <- Sys.info()[["user"]]
+    tmp <- tempdir()
+    repeat {
+        whitelist <- union(whitelist, file.info(tmp)[["uname"]])
+        parent <- dirname(tmp)
+        if (parent == tmp) {
+            break
+        }
+        tmp <- parent
+    }
+    whitelist
+}
+
 assemble_url <- function(port) { 
     paste0("http://0.0.0.0:", port)
 }

inst/scripts/deploy.sh

@@ -3,7 +3,7 @@
 # We shovel this into a shell script as system(2) doesn't like multiple
 # statements, especially if one of them is backgrounded. We need to do
 # multiple statements so that we can run `$!` to get the PID.
-"$1" -db "$2" -port "$3" > /dev/null &
+"$1" -db "$2" -port "$3" -whitelist "$4" > /dev/null &
 PID=$!
 
 sleep 1 # Give it a second to set up before it's considered 'ready'.