Simple distributed lock using BiocParallel::ipclock() and httpuv

uvlock_client.R

.host <- "localhost"
.port <- 5001

library(httr)
library(BiocParallel)

.get <-
    function(fmt, ..., host = .host, port = .port)
{
    query <- sprintf(fmt, host, port, ...)
    response <- GET(query)
    stop_for_status(response)
    unserialize(content(response))
}

uvlock <- function(id, ...)
    .get("http://%s:%d/lock?%s", id = id, ...)

uvunlock <- function(id, ...)
    .get("http://%s:%d/unlock?%s", id = id, ...)

uvlocked <- function(id, ...)
    .get("http://%s:%d/locked?%s", id = id, ...)

uvtrylock <- function(id, ...)
    .get("http://%s:%d/trylock?%s", id = id, ...)

id <- BiocParallel::ipcid()
uvlocked(id)
uvlock(id)
uvlocked(id)
uvtrylock(id)
uvunlock(id)
uvtrylock(id)
uvunlock(id)

uvlock_server.R

.host <- "0.0.0.0"
.port <- 5001

library(httpuv)
library(BiocParallel)

app <- list(call = function(req) {

    path <- basename(req[["PATH_INFO"]])
    query <- req[["QUERY_STRING"]]
    id <- substring(query, 2)

    response <- switch(path,
        lock = {
            ## I _think_ this is atomic
            while(ipclocked(id))
                later::run_now()
            ipclock(id)
        },
        unlock = ipcunlock(id),
        trylock = ipctrylock(id),
        locked = ipclocked(id),
        NULL
    )

    list(
        status = if (is.null(response)) 400L else 200L,
        headers = list(`Content-Type` = "application/octet-stream"),
        body = serialize(response, NULL)
    )
})

runServer(host = .host, port = .port, app = app)