Revision 732d8031c32adf4a1c99d9db2f1646fdd529375e authored by Vladislav Kamenev on 26 February 2019, 16:42:10 UTC, committed by GitHub on 26 February 2019, 16:42:10 UTC
serve.R
#' Serve phantasus.
#'
#' \code{servePhantasus} starts http server handling phantasus static files
#' and opencpu server.
#'
#' @param host Host to listen.
#'
#' @param port Port to listen.
#'
#' @param staticRoot Path to static files with phantasus.js
#' (on local file system).
#'
#' @param cacheDir Full path to cache directory.
#'
#' @param preloadedDir Full path to directory with preloaded files.
#'
#' @param openInBrowser Boolean value which states if application will be
#' automatically loaded in default browser.
#'
#' @param quiet Boolean value which states whether the connection log should
#' be hidden (default: TRUE)
#'
#' @return Running instance of phantasus application.
#'
#' @import opencpu
#' @import httpuv
#' @import Rook
#' @importFrom utils getFromNamespace
#' @importFrom parallel makeCluster stopCluster
#' @export
#'
#' @examples
#' \dontrun{
#' servePhantasus()
#' }
servePhantasus <- function(host = '0.0.0.0',
port = 8000,
staticRoot = system.file("www/phantasus.js",
package = "phantasus"),
cacheDir = tempdir(),
preloadedDir = NULL,
openInBrowser = TRUE,
quiet=TRUE) {
cacheDir <- normalizePath(cacheDir)
preloadedDir <- if (is.null(preloadedDir))
NULL
else
normalizePath(preloadedDir)
options(phantasusCacheDir = cacheDir,
phantasusPreloadedDir = preloadedDir)
annotationDBMeta(cacheDir)
FGSEAmeta(cacheDir)
if (!opencpu:::win_or_mac()) {
run_worker <- NULL
} else {
#### this fragment is adopted from opencpu::ocpu_start_server function
#### https://github.com/opencpu/opencpu/blob/master/R/start.R
#### :ToDo: remove code duplication
# set root home for workers
Sys.setenv("OCPU_MASTER_HOME" = opencpu:::tmp_root())
on.exit(Sys.unsetenv("OCPU_MASTER_HOME"))
# import
sendCall <- getFromNamespace('sendCall', 'parallel')
recvResult <- getFromNamespace('recvResult', 'parallel')
preload <- "opencpu"
# worker pool
pool <- list()
# add new workers if needed
add_workers <- function(n = 1){
if(length(pool) < 2){
cl <- parallel::makeCluster(n)
lapply(cl, sendCall, fun = function(){
lapply(preload, getNamespace)
options(phantasusCacheDir = cacheDir,
phantasusPreloadedDir = preloadedDir)
Sys.getpid()
}, args = list())
pool <<- c(pool, cl)
}
}
# get a worker
get_worker <- function(){
if(!length(pool))
add_workers(1)
node <- pool[[1]]
pool <<- pool[-1]
pid <- recvResult(node)
if(inherits(pid, "try-error"))
warning("Worker preload error: ", pid, call. = FALSE, immediate. = TRUE)
node$pid <- pid
structure(list(node), class = c("SOCKcluster", "cluster"))
}
# main interface
run_worker <- function(fun, ..., timeout = NULL){
res <- tryCatch({
if(length(timeout)){
setTimeLimit(elapsed = timeout)
on.exit(setTimeLimit(cpu = Inf, elapsed = Inf), add = TRUE)
}
cl <- get_worker()
on.exit(kill_workers(cl), add = TRUE)
node <- cl[[1]]
sendCall(node, fun, list(...))
recvResult(node)
}, error = function(e){
if(grepl("elapsed time limit", e$message)){
tools::pskill(node$pid)
stop(sprintf("Timeout reached: %ds (see rlimit.post in user.conf)", timeout))
}
stop(e)
})
if(inherits(res, "try-error"))
stop(res)
res
}
kill_workers <- function(cl){
parallel::stopCluster(cl) # does not work when child is busy
}
add_workers(2)
on.exit(kill_workers(structure(pool, class = c("SOCKcluster", "cluster"))), add = TRUE)
}
utils::capture.output(type = "output", {
app <- Rook::URLMap$new(`/ocpu` = opencpu:::rookhandler("/ocpu", worker_cb=run_worker),
`/geo` = Rook::Static$new(urls = c("/geo"), root = cacheDir),
`/preloaded` = Rook::Static$new(urls = c("/preloaded"), root = cacheDir),
`/?` = Rook::Static$new(urls = c("/"),
root = staticRoot))
tryCatch({
server <- startServer(host, port, app = app)
message(sprintf(
"Server was started with following parameters: host=%s, port=%s",
host,
port))
},
error = function(e) {
stop(paste(e,
"The reason may be that requested port", port,
"is occupied with some other application"))
})
if (openInBrowser) {
url <- sprintf("http://%s:%s", host, port)
utils::browseURL(url)
message(paste(url, "have been opened in your default browser.\n",
"If nothing happened, check your 'browser'",
"option with getOption('browser')",
"or open the address manually."))
}
on.exit(stopServer(server))
while(TRUE) {
service()
Sys.sleep(0.001)
}
}, split=!quiet)
}
![swh spinner](/static/img/swh-spinner.gif)
Computing file changes ...