unlock(remove = TRUE): delete the lock file on release, safely

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: filelock
 Title: Portable File Locking
-Version: 1.0.3.9001
+Version: 1.0.3.9002
 Authors@R: c(
     person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("aut", "cre")),
     person("Posit Software, PBC", role = c("cph", "fnd"),
@@ -23,4 +23,4 @@ Config/testthat/edition: 3
 Config/usethis/last-upkeep: 2025-04-29
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+Config/roxygen2/version: 8.1.0

NEWS.md

@@ -1,5 +1,10 @@
 # filelock (development version)
 
+* `unlock()` gains `remove`: `unlock(lock, remove = TRUE)` deletes the lock file before releasing an
+  exclusive lock, so lock files exist only while in use. `lock()` now checks that the file it locked is
+  still the one at `path`, and starts over if it was deleted while it waited, so deleting is safe.
+  `remove` is ignored on Windows.
+
 * `lock()` now closes the lock file if it fails to acquire the lock,
   because of a timeout, an error or an interrupt. Before, every failed
   `lock()` call leaked a file descriptor (a file handle on Windows) (#28).

R/package.R

@@ -112,6 +112,14 @@
 #'   then the process will wait indefinitely to acquire the lock. If zero,
 #'   then the function it returns immediately, with or without acquiring
 #'   the lock
+#' @param remove If `TRUE`, `unlock()` deletes the lock file just before
+#'   releasing an exclusive lock (the last reference to it), so a lock file
+#'   exists only while it is in use. A process waiting on the deleted file
+#'   then finds it gone and `lock()` starts over on a new file: `lock()`
+#'   always checks that the file it locked is still the one at `path`. A
+#'   crash leaves the file behind; the next `unlock(remove = TRUE)` on it
+#'   deletes it. Ignored on Windows, where a file other processes have open
+#'   cannot be deleted.
 #' @param lock The lock object to unlock. It is not an error to try to
 #'   unlock an already unlocked lock. It is not possible to lock an
 #'   unlocked lock again, a new lock has to be requested.
@@ -168,11 +176,12 @@ lock <- function(path, exclusive = TRUE, timeout = Inf) {
 #' @export
 #' @rdname lock
 
-unlock <- function(lock) {
+unlock <- function(lock, remove = FALSE) {
   if (!inherits(lock, "filelock_lock")) {
     stop("`unlock()` needs a lock object, not a file name")
   }
-  .Call(c_filelock_unlock, lock)
+  stopifnot(is_flag(remove))
+  .Call(c_filelock_unlock, lock, remove)
 }
 
 #' @export

src/filelock-unix.c

@@ -80,6 +80,8 @@ int filelock__interruptible(int filedes, struct flock *lck,
     /* If ret != -1, then we have the lock, return.
        If -1, but not EINTR, then a real error happened. */
     if (ret != -1) { ret = 0; break; }
+    /* NFS: the file was deleted by its holder (unlock(remove = TRUE)); start over */
+    if (errno == ESTALE) { ret = 2; break; }
     if (ret == -1 && errno != EINTR) {
       error("Can't lock file `%s`: %s.", c_path, strerror(errno));
     }
@@ -114,6 +116,16 @@ void filelock__interruptible_cleanup(void *data, Rboolean jump) {
   if (jump) close(d->filedes);
 }
 
+/* Is the open file `filedes` the file now at `path`? */
+static int filelock__same_file(int filedes, const char *path) {
+  struct stat open_st, path_st;
+  if (fstat(filedes, &open_st) == -1) {
+    error("Can't stat lock file `%s`: %s.", path, strerror(errno));
+  }
+  if (stat(path, &path_st) == -1) return 0;
+  return open_st.st_dev == path_st.st_dev && open_st.st_ino == path_st.st_ino;
+}
+
 SEXP filelock_lock(SEXP path, SEXP exclusive, SEXP timeout) {
   struct flock lck;
   const char *c_path = CHAR(STRING_ELT(path, 0));
@@ -139,47 +151,65 @@ SEXP filelock_lock(SEXP path, SEXP exclusive, SEXP timeout) {
   lck.l_start = 0;
   lck.l_len = 0;
 
-  filedes = open(c_path, O_RDWR | O_CREAT, S_IRUSR | S_IWUSR);
-  if (filedes == -1) {
-    error("Can't open lock file `%s`: %s.", c_path, strerror(errno));
-  }
+  for (;;) {
+    filedes = open(c_path, O_RDWR | O_CREAT, S_IRUSR | S_IWUSR);
+    if (filedes == -1) {
+      error("Can't open lock file `%s`: %s.", c_path, strerror(errno));
+    }
 
-  /* One shot only? Do not block if cannot lock */
-  if (c_timeout == 0) {
-    ret = fcntl(filedes, F_SETLK, &lck);
-    if (ret == -1) {
-      int err = errno;
-      close(filedes);
-      if (err == EAGAIN || err == EACCES) {
-	return R_NilValue;
+    /* One shot only? Do not block if cannot lock */
+    if (c_timeout == 0) {
+      ret = fcntl(filedes, F_SETLK, &lck);
+      if (ret == -1) {
+        int err = errno;
+        close(filedes);
+        if (err == EAGAIN || err == EACCES) {
+          return R_NilValue;
+        }
+        /* NFS: the file was deleted by its holder (unlock(remove = TRUE)); start over */
+        if (err == ESTALE) continue;
+        error("Can't lock file `%s`: %s.", c_path, strerror(err));
       }
-      error("Can't lock file `%s`: %s.", c_path, strerror(err));
+
+    } else {
+      struct filelock__interruptible_data d = {
+        filedes, &lck, c_path, c_exclusive, c_timeout, 1
+      };
+      SEXP cont = PROTECT(R_MakeUnwindCont());
+      R_UnwindProtect(filelock__interruptible_body, &d,
+                      filelock__interruptible_cleanup, &d, cont);
+      UNPROTECT(1);
+      ret = d.ret;
     }
 
-  } else {
-    struct filelock__interruptible_data d = {
-      filedes, &lck, c_path, c_exclusive, c_timeout, 1
-    };
-    SEXP cont = PROTECT(R_MakeUnwindCont());
-    R_UnwindProtect(filelock__interruptible_body, &d,
-		    filelock__interruptible_cleanup, &d, cont);
-    UNPROTECT(1);
-    ret = d.ret;
-  }
+    /* The file was deleted while we waited (ESTALE on NFS): start over */
+    if (ret == 2) {
+      close(filedes);
+      continue;
+    }
+
+    /* Failed to acquire the lock? */
+    if (ret) {
+      close(filedes);
+      return R_NilValue;
+    }
 
-  /* Failed to acquire the lock? */
-  if (ret) {
+    /* The holder before us may have deleted the file (unlock(remove = TRUE)) while we
+       waited, so our lock is on a file that is no longer at `path`, and a newcomer may
+       lock the new one. Only a lock on the file now at `path` counts: else start over.
+       The timeout restarts for the new attempt. */
+    if (filelock__same_file(filedes, c_path)) {
+      return filelock__list_add(c_path, filedes, c_exclusive);
+    }
     close(filedes);
-    return R_NilValue;
-  } else {
-    return filelock__list_add(c_path, filedes, c_exclusive);
   }
 }
 
-SEXP filelock_unlock(SEXP lock) {
+SEXP filelock_unlock(SEXP lock, SEXP remove) {
   void *ptr = R_ExternalPtrAddr(VECTOR_ELT(lock, 0));
   const char *c_path;
   filelock__list_t *node;
+  int c_remove = LOGICAL(remove)[0];
 
   if (!ptr) return ScalarLogical(1);
 
@@ -190,6 +220,9 @@ SEXP filelock_unlock(SEXP lock) {
   if (node) {
     node->refcount -= 1;
     if (!node->refcount) {
+      /* Delete while still holding the lock: a waiter then finds the file gone and
+         starts over on a new one (see filelock_lock()) */
+      if (c_remove && node->exclusive) unlink(c_path);
       close(node->file);
       filelock__list_remove(c_path);
     }

src/filelock-windows.c

@@ -252,7 +252,9 @@ SEXP filelock_lock(SEXP path, SEXP exclusive, SEXP timeout) {
   }
 }
 
-SEXP filelock_unlock(SEXP lock) {
+/* `remove` is ignored on Windows: a file other processes have open cannot be deleted
+   there, so the lock file is kept. */
+SEXP filelock_unlock(SEXP lock, SEXP remove) {
   void *ptr = R_ExternalPtrAddr(VECTOR_ELT(lock, 0));
   const char *c_path;
   filelock__list_t *node;

src/filelock.h

@@ -8,7 +8,7 @@
 #endif
 
 SEXP filelock_lock(SEXP path, SEXP exclusive, SEXP timeout);
-SEXP filelock_unlock(SEXP path);
+SEXP filelock_unlock(SEXP lock, SEXP remove);
 SEXP filelock_is_unlocked(SEXP lock);
 
 /* ------------------------------------------------------------------ */

src/init.c

@@ -3,7 +3,7 @@
 
 static const R_CallMethodDef callMethods[]  = {
   { "filelock_lock",        (DL_FUNC) &filelock_lock,         3 },
-  { "filelock_unlock",      (DL_FUNC) &filelock_unlock,       1 },
+  { "filelock_unlock",      (DL_FUNC) &filelock_unlock,       2 },
   { "filelock_is_unlocked", (DL_FUNC) &filelock_is_unlocked,  1 },
   { NULL, NULL, 0 }
 };

tests/testthat/test.R

@@ -351,6 +351,49 @@ test_that("unlock() needs lock object", {
   expect_snapshot(error = TRUE, unlock(1))
 })
 
+test_that("unlock(remove = TRUE) deletes the lock file", {
+  tmp <- tempfile()
+  lck <- lock(tmp)
+  expect_true(file.exists(tmp))
+  unlock(lck, remove = TRUE)
+  expect_false(file.exists(tmp))
+
+  ## a shared lock, or a nested reference, does not delete it
+  lck <- lock(tmp, exclusive = FALSE)
+  unlock(lck, remove = TRUE)
+  expect_true(file.exists(tmp))
+  lck1 <- lock(tmp)
+  lck2 <- lock(tmp)
+  unlock(lck2, remove = TRUE)
+  expect_true(file.exists(tmp))
+  unlock(lck1, remove = TRUE)
+  expect_false(file.exists(tmp))
+})
+
+test_that("a waiter whose file was deleted locks the new file at the path", {
+  skip_on_cran()
+  skip_on_os("windows")
+  tmp <- tempfile()
+  lck <- lock(tmp)
+
+  ## px waits on the file we hold, then reports whether, holding its lock, the path is locked
+  px <- callr::r_bg(function(path) {
+    l <- filelock::lock(path, timeout = 10000)
+    if (is.null(l)) return("no lock")
+    Sys.sleep(3)
+    "done"
+  }, args = list(path = tmp))
+  Sys.sleep(1.5) # px is now waiting on the file we hold
+  unlock(lck, remove = TRUE)
+  Sys.sleep(0.8) # px takes the lock, finds the file gone, locks a new one at tmp
+
+  ## px holds tmp, so we must not get it; on a deleted file we would, wrongly
+  expect_true(file.exists(tmp))
+  expect_null(lock(tmp, timeout = 0))
+  px$wait(5000)
+  expect_identical(px$get_result(), "done")
+})
+
 test_that("lock file path is included in the error message", {
   # Directory permissions do not reliably restrict file creation on Windows
   skip_on_os("windows")