R/host.R
In stencila/r: Stencila for R
# List of types that hosts supports
#' @include r-context.R
TYPES <- list(
RContext = RContext
)
# List of specifications for the types
TYPES_SPECS <- list()
for (name in names(TYPES)) {
TYPES_SPECS[[name]] <- TYPES[[name]]$spec
}
#' A Host
#'
#' Hosts allows you to remotely create, get, run methods of, and delete instances of various types.
#' The types can be thought of a "services" provided by the host e.g. `RContext`, `FileSystemStorer`
#'
#' The API of a host is similar to that of a HTTP server. It's methods names
#' (e.g. `post`, `get`) are similar to HTTP methods (e.g. `POST`, `GET`) but
#' the sematics sometimes differ (e.g. a host's `put()` method is used to call an
#' instance method)
#'
#' A host's methods are exposed by `HostHttpServer` and `HostWebsocketServer`.
#' Those other classes are responsible for tasks associated with their communication
#' protocol (e.g. serialising and deserialising objects).
#'
#' This is a singleton class. There should only ever be one `Host` in memory in each process
#' (although, for purposes of testing, this is not enforced)
#'
#' @format \code{R6Class}.
#' @examples
#' host$servers
#' host$start()
#' host$servers
#' host$stop()
Host <- R6::R6Class("Host",
public = list(
#' @section new():
#'
#' Create a new \code{Host}
initialize = function () {
private$.id <- paste0("r-host-", uuid::UUIDgenerate())
if (Sys.getenv("STENCILA_AUTH") == "false") {
key <- NULL
} else {
key <- paste(sample(c(letters, 0:9), 64, replace = TRUE), collapse = "")
}
private$.key <- key
private$.servers <- list()
private$.instances <- list()
},
#' @section user_dir():
#'
#' Get the current user's Stencila data directory.
#'
#' This is the directory that Stencila configuration settings, such as the
#' installed Stencila hosts, and document buffers get stored.
user_dir = function() {
os <- tolower(Sys.info()["sysname"])
dir <- switch(os,
darwin = file.path(Sys.getenv("HOME"), "Library", "Application Support", "Stencila"),
linux = file.path(Sys.getenv("HOME"), ".stencila"),
windows = file.path(Sys.getenv("APPDATA"), "Stencila")
)
if (!dir.exists(dir)) dir.create(dir, recursive = T)
dir
},
#' @section temp_dir():
#'
#' Get the current user's Stencila temporary directory
#'
#' This directory is used by Stencila for files such as "run files" (see below)
temp_dir = function() {
# Get system's temporary directory
# Thanks to Steve Weston at https://stackoverflow.com/a/16492084/4625911
os <- tolower(Sys.info()["sysname"])
envs <- Sys.getenv(c("TMPDIR", "TMP", "TEMP"))
useable <- which(file.info(envs)$isdir & file.access(envs, 2) == 0)
if (length(useable) > 0)
temp <- envs[[useable[1]]]
else if (os == "windows")
temp <- Sys.getenv("R_USER")
else
temp <- "/tmp"
dir <- file.path(temp, "stencila")
if (!dir.exists(dir)) dir.create(dir, recursive = T)
dir
},
#' @section run_file():
#'
#' Get the path of the "run file" for this host.
#'
#' A run file is used to indicate that a particular host is running
#' and allow other Stencila processes on the same machine
#' to communicate with it. It is created by by \code{host$start()} and
#' destroyed by \code{host$stop()}. It is placed in the machine's temporarily
#' directory to reduce the chances of a run file being present when a host
#' has aborted with out by \code{host$stop()} being called.
run_file = function() {
dir <- file.path(self$temp_dir(), "hosts")
if (!file.exists(dir)) dir.create(dir, recursive = TRUE)
file.path(dir, paste0(self$id, ".json"))
},
#' @section new():
#'
#' Get the environment of this \code{Host} including the version of R
#' and the version of installed packages.
environ = function () {
# R
env <- with(R.version, list(
version = paste(major, minor, sep = "."),
codename = nickname,
date = paste(year, month, day, sep = "-"),
platform = platform
))
# Installed packages and their versions in order of library paths
# to prevent duplicates caused by the same package being in multiple libraries
packages <- list()
for (library in .libPaths()) {
library_packages <- installed.packages(library)[, c(1, 3)]
if (nrow(library_packages)) {
for (row in 1:nrow(library_packages)) {
name <- library_packages[row, 1]
if (!(name %in% names(packages))) {
version <- library_packages[row, 2]
packages[[name]] <- version
}
}
}
}
env[["packages"]] <- packages[sort(names(packages))]
env
},
#' @section manifest():
#'
#' Get a manifest for this host
#'
#' The manifest describes the host and it's capabilities. It is used
#' by peer hosts to determine which "types" this host provides and
#' which "instances" have already been instantiated.
manifest = function (complete=TRUE) {
environs <- list(
list(id = "local", name = "local", version = "")
)
manifest <- list(
stencila = list(
package = "r",
version = version
),
id = private$.id,
spawn = c(unname(Sys.which("Rscript")), "-e", "stencila:::spawn()"),
environs = environs,
types = TYPES_SPECS
)
if (complete) {
manifest <- c(manifest, list(
machine = list(),
process = list(
pid = Sys.getpid()
),
servers = self$servers
))
}
manifest
},
#' @section register():
#'
#' Register this Stencila \code{Host} on this machine.
#'
#' Registering a host involves creating a file \code{r.json} inside of
#' the user's Stencila data (see \code{user_dir}) directory which describes
#' the capabilities of this host.
register = function () {
dir <- file.path(self$user_dir(), "hosts")
if (!file.exists(dir)) dir.create(dir, recursive = TRUE)
cat(
jsonlite::toJSON(
self$manifest(complete = FALSE),
pretty = TRUE, auto_unbox = TRUE
),
file = file.path(dir, "r.json")
)
},
# TODO: these methods implement edndpoints for
# starting and stopping hosts in other environments
# (e.g. a Docker container). Currently, only 'local'
# environment is supported
startup = function (environ) {
list(path = "")
},
shutdown = function (host) {
TRUE
},
#' @section create():
#'
#' Create a new instance of a type
#'
#' \describe{
#' \item{type}{Type of new instance}
#' \item{args}{Arguments to be passed to type constructor}
#' \item{name}{Name of new instance. Depreciated but retained for compatability.}
#' \item{return}{Address of the newly created instance}
#' }
create = function (type, args = list(), name = NULL) {
Class <- TYPES[[type]]
if (!is.null(Class)) {
# Remove depreciated `name` arg from arguments
args[["name"]] <- NULL
instance <- do.call(Class$new, args)
# Generate and ID
id <- paste0(type, paste(sample(c(letters, 0:9), 10), collapse = ""))
private$.instances[[id]] <- instance
id
} else {
stop(paste("Unknown type:", type))
}
},
#' @section get():
#'
#' Get an instance
#'
#' \describe{
#' \item{id}{ID of instance}
#' \item{return}{The instance}
#' }
get = function (id) {
instance <- private$.instances[[id]]
if (!is.null(instance)) {
instance
} else {
stop(paste("Unknown instance:", id))
}
},
#' @section call():
#'
#' Call a method of an instance
#'
#' \describe{
#' \item{id}{ID of instance}
#' \item{method}{Name of instance method}
#' \item{arg}{The argument to pass to the method}
#' \item{return}{The result of the method call}
#' }
call = function (id, method, arg = NULL) {
instance <- private$.instances[[id]]
if (!is.null(instance)) {
func <- instance[[method]]
if (!is.null(func)) {
do.call(func, list(arg))
} else {
stop(paste("Unknown method:", method))
}
} else {
stop(paste("Unknown instance:", id))
}
},
#' @section delete():
#'
#' Delete an instance
#'
#' \describe{
#' \item{id}{ID of the instance}
#' }
delete = function (id) {
instance <- private$.instances[[id]]
if (!is.null(instance)) {
private$.instances[[id]] <- NULL
} else {
stop(paste("Unknown instance:", id))
}
},
#' @section start():
#'
#' Start serving this host
#'
#' \describe{
#' \item{address}{The address to listen. Default '127.0.0.1'}
#' \item{port}{The port to listen on. Default 2000}
#' \item{quiet}{Don't print out message. Default FALSE}
#' }
#'
#' Currently, HTTP is the only server available
#' for hosts. We plan to implement a `HostWebsocketServer` soon.
start = function (address="127.0.0.1", port=2000, quiet=FALSE) {
if (is.null(private$.servers[["http"]])) {
# Start HTTP server
server <- HostHttpServer$new(self, address, port)
private$.servers[["http"]] <- server
server$start()
# Register as a running host ...
dir <- file.path(self$temp_dir(), "hosts")
if (!file.exists(dir)) dir.create(dir, recursive = TRUE)
# ...by creating a manifest file
manifest_file <- file.path(dir, paste0(self$id, ".json"))
file.create(manifest_file)
Sys.chmod(manifest_file, "0600")
cat(
jsonlite::toJSON(self$manifest(), pretty = TRUE, auto_unbox = TRUE),
file = manifest_file
)
# ...and a key file
key_file <- file.path(dir, paste0(self$id, ".key"))
file.create(key_file)
Sys.chmod(key_file, "0600")
cat(
self$key,
file = key_file
)
if (!quiet) {
cat("Host HTTP server has started:\n")
cat(" URL:", server$url, "\n")
cat(" Key:", self$key, "\n")
if (is.null(self$key)) {
cat(" Warning: authentication has been disabled!\n")
}
}
}
invisible(self)
},
#' @section stop():
#'
#' Stop serving this host. Stops all servers that are currently serving this host
stop = function (quiet=FALSE) {
# Stop each server
for (name in names(private$.servers)) {
server <- private$.servers[[name]]
server$stop()
private$.servers[[name]] <- NULL
}
# Deregister as a running host
for (file in paste0(self$id, c(".json", ".key"))) {
path <- file.path(self$temp_dir(), "hosts", file)
if (file.exists(path)) file.remove(path)
}
if (!quiet) cat("Host has stopped\n")
invisible(self)
},
#' @section run():
#'
#' \describe{
#' \item{address}{The address to listen. Default '127.0.0.1'}
#' \item{port}{The port to listen on. Default 2000}
#' \item{quiet}{Do not print status messages to the console? Default FALSE}
#' \item{echo}{Print the host's manifest to the console? Default FALSE}
#' }
#'
#' Start serving the Stencila host and wait for connections indefinitely
run = function (address="127.0.0.1", port=2000, quiet=FALSE, echo=FALSE) {
if (echo) quiet <- TRUE
self$start(address = address, port = port, quiet = quiet)
if (echo) {
cat(to_json(list(
id = self$id,
manifest = self$manifest(),
key = self$key
)))
flush.console()
}
if (!quiet) cat("Use Ctl+C (terminal) or Esc (RStudio) to stop\n")
tryCatch({
while (TRUE) {
# Process HTTP requests
httpuv::service()
}
},
interrupt = function (condition) {
self$stop(quiet = quiet)
}
)
},
spawn = function (options=list()) {
self$run(quiet = TRUE, echo = TRUE)
},
#' @section open():
#'
#' Open a file in the browser.
open = function (address="", external=FALSE) {
# Difficult to test headlessly, so don't include in coverage
# nocov start
self$start()
# Eventually we plan to serve static HTML, JS and CSS from within the package
# but for now use S3 bucket http://open.stenci.la
origin <- "http://open.stenci.la"
server <- private$.servers[["http"]]
peer <- server$url
url <- sprintf("%s/?address=%s&peers=%s", origin, address, peer)
# See if there is a `viewer` option (defined by RStudio if we are in RStudio)
viewer <- getOption("viewer")
# Currently, force external because Stencila will not run in the older
# browser that is embedded in RStdio (as of Stencila 0.27 and RStudio 1.0.153)
external <- TRUE
if (is.null(viewer) || external) {
# Use builtin function to open the URL in a new browser window/tab
utils::browseURL(url)
} else {
# Use the `rstudioapi` function to view in a pane
# Arbitrarily large height to produce max height while still maintaining
# the visibility of other panes above or below.
viewer(url, height = 5000)
}
invisible(self)
# nocov end
},
#' @section generate_token():
#'
#' Generate a request token.
#'
#' \describe{
#' \item{host}{The id of the host}
#' }
generate_token = function (host = NULL) {
if (is.null(host)) key <- self$key
else {
# TODO Support token generation for peers based on held keys
stop("Generation of tokens for peer hosts is not yet supported") # nocov
}
now <- unclass(Sys.time())
payload <- jose::jwt_claim(
iat = now,
exp = now + 300,
iss = self$id,
jti = paste(sample(c(letters, 0:9), 32), collapse = "")
)
jose::jwt_encode_hmac(payload, secret = charToRaw(key))
},
#' @section authorize_token():
#'
#' Authorize a request token.
#'
#' Throws an error if the token is invalid.
#'
#' \describe{
#' \item{token}{The request token}
#' }
authorize_token = function (token) {
payload <- jose::jwt_decode_hmac(token, secret = charToRaw(private$.key))
# Has token expired?
exp <- payload$exp
if (!is.null(exp)) {
if (exp < Sys.time()) stop("Token has expired")
}
# TODO Check and store `iss` and `jti` to prevent replay attacks
return(payload)
}
),
active = list(
#' @section id:
#'
#' Get unique ID of this host
id = function () {
private$.id
},
#' @section key:
#'
#' Get secret key of this host
key = function () {
private$.key
},
#' @section servers:
#'
#' Get a list of servers for this host. Servers are identified by the protocol shorthand
#' e.g. `http` for `HostHttpServer`
servers = function () {
servers <- list()
for (name in names(private$.servers)) {
server <- private$.servers[[name]]
servers[[name]] <- list(
url = server$url
)
}
servers
},
#' @section urls:
#'
#' Get a list of URLs for this host
urls = function () {
sapply(private$.servers, function (server) server$url)
}
),
private = list(
.id = NULL,
.key = NULL,
.servers = NULL,
.instances = NULL
)
)
#' The singleton instance of the \code{Host} class
#' @rdname host-instance
#' @export
host <- NULL
stencila/r documentation built on Sept. 1, 2021, 4:50 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# List of types that hosts supports
#' @include r-context.R
TYPES <- list(
RContext = RContext
)
# List of specifications for the types
TYPES_SPECS <- list()
for (name in names(TYPES)) {
TYPES_SPECS[[name]] <- TYPES[[name]]$spec
}
#' A Host
#'
#' Hosts allows you to remotely create, get, run methods of, and delete instances of various types.
#' The types can be thought of a "services" provided by the host e.g. `RContext`, `FileSystemStorer`
#'
#' The API of a host is similar to that of a HTTP server. It's methods names
#' (e.g. `post`, `get`) are similar to HTTP methods (e.g. `POST`, `GET`) but
#' the sematics sometimes differ (e.g. a host's `put()` method is used to call an
#' instance method)
#'
#' A host's methods are exposed by `HostHttpServer` and `HostWebsocketServer`.
#' Those other classes are responsible for tasks associated with their communication
#' protocol (e.g. serialising and deserialising objects).
#'
#' This is a singleton class. There should only ever be one `Host` in memory in each process
#' (although, for purposes of testing, this is not enforced)
#'
#' @format \code{R6Class}.
#' @examples
#' host$servers
#' host$start()
#' host$servers
#' host$stop()
Host <- R6::R6Class("Host",
public = list(
#' @section new():
#'
#' Create a new \code{Host}
initialize = function () {
private$.id <- paste0("r-host-", uuid::UUIDgenerate())
if (Sys.getenv("STENCILA_AUTH") == "false") {
key <- NULL
} else {
key <- paste(sample(c(letters, 0:9), 64, replace = TRUE), collapse = "")
}
private$.key <- key
private$.servers <- list()
private$.instances <- list()
},
#' @section user_dir():
#'
#' Get the current user's Stencila data directory.
#'
#' This is the directory that Stencila configuration settings, such as the
#' installed Stencila hosts, and document buffers get stored.
user_dir = function() {
os <- tolower(Sys.info()["sysname"])
dir <- switch(os,
darwin = file.path(Sys.getenv("HOME"), "Library", "Application Support", "Stencila"),
linux = file.path(Sys.getenv("HOME"), ".stencila"),
windows = file.path(Sys.getenv("APPDATA"), "Stencila")
)
if (!dir.exists(dir)) dir.create(dir, recursive = T)
dir
},
#' @section temp_dir():
#'
#' Get the current user's Stencila temporary directory
#'
#' This directory is used by Stencila for files such as "run files" (see below)
temp_dir = function() {
# Get system's temporary directory
# Thanks to Steve Weston at https://stackoverflow.com/a/16492084/4625911
os <- tolower(Sys.info()["sysname"])
envs <- Sys.getenv(c("TMPDIR", "TMP", "TEMP"))
useable <- which(file.info(envs)$isdir & file.access(envs, 2) == 0)
if (length(useable) > 0)
temp <- envs[[useable[1]]]
else if (os == "windows")
temp <- Sys.getenv("R_USER")
else
temp <- "/tmp"
dir <- file.path(temp, "stencila")
if (!dir.exists(dir)) dir.create(dir, recursive = T)
dir
},
#' @section run_file():
#'
#' Get the path of the "run file" for this host.
#'
#' A run file is used to indicate that a particular host is running
#' and allow other Stencila processes on the same machine
#' to communicate with it. It is created by by \code{host$start()} and
#' destroyed by \code{host$stop()}. It is placed in the machine's temporarily
#' directory to reduce the chances of a run file being present when a host
#' has aborted with out by \code{host$stop()} being called.
run_file = function() {
dir <- file.path(self$temp_dir(), "hosts")
if (!file.exists(dir)) dir.create(dir, recursive = TRUE)
file.path(dir, paste0(self$id, ".json"))
},
#' @section new():
#'
#' Get the environment of this \code{Host} including the version of R
#' and the version of installed packages.
environ = function () {
# R
env <- with(R.version, list(
version = paste(major, minor, sep = "."),
codename = nickname,
date = paste(year, month, day, sep = "-"),
platform = platform
))
# Installed packages and their versions in order of library paths
# to prevent duplicates caused by the same package being in multiple libraries
packages <- list()
for (library in .libPaths()) {
library_packages <- installed.packages(library)[, c(1, 3)]
if (nrow(library_packages)) {
for (row in 1:nrow(library_packages)) {
name <- library_packages[row, 1]
if (!(name %in% names(packages))) {
version <- library_packages[row, 2]
packages[[name]] <- version
}
}
}
}
env[["packages"]] <- packages[sort(names(packages))]
env
},
#' @section manifest():
#'
#' Get a manifest for this host
#'
#' The manifest describes the host and it's capabilities. It is used
#' by peer hosts to determine which "types" this host provides and
#' which "instances" have already been instantiated.
manifest = function (complete=TRUE) {
environs <- list(
list(id = "local", name = "local", version = "")
)
manifest <- list(
stencila = list(
package = "r",
version = version
),
id = private$.id,
spawn = c(unname(Sys.which("Rscript")), "-e", "stencila:::spawn()"),
environs = environs,
types = TYPES_SPECS
)
if (complete) {
manifest <- c(manifest, list(
machine = list(),
process = list(
pid = Sys.getpid()
),
servers = self$servers
))
}
manifest
},
#' @section register():
#'
#' Register this Stencila \code{Host} on this machine.
#'
#' Registering a host involves creating a file \code{r.json} inside of
#' the user's Stencila data (see \code{user_dir}) directory which describes
#' the capabilities of this host.
register = function () {
dir <- file.path(self$user_dir(), "hosts")
if (!file.exists(dir)) dir.create(dir, recursive = TRUE)
cat(
jsonlite::toJSON(
self$manifest(complete = FALSE),
pretty = TRUE, auto_unbox = TRUE
),
file = file.path(dir, "r.json")
)
},
# TODO: these methods implement edndpoints for
# starting and stopping hosts in other environments
# (e.g. a Docker container). Currently, only 'local'
# environment is supported
startup = function (environ) {
list(path = "")
},
shutdown = function (host) {
TRUE
},
#' @section create():
#'
#' Create a new instance of a type
#'
#' \describe{
#' \item{type}{Type of new instance}
#' \item{args}{Arguments to be passed to type constructor}
#' \item{name}{Name of new instance. Depreciated but retained for compatability.}
#' \item{return}{Address of the newly created instance}
#' }
create = function (type, args = list(), name = NULL) {
Class <- TYPES[[type]]
if (!is.null(Class)) {
# Remove depreciated `name` arg from arguments
args[["name"]] <- NULL
instance <- do.call(Class$new, args)
# Generate and ID
id <- paste0(type, paste(sample(c(letters, 0:9), 10), collapse = ""))
private$.instances[[id]] <- instance
id
} else {
stop(paste("Unknown type:", type))
}
},
#' @section get():
#'
#' Get an instance
#'
#' \describe{
#' \item{id}{ID of instance}
#' \item{return}{The instance}
#' }
get = function (id) {
instance <- private$.instances[[id]]
if (!is.null(instance)) {
instance
} else {
stop(paste("Unknown instance:", id))
}
},
#' @section call():
#'
#' Call a method of an instance
#'
#' \describe{
#' \item{id}{ID of instance}
#' \item{method}{Name of instance method}
#' \item{arg}{The argument to pass to the method}
#' \item{return}{The result of the method call}
#' }
call = function (id, method, arg = NULL) {
instance <- private$.instances[[id]]
if (!is.null(instance)) {
func <- instance[[method]]
if (!is.null(func)) {
do.call(func, list(arg))
} else {
stop(paste("Unknown method:", method))
}
} else {
stop(paste("Unknown instance:", id))
}
},
#' @section delete():
#'
#' Delete an instance
#'
#' \describe{
#' \item{id}{ID of the instance}
#' }
delete = function (id) {
instance <- private$.instances[[id]]
if (!is.null(instance)) {
private$.instances[[id]] <- NULL
} else {
stop(paste("Unknown instance:", id))
}
},
#' @section start():
#'
#' Start serving this host
#'
#' \describe{
#' \item{address}{The address to listen. Default '127.0.0.1'}
#' \item{port}{The port to listen on. Default 2000}
#' \item{quiet}{Don't print out message. Default FALSE}
#' }
#'
#' Currently, HTTP is the only server available
#' for hosts. We plan to implement a `HostWebsocketServer` soon.
start = function (address="127.0.0.1", port=2000, quiet=FALSE) {
if (is.null(private$.servers[["http"]])) {
# Start HTTP server
server <- HostHttpServer$new(self, address, port)
private$.servers[["http"]] <- server
server$start()
# Register as a running host ...
dir <- file.path(self$temp_dir(), "hosts")
if (!file.exists(dir)) dir.create(dir, recursive = TRUE)
# ...by creating a manifest file
manifest_file <- file.path(dir, paste0(self$id, ".json"))
file.create(manifest_file)
Sys.chmod(manifest_file, "0600")
cat(
jsonlite::toJSON(self$manifest(), pretty = TRUE, auto_unbox = TRUE),
file = manifest_file
)
# ...and a key file
key_file <- file.path(dir, paste0(self$id, ".key"))
file.create(key_file)
Sys.chmod(key_file, "0600")
cat(
self$key,
file = key_file
)
if (!quiet) {
cat("Host HTTP server has started:\n")
cat(" URL:", server$url, "\n")
cat(" Key:", self$key, "\n")
if (is.null(self$key)) {
cat(" Warning: authentication has been disabled!\n")
}
}
}
invisible(self)
},
#' @section stop():
#'
#' Stop serving this host. Stops all servers that are currently serving this host
stop = function (quiet=FALSE) {
# Stop each server
for (name in names(private$.servers)) {
server <- private$.servers[[name]]
server$stop()
private$.servers[[name]] <- NULL
}
# Deregister as a running host
for (file in paste0(self$id, c(".json", ".key"))) {
path <- file.path(self$temp_dir(), "hosts", file)
if (file.exists(path)) file.remove(path)
}
if (!quiet) cat("Host has stopped\n")
invisible(self)
},
#' @section run():
#'
#' \describe{
#' \item{address}{The address to listen. Default '127.0.0.1'}
#' \item{port}{The port to listen on. Default 2000}
#' \item{quiet}{Do not print status messages to the console? Default FALSE}
#' \item{echo}{Print the host's manifest to the console? Default FALSE}
#' }
#'
#' Start serving the Stencila host and wait for connections indefinitely
run = function (address="127.0.0.1", port=2000, quiet=FALSE, echo=FALSE) {
if (echo) quiet <- TRUE
self$start(address = address, port = port, quiet = quiet)
if (echo) {
cat(to_json(list(
id = self$id,
manifest = self$manifest(),
key = self$key
)))
flush.console()
}
if (!quiet) cat("Use Ctl+C (terminal) or Esc (RStudio) to stop\n")
tryCatch({
while (TRUE) {
# Process HTTP requests
httpuv::service()
}
},
interrupt = function (condition) {
self$stop(quiet = quiet)
}
)
},
spawn = function (options=list()) {
self$run(quiet = TRUE, echo = TRUE)
},
#' @section open():
#'
#' Open a file in the browser.
open = function (address="", external=FALSE) {
# Difficult to test headlessly, so don't include in coverage
# nocov start
self$start()
# Eventually we plan to serve static HTML, JS and CSS from within the package
# but for now use S3 bucket http://open.stenci.la
origin <- "http://open.stenci.la"
server <- private$.servers[["http"]]
peer <- server$url
url <- sprintf("%s/?address=%s&peers=%s", origin, address, peer)
# See if there is a `viewer` option (defined by RStudio if we are in RStudio)
viewer <- getOption("viewer")
# Currently, force external because Stencila will not run in the older
# browser that is embedded in RStdio (as of Stencila 0.27 and RStudio 1.0.153)
external <- TRUE
if (is.null(viewer) || external) {
# Use builtin function to open the URL in a new browser window/tab
utils::browseURL(url)
} else {
# Use the `rstudioapi` function to view in a pane
# Arbitrarily large height to produce max height while still maintaining
# the visibility of other panes above or below.
viewer(url, height = 5000)
}
invisible(self)
# nocov end
},
#' @section generate_token():
#'
#' Generate a request token.
#'
#' \describe{
#' \item{host}{The id of the host}
#' }
generate_token = function (host = NULL) {
if (is.null(host)) key <- self$key
else {
# TODO Support token generation for peers based on held keys
stop("Generation of tokens for peer hosts is not yet supported") # nocov
}
now <- unclass(Sys.time())
payload <- jose::jwt_claim(
iat = now,
exp = now + 300,
iss = self$id,
jti = paste(sample(c(letters, 0:9), 32), collapse = "")
)
jose::jwt_encode_hmac(payload, secret = charToRaw(key))
},
#' @section authorize_token():
#'
#' Authorize a request token.
#'
#' Throws an error if the token is invalid.
#'
#' \describe{
#' \item{token}{The request token}
#' }
authorize_token = function (token) {
payload <- jose::jwt_decode_hmac(token, secret = charToRaw(private$.key))
# Has token expired?
exp <- payload$exp
if (!is.null(exp)) {
if (exp < Sys.time()) stop("Token has expired")
}
# TODO Check and store `iss` and `jti` to prevent replay attacks
return(payload)
}
),
active = list(
#' @section id:
#'
#' Get unique ID of this host
id = function () {
private$.id
},
#' @section key:
#'
#' Get secret key of this host
key = function () {
private$.key
},
#' @section servers:
#'
#' Get a list of servers for this host. Servers are identified by the protocol shorthand
#' e.g. `http` for `HostHttpServer`
servers = function () {
servers <- list()
for (name in names(private$.servers)) {
server <- private$.servers[[name]]
servers[[name]] <- list(
url = server$url
)
}
servers
},
#' @section urls:
#'
#' Get a list of URLs for this host
urls = function () {
sapply(private$.servers, function (server) server$url)
}
),
private = list(
.id = NULL,
.key = NULL,
.servers = NULL,
.instances = NULL
)
)
#' The singleton instance of the \code{Host} class
#' @rdname host-instance
#' @export
host <- NULL
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.