R/lockDirectory.R

In LTLA/dir.expiry: Managing Expiration for Cache Directories

#' Lock and unlock directories
#'
#' Mark directories as locked or unlocked for thread-safe processing,
#' using a standard naming scheme for the lock files.
#'
#' @inheritParams touchDirectory
#' @param ... For \code{lockDirectory}, further arguments to pass to \code{\link{lock}}.
#' 
#' For \code{unlockDirectory}, further arguments to pass to \code{\link{clearDirectories}}.
#' @param lock.info The list returned by \code{\link{lockDirectory}}.
#' @param clear Logical scalar indicating whether to remove expired versions via \code{\link{clearDirectories}}.
#' 
#' @return 
#' \code{lockDirectory} returns a list of locking information, including lock handles generated by the \pkg{filelock} package.
#'
#' \code{unlockDirectory} unlocks the handles generated by \code{lockDirectory}.
#' If \code{clear=TRUE}, versioned directories that have expired are removed by \code{\link{clearDirectories}}.
#' It returns a \code{NULL} invisibly.
#'
#' @details
#' \code{lockDirectory} actually creates two locks:
#' \itemize{
#' \item The first lock is applied to the versioned directory (i.e., \code{basename(path)}) within the package cache (i.e., \code{dirname(path)}).
#' This provides thread-safe read/write on its contents, protecting against other processes that want to write to the same versioned directory.
#' Concurrent read operations are also permitted by setting \code{exclusive=FALSE} in \code{...} to define a shared lock..
#' \item The second lock is applied to the package cache and is always a shared lock, regardless of the contents of \code{...}.
#' This provides thread-safe access to the lock file used in the first lock,
#' protecting it from deletion when the relevant directory expires in \code{\link{clearDirectories}}.
#' }
#' If \code{dirname(path)} does not exist, it will be created by \code{lockDirectory}.
#'
#' \code{\link{clearDirectories}} is called in \code{unlockDirectory} as the former needs to hold an exclusive lock on the package cache.
#' Thus, the clearing can only be performed after the shared lock created by \code{lockDirectory} is released.
#'
#' @author Aaron Lun
#' 
#' @examples
#' # Creating the relevant directories.
#' cache.dir <- tempfile(pattern="expired_demo")
#' version <- package_version("1.11.0")
#' 
#' handle <- lockDirectory(file.path(cache.dir, version))
#' handle
#' unlockDirectory(handle)
#'
#' list.files(cache.dir)
#' 
#' @export
#' @importFrom filelock lock unlock
lockDirectory <- function(path, ...) {
    dir <- dirname(path)
    dir.create(dir, showWarnings=FALSE, recursive=TRUE)

    plock <- .plock_path(dir)
    second <- lock(plock, exclusive=FALSE) # define this first to protect the other lock.

    vlock <- .vlock_path(path)
    tryCatch({
        first <- lock(vlock, ...)
    }, error=function(e) {
        # Release the prior lock if acquiring this one fails.
        unlock(second)
        stop(e)
    })

    list(version=first, central=second, path=path)
}

lock.suffix <- "-00LOCK"

.unslash <- function(path) {
    sub("/$", "", path)
}

.vlock_path <- function(path) {
    paste0(.unslash(path), lock.suffix)
}

.plock_path <- function(dir) { 
    file.path(dir, paste0("central", lock.suffix))
}

#' @export
#' @importFrom filelock unlock
#' @rdname lockDirectory
unlockDirectory <- function(lock.info, clear=TRUE, ...) {
    # Unlock the first one while the second lock on the 'path' directory is
    # still in place to protect the lock file.
    unlock(lock.info$version)
    unlock(lock.info$central)

    if (clear) {
        path <- lock.info$path
        clearDirectories(dirname(path), reference=basename(path), ...)
    }
}