diff --git a/DESCRIPTION b/DESCRIPTION index d942436b3..009484a87 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,7 +42,10 @@ Authors@R: c( person("Trantor Standard Systems", role = "cph", comment = "base64 implementation"), person("Igor", "Sysoev", role = "cph", - comment = "http-parser") + comment = "http-parser"), + person("Mauricio", "Vargas Sepulveda", role = "aut", + comment = c(ORCID = "0000-0003-1017-7574") + ) ) Description: Provides low-level socket and protocol support for handling HTTP and WebSocket requests directly from within R. It is primarily @@ -60,7 +63,6 @@ Imports: later (>= 0.8.0), promises, R6, - Rcpp (>= 1.0.7), utils Suggests: callr, @@ -69,21 +71,20 @@ Suggests: testthat (>= 3.0.0), websocket LinkingTo: - later, - Rcpp + later Config/Needs/website: tidyverse/tidytemplate Config/testthat/edition: 3 Config/usethis/last-upkeep: 2025-07-01 Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.3 SystemRequirements: GNU make, zlib Collate: - 'RcppExports.R' 'httpuv-package.R' 'httpuv.R' 'random_port.R' + 'rapi.R' 'server.R' 'staticServer.R' 'static_paths.R' 'utils.R' +Config/roxygen2/version: 8.0.0 diff --git a/NAMESPACE b/NAMESPACE index 5200da447..196ec9a16 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,14 +9,8 @@ S3method(print,staticPath) S3method(print,staticPathOptions) export(WebSocket) export(as.staticPath) -export(decodeURI) -export(decodeURIComponent) -export(encodeURI) -export(encodeURIComponent) export(excludeStaticPath) -export(getRNGState) export(interrupt) -export(ipFamily) export(listServers) export(randomPort) export(rawToBase64) @@ -32,7 +26,6 @@ export(stopAllServers) export(stopDaemonizedServer) export(stopServer) importFrom(R6,R6Class) -importFrom(Rcpp,evalCpp) importFrom(later,run_now) importFrom(promises,"%...!%") importFrom(promises,"%...>%") @@ -40,4 +33,4 @@ importFrom(promises,finally) importFrom(promises,is.promise) importFrom(promises,promise) importFrom(promises,then) -useDynLib(httpuv, .registration = TRUE) +useDynLib(httpuv, .registration = TRUE, .fixes = "C_") diff --git a/NEWS.md b/NEWS.md index 598cda22b..2538e2435 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # httpuv (development version) +# httpuv 1.6.16.9000 + +* @pachadotdev: Changed all the code to rely 100% on R's C API. + * Closed #426: Uses native symbol registration for calls into compiled code, resulting in performance gains from not having to perform a lookup on each call. (#427) * Fixed installation failures on macOS caused by the bundled libuv build trying to regenerate autotools files when only some tools (e.g., automake) are present. (#430) diff --git a/R/RcppExports.R b/R/RcppExports.R deleted file mode 100644 index 406dedb79..000000000 --- a/R/RcppExports.R +++ /dev/null @@ -1,147 +0,0 @@ -# Generated by using Rcpp::compileAttributes() -> do not edit by hand -# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -sendWSMessage <- function(conn, binary, message) { - invisible(.Call(`_httpuv_sendWSMessage`, conn, binary, message)) -} - -closeWS <- function(conn, code, reason) { - invisible(.Call(`_httpuv_closeWS`, conn, code, reason)) -} - -makeTcpServer <- function(host, port, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, staticPaths, staticPathOptions, quiet) { - .Call(`_httpuv_makeTcpServer`, host, port, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, staticPaths, staticPathOptions, quiet) -} - -makePipeServer <- function(name, mask, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, staticPaths, staticPathOptions, quiet) { - .Call(`_httpuv_makePipeServer`, name, mask, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, staticPaths, staticPathOptions, quiet) -} - -stopServer_ <- function(handle) { - invisible(.Call(`_httpuv_stopServer_`, handle)) -} - -getStaticPaths_ <- function(handle) { - .Call(`_httpuv_getStaticPaths_`, handle) -} - -setStaticPaths_ <- function(handle, sp) { - .Call(`_httpuv_setStaticPaths_`, handle, sp) -} - -removeStaticPaths_ <- function(handle, paths) { - .Call(`_httpuv_removeStaticPaths_`, handle, paths) -} - -getStaticPathOptions_ <- function(handle) { - .Call(`_httpuv_getStaticPathOptions_`, handle) -} - -setStaticPathOptions_ <- function(handle, opts) { - .Call(`_httpuv_setStaticPathOptions_`, handle, opts) -} - -base64encode <- function(x) { - .Call(`_httpuv_base64encode`, x) -} - -#' URI encoding/decoding -#' -#' Encodes/decodes strings using URI encoding/decoding in the same way that web -#' browsers do. The precise behaviors of these functions can be found at -#' developer.mozilla.org: -#' \href{https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/encodeURI}{encodeURI}, -#' \href{https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/encodeURIComponent}{encodeURIComponent}, -#' \href{https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/decodeURI}{decodeURI}, -#' \href{https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/decodeURIComponent}{decodeURIComponent} -#' -#' Intended as a faster replacement for [utils::URLencode()] and -#' [utils::URLdecode()]. -#' -#' encodeURI differs from encodeURIComponent in that the former will not encode -#' reserved characters: \code{;,/?:@@&=+$} -#' -#' decodeURI differs from decodeURIComponent in that it will refuse to decode -#' encoded sequences that decode to a reserved character. (If in doubt, use -#' decodeURIComponent.) -#' -#' For \code{encodeURI} and \code{encodeURIComponent}, input strings will be -#' converted to UTF-8 before URL-encoding. -#' -#' @param value Character vector to be encoded or decoded. -#' @return Encoded or decoded character vector of the same length as the -#' input value. \code{decodeURI} and \code{decodeURIComponent} will return -#' strings that are UTF-8 encoded. -#' -#' @export -encodeURI <- function(value) { - .Call(`_httpuv_encodeURI`, value) -} - -#' @rdname encodeURI -#' @export -encodeURIComponent <- function(value) { - .Call(`_httpuv_encodeURIComponent`, value) -} - -#' @rdname encodeURI -#' @export -decodeURI <- function(value) { - .Call(`_httpuv_decodeURI`, value) -} - -#' @rdname encodeURI -#' @export -decodeURIComponent <- function(value) { - .Call(`_httpuv_decodeURIComponent`, value) -} - -#' Check whether an address is IPv4 or IPv6 -#' -#' Given an IP address, this checks whether it is an IPv4 or IPv6 address. -#' -#' @param ip A single string representing an IP address. -#' -#' @return -#' For IPv4 addresses, \code{4}; for IPv6 addresses, \code{6}. If the address is -#' neither, \code{-1}. -#' -#' @examples -#' ipFamily("127.0.0.1") # 4 -#' ipFamily("500.0.0.500") # -1 -#' ipFamily("500.0.0.500") # -1 -#' -#' ipFamily("::") # 6 -#' ipFamily("::1") # 6 -#' ipFamily("fe80::1ff:fe23:4567:890a") # 6 -#' @export -ipFamily <- function(ip) { - .Call(`_httpuv_ipFamily`, ip) -} - -invokeCppCallback <- function(data, callback_xptr) { - invisible(.Call(`_httpuv_invokeCppCallback`, data, callback_xptr)) -} - -#' Apply the value of .Random.seed to R's internal RNG state -#' -#' This function is needed in unusual cases where a C++ function calls -#' an R function which sets the value of \code{.Random.seed}. This function -#' should be called at the end of the R function to ensure that the new value -#' \code{.Random.seed} is preserved. Otherwise, Rcpp may overwrite it with a -#' previous value. -#' -#' @keywords internal -#' @export -getRNGState <- function() { - invisible(.Call(`_httpuv_getRNGState`)) -} - -wsconn_address <- function(external_ptr) { - .Call(`_httpuv_wsconn_address`, external_ptr) -} - -log_level <- function(level) { - .Call(`_httpuv_log_level`, level) -} - diff --git a/R/httpuv-package.R b/R/httpuv-package.R index a0abe6420..aa3d844e5 100644 --- a/R/httpuv-package.R +++ b/R/httpuv-package.R @@ -22,11 +22,10 @@ #' @title HTTP and WebSocket server #' @author Joe Cheng \email{joe@@rstudio.com} #' @keywords package -#' @useDynLib httpuv, .registration = TRUE +#' @useDynLib httpuv, .registration = TRUE, .fixes = "C_" "_PACKAGE" ## usethis namespace: start -#' @importFrom Rcpp evalCpp #' @importFrom promises promise then finally is.promise %...>% %...!% #' @importFrom later run_now #' @importFrom R6 R6Class diff --git a/R/rapi.R b/R/rapi.R new file mode 100644 index 000000000..c28f000e1 --- /dev/null +++ b/R/rapi.R @@ -0,0 +1,87 @@ +sendWSMessage <- function(conn, binary, message) { + invisible(.Call(C_sendWSMessage, conn, binary, message)) +} + +closeWS <- function(conn, code, reason) { + invisible(.Call(C_closeWS, conn, as.integer(code), reason)) +} + +makeTcpServer <- function(host, port, onHeaders, onBodyData, onRequest, + onWSOpen, onWSMessage, onWSClose, + staticPaths, staticPathOptions, quiet) { + .Call(C_makeTcpServer, host, as.integer(port), onHeaders, onBodyData, + onRequest, onWSOpen, onWSMessage, onWSClose, + staticPaths, staticPathOptions, quiet) +} + +makePipeServer <- function(name, mask, onHeaders, onBodyData, onRequest, + onWSOpen, onWSMessage, onWSClose, + staticPaths, staticPathOptions, quiet) { + .Call(C_makePipeServer, name, as.integer(mask), onHeaders, onBodyData, + onRequest, onWSOpen, onWSMessage, onWSClose, + staticPaths, staticPathOptions, quiet) +} + +stopServer_ <- function(handle) { + invisible(.Call(C_stopServer_, handle)) +} + +getStaticPaths_ <- function(handle) { + .Call(C_getStaticPaths_, handle) +} + +setStaticPaths_ <- function(handle, sp) { + .Call(C_setStaticPaths_, handle, sp) +} + +removeStaticPaths_ <- function(handle, paths) { + .Call(C_removeStaticPaths_, handle, paths) +} + +getStaticPathOptions_ <- function(handle) { + .Call(C_getStaticPathOptions_, handle) +} + +setStaticPathOptions_ <- function(handle, opts) { + .Call(C_setStaticPathOptions_, handle, opts) +} + +rawToBase64 <- function(x) { + .Call(C_base64encode, x) +} + +encodeURI <- function(value) { + .Call(C_encodeURI, value) +} + +encodeURIComponent <- function(value) { + .Call(C_encodeURIComponent, value) +} + +decodeURI <- function(value) { + .Call(C_decodeURI, value) +} + +decodeURIComponent <- function(value) { + .Call(C_decodeURIComponent, value) +} + +ipFamily <- function(ip) { + .Call(C_ipFamily, ip) +} + +invokeCppCallback <- function(data, callback_xptr) { + invisible(.Call(C_invokeCppCallback, data, callback_xptr)) +} + +getRNGState <- function() { + invisible(.Call(C_getRNGState)) +} + +wsconn_address <- function(external_ptr) { + .Call(C_wsconn_address, external_ptr) +} + +log_level <- function(level) { + .Call(C_log_level, level) +} diff --git a/R/static_paths.R b/R/static_paths.R index ab4cb5430..66a83df42 100644 --- a/R/static_paths.R +++ b/R/static_paths.R @@ -307,12 +307,15 @@ normalizeStaticPathOptions <- function(opts) { # side, we want a named character vector. if (is.list(opts$headers)) { # Convert list to named character vector - opts$headers <- unlist(opts$headers, recursive = FALSE) + new_headers <- unlist(opts$headers, recursive = FALSE) # Special case: if opts$headers was an empty list before unlist(), it is # now NULL. Replace it with an empty named character vector. - if (length(opts$headers) == 0) { - opts$headers <- c(a = "a")[0] + if (length(new_headers) == 0) { + new_headers <- c(a = "a")[0] } + # Assign in place to preserve list element order (assigning NULL would + # remove the element). + opts$headers <- new_headers if (!is.character(opts$headers) || any_unnamed(opts$headers)) { stop("`headers` option must be a named list or character vector.") diff --git a/man/PipeServer.Rd b/man/PipeServer.Rd index 865b487c9..7502667c8 100644 --- a/man/PipeServer.Rd +++ b/man/PipeServer.Rd @@ -10,7 +10,7 @@ named pipe. \examples{ ## ------------------------------------------------ -## Method `PipeServer$new` +## Method `PipeServer$new()` ## ------------------------------------------------ \dontrun{ @@ -31,62 +31,57 @@ server <- PipeServer$new("my_pipe", -1, app) } \keyword{internal} \section{Super class}{ -\code{\link[httpuv:Server]{httpuv::Server}} -> \code{PipeServer} +\code{\link[httpuv:Server]{Server}} -> \code{PipeServer} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-PipeServer-new}{\code{PipeServer$new()}} -\item \href{#method-PipeServer-getName}{\code{PipeServer$getName()}} -\item \href{#method-PipeServer-getMask}{\code{PipeServer$getMask()}} + \itemize{ + \item \href{#method-PipeServer-initialize}{\code{PipeServer$new()}} + \item \href{#method-PipeServer-getName}{\code{PipeServer$getName()}} + \item \href{#method-PipeServer-getMask}{\code{PipeServer$getMask()}} + } } -} -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PipeServer-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a new PipeServer object +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-PipeServer-initialize}{}}} +\subsection{\code{PipeServer$new()}}{ + Initialize a new PipeServer object Create a new \code{PipeServer} object. \code{app} is an httpuv application object as described in \code{\link[=startServer]{startServer()}}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PipeServer$new(name, mask, app, quiet = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{name}}{The name of the named pipe to bind the server to.} - -\item{\code{mask}}{The mask for the named pipe. If NULL, it defaults to -1.} - -\item{\code{app}}{An httpuv application object as described in + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PipeServer$new(name, mask, app, quiet = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{name}}{The name of the named pipe to bind the server to.} + \item{\code{mask}}{The mask for the named pipe. If NULL, it defaults to -1.} + \item{\code{app}}{An httpuv application object as described in \code{\link[=startServer]{startServer()}}.} - -\item{\code{quiet}}{If TRUE, suppresses output from the server.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A new \code{PipeServer} object. -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{\dontrun{ -# Create a simple app + \item{\code{quiet}}{If TRUE, suppresses output from the server.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A new \code{PipeServer} object. + } + \subsection{Examples}{ + \if{html}{\out{
}} + \preformatted{# Create a simple app app <- function(req) { list( status = 200L, @@ -97,36 +92,38 @@ app <- function(req) { # Create a server server <- PipeServer$new("my_pipe", -1, app) } -} -\if{html}{\out{
}} - + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PipeServer-getName}{}}} -\subsection{Method \code{getName()}}{ -Get the name of the named pipe -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PipeServer$getName()}\if{html}{\out{
}} +\subsection{\code{PipeServer$getName()}}{ + Get the name of the named pipe + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PipeServer$getName()} + \if{html}{\out{
}} + } + \subsection{Returns}{ + The name of the named pipe that the server is bound to. + } } -\subsection{Returns}{ -The name of the named pipe that the server is bound to. -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-PipeServer-getMask}{}}} -\subsection{Method \code{getMask()}}{ -Get the mask for the named pipe -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PipeServer$getMask()}\if{html}{\out{
}} +\subsection{\code{PipeServer$getMask()}}{ + Get the mask for the named pipe + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{PipeServer$getMask()} + \if{html}{\out{
}} + } + \subsection{Returns}{ + The mask for the named pipe that the server is bound to. + } } -\subsection{Returns}{ -The mask for the named pipe that the server is bound to. -} -} } diff --git a/man/Server.Rd b/man/Server.Rd index 77c94ae6c..74bb83b2a 100644 --- a/man/Server.Rd +++ b/man/Server.Rd @@ -11,7 +11,7 @@ be instantiated. \examples{ ## ------------------------------------------------ -## Method `Server$setStaticPath` +## Method `Server$setStaticPath()` ## ------------------------------------------------ \dontrun{ @@ -25,7 +25,7 @@ server$setStaticPath( } ## ------------------------------------------------ -## Method `Server$removeStaticPath` +## Method `Server$removeStaticPath()` ## ------------------------------------------------ \dontrun{ @@ -46,78 +46,83 @@ server$removeStaticPath("staticPath1") \keyword{internal} \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-Server-stop}{\code{Server$stop()}} -\item \href{#method-Server-isRunning}{\code{Server$isRunning()}} -\item \href{#method-Server-getStaticPaths}{\code{Server$getStaticPaths()}} -\item \href{#method-Server-setStaticPath}{\code{Server$setStaticPath()}} -\item \href{#method-Server-removeStaticPath}{\code{Server$removeStaticPath()}} -\item \href{#method-Server-getStaticPathOptions}{\code{Server$getStaticPathOptions()}} -\item \href{#method-Server-setStaticPathOption}{\code{Server$setStaticPathOption()}} -} + \itemize{ + \item \href{#method-Server-stop}{\code{Server$stop()}} + \item \href{#method-Server-isRunning}{\code{Server$isRunning()}} + \item \href{#method-Server-getStaticPaths}{\code{Server$getStaticPaths()}} + \item \href{#method-Server-setStaticPath}{\code{Server$setStaticPath()}} + \item \href{#method-Server-removeStaticPath}{\code{Server$removeStaticPath()}} + \item \href{#method-Server-getStaticPathOptions}{\code{Server$getStaticPathOptions()}} + \item \href{#method-Server-setStaticPathOption}{\code{Server$setStaticPathOption()}} + } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Server-stop}{}}} -\subsection{Method \code{stop()}}{ -Stop a running server -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Server$stop()}\if{html}{\out{
}} +\subsection{\code{Server$stop()}}{ + Stop a running server + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Server$stop()} + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Server-isRunning}{}}} -\subsection{Method \code{isRunning()}}{ -Check if the server is running -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Server$isRunning()}\if{html}{\out{
}} +\subsection{\code{Server$isRunning()}}{ + Check if the server is running + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Server$isRunning()} + \if{html}{\out{
}} + } + \subsection{Returns}{ + TRUE if the server is running, FALSE otherwise. + } } -\subsection{Returns}{ -TRUE if the server is running, FALSE otherwise. -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Server-getStaticPaths}{}}} -\subsection{Method \code{getStaticPaths()}}{ -Get the static paths for the server -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Server$getStaticPaths()}\if{html}{\out{
}} +\subsection{\code{Server$getStaticPaths()}}{ + Get the static paths for the server + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Server$getStaticPaths()} + \if{html}{\out{
}} + } + \subsection{Returns}{ + A list of \code{\link[=staticPath]{staticPath()}} objects. + } } -\subsection{Returns}{ -A list of \code{\link[=staticPath]{staticPath()}} objects. -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Server-setStaticPath}{}}} -\subsection{Method \code{setStaticPath()}}{ -Set a static path for the server -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Server$setStaticPath(..., .list = NULL)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{Named arguments where each name is the name of the static path +\subsection{\code{Server$setStaticPath()}}{ + Set a static path for the server + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Server$setStaticPath(..., .list = NULL)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{...}}{Named arguments where each name is the name of the static path and the value is the path to the directory to serve. If there already exists a static path with the same name, it will be replaced.} - -\item{\code{.list}}{A named list where each name is the name of the static path + \item{\code{.list}}{A named list where each name is the name of the static path and the value is the path to the directory to serve. If there already exists a static path with the same name, it will be replaced.} -} -\if{html}{\out{
}} -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{\dontrun{ -# Create a server + } + \if{html}{\out{
}} + } + \subsection{Examples}{ + \if{html}{\out{
}} + \preformatted{# Create a server server <- WebServer$new("127.0.0.1", 8080, app = my_app) #' # Set a static path server$setStaticPath( @@ -125,36 +130,34 @@ server$setStaticPath( staticPath2 = "another/path/to/static/files" ) } -} -\if{html}{\out{
}} - + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Server-removeStaticPath}{}}} -\subsection{Method \code{removeStaticPath()}}{ -Remove a static path -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Server$removeStaticPath(path)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{path}}{The name of the static path to remove.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -An invisible NULL if the server is running, otherwise it does +\subsection{\code{Server$removeStaticPath()}}{ + Remove a static path + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Server$removeStaticPath(path)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{path}}{The name of the static path to remove.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + An invisible NULL if the server is running, otherwise it does nothing. -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{\dontrun{ -# Create a server + } + \subsection{Examples}{ + \if{html}{\out{
}} + \preformatted{# Create a server server <- WebServer$new("127.0.0.1", 8080, app = my_app) # Set a static path server$setStaticPath( @@ -164,50 +167,51 @@ server$setStaticPath( # Remove a static path server$removeStaticPath("staticPath1") } -} -\if{html}{\out{
}} - + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Server-getStaticPathOptions}{}}} -\subsection{Method \code{getStaticPathOptions()}}{ -Get the static path options for the server -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Server$getStaticPathOptions()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -A list of default \code{staticPathOptions} for the current server. +\subsection{\code{Server$getStaticPathOptions()}}{ + Get the static path options for the server + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Server$getStaticPathOptions()} + \if{html}{\out{
}} + } + \subsection{Returns}{ + A list of default \code{staticPathOptions} for the current server. Each static path will use these options by default, but they can be overridden for each static path. + } } -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Server-setStaticPathOption}{}}} -\subsection{Method \code{setStaticPathOption()}}{ -Set one or more static path options -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Server$setStaticPathOption(..., .list = NULL)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{Named arguments where each name is the name of the static path +\subsection{\code{Server$setStaticPathOption()}}{ + Set one or more static path options + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{Server$setStaticPathOption(..., .list = NULL)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{...}}{Named arguments where each name is the name of the static path option and the value is the value to set for that option.} - -\item{\code{.list}}{A named list where each name is the name of the static path + \item{\code{.list}}{A named list where each name is the name of the static path option and the value is the value to set for that option.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -An invisible NULL if the server is running, otherwise it does + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + An invisible NULL if the server is running, otherwise it does nothing. + } } -} + } diff --git a/man/WebServer.Rd b/man/WebServer.Rd index 2e5d99267..daf83c785 100644 --- a/man/WebServer.Rd +++ b/man/WebServer.Rd @@ -10,7 +10,7 @@ can be running at the same time. \examples{ ## ------------------------------------------------ -## Method `WebServer$new` +## Method `WebServer$new()` ## ------------------------------------------------ \dontrun{ @@ -31,61 +31,56 @@ server <- WebServer$new("127.0.0.1", 8080, app) } \keyword{internal} \section{Super class}{ -\code{\link[httpuv:Server]{httpuv::Server}} -> \code{WebServer} +\code{\link[httpuv:Server]{Server}} -> \code{WebServer} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-WebServer-new}{\code{WebServer$new()}} -\item \href{#method-WebServer-getHost}{\code{WebServer$getHost()}} -\item \href{#method-WebServer-getPort}{\code{WebServer$getPort()}} + \itemize{ + \item \href{#method-WebServer-initialize}{\code{WebServer$new()}} + \item \href{#method-WebServer-getHost}{\code{WebServer$getHost()}} + \item \href{#method-WebServer-getPort}{\code{WebServer$getPort()}} + } } -} -\if{html}{\out{ -
Inherited methods +\if{html}{\out{
Inherited methods -
-}} +
}} \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-WebServer-new}{}}} -\subsection{Method \code{new()}}{ -Initialize a new WebServer object +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-WebServer-initialize}{}}} +\subsection{\code{WebServer$new()}}{ + Initialize a new WebServer object Create a new \code{WebServer} object. \code{app} is an httpuv application object as described in \code{\link[=startServer]{startServer()}}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{WebServer$new(host, port, app, quiet = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{host}}{The host name or IP address to bind the server to.} - -\item{\code{port}}{The port number to bind the server to.} - -\item{\code{app}}{An httpuv application object as described in \code{\link[=startServer]{startServer()}}.} - -\item{\code{quiet}}{If TRUE, suppresses output from the server.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -A new \code{WebServer} object. -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{\dontrun{ -# Create a simple app + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{WebServer$new(host, port, app, quiet = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{host}}{The host name or IP address to bind the server to.} + \item{\code{port}}{The port number to bind the server to.} + \item{\code{app}}{An httpuv application object as described in \code{\link[=startServer]{startServer()}}.} + \item{\code{quiet}}{If TRUE, suppresses output from the server.} + } + \if{html}{\out{
}} + } + \subsection{Returns}{ + A new \code{WebServer} object. + } + \subsection{Examples}{ + \if{html}{\out{
}} + \preformatted{# Create a simple app app <- function(req) { list( status = 200L, @@ -96,36 +91,38 @@ app <- function(req) { # Create a server server <- WebServer$new("127.0.0.1", 8080, app) } -} -\if{html}{\out{
}} - + \if{html}{\out{
}} + } } -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-WebServer-getHost}{}}} -\subsection{Method \code{getHost()}}{ -Get the host name or IP address of the server -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{WebServer$getHost()}\if{html}{\out{
}} +\subsection{\code{WebServer$getHost()}}{ + Get the host name or IP address of the server + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{WebServer$getHost()} + \if{html}{\out{
}} + } + \subsection{Returns}{ + The host name or IP address that the server is bound to. + } } -\subsection{Returns}{ -The host name or IP address that the server is bound to. -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-WebServer-getPort}{}}} -\subsection{Method \code{getPort()}}{ -Get the port number of the server -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{WebServer$getPort()}\if{html}{\out{
}} +\subsection{\code{WebServer$getPort()}}{ + Get the port number of the server + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{WebServer$getPort()} + \if{html}{\out{
}} + } + \subsection{Returns}{ + The port number that the server is bound to. + } } -\subsection{Returns}{ -The port number that the server is bound to. -} -} } diff --git a/man/WebSocket.Rd b/man/WebSocket.Rd index cc24d6a7d..5e56384e6 100644 --- a/man/WebSocket.Rd +++ b/man/WebSocket.Rd @@ -45,142 +45,152 @@ startServer("0.0.0.0", 8080, } } \section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{handle}}{The server handle} + \if{html}{\out{
}} + \describe{ + \item{\code{handle}}{The server handle} -\item{\code{messageCallbacks}}{A list of callback functions that will be invoked + \item{\code{messageCallbacks}}{A list of callback functions that will be invoked when a message is received on this connection.} -\item{\code{closeCallbacks}}{A list of callback functions that will be invoked + \item{\code{closeCallbacks}}{A list of callback functions that will be invoked when the connection is closed.} -\item{\code{request}}{The Rook request environment that opened the connection. + \item{\code{request}}{The Rook request environment that opened the connection. This can be used to inspect HTTP headers, for example.} -} -\if{html}{\out{
}} + } + \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ -\itemize{ -\item \href{#method-WebSocket-new}{\code{WebSocket$new()}} -\item \href{#method-WebSocket-onMessage}{\code{WebSocket$onMessage()}} -\item \href{#method-WebSocket-onClose}{\code{WebSocket$onClose()}} -\item \href{#method-WebSocket-send}{\code{WebSocket$send()}} -\item \href{#method-WebSocket-close}{\code{WebSocket$close()}} -\item \href{#method-WebSocket-clone}{\code{WebSocket$clone()}} -} + \itemize{ + \item \href{#method-WebSocket-initialize}{\code{WebSocket$new()}} + \item \href{#method-WebSocket-onMessage}{\code{WebSocket$onMessage()}} + \item \href{#method-WebSocket-onClose}{\code{WebSocket$onClose()}} + \item \href{#method-WebSocket-send}{\code{WebSocket$send()}} + \item \href{#method-WebSocket-close}{\code{WebSocket$close()}} + \item \href{#method-WebSocket-clone}{\code{WebSocket$clone()}} + } } \if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-WebSocket-new}{}}} -\subsection{Method \code{new()}}{ -Initializes a new WebSocket object. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{WebSocket$new(handle, req)}\if{html}{\out{
}} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-WebSocket-initialize}{}}} +\subsection{\code{WebSocket$new()}}{ + Initializes a new WebSocket object. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{WebSocket$new(handle, req)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{handle}}{An C++ WebSocket handle.} + \item{\code{req}}{The Rook request environment that opened the connection.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{handle}}{An C++ WebSocket handle.} - -\item{\code{req}}{The Rook request environment that opened the connection.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-WebSocket-onMessage}{}}} -\subsection{Method \code{onMessage()}}{ -Registers a callback function that will be invoked whenever a message is +\subsection{\code{WebSocket$onMessage()}}{ + Registers a callback function that will be invoked whenever a message is received on this connection. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{WebSocket$onMessage(func)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{func}}{The callback function to be registered. The callback function will be invoked with + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{WebSocket$onMessage(func)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{func}}{The callback function to be registered. The callback function will be invoked with two arguments. The first argument is \code{TRUE} if the message is binary and \code{FALSE} if it is text. The second argument is either a raw vector (if the message is binary) or a character vector.} + } + \if{html}{\out{
}} + } } -\if{html}{\out{
}} -} -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-WebSocket-onClose}{}}} -\subsection{Method \code{onClose()}}{ -Registers a callback function that will be invoked when the connection is +\subsection{\code{WebSocket$onClose()}}{ + Registers a callback function that will be invoked when the connection is closed. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{WebSocket$onClose(func)}\if{html}{\out{
}} + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{WebSocket$onClose(func)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{func}}{The callback function to be registered.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{func}}{The callback function to be registered.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-WebSocket-send}{}}} -\subsection{Method \code{send()}}{ -Begins sending the given message over the websocket. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{WebSocket$send(message)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{message}}{Either a raw vector, or a single-element character +\subsection{\code{WebSocket$send()}}{ + Begins sending the given message over the websocket. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{WebSocket$send(message)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{message}}{Either a raw vector, or a single-element character vector that is encoded in UTF-8.} + } + \if{html}{\out{
}} + } } -\if{html}{\out{
}} -} -} + \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-WebSocket-close}{}}} -\subsection{Method \code{close()}}{ -Closes the websocket connection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{WebSocket$close(code = 1000L, reason = "")}\if{html}{\out{
}} +\subsection{\code{WebSocket$close()}}{ + Closes the websocket connection + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{WebSocket$close(code = 1000L, reason = "")} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{code}}{An integer that indicates the \href{https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/close#code}{WebSocket close code}.} + \item{\code{reason}}{A concise human-readable prose \href{https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/close#reason}{explanation for the closure}.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{code}}{An integer that indicates the \href{https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/close#code}{WebSocket close code}.} - -\item{\code{reason}}{A concise human-readable prose \href{https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/close#reason}{explanation for the closure}.} -} -\if{html}{\out{
}} -} -} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-WebSocket-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{WebSocket$clone(deep = FALSE)}\if{html}{\out{
}} +\subsection{\code{WebSocket$clone()}}{ + The objects of this class are cloneable with this method. + \subsection{Usage}{ + \if{html}{\out{
}} + \preformatted{WebSocket$clone(deep = FALSE)} + \if{html}{\out{
}} + } + \subsection{Arguments}{ + \if{html}{\out{
}} + \describe{ + \item{\code{deep}}{Whether to make a deep clone.} + } + \if{html}{\out{
}} + } } -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} } diff --git a/man/encodeURI.Rd b/man/encodeURI.Rd deleted file mode 100644 index 6671c0e9f..000000000 --- a/man/encodeURI.Rd +++ /dev/null @@ -1,48 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RcppExports.R -\name{encodeURI} -\alias{encodeURI} -\alias{encodeURIComponent} -\alias{decodeURI} -\alias{decodeURIComponent} -\title{URI encoding/decoding} -\usage{ -encodeURI(value) - -encodeURIComponent(value) - -decodeURI(value) - -decodeURIComponent(value) -} -\arguments{ -\item{value}{Character vector to be encoded or decoded.} -} -\value{ -Encoded or decoded character vector of the same length as the -input value. \code{decodeURI} and \code{decodeURIComponent} will return -strings that are UTF-8 encoded. -} -\description{ -Encodes/decodes strings using URI encoding/decoding in the same way that web -browsers do. The precise behaviors of these functions can be found at -developer.mozilla.org: -\href{https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/encodeURI}{encodeURI}, -\href{https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/encodeURIComponent}{encodeURIComponent}, -\href{https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/decodeURI}{decodeURI}, -\href{https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/decodeURIComponent}{decodeURIComponent} -} -\details{ -Intended as a faster replacement for \code{\link[utils:URLencode]{utils::URLencode()}} and -\code{\link[utils:URLencode]{utils::URLdecode()}}. - -encodeURI differs from encodeURIComponent in that the former will not encode -reserved characters: \code{;,/?:@&=+$} - -decodeURI differs from decodeURIComponent in that it will refuse to decode -encoded sequences that decode to a reserved character. (If in doubt, use -decodeURIComponent.) - -For \code{encodeURI} and \code{encodeURIComponent}, input strings will be -converted to UTF-8 before URL-encoding. -} diff --git a/man/getRNGState.Rd b/man/getRNGState.Rd deleted file mode 100644 index 5c0ac4d54..000000000 --- a/man/getRNGState.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RcppExports.R -\name{getRNGState} -\alias{getRNGState} -\title{Apply the value of .Random.seed to R's internal RNG state} -\usage{ -getRNGState() -} -\description{ -This function is needed in unusual cases where a C++ function calls -an R function which sets the value of \code{.Random.seed}. This function -should be called at the end of the R function to ensure that the new value -\code{.Random.seed} is preserved. Otherwise, Rcpp may overwrite it with a -previous value. -} -\keyword{internal} diff --git a/man/ipFamily.Rd b/man/ipFamily.Rd deleted file mode 100644 index 29b26ddf8..000000000 --- a/man/ipFamily.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/RcppExports.R -\name{ipFamily} -\alias{ipFamily} -\title{Check whether an address is IPv4 or IPv6} -\usage{ -ipFamily(ip) -} -\arguments{ -\item{ip}{A single string representing an IP address.} -} -\value{ -For IPv4 addresses, \code{4}; for IPv6 addresses, \code{6}. If the address is -neither, \code{-1}. -} -\description{ -Given an IP address, this checks whether it is an IPv4 or IPv6 address. -} -\examples{ -ipFamily("127.0.0.1") # 4 -ipFamily("500.0.0.500") # -1 -ipFamily("500.0.0.500") # -1 - -ipFamily("::") # 6 -ipFamily("::1") # 6 -ipFamily("fe80::1ff:fe23:4567:890a") # 6 -} diff --git a/man/runStaticServer.Rd b/man/runStaticServer.Rd index 3da02c595..31e4ec674 100644 --- a/man/runStaticServer.Rd +++ b/man/runStaticServer.Rd @@ -24,7 +24,7 @@ listened on. Note that on most Unix-like systems including Linux and macOS, port numbers smaller than 1024 require root privileges.} \item{...}{ - Arguments passed on to \code{\link[=staticPath]{staticPath}} + Arguments passed on to \code{\link{staticPath}} \describe{ \item{\code{path}}{The local path.} \item{\code{indexhtml}}{If an index.html file is present, should it be served up diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp deleted file mode 100644 index 3e522207e..000000000 --- a/src/RcppExports.cpp +++ /dev/null @@ -1,283 +0,0 @@ -// Generated by using Rcpp::compileAttributes() -> do not edit by hand -// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 - -#include - -using namespace Rcpp; - -#ifdef RCPP_USE_GLOBAL_ROSTREAM -Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); -Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); -#endif - -// sendWSMessage -void sendWSMessage(SEXP conn, bool binary, Rcpp::RObject message); -RcppExport SEXP _httpuv_sendWSMessage(SEXP connSEXP, SEXP binarySEXP, SEXP messageSEXP) { -BEGIN_RCPP - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< SEXP >::type conn(connSEXP); - Rcpp::traits::input_parameter< bool >::type binary(binarySEXP); - Rcpp::traits::input_parameter< Rcpp::RObject >::type message(messageSEXP); - sendWSMessage(conn, binary, message); - return R_NilValue; -END_RCPP -} -// closeWS -void closeWS(SEXP conn, uint16_t code, std::string reason); -RcppExport SEXP _httpuv_closeWS(SEXP connSEXP, SEXP codeSEXP, SEXP reasonSEXP) { -BEGIN_RCPP - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< SEXP >::type conn(connSEXP); - Rcpp::traits::input_parameter< uint16_t >::type code(codeSEXP); - Rcpp::traits::input_parameter< std::string >::type reason(reasonSEXP); - closeWS(conn, code, reason); - return R_NilValue; -END_RCPP -} -// makeTcpServer -Rcpp::RObject makeTcpServer(const std::string& host, int port, Rcpp::Function onHeaders, Rcpp::Function onBodyData, Rcpp::Function onRequest, Rcpp::Function onWSOpen, Rcpp::Function onWSMessage, Rcpp::Function onWSClose, Rcpp::List staticPaths, Rcpp::List staticPathOptions, bool quiet); -RcppExport SEXP _httpuv_makeTcpServer(SEXP hostSEXP, SEXP portSEXP, SEXP onHeadersSEXP, SEXP onBodyDataSEXP, SEXP onRequestSEXP, SEXP onWSOpenSEXP, SEXP onWSMessageSEXP, SEXP onWSCloseSEXP, SEXP staticPathsSEXP, SEXP staticPathOptionsSEXP, SEXP quietSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const std::string& >::type host(hostSEXP); - Rcpp::traits::input_parameter< int >::type port(portSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onHeaders(onHeadersSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onBodyData(onBodyDataSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onRequest(onRequestSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onWSOpen(onWSOpenSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onWSMessage(onWSMessageSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onWSClose(onWSCloseSEXP); - Rcpp::traits::input_parameter< Rcpp::List >::type staticPaths(staticPathsSEXP); - Rcpp::traits::input_parameter< Rcpp::List >::type staticPathOptions(staticPathOptionsSEXP); - Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); - rcpp_result_gen = Rcpp::wrap(makeTcpServer(host, port, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, staticPaths, staticPathOptions, quiet)); - return rcpp_result_gen; -END_RCPP -} -// makePipeServer -Rcpp::RObject makePipeServer(const std::string& name, int mask, Rcpp::Function onHeaders, Rcpp::Function onBodyData, Rcpp::Function onRequest, Rcpp::Function onWSOpen, Rcpp::Function onWSMessage, Rcpp::Function onWSClose, Rcpp::List staticPaths, Rcpp::List staticPathOptions, bool quiet); -RcppExport SEXP _httpuv_makePipeServer(SEXP nameSEXP, SEXP maskSEXP, SEXP onHeadersSEXP, SEXP onBodyDataSEXP, SEXP onRequestSEXP, SEXP onWSOpenSEXP, SEXP onWSMessageSEXP, SEXP onWSCloseSEXP, SEXP staticPathsSEXP, SEXP staticPathOptionsSEXP, SEXP quietSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const std::string& >::type name(nameSEXP); - Rcpp::traits::input_parameter< int >::type mask(maskSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onHeaders(onHeadersSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onBodyData(onBodyDataSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onRequest(onRequestSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onWSOpen(onWSOpenSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onWSMessage(onWSMessageSEXP); - Rcpp::traits::input_parameter< Rcpp::Function >::type onWSClose(onWSCloseSEXP); - Rcpp::traits::input_parameter< Rcpp::List >::type staticPaths(staticPathsSEXP); - Rcpp::traits::input_parameter< Rcpp::List >::type staticPathOptions(staticPathOptionsSEXP); - Rcpp::traits::input_parameter< bool >::type quiet(quietSEXP); - rcpp_result_gen = Rcpp::wrap(makePipeServer(name, mask, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, staticPaths, staticPathOptions, quiet)); - return rcpp_result_gen; -END_RCPP -} -// stopServer_ -void stopServer_(std::string handle); -RcppExport SEXP _httpuv_stopServer_(SEXP handleSEXP) { -BEGIN_RCPP - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< std::string >::type handle(handleSEXP); - stopServer_(handle); - return R_NilValue; -END_RCPP -} -// getStaticPaths_ -Rcpp::List getStaticPaths_(std::string handle); -RcppExport SEXP _httpuv_getStaticPaths_(SEXP handleSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< std::string >::type handle(handleSEXP); - rcpp_result_gen = Rcpp::wrap(getStaticPaths_(handle)); - return rcpp_result_gen; -END_RCPP -} -// setStaticPaths_ -Rcpp::List setStaticPaths_(std::string handle, Rcpp::List sp); -RcppExport SEXP _httpuv_setStaticPaths_(SEXP handleSEXP, SEXP spSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< std::string >::type handle(handleSEXP); - Rcpp::traits::input_parameter< Rcpp::List >::type sp(spSEXP); - rcpp_result_gen = Rcpp::wrap(setStaticPaths_(handle, sp)); - return rcpp_result_gen; -END_RCPP -} -// removeStaticPaths_ -Rcpp::List removeStaticPaths_(std::string handle, Rcpp::CharacterVector paths); -RcppExport SEXP _httpuv_removeStaticPaths_(SEXP handleSEXP, SEXP pathsSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< std::string >::type handle(handleSEXP); - Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type paths(pathsSEXP); - rcpp_result_gen = Rcpp::wrap(removeStaticPaths_(handle, paths)); - return rcpp_result_gen; -END_RCPP -} -// getStaticPathOptions_ -Rcpp::List getStaticPathOptions_(std::string handle); -RcppExport SEXP _httpuv_getStaticPathOptions_(SEXP handleSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< std::string >::type handle(handleSEXP); - rcpp_result_gen = Rcpp::wrap(getStaticPathOptions_(handle)); - return rcpp_result_gen; -END_RCPP -} -// setStaticPathOptions_ -Rcpp::List setStaticPathOptions_(std::string handle, Rcpp::List opts); -RcppExport SEXP _httpuv_setStaticPathOptions_(SEXP handleSEXP, SEXP optsSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< std::string >::type handle(handleSEXP); - Rcpp::traits::input_parameter< Rcpp::List >::type opts(optsSEXP); - rcpp_result_gen = Rcpp::wrap(setStaticPathOptions_(handle, opts)); - return rcpp_result_gen; -END_RCPP -} -// base64encode -std::string base64encode(const Rcpp::RawVector& x); -RcppExport SEXP _httpuv_base64encode(SEXP xSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const Rcpp::RawVector& >::type x(xSEXP); - rcpp_result_gen = Rcpp::wrap(base64encode(x)); - return rcpp_result_gen; -END_RCPP -} -// encodeURI -Rcpp::CharacterVector encodeURI(Rcpp::CharacterVector value); -RcppExport SEXP _httpuv_encodeURI(SEXP valueSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type value(valueSEXP); - rcpp_result_gen = Rcpp::wrap(encodeURI(value)); - return rcpp_result_gen; -END_RCPP -} -// encodeURIComponent -Rcpp::CharacterVector encodeURIComponent(Rcpp::CharacterVector value); -RcppExport SEXP _httpuv_encodeURIComponent(SEXP valueSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type value(valueSEXP); - rcpp_result_gen = Rcpp::wrap(encodeURIComponent(value)); - return rcpp_result_gen; -END_RCPP -} -// decodeURI -Rcpp::CharacterVector decodeURI(Rcpp::CharacterVector value); -RcppExport SEXP _httpuv_decodeURI(SEXP valueSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type value(valueSEXP); - rcpp_result_gen = Rcpp::wrap(decodeURI(value)); - return rcpp_result_gen; -END_RCPP -} -// decodeURIComponent -Rcpp::CharacterVector decodeURIComponent(Rcpp::CharacterVector value); -RcppExport SEXP _httpuv_decodeURIComponent(SEXP valueSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::CharacterVector >::type value(valueSEXP); - rcpp_result_gen = Rcpp::wrap(decodeURIComponent(value)); - return rcpp_result_gen; -END_RCPP -} -// ipFamily -int ipFamily(const std::string& ip); -RcppExport SEXP _httpuv_ipFamily(SEXP ipSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const std::string& >::type ip(ipSEXP); - rcpp_result_gen = Rcpp::wrap(ipFamily(ip)); - return rcpp_result_gen; -END_RCPP -} -// invokeCppCallback -void invokeCppCallback(Rcpp::List data, SEXP callback_xptr); -RcppExport SEXP _httpuv_invokeCppCallback(SEXP dataSEXP, SEXP callback_xptrSEXP) { -BEGIN_RCPP - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< Rcpp::List >::type data(dataSEXP); - Rcpp::traits::input_parameter< SEXP >::type callback_xptr(callback_xptrSEXP); - invokeCppCallback(data, callback_xptr); - return R_NilValue; -END_RCPP -} -// getRNGState -void getRNGState(); -RcppExport SEXP _httpuv_getRNGState() { -BEGIN_RCPP - Rcpp::RNGScope rcpp_rngScope_gen; - getRNGState(); - return R_NilValue; -END_RCPP -} -// wsconn_address -std::string wsconn_address(SEXP external_ptr); -RcppExport SEXP _httpuv_wsconn_address(SEXP external_ptrSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< SEXP >::type external_ptr(external_ptrSEXP); - rcpp_result_gen = Rcpp::wrap(wsconn_address(external_ptr)); - return rcpp_result_gen; -END_RCPP -} -// log_level -std::string log_level(const std::string& level); -RcppExport SEXP _httpuv_log_level(SEXP levelSEXP) { -BEGIN_RCPP - Rcpp::RObject rcpp_result_gen; - Rcpp::RNGScope rcpp_rngScope_gen; - Rcpp::traits::input_parameter< const std::string& >::type level(levelSEXP); - rcpp_result_gen = Rcpp::wrap(log_level(level)); - return rcpp_result_gen; -END_RCPP -} - -static const R_CallMethodDef CallEntries[] = { - {"_httpuv_sendWSMessage", (DL_FUNC) &_httpuv_sendWSMessage, 3}, - {"_httpuv_closeWS", (DL_FUNC) &_httpuv_closeWS, 3}, - {"_httpuv_makeTcpServer", (DL_FUNC) &_httpuv_makeTcpServer, 11}, - {"_httpuv_makePipeServer", (DL_FUNC) &_httpuv_makePipeServer, 11}, - {"_httpuv_stopServer_", (DL_FUNC) &_httpuv_stopServer_, 1}, - {"_httpuv_getStaticPaths_", (DL_FUNC) &_httpuv_getStaticPaths_, 1}, - {"_httpuv_setStaticPaths_", (DL_FUNC) &_httpuv_setStaticPaths_, 2}, - {"_httpuv_removeStaticPaths_", (DL_FUNC) &_httpuv_removeStaticPaths_, 2}, - {"_httpuv_getStaticPathOptions_", (DL_FUNC) &_httpuv_getStaticPathOptions_, 1}, - {"_httpuv_setStaticPathOptions_", (DL_FUNC) &_httpuv_setStaticPathOptions_, 2}, - {"_httpuv_base64encode", (DL_FUNC) &_httpuv_base64encode, 1}, - {"_httpuv_encodeURI", (DL_FUNC) &_httpuv_encodeURI, 1}, - {"_httpuv_encodeURIComponent", (DL_FUNC) &_httpuv_encodeURIComponent, 1}, - {"_httpuv_decodeURI", (DL_FUNC) &_httpuv_decodeURI, 1}, - {"_httpuv_decodeURIComponent", (DL_FUNC) &_httpuv_decodeURIComponent, 1}, - {"_httpuv_ipFamily", (DL_FUNC) &_httpuv_ipFamily, 1}, - {"_httpuv_invokeCppCallback", (DL_FUNC) &_httpuv_invokeCppCallback, 2}, - {"_httpuv_getRNGState", (DL_FUNC) &_httpuv_getRNGState, 0}, - {"_httpuv_wsconn_address", (DL_FUNC) &_httpuv_wsconn_address, 1}, - {"_httpuv_log_level", (DL_FUNC) &_httpuv_log_level, 1}, - {NULL, NULL, 0} -}; - -RcppExport void R_init_httpuv(DllInfo *dll) { - R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); - R_useDynamicSymbols(dll, FALSE); -} diff --git a/src/http.h b/src/http.h index 882bbf288..8d150d31e 100644 --- a/src/http.h +++ b/src/http.h @@ -56,47 +56,38 @@ bool runNonBlocking(uv_loop_t* loop); // This was due to a bug in gcc which was fixed in later versions. // https://gcc.gnu.org/bugzilla/show_bug.cgi?id=38600 +// Finalizer for WebSocketConnection external pointers. Schedules deletion +// on the background thread so that R's GC (which runs on the main thread) +// does not directly delete an object that must be destroyed on the bg thread. +inline void ws_conn_xptr_finalizer(SEXP xptr) { + std::shared_ptr* obj = + (std::shared_ptr*)R_ExternalPtrAddr(xptr); + if (obj) { + auto_deleter_background(obj); + R_ClearExternalPtr(xptr); + } +} + // externalize_shared_ptr is used to pass a shared_ptr to R, and have its -// lifetime be tied to the R external pointer object. This function creates a -// copy of the shared_ptr (incrementing the shared_ptr's target's refcount) -// using `new`, and puts it inside of the XPtr. When the XPtr is garbage -// collected, the shared_ptr is deleted, which decrements the refcount. -// -// As long as R has the XPtr object, the shared_ptr's target won't be deleted. -// Also, when the XPtr gets GC'd, the shared_ptr will get deleted, and if the -// refcount goes to 0, then the target object will be deleted (or, if it has a -// deleter, that will be called). This means that the target object could be -// deleted from the main thread due to a GC event in R. -// -// The reason we need the explicit Xptr type is because we want to set the last -// argument (finalizeOnExit) to true. -inline Rcpp::XPtr, - Rcpp::PreserveStorage, - auto_deleter_background >, - true> externalize_shared_ptr(std::shared_ptr obj) +// lifetime be tied to the R external pointer object. This function allocates +// a copy of the shared_ptr on the heap and wraps it in an R external pointer +// with a finalizer that schedules deletion on the background thread. +inline SEXP externalize_shared_ptr(std::shared_ptr obj) { ASSERT_MAIN_THREAD() std::shared_ptr* obj_copy = new std::shared_ptr(obj); - - Rcpp::XPtr, - Rcpp::PreserveStorage, - auto_deleter_background >, - true> obj_xptr(obj_copy, true); - - return obj_xptr; + SEXP xptr = R_MakeExternalPtr(obj_copy, R_NilValue, R_NilValue); + R_RegisterCFinalizer(xptr, ws_conn_xptr_finalizer); + return xptr; } -// Given an XPtr to a shared_ptr, return a copy of the shared_ptr. This -// increases the shared_ptr's ref count by one. -inline std::shared_ptr internalize_shared_ptr( - Rcpp::XPtr, - Rcpp::PreserveStorage, - auto_deleter_background >, - true> obj_xptr) +// Given an R external pointer wrapping a shared_ptr, return a copy of the +// shared_ptr (incrementing the ref count by one). +inline std::shared_ptr internalize_shared_ptr(SEXP xptr) { ASSERT_MAIN_THREAD() - std::shared_ptr* obj_copy = obj_xptr.get(); - // Return a copy of the shared pointer. + std::shared_ptr* obj_copy = + (std::shared_ptr*)R_ExternalPtrAddr(xptr); return *obj_copy; } diff --git a/src/httprequest.cpp b/src/httprequest.cpp index 55fee9528..5a8498083 100644 --- a/src/httprequest.cpp +++ b/src/httprequest.cpp @@ -148,24 +148,35 @@ void HttpRequest::_newRequest() { void HttpRequest::_initializeEnv() { ASSERT_MAIN_THREAD() - using namespace Rcpp; - Environment base(R_BaseEnv); - Function new_env = Rcpp::as(base["new.env"]); + // Get new.env function from base + SEXP base = R_BaseEnv; + SEXP new_env_sym = Rf_install("new.env"); + SEXP new_env_fn = PROTECT(Rf_findFun(new_env_sym, base)); + + // Build the call: new.env(parent = emptyenv()) + SEXP parent_sym = Rf_install("parent"); + SEXP call = PROTECT(Rf_lang2(new_env_fn, R_EmptyEnv)); + SET_TAG(CDR(call), parent_sym); + + // Evaluate the call + SEXP new_env_result = PROTECT(Rf_eval(call, R_GlobalEnv)); // The deleter is called either when this function is called again, or when // the HttpRequest object is deleted. The deletion will happen on the // background thread; auto_deleter_main() schedules the deletion of the - // Rcpp::Environment object on the main thread. - _env = std::shared_ptr( - new Environment(new_env(_["parent"] = R_EmptyEnv)), - auto_deleter_main + // RProtectedSEXP object on the main thread. + _env = std::shared_ptr( + new RProtectedSEXP(new_env_result), + auto_deleter_main ); + + UNPROTECT(3); } -Rcpp::Environment& HttpRequest::env() { +SEXP HttpRequest::env() { ASSERT_MAIN_THREAD() - return *_env; + return _env->sexp; } std::string HttpRequest::method() const { diff --git a/src/httprequest.h b/src/httprequest.h index 543e4baa5..c310891e5 100644 --- a/src/httprequest.h +++ b/src/httprequest.h @@ -38,13 +38,13 @@ class HttpRequest : public WebSocketConnectionCallbacks, std::string _lastHeaderField; std::shared_ptr _pWebSocketConnection; - // `_env` is an shared_ptr instead of an Environment because it + // `_env` is a shared_ptr instead of a plain SEXP because it // must be created and deleted on the main thread. However, the creation and // deletion of HttpRequest objects happens on the background thread, and so - // the lifetime of the Environment can't be strictly tied to the lifetime of + // the lifetime of the environment can't be strictly tied to the lifetime of // the HttpRequest. It is instantiated with a deleter function that ensures // deletion happens on the main thread. - std::shared_ptr _env; + std::shared_ptr _env; void _newRequest(); void _initializeEnv(); @@ -133,7 +133,7 @@ class HttpRequest : public WebSocketConnectionCallbacks, } Address clientAddress(); Address serverAddress(); - Rcpp::Environment& env(); + SEXP env(); void handleRequest(); diff --git a/src/httpuv.cpp b/src/httpuv.cpp index 25963b1d9..6d883f03a 100644 --- a/src/httpuv.cpp +++ b/src/httpuv.cpp @@ -19,6 +19,12 @@ #include "auto_deleter.h" #include "socket.h" #include +#ifdef length +# undef length +#endif +#include +#include +#include void throwError(int err, @@ -27,7 +33,7 @@ void throwError(int err, { ASSERT_MAIN_THREAD() std::string msg = prefix + uv_strerror(err) + suffix; - throw Rcpp::exception(msg.c_str()); + throw std::runtime_error(msg.c_str()); } // For keeping track of all running server apps. @@ -166,7 +172,7 @@ void ensure_io_thread() { blocker->wait(); if (ret != 0) { - Rcpp::stop(std::string("Error: ") + uv_strerror(ret)); + Rf_error("Error: %s", uv_strerror(ret)); } } @@ -175,27 +181,19 @@ void ensure_io_thread() { // Outgoing websocket messages // ============================================================================ -// [[Rcpp::export]] -void sendWSMessage(SEXP conn, - bool binary, - Rcpp::RObject message) +SEXP sendWSMessage(SEXP conn, SEXP binary, SEXP message) { ASSERT_MAIN_THREAD() - Rcpp::XPtr, - Rcpp::PreserveStorage, - auto_deleter_background >, - true> conn_xptr(conn); - std::shared_ptr wsc = internalize_shared_ptr(conn_xptr); + std::shared_ptr wsc = internalize_shared_ptr(conn); Opcode mode; SEXP msg_sexp; std::vector* str; - // Efficiently copy message into a new vector. There's probably a - // cleaner way to do this. - if (binary) { + // Efficiently copy message into a new vector. + if (LOGICAL(binary)[0]) { mode = Binary; - msg_sexp = PROTECT(Rcpp::as(message)); + msg_sexp = PROTECT(message); str = new std::vector(RAW(msg_sexp), RAW(msg_sexp) + Rf_length(msg_sexp)); UNPROTECT(1); @@ -206,7 +204,6 @@ void sendWSMessage(SEXP conn, UNPROTECT(1); } - std::function cb( std::bind(&WebSocketConnection::sendWSMessage, wsc, mode, @@ -216,29 +213,23 @@ void sendWSMessage(SEXP conn, ); background_queue->push(cb); - // Free str after data is written - // deleter_background>(str) background_queue->push(std::bind(deleter_background >, str)); + return R_NilValue; } -// [[Rcpp::export]] -void closeWS(SEXP conn, - uint16_t code, - std::string reason) +SEXP closeWS(SEXP conn, SEXP code, SEXP reason) { ASSERT_MAIN_THREAD() debug_log("closeWS", LOG_DEBUG); - Rcpp::XPtr, - Rcpp::PreserveStorage, - auto_deleter_background >, - true> conn_xptr(conn); - std::shared_ptr wsc = internalize_shared_ptr(conn_xptr); - - // Schedule on background thread: - // wsc->closeWS(code, reason); + std::shared_ptr wsc = internalize_shared_ptr(conn); + + uint16_t code_val = (uint16_t)INTEGER(code)[0]; + std::string reason_str = std::string(CHAR(STRING_ELT(reason, 0))); + background_queue->push( - std::bind(&WebSocketConnection::closeWS, wsc, code, reason) + std::bind(&WebSocketConnection::closeWS, wsc, code_val, reason_str) ); + return R_NilValue; } @@ -246,22 +237,23 @@ void closeWS(SEXP conn, // Create/stop servers // ============================================================================ -// [[Rcpp::export]] -Rcpp::RObject makeTcpServer(const std::string& host, int port, - Rcpp::Function onHeaders, - Rcpp::Function onBodyData, - Rcpp::Function onRequest, - Rcpp::Function onWSOpen, - Rcpp::Function onWSMessage, - Rcpp::Function onWSClose, - Rcpp::List staticPaths, - Rcpp::List staticPathOptions, - bool quiet -) { - - using namespace Rcpp; +SEXP makeTcpServer(SEXP host, SEXP port, + SEXP onHeaders, + SEXP onBodyData, + SEXP onRequest, + SEXP onWSOpen, + SEXP onWSMessage, + SEXP onWSClose, + SEXP staticPaths, + SEXP staticPathOptions, + SEXP quiet) +{ register_main_thread(); + std::string host_str = std::string(CHAR(STRING_ELT(host, 0))); + int port_int = INTEGER(port)[0]; + bool quiet_bool = LOGICAL(quiet)[0] != 0; + // Deleted when owning pServer is deleted. If pServer creation fails, // this should be deleted when it goes out of scope. std::shared_ptr pHandler( @@ -273,23 +265,15 @@ Rcpp::RObject makeTcpServer(const std::string& host, int port, ensure_io_thread(); - // Use a shared_ptr because the lifetime of this object might be longer than - // this function, since it is passed to the background thread. std::shared_ptr blocker = std::make_shared(2); uv_stream_t* pServer; - // Run on background thread: - // createTcpServerSync( - // io_loop.get(), host.c_str(), port, - // std::static_pointer_cast(pHandler), - // background_queue, &pServer, blocker - // ); background_queue->push( std::bind(createTcpServerSync, - io_loop.get(), host.c_str(), port, + io_loop.get(), host_str.c_str(), port_int, std::static_pointer_cast(pHandler), - quiet, background_queue, &pServer, blocker + quiet_bool, background_queue, &pServer, blocker ) ); @@ -302,26 +286,26 @@ Rcpp::RObject makeTcpServer(const std::string& host, int port, pServers.push_back(pServer); - return Rcpp::wrap(externalize_str(pServer)); + return Rf_mkString(externalize_str(pServer).c_str()); } -// [[Rcpp::export]] -Rcpp::RObject makePipeServer(const std::string& name, - int mask, - Rcpp::Function onHeaders, - Rcpp::Function onBodyData, - Rcpp::Function onRequest, - Rcpp::Function onWSOpen, - Rcpp::Function onWSMessage, - Rcpp::Function onWSClose, - Rcpp::List staticPaths, - Rcpp::List staticPathOptions, - bool quiet -) { - - using namespace Rcpp; +SEXP makePipeServer(SEXP name, SEXP mask, + SEXP onHeaders, + SEXP onBodyData, + SEXP onRequest, + SEXP onWSOpen, + SEXP onWSMessage, + SEXP onWSClose, + SEXP staticPaths, + SEXP staticPathOptions, + SEXP quiet) +{ register_main_thread(); + std::string name_str = std::string(CHAR(STRING_ELT(name, 0))); + int mask_int = INTEGER(mask)[0]; + bool quiet_bool = LOGICAL(quiet)[0] != 0; + // Deleted when owning pServer is deleted. If pServer creation fails, // this should be deleted when it goes out of scope. std::shared_ptr pHandler( @@ -337,17 +321,11 @@ Rcpp::RObject makePipeServer(const std::string& name, uv_stream_t* pServer; - // Run on background thread: - // createPipeServerSync( - // io_loop.get(), name.c_str(), mask, - // std::static_pointer_cast(pHandler), - // background_queue, &pServer, blocker - // ); background_queue->push( std::bind(createPipeServerSync, - io_loop.get(), name.c_str(), mask, + io_loop.get(), name_str.c_str(), mask_int, std::static_pointer_cast(pHandler), - quiet, background_queue, &pServer, blocker + quiet_bool, background_queue, &pServer, blocker ) ); @@ -360,7 +338,7 @@ Rcpp::RObject makePipeServer(const std::string& name, pServers.push_back(pServer); - return Rcpp::wrap(externalize_str(pServer)); + return Rf_mkString(externalize_str(pServer).c_str()); } @@ -374,7 +352,7 @@ void stopServer_(uv_stream_t* pServer) { if (pos != pServers.end()) { pServers.erase(pos); } else { - throw Rcpp::exception("pServer handle not found in list of running servers."); + throw std::runtime_error("pServer handle not found in list of running servers."); } // Run on background thread: @@ -384,11 +362,12 @@ void stopServer_(uv_stream_t* pServer) { ); } -// [[Rcpp::export]] -void stopServer_(std::string handle) { +SEXP stopServer_sexp(SEXP handle) { ASSERT_MAIN_THREAD() - uv_stream_t* pServer = internalize_str(handle); + std::string handle_str = std::string(CHAR(STRING_ELT(handle, 0))); + uv_stream_t* pServer = internalize_str(handle_str); stopServer_(pServer); + return R_NilValue; } void stop_loop_timer_cb(uv_timer_t* handle) { @@ -411,38 +390,37 @@ std::shared_ptr get_pWebApplication(std::string handle) { return get_pWebApplication(pServer); } -// [[Rcpp::export]] -Rcpp::List getStaticPaths_(std::string handle) { +SEXP getStaticPaths_(SEXP handle) { ASSERT_MAIN_THREAD() - return get_pWebApplication(handle)->getStaticPathManager().pathsAsRObject(); + std::string h = std::string(CHAR(STRING_ELT(handle, 0))); + return get_pWebApplication(h)->getStaticPathManager().pathsAsRObject(); } -// [[Rcpp::export]] -Rcpp::List setStaticPaths_(std::string handle, Rcpp::List sp) { +SEXP setStaticPaths_(SEXP handle, SEXP sp) { ASSERT_MAIN_THREAD() - get_pWebApplication(handle)->getStaticPathManager().set(sp); - return getStaticPaths_(handle); + std::string h = std::string(CHAR(STRING_ELT(handle, 0))); + get_pWebApplication(h)->getStaticPathManager().set(sp); + return get_pWebApplication(h)->getStaticPathManager().pathsAsRObject(); } -// [[Rcpp::export]] -Rcpp::List removeStaticPaths_(std::string handle, Rcpp::CharacterVector paths) { +SEXP removeStaticPaths_(SEXP handle, SEXP paths) { ASSERT_MAIN_THREAD() - get_pWebApplication(handle)->getStaticPathManager().remove(paths); - return getStaticPaths_(handle); + std::string h = std::string(CHAR(STRING_ELT(handle, 0))); + get_pWebApplication(h)->getStaticPathManager().remove(paths); + return get_pWebApplication(h)->getStaticPathManager().pathsAsRObject(); } -// [[Rcpp::export]] -Rcpp::List getStaticPathOptions_(std::string handle) { +SEXP getStaticPathOptions_(SEXP handle) { ASSERT_MAIN_THREAD() - return get_pWebApplication(handle)->getStaticPathManager().getOptions().asRObject(); + std::string h = std::string(CHAR(STRING_ELT(handle, 0))); + return get_pWebApplication(h)->getStaticPathManager().getOptions().asRObject(); } - -// [[Rcpp::export]] -Rcpp::List setStaticPathOptions_(std::string handle, Rcpp::List opts) { +SEXP setStaticPathOptions_(SEXP handle, SEXP opts) { ASSERT_MAIN_THREAD() - get_pWebApplication(handle)->getStaticPathManager().setOptions(opts); - return getStaticPathOptions_(handle); + std::string h = std::string(CHAR(STRING_ELT(handle, 0))); + get_pWebApplication(h)->getStaticPathManager().setOptions(opts); + return get_pWebApplication(h)->getStaticPathManager().getOptions().asRObject(); } @@ -450,9 +428,11 @@ Rcpp::List setStaticPathOptions_(std::string handle, Rcpp::List opts) { // Miscellaneous utility functions // ============================================================================ -// [[Rcpp::export]] -std::string base64encode(const Rcpp::RawVector& x) { - return b64encode(x.begin(), x.end()); +SEXP base64encode(SEXP x) { + const uint8_t* begin = RAW(x); + const uint8_t* end = begin + Rf_xlength(x); + std::string result = b64encode(begin, end); + return Rf_mkString(result.c_str()); } static std::string allowed = ";,/?:@&=+$abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-_.!~*'()"; @@ -544,31 +524,39 @@ std::string doEncodeURI(std::string value, bool encodeReserved) { //' strings that are UTF-8 encoded. //' //' @export -// [[Rcpp::export]] -Rcpp::CharacterVector encodeURI(Rcpp::CharacterVector value) { - Rcpp::CharacterVector out(value.size(), NA_STRING); - - for (int i = 0; i < value.size(); i++) { - if (value[i] != NA_STRING) { - std::string encoded = doEncodeURI(Rf_translateCharUTF8(value[i]), false); - out[i] = Rf_mkCharCE(encoded.c_str(), CE_UTF8); +SEXP encodeURI(SEXP value) { + R_xlen_t n = Rf_xlength(value); + SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); + for (R_xlen_t i = 0; i < n; i++) { + SET_STRING_ELT(out, i, NA_STRING); + } + + for (R_xlen_t i = 0; i < n; i++) { + if (STRING_ELT(value, i) != NA_STRING) { + std::string encoded = doEncodeURI(Rf_translateCharUTF8(STRING_ELT(value, i)), false); + SET_STRING_ELT(out, i, Rf_mkCharCE(encoded.c_str(), CE_UTF8)); } } + UNPROTECT(1); return out; } //' @rdname encodeURI //' @export -// [[Rcpp::export]] -Rcpp::CharacterVector encodeURIComponent(Rcpp::CharacterVector value) { - Rcpp::CharacterVector out(value.size(), NA_STRING); - - for (int i = 0; i < value.size(); i++) { - if (value[i] != NA_STRING) { - std::string encoded = doEncodeURI(Rf_translateCharUTF8(value[i]), true); - out[i] = Rf_mkCharCE(encoded.c_str(), CE_UTF8); +SEXP encodeURIComponent(SEXP value) { + R_xlen_t n = Rf_xlength(value); + SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); + for (R_xlen_t i = 0; i < n; i++) { + SET_STRING_ELT(out, i, NA_STRING); + } + + for (R_xlen_t i = 0; i < n; i++) { + if (STRING_ELT(value, i) != NA_STRING) { + std::string encoded = doEncodeURI(Rf_translateCharUTF8(STRING_ELT(value, i)), true); + SET_STRING_ELT(out, i, Rf_mkCharCE(encoded.c_str(), CE_UTF8)); } } + UNPROTECT(1); return out; } @@ -634,33 +622,41 @@ std::string doDecodeURI(std::string value, bool component) { //' @rdname encodeURI //' @export -// [[Rcpp::export]] -Rcpp::CharacterVector decodeURI(Rcpp::CharacterVector value) { - Rcpp::CharacterVector out(value.size(), NA_STRING); - - for (int i = 0; i < value.size(); i++) { - if (value[i] != NA_STRING) { - std::string decoded = doDecodeURI(Rcpp::as(value[i]), false); - out[i] = Rf_mkCharLenCE(decoded.c_str(), decoded.length(), CE_UTF8); +SEXP decodeURI(SEXP value) { + R_xlen_t n = Rf_xlength(value); + SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); + for (R_xlen_t i = 0; i < n; i++) { + SET_STRING_ELT(out, i, NA_STRING); + } + + for (R_xlen_t i = 0; i < n; i++) { + if (STRING_ELT(value, i) != NA_STRING) { + std::string decoded = doDecodeURI(std::string(CHAR(STRING_ELT(value, i))), false); + SET_STRING_ELT(out, i, Rf_mkCharLenCE(decoded.c_str(), (int)decoded.size(), CE_UTF8)); } } + UNPROTECT(1); return out; } //' @rdname encodeURI //' @export -// [[Rcpp::export]] -Rcpp::CharacterVector decodeURIComponent(Rcpp::CharacterVector value) { - Rcpp::CharacterVector out(value.size(), NA_STRING); - - for (int i = 0; i < value.size(); i++) { - if (value[i] != NA_STRING) { - std::string decoded = doDecodeURI(Rcpp::as(value[i]), true); - out[i] = Rf_mkCharLenCE(decoded.c_str(), decoded.length(), CE_UTF8); +SEXP decodeURIComponent(SEXP value) { + R_xlen_t n = Rf_xlength(value); + SEXP out = PROTECT(Rf_allocVector(STRSXP, n)); + for (R_xlen_t i = 0; i < n; i++) { + SET_STRING_ELT(out, i, NA_STRING); + } + + for (R_xlen_t i = 0; i < n; i++) { + if (STRING_ELT(value, i) != NA_STRING) { + std::string decoded = doDecodeURI(std::string(CHAR(STRING_ELT(value, i))), true); + SET_STRING_ELT(out, i, Rf_mkCharLenCE(decoded.c_str(), (int)decoded.size(), CE_UTF8)); } } + UNPROTECT(1); return out; } @@ -683,30 +679,29 @@ Rcpp::CharacterVector decodeURIComponent(Rcpp::CharacterVector value) { //' ipFamily("::1") # 6 //' ipFamily("fe80::1ff:fe23:4567:890a") # 6 //' @export -// [[Rcpp::export]] -int ipFamily(const std::string& ip) { - int family = ip_family(ip); +SEXP ipFamily(SEXP ip) { + std::string ip_str = std::string(CHAR(STRING_ELT(ip, 0))); + int family = ip_family(ip_str); if (family == AF_INET6) - return 6; + return Rf_ScalarInteger(6); else if (family == AF_INET) - return 4; + return Rf_ScalarInteger(4); else - return -1; + return Rf_ScalarInteger(-1); } // Given a List and an external pointer to a C++ function that takes a List, // invoke the function with the List as the single argument. This also clears // the external pointer so that the C++ function can't be called again. -// [[Rcpp::export]] -void invokeCppCallback(Rcpp::List data, SEXP callback_xptr) { +SEXP invokeCppCallback(SEXP data, SEXP callback_xptr) { ASSERT_MAIN_THREAD() if (TYPEOF(callback_xptr) != EXTPTRSXP) { - throw Rcpp::exception("Expected external pointer."); + Rf_error("Expected external pointer."); } - std::function* callback_wrapper = - (std::function*)(R_ExternalPtrAddr(callback_xptr)); + std::function* callback_wrapper = + (std::function*)(R_ExternalPtrAddr(callback_xptr)); (*callback_wrapper)(data); @@ -715,6 +710,7 @@ void invokeCppCallback(Rcpp::List data, SEXP callback_xptr) { // std::function. delete callback_wrapper; R_ClearExternalPtr(callback_xptr); + return R_NilValue; } //' Apply the value of .Random.seed to R's internal RNG state @@ -722,25 +718,61 @@ void invokeCppCallback(Rcpp::List data, SEXP callback_xptr) { //' This function is needed in unusual cases where a C++ function calls //' an R function which sets the value of \code{.Random.seed}. This function //' should be called at the end of the R function to ensure that the new value -//' \code{.Random.seed} is preserved. Otherwise, Rcpp may overwrite it with a -//' previous value. +//' \code{.Random.seed} is preserved. Otherwise, the C++ code may overwrite it +//' with a previous value. //' //' @keywords internal //' @export -// [[Rcpp::export]] -void getRNGState() { +SEXP getRNGState(void) { GetRNGstate(); + return R_NilValue; } // We are given an external pointer to a // std::shared_ptr. This returns a hexadecimal string // representing the address of the WebSocketConnection (not the shared_ptr to // it!). -// -//[[Rcpp::export]] -std::string wsconn_address(SEXP external_ptr) { - Rcpp::XPtr > xptr(external_ptr); +SEXP wsconn_address(SEXP external_ptr) { + std::shared_ptr* xptr = + (std::shared_ptr*)R_ExternalPtrAddr(external_ptr); std::ostringstream os; - os << std::hex << reinterpret_cast(xptr.get()->get()); - return os.str(); + os << std::hex << reinterpret_cast(xptr->get()); + return Rf_mkString(os.str().c_str()); } + +// ============================================================================ +// R function registration +// ============================================================================ + +extern "C" { + +static const R_CallMethodDef callMethods[] = { + {"sendWSMessage", (DL_FUNC)&sendWSMessage, 3}, + {"closeWS", (DL_FUNC)&closeWS, 3}, + {"makeTcpServer", (DL_FUNC)&makeTcpServer, 11}, + {"makePipeServer", (DL_FUNC)&makePipeServer, 11}, + {"stopServer_", (DL_FUNC)&stopServer_sexp, 1}, + {"getStaticPaths_", (DL_FUNC)&getStaticPaths_, 1}, + {"setStaticPaths_", (DL_FUNC)&setStaticPaths_, 2}, + {"removeStaticPaths_", (DL_FUNC)&removeStaticPaths_, 2}, + {"getStaticPathOptions_", (DL_FUNC)&getStaticPathOptions_, 1}, + {"setStaticPathOptions_", (DL_FUNC)&setStaticPathOptions_, 2}, + {"base64encode", (DL_FUNC)&base64encode, 1}, + {"encodeURI", (DL_FUNC)&encodeURI, 1}, + {"encodeURIComponent", (DL_FUNC)&encodeURIComponent, 1}, + {"decodeURI", (DL_FUNC)&decodeURI, 1}, + {"decodeURIComponent", (DL_FUNC)&decodeURIComponent, 1}, + {"ipFamily", (DL_FUNC)&ipFamily, 1}, + {"invokeCppCallback", (DL_FUNC)&invokeCppCallback, 2}, + {"getRNGState", (DL_FUNC)&getRNGState, 0}, + {"wsconn_address", (DL_FUNC)&wsconn_address, 1}, + {"log_level", (DL_FUNC)&log_level, 1}, + {NULL, NULL, 0} +}; + +void attribute_visible R_init_httpuv(DllInfo *dll) { + R_registerRoutines(dll, NULL, callMethods, NULL, NULL); + R_useDynamicSymbols(dll, FALSE); +} + +} // extern "C" diff --git a/src/httpuv.h b/src/httpuv.h index 097fefb43..ebd1a9f27 100644 --- a/src/httpuv.h +++ b/src/httpuv.h @@ -1,11 +1,12 @@ #ifndef HTTPUV_HPP #define HTTPUV_HPP -#include #include +#ifdef length +# undef length +#endif - -void invokeCppCallback(Rcpp::List data, SEXP callback_xptr); +SEXP invokeCppCallback(SEXP data, SEXP callback_xptr); std::string doEncodeURI(std::string value, bool encodeReserved); std::string doDecodeURI(std::string value, bool component); diff --git a/src/staticpath.cpp b/src/staticpath.cpp index decc6308c..06e190611 100644 --- a/src/staticpath.cpp +++ b/src/staticpath.cpp @@ -8,7 +8,7 @@ // StaticPathOptions // ============================================================================ -StaticPathOptions::StaticPathOptions(const Rcpp::List& options) : +StaticPathOptions::StaticPathOptions(SEXP options) : indexhtml(std::experimental::nullopt), fallthrough(std::experimental::nullopt), html_charset(std::experimental::nullopt), @@ -18,87 +18,114 @@ StaticPathOptions::StaticPathOptions(const Rcpp::List& options) : { ASSERT_MAIN_THREAD() - std::string obj_class = options.attr("class"); + SEXP class_attr = Rf_getAttrib(options, R_ClassSymbol); + std::string obj_class = ""; + if (class_attr != R_NilValue) { + obj_class = CHAR(STRING_ELT(class_attr, 0)); + } if (obj_class != "staticPathOptions") { - throw Rcpp::exception("staticPath options object must have class 'staticPathOptions'."); + throw std::runtime_error("staticPath options object must have class 'staticPathOptions'."); } // This seems to be a necessary intermediary for passing objects to // `optional_as()`. - Rcpp::RObject temp; + SEXP temp; - temp = options.attr("normalized"); + temp = Rf_getAttrib(options, Rf_install("normalized")); std::experimental::optional normalized = optional_as(temp); if (!normalized || !*normalized) { - throw Rcpp::exception("staticPathOptions object must be normalized."); + throw std::runtime_error("staticPathOptions object must be normalized."); } // There's probably a more concise way to do this assignment than by using temp. - temp = options["indexhtml"]; indexhtml = optional_as(temp); - temp = options["fallthrough"]; fallthrough = optional_as(temp); - temp = options["html_charset"]; html_charset = optional_as(temp); - temp = options["headers"]; headers = optional_as(temp); - temp = options["validation"]; validation = optional_as >(temp); - temp = options["exclude"]; exclude = optional_as(temp); + temp = VECTOR_ELT(options, 0); // indexhtml + indexhtml = optional_as(temp); + temp = VECTOR_ELT(options, 1); // fallthrough + fallthrough = optional_as(temp); + temp = VECTOR_ELT(options, 2); // html_charset + html_charset = optional_as(temp); + temp = VECTOR_ELT(options, 3); // headers + if (temp != R_NilValue) { + headers = response_headers_from_sexp(temp); + } + temp = VECTOR_ELT(options, 4); // validation + if (temp != R_NilValue) { + validation = as_cpp>(temp); + } + temp = VECTOR_ELT(options, 5); // exclude + exclude = optional_as(temp); } - -void StaticPathOptions::setOptions(const Rcpp::List& options) { +void StaticPathOptions::setOptions(SEXP options) { ASSERT_MAIN_THREAD() - Rcpp::RObject temp; - if (options.containsElementNamed("indexhtml")) { - temp = options["indexhtml"]; - if (!temp.isNULL()) { + SEXP temp; + SEXP opts = options; + if (list_contains_element(opts, "indexhtml")) { + temp = get_list_element(opts, "indexhtml"); + if (temp != R_NilValue) { indexhtml = optional_as(temp); } } - if (options.containsElementNamed("fallthrough")) { - temp = options["fallthrough"]; - if (!temp.isNULL()) { + if (list_contains_element(opts, "fallthrough")) { + temp = get_list_element(opts, "fallthrough"); + if (temp != R_NilValue) { fallthrough = optional_as(temp); } } - if (options.containsElementNamed("html_charset")) { - temp = options["html_charset"]; - if (!temp.isNULL()) { + if (list_contains_element(opts, "html_charset")) { + temp = get_list_element(opts, "html_charset"); + if (temp != R_NilValue) { html_charset = optional_as(temp); } } - if (options.containsElementNamed("headers")) { - temp = options["headers"]; - if (!temp.isNULL()) { - headers = optional_as(temp); + if (list_contains_element(opts, "headers")) { + temp = get_list_element(opts, "headers"); + if (temp != R_NilValue) { + headers = response_headers_from_sexp(temp); } } - if (options.containsElementNamed("validation")) { - temp = options["validation"]; - if (!temp.isNULL()) { - validation = optional_as >(temp); + if (list_contains_element(opts, "validation")) { + temp = get_list_element(opts, "validation"); + if (temp != R_NilValue) { + validation = as_cpp>(temp); } } - if (options.containsElementNamed("exclude")) { - temp = options["exclude"]; - if (!temp.isNULL()) { + if (list_contains_element(opts, "exclude")) { + temp = get_list_element(opts, "exclude"); + if (temp != R_NilValue) { exclude = optional_as(temp); } } } -Rcpp::List StaticPathOptions::asRObject() const { +SEXP StaticPathOptions::asRObject() const { ASSERT_MAIN_THREAD() - using namespace Rcpp; - - List obj = List::create( - _["indexhtml"] = optional_wrap(indexhtml), - _["fallthrough"] = optional_wrap(fallthrough), - _["html_charset"] = optional_wrap(html_charset), - _["headers"] = optional_wrap(headers), - _["validation"] = optional_wrap(validation), - _["exclude"] = optional_wrap(exclude) - ); - obj.attr("class") = "staticPathOptions"; + SEXP obj = PROTECT(Rf_allocVector(VECSXP, 6)); + SEXP names = PROTECT(Rf_allocVector(STRSXP, 6)); + + SET_STRING_ELT(names, 0, Rf_mkChar("indexhtml")); + SET_STRING_ELT(names, 1, Rf_mkChar("fallthrough")); + SET_STRING_ELT(names, 2, Rf_mkChar("html_charset")); + SET_STRING_ELT(names, 3, Rf_mkChar("headers")); + SET_STRING_ELT(names, 4, Rf_mkChar("validation")); + SET_STRING_ELT(names, 5, Rf_mkChar("exclude")); + + SET_VECTOR_ELT(obj, 0, optional_wrap(indexhtml)); + SET_VECTOR_ELT(obj, 1, optional_wrap(fallthrough)); + SET_VECTOR_ELT(obj, 2, optional_wrap(html_charset)); + if (headers.has_value()) { + SET_VECTOR_ELT(obj, 3, response_headers_to_sexp(*headers)); + } else { + SET_VECTOR_ELT(obj, 3, R_NilValue); + } + SET_VECTOR_ELT(obj, 4, optional_wrap(validation)); + SET_VECTOR_ELT(obj, 5, optional_wrap(exclude)); + + Rf_setAttrib(obj, R_NamesSymbol, names); + Rf_setAttrib(obj, R_ClassSymbol, Rf_mkString("staticPathOptions")); + UNPROTECT(2); return obj; } @@ -149,11 +176,11 @@ bool StaticPathOptions::validateRequestHeaders(const RequestHeaders& headers) co // StaticPath // ============================================================================ -StaticPath::StaticPath(const Rcpp::List& sp) { +StaticPath::StaticPath(SEXP sp) { ASSERT_MAIN_THREAD() - path = Rcpp::as(sp["path"]); + path = as_cpp(get_list_element(sp, "path")); - Rcpp::List options_list = sp["options"]; + SEXP options_list = get_list_element(sp, "options"); options = StaticPathOptions(options_list); if (path.length() == 0) { @@ -167,17 +194,22 @@ StaticPath::StaticPath(const Rcpp::List& sp) { } } -Rcpp::List StaticPath::asRObject() const { +SEXP StaticPath::asRObject() const { ASSERT_MAIN_THREAD() - using namespace Rcpp; - List obj = List::create( - _["path"] = path, - _["options"] = options.asRObject() - ); + SEXP obj = PROTECT(Rf_allocVector(VECSXP, 2)); + SEXP names = PROTECT(Rf_allocVector(STRSXP, 2)); + + SET_STRING_ELT(names, 0, Rf_mkChar("path")); + SET_STRING_ELT(names, 1, Rf_mkChar("options")); + + SET_VECTOR_ELT(obj, 0, Rf_mkString(path.c_str())); + SET_VECTOR_ELT(obj, 1, options.asRObject()); - obj.attr("class") = "staticPath"; + Rf_setAttrib(obj, R_NamesSymbol, names); + Rf_setAttrib(obj, R_ClassSymbol, Rf_mkString("staticPath")); + UNPROTECT(2); return obj; } @@ -189,29 +221,28 @@ StaticPathManager::StaticPathManager() { uv_mutex_init(&mutex); } -StaticPathManager::StaticPathManager(const Rcpp::List& path_list, const Rcpp::List& options_list) { +StaticPathManager::StaticPathManager(SEXP path_list, SEXP options_list) { ASSERT_MAIN_THREAD() uv_mutex_init(&mutex); this->options = StaticPathOptions(options_list); - if (path_list.size() == 0) { + if (Rf_xlength(path_list) == 0) { return; } - Rcpp::CharacterVector names = path_list.names(); - if (names.isNULL()) { - throw Rcpp::exception("Error processing static paths: all static paths must be named."); + SEXP names_sexp = Rf_getAttrib(path_list, R_NamesSymbol); + if (names_sexp == R_NilValue) { + throw std::runtime_error("Error processing static paths: all static paths must be named."); } - for (int i=0; i(names[i]); + for (R_xlen_t i = 0; i < Rf_xlength(path_list); i++) { + std::string name = std::string(CHAR(STRING_ELT(names_sexp, i))); if (name == "") { - throw Rcpp::exception("Error processing static paths."); + throw std::runtime_error("Error processing static paths."); } - Rcpp::List sp(path_list[i]); - StaticPath staticpath(sp); + StaticPath staticpath(VECTOR_ELT(path_list, i)); this->path_map.insert( std::pair(name, staticpath) @@ -235,12 +266,12 @@ std::experimental::optional StaticPathManager::get(const std::string return sp; } -std::experimental::optional StaticPathManager::get(const Rcpp::CharacterVector& path) const { +std::experimental::optional StaticPathManager::get(SEXP path) const { ASSERT_MAIN_THREAD() - if (path.size() != 1) { - throw Rcpp::exception("Can only get a single StaticPath object."); + if (Rf_xlength(path) != 1) { + throw std::runtime_error("Can only get a single StaticPath object."); } - return get(Rcpp::as(path)); + return get(std::string(CHAR(STRING_ELT(path, 0)))); } @@ -265,10 +296,14 @@ void StaticPathManager::set(const std::map& pmap) { } } -void StaticPathManager::set(const Rcpp::List& pmap) { +void StaticPathManager::set(SEXP pmap) { ASSERT_MAIN_THREAD() - std::map pmap2 = toMap(pmap); - set(pmap2); + SEXP names_sexp = Rf_getAttrib(pmap, R_NamesSymbol); + for (R_xlen_t i = 0; i < Rf_xlength(pmap); i++) { + std::string name = std::string(CHAR(STRING_ELT(names_sexp, i))); + StaticPath sp(VECTOR_ELT(pmap, i)); + set(name, sp); + } } @@ -287,9 +322,9 @@ void StaticPathManager::remove(const std::vector& paths) { } } -void StaticPathManager::remove(const Rcpp::CharacterVector& paths) { +void StaticPathManager::remove(SEXP paths) { ASSERT_MAIN_THREAD() - std::vector paths_vec = Rcpp::as >(paths); + std::vector paths_vec = as_cpp>(paths); remove(paths_vec); } @@ -384,21 +419,29 @@ const StaticPathOptions& StaticPathManager::getOptions() const { return options; } -void StaticPathManager::setOptions(const Rcpp::List& opts) { +void StaticPathManager::setOptions(SEXP opts) { options.setOptions(opts); } // Returns a list of R objects that reflect the StaticPaths, without merging // the overall options. -Rcpp::List StaticPathManager::pathsAsRObject() const { +SEXP StaticPathManager::pathsAsRObject() const { ASSERT_MAIN_THREAD() guard guard(mutex); - Rcpp::List obj; + R_xlen_t n = (R_xlen_t)path_map.size(); + SEXP obj = PROTECT(Rf_allocVector(VECSXP, n)); + SEXP names = PROTECT(Rf_allocVector(STRSXP, n)); + + R_xlen_t i = 0; std::map::const_iterator it; - for (it = path_map.begin(); it != path_map.end(); it++) { - obj[it->first] = it->second.asRObject(); + for (it = path_map.begin(); it != path_map.end(); it++, i++) { + SET_STRING_ELT(names, i, Rf_mkChar(it->first.c_str())); + SET_VECTOR_ELT(obj, i, it->second.asRObject()); } + Rf_setAttrib(obj, R_NamesSymbol, names); + + UNPROTECT(2); return obj; } diff --git a/src/staticpath.h b/src/staticpath.h index 24a99f6d1..8cd4ac815 100644 --- a/src/staticpath.h +++ b/src/staticpath.h @@ -3,7 +3,10 @@ #include #include -#include +#include +#ifdef length +# undef length +#endif #include "optional.h" #include "thread.h" #include "constants.h" @@ -24,11 +27,11 @@ class StaticPathOptions { validation(std::experimental::nullopt), exclude(std::experimental::nullopt) { }; - StaticPathOptions(const Rcpp::List& options); + StaticPathOptions(SEXP options); - void setOptions(const Rcpp::List& options); + void setOptions(SEXP options); - Rcpp::List asRObject() const; + SEXP asRObject() const; static StaticPathOptions merge(const StaticPathOptions& a, const StaticPathOptions& b); @@ -41,9 +44,9 @@ class StaticPath { std::string path; StaticPathOptions options; - StaticPath(const Rcpp::List& sp); + StaticPath(SEXP sp); - Rcpp::List asRObject() const; + SEXP asRObject() const; }; @@ -56,27 +59,27 @@ class StaticPathManager { public: StaticPathManager(); - StaticPathManager(const Rcpp::List& path_list, const Rcpp::List& options_list); + StaticPathManager(SEXP path_list, SEXP options_list); std::experimental::optional get(const std::string& path) const; - std::experimental::optional get(const Rcpp::CharacterVector& path) const; + std::experimental::optional get(SEXP path) const; void set(const std::string& path, const StaticPath& sp); void set(const std::map& pmap); - void set(const Rcpp::List& pmap); + void set(SEXP pmap); void remove(const std::string& path); void remove(const std::vector& paths); - void remove(const Rcpp::CharacterVector& paths); + void remove(SEXP paths); std::experimental::optional > matchStaticPath( const std::string& url_path) const; const StaticPathOptions& getOptions() const; - void setOptions(const Rcpp::List& opts); + void setOptions(SEXP opts); - Rcpp::List pathsAsRObject() const; + SEXP pathsAsRObject() const; }; #endif diff --git a/src/utils.cpp b/src/utils.cpp index 69be8c90a..c4ceea69c 100644 --- a/src/utils.cpp +++ b/src/utils.cpp @@ -11,33 +11,33 @@ void debug_log(const std::string& msg, LogLevel level) { // Sets the current log level and returns previous value. -// [[Rcpp::export]] -std::string log_level(const std::string& level) { +SEXP log_level(SEXP level_sxp) { + const char* level = CHAR(STRING_ELT(level_sxp, 0)); LogLevel old_level = log_level_; - if (level == "") { + if (level[0] == '\0') { // Do nothing - } else if (level == "OFF") { + } else if (strcmp(level, "OFF") == 0) { log_level_ = LOG_OFF; - } else if (level == "ERROR") { + } else if (strcmp(level, "ERROR") == 0) { log_level_ = LOG_ERROR; - } else if (level == "WARN") { + } else if (strcmp(level, "WARN") == 0) { log_level_ = LOG_WARN; - } else if (level == "INFO") { + } else if (strcmp(level, "INFO") == 0) { log_level_ = LOG_INFO; - } else if (level == "DEBUG") { + } else if (strcmp(level, "DEBUG") == 0) { log_level_ = LOG_DEBUG; } else { - Rcpp::stop("Unknown value for `level`"); + Rf_error("Unknown value for `level`"); } switch(old_level) { - case LOG_OFF: return "OFF"; - case LOG_ERROR: return "ERROR"; - case LOG_WARN: return "WARN"; - case LOG_INFO: return "INFO"; - case LOG_DEBUG: return "DEBUG"; - default: return ""; + case LOG_OFF: return Rf_mkString("OFF"); + case LOG_ERROR: return Rf_mkString("ERROR"); + case LOG_WARN: return Rf_mkString("WARN"); + case LOG_INFO: return Rf_mkString("INFO"); + case LOG_DEBUG: return Rf_mkString("DEBUG"); + default: return Rf_mkString(""); } } diff --git a/src/utils.h b/src/utils.h index 94448ec14..b71d755be 100644 --- a/src/utils.h +++ b/src/utils.h @@ -2,20 +2,144 @@ #define UTILS_H #include +#include #include #include #include #include #include +#include #include -#include +#include +#include +#include +// Undo R's length() macro so std::string::length() and STL internals work. +#ifdef length +# undef length +#endif #include "optional.h" #include "thread.h" #include "timegm.h" +// ============================================================================ +// RAII wrapper for R_PreserveObject / R_ReleaseObject +// ============================================================================ + +struct RProtectedSEXP { + SEXP sexp; + explicit RProtectedSEXP(SEXP s = R_NilValue) : sexp(s) { + R_PreserveObject(sexp); + } + ~RProtectedSEXP() { + R_ReleaseObject(sexp); + } + operator SEXP() const { return sexp; } + RProtectedSEXP(const RProtectedSEXP&) = delete; + RProtectedSEXP& operator=(const RProtectedSEXP&) = delete; +}; + +// ============================================================================ +// Type conversion helpers (R C API equivalents of cpp4r::as_cpp / as_sexp) +// ============================================================================ + +template +inline T as_cpp(SEXP x); + +template<> +inline bool as_cpp(SEXP x) { + if (TYPEOF(x) == LGLSXP) return LOGICAL(x)[0] != 0; + if (TYPEOF(x) == INTSXP) return INTEGER(x)[0] != 0; + if (TYPEOF(x) == REALSXP) return REAL(x)[0] != 0; + // Fallback: coerce + SEXP coerced = PROTECT(Rf_coerceVector(x, LGLSXP)); + bool result = LOGICAL(coerced)[0] != 0; + UNPROTECT(1); + return result; +} + +template<> +inline int as_cpp(SEXP x) { + if (TYPEOF(x) == INTSXP) return INTEGER(x)[0]; + if (TYPEOF(x) == REALSXP) return (int)REAL(x)[0]; + if (TYPEOF(x) == LGLSXP) return LOGICAL(x)[0]; + // Fallback: coerce (e.g. CHARSXP) + SEXP coerced = PROTECT(Rf_coerceVector(x, INTSXP)); + int result = INTEGER(coerced)[0]; + UNPROTECT(1); + return result; +} + +template<> +inline std::string as_cpp(SEXP x) { + return std::string(CHAR(STRING_ELT(x, 0))); +} + +template<> +inline std::vector as_cpp>(SEXP x) { + R_xlen_t n = Rf_xlength(x); + std::vector result; + result.reserve(n); + for (R_xlen_t i = 0; i < n; ++i) + result.push_back(std::string(CHAR(STRING_ELT(x, i)))); + return result; +} + +inline SEXP as_sexp(bool x) { + return Rf_ScalarLogical(x ? TRUE : FALSE); +} + +inline SEXP as_sexp(const std::string& x) { + return Rf_mkString(x.c_str()); +} + +inline SEXP as_sexp(const std::vector& x) { + SEXP result = PROTECT(Rf_allocVector(STRSXP, (R_xlen_t)x.size())); + for (size_t i = 0; i < x.size(); ++i) + SET_STRING_ELT(result, (R_xlen_t)i, Rf_mkChar(x[i].c_str())); + UNPROTECT(1); + return result; +} + +inline SEXP as_sexp(const std::vector& x) { + SEXP result = PROTECT(Rf_allocVector(RAWSXP, (R_xlen_t)x.size())); + if (!x.empty()) memcpy(RAW(result), x.data(), x.size()); + UNPROTECT(1); + return result; +} + +// ============================================================================ +// List helper functions +// ============================================================================ + +// Helper function to get element by name from a list SEXP +inline SEXP get_list_element(SEXP lst, const char* name) { + SEXP names = Rf_getAttrib(lst, R_NamesSymbol); + if (names == R_NilValue) return R_NilValue; + for (R_xlen_t i = 0; i < Rf_xlength(lst); i++) { + if (strcmp(CHAR(STRING_ELT(names, i)), name) == 0) { + return VECTOR_ELT(lst, i); + } + } + return R_NilValue; +} + +// Helper function to check if list contains element by name +inline bool list_contains_element(SEXP lst, const char* name) { + SEXP names = Rf_getAttrib(lst, R_NamesSymbol); + if (names == R_NilValue) return false; + for (R_xlen_t i = 0; i < Rf_xlength(lst); i++) { + if (strcmp(CHAR(STRING_ELT(names, i)), name) == 0) { + return true; + } + } + return false; +} + +// ============================================================================ + // A callback for deleting objects on the main thread using later(). This is -// needed when the object is an Rcpp object or contains one, because deleting -// such objects invoke R's memory management functions. +// needed when the object holds R memory that must only be released on the main +// thread. template void deleter_main(void* obj) { ASSERT_MAIN_THREAD() @@ -104,27 +228,27 @@ std::string toString(T x) { return ss.str(); } -// This is used for converting an Rcpp named vector (T2) to a std::map. -template -std::map toMap(T2 x) { +// This is used for converting a named R list (SEXP) to a std::map. +template +std::map toMap(SEXP x) { ASSERT_MAIN_THREAD() std::map strmap; - if (x.size() == 0) { + if (Rf_xlength(x) == 0) { return strmap; } - Rcpp::CharacterVector names = x.names(); - if (names.isNULL()) { - throw Rcpp::exception("Error converting R object to map: vector does not have names."); + SEXP names_sexp = Rf_getAttrib(x, R_NamesSymbol); + if (names_sexp == R_NilValue || Rf_xlength(names_sexp) == 0) { + throw std::runtime_error("Error converting R object to map: vector does not have names."); } - for (int i=0; i(names[i]); - T1 value = Rcpp::as (x[i]); + for (R_xlen_t i = 0; i < Rf_xlength(x); i++) { + std::string name = std::string(CHAR(STRING_ELT(names_sexp, i))); + T1 value = as_cpp(VECTOR_ELT(x, i)); if (name == "") { - throw Rcpp::exception("Error converting R object to map: element has empty name."); + throw std::runtime_error("Error converting R object to map: element has empty name."); } strmap.insert( @@ -135,76 +259,73 @@ std::map toMap(T2 x) { return strmap; } -// A wrapper for Rcpp::as. If the R value is NULL, this returns nullopt; -// otherwise it returns the usual value that Rcpp::as returns, wrapped in -// std::experimental::optional. -template -std::experimental::optional optional_as(T2 value) { - if (value.isNULL()) { +// A wrapper for as_cpp. If the R value is NULL, this returns nullopt; +// otherwise it returns the usual value that as_cpp returns, wrapped in +// std::experimental::optional. +template +std::experimental::optional optional_as(SEXP value) { + if (value == R_NilValue) { return std::experimental::nullopt; } - return std::experimental::optional( Rcpp::as(value) ); + return std::experimental::optional( as_cpp(value) ); } -// A wrapper for Rcpp::wrap. If the C++ value is missing, this returns the -// R value NULL; otherwise it returns the usual value that Rcpp::wrap returns, after +// A wrapper for as_sexp. If the C++ value is missing, this returns the +// R value NULL; otherwise it returns the usual value that as_sexp returns, after // unwrapping from the std::experimental::optional. template -Rcpp::RObject optional_wrap(std::experimental::optional value) { +SEXP optional_wrap(std::experimental::optional value) { if (!value.has_value()) { return R_NilValue; } - return Rcpp::wrap(*value); + return as_sexp(*value); } -// as() and wrap() for ResponseHeaders. Since the ResponseHeaders typedef is -// in constants.h and this file doesn't include constants.h, we'll define them -// using the actual vector type instead of the ResponseHeaders typedef. -// (constants.h doesn't include Rcpp.h so we can't define these functions -// there.) -namespace Rcpp { - template <> inline std::vector > as(SEXP x) { - ASSERT_MAIN_THREAD() - Rcpp::CharacterVector headers(x); - Rcpp::CharacterVector names = headers.names(); - - if (names.isNULL()) { - throw Rcpp::exception("All values must be named."); - } +// Conversion functions for ResponseHeaders (vector of pairs of strings). +// Since the ResponseHeaders typedef is in constants.h and this file doesn't +// include constants.h, we'll define them using the actual vector type instead +// of the ResponseHeaders typedef. - std::vector > result; +inline std::vector > response_headers_from_sexp(SEXP x) { + ASSERT_MAIN_THREAD() + SEXP names_sexp = Rf_getAttrib(x, R_NamesSymbol); - for (int i=0; i(names[i]); - if (name == "") { - throw Rcpp::exception("All values must be named."); - } + if (names_sexp == R_NilValue) { + throw std::runtime_error("All values must be named."); + } - std::string value = Rcpp::as(headers[i]); + std::vector > result; - result.push_back(std::make_pair(name, value)); + for (R_xlen_t i = 0; i < Rf_xlength(x); i++) { + std::string name = std::string(CHAR(STRING_ELT(names_sexp, i))); + if (name == "") { + throw std::runtime_error("All values must be named."); } - return result; - } + std::string value = std::string(CHAR(STRING_ELT(x, i))); - template <> inline SEXP wrap(const std::vector > &x) { - ASSERT_MAIN_THREAD() + result.push_back(std::make_pair(name, value)); + } - std::vector values(x.size()); - std::vector names(x.size()); + return result; +} - for (unsigned int i=0; i > &x) { + ASSERT_MAIN_THREAD() - Rcpp::CharacterVector result = Rcpp::wrap(values); - result.attr("names") = Rcpp::wrap(names); + R_xlen_t n = (R_xlen_t)x.size(); + SEXP result = PROTECT(Rf_allocVector(STRSXP, n)); + SEXP names = PROTECT(Rf_allocVector(STRSXP, n)); - return result; + for (size_t i = 0; i < x.size(); i++) { + SET_STRING_ELT(names, (R_xlen_t)i, Rf_mkChar(x[i].first.c_str())); + SET_STRING_ELT(result, (R_xlen_t)i, Rf_mkChar(x[i].second.c_str())); } + + Rf_setAttrib(result, R_NamesSymbol, names); + UNPROTECT(2); + return result; } @@ -266,16 +387,18 @@ inline std::string http_date_string(const time_t& t) { // time_t representing that time. If the date is malformed, then return 0. time_t parse_http_date_string(const std::string& date); +SEXP log_level(SEXP level_sxp); + // Compares two strings in constant time. Returns true if they are the same; // false otherwise. inline bool constant_time_compare(const std::string& a, const std::string& b) { - if (a.length() != b.length()) + if (a.size() != b.size()) return false; volatile const char* ac = a.c_str(); volatile const char* bc = b.c_str(); volatile char result = 0; - int len = a.length(); + int len = (int)a.size(); for (int i=0; i #include diff --git a/src/uvutil.h b/src/uvutil.h index ce3e97049..9f9b846fe 100644 --- a/src/uvutil.h +++ b/src/uvutil.h @@ -5,9 +5,13 @@ #include #include #include +#include #include -#include +#include +#ifdef length +# undef length +#endif inline uv_handle_t* toHandle(uv_timer_t* timer) { return (uv_handle_t*)timer; @@ -46,11 +50,12 @@ class InMemoryDataSource : public DataSource { explicit InMemoryDataSource(const std::vector& buffer = std::vector()) : _buffer(buffer), _pos(0) {} - explicit InMemoryDataSource(const Rcpp::RawVector& rawVector) - : _buffer(rawVector.size()), _pos(0) + explicit InMemoryDataSource(SEXP rawVector) + : _buffer(Rf_xlength(rawVector)), _pos(0) { ASSERT_MAIN_THREAD() - std::copy(rawVector.begin(), rawVector.end(), _buffer.begin()); + if (Rf_xlength(rawVector) > 0) + memcpy(_buffer.data(), RAW(rawVector), Rf_xlength(rawVector)); } virtual ~InMemoryDataSource() { diff --git a/src/webapplication.cpp b/src/webapplication.cpp index 77d41d63d..150a7d71d 100644 --- a/src/webapplication.cpp +++ b/src/webapplication.cpp @@ -11,6 +11,9 @@ #include "staticpath.h" #include "fs.h" #include +#ifdef length +# undef length +#endif // ============================================================================ // Utility functions @@ -83,16 +86,29 @@ const std::string& getStatusDescription(int code) { // A generic HTTP response to send when an error (uncaught in the R code) // happens during processing a request. -Rcpp::List errorResponse() { +SEXP errorResponse() { ASSERT_MAIN_THREAD() - using namespace Rcpp; - return List::create( - _["status"] = 500L, - _["headers"] = List::create( - _["Content-Type"] = "text/plain; charset=UTF-8" - ), - _["body"] = "An exception occurred." - ); + + // Create headers list using R C API + SEXP headers = PROTECT(Rf_allocVector(VECSXP, 1)); + SET_VECTOR_ELT(headers, 0, Rf_mkString("text/plain; charset=UTF-8")); + SEXP headers_names = PROTECT(Rf_allocVector(STRSXP, 1)); + SET_STRING_ELT(headers_names, 0, Rf_mkChar("Content-Type")); + Rf_setAttrib(headers, R_NamesSymbol, headers_names); + + // Create response list using R C API + SEXP response = PROTECT(Rf_allocVector(VECSXP, 3)); + SET_VECTOR_ELT(response, 0, Rf_ScalarInteger(500)); + SET_VECTOR_ELT(response, 1, headers); + SET_VECTOR_ELT(response, 2, Rf_mkString("An exception occurred.")); + SEXP response_names = PROTECT(Rf_allocVector(STRSXP, 3)); + SET_STRING_ELT(response_names, 0, Rf_mkChar("status")); + SET_STRING_ELT(response_names, 1, Rf_mkChar("headers")); + SET_STRING_ELT(response_names, 2, Rf_mkChar("body")); + Rf_setAttrib(response, R_NamesSymbol, response_names); + + UNPROTECT(4); + return response; } // An analog to errorResponse, but this returns an shared_ptr @@ -128,76 +144,72 @@ std::pair splitQueryString(const std::string& url) { } -void requestToEnv(std::shared_ptr pRequest, Rcpp::Environment* pEnv) { +void requestToEnv(std::shared_ptr pRequest, SEXP env) { ASSERT_MAIN_THREAD() - using namespace Rcpp; - - Environment& env = *pEnv; std::pair url_query = splitQueryString(pRequest->url()); std::string& path = url_query.first; std::string& queryString = url_query.second; - // When making assignments into the Environment, the value must be wrapped - // in a Rcpp object -- letting Rcpp automatically do the wrapping can result - // in an object being GC'd too early. - // https://github.com/RcppCore/Rcpp/issues/780 - env["REQUEST_METHOD"] = CharacterVector(pRequest->method()); - env["SCRIPT_NAME"] = CharacterVector(std::string("")); - env["PATH_INFO"] = CharacterVector(path); - env["QUERY_STRING"] = CharacterVector(queryString); + // Make assignments into the Environment using Rf_defineVar + Rf_defineVar(Rf_install("REQUEST_METHOD"), Rf_mkString(pRequest->method().c_str()), env); + Rf_defineVar(Rf_install("SCRIPT_NAME"), Rf_mkString(""), env); + Rf_defineVar(Rf_install("PATH_INFO"), Rf_mkString(path.c_str()), env); + Rf_defineVar(Rf_install("QUERY_STRING"), Rf_mkString(queryString.c_str()), env); - env["rook.version"] = CharacterVector("1.1-0"); - env["rook.url_scheme"] = CharacterVector("http"); + Rf_defineVar(Rf_install("rook.version"), Rf_mkString("1.1-0"), env); + Rf_defineVar(Rf_install("rook.url_scheme"), Rf_mkString("http"), env); Address addr = pRequest->serverAddress(); - env["SERVER_NAME"] = CharacterVector(addr.host); + Rf_defineVar(Rf_install("SERVER_NAME"), Rf_mkString(addr.host.c_str()), env); std::ostringstream portstr; portstr << addr.port; - env["SERVER_PORT"] = CharacterVector(portstr.str()); + Rf_defineVar(Rf_install("SERVER_PORT"), Rf_mkString(portstr.str().c_str()), env); Address raddr = pRequest->clientAddress(); - env["REMOTE_ADDR"] = CharacterVector(raddr.host); + Rf_defineVar(Rf_install("REMOTE_ADDR"), Rf_mkString(raddr.host.c_str()), env); std::ostringstream rportstr; rportstr << raddr.port; - env["REMOTE_PORT"] = CharacterVector(rportstr.str()); + Rf_defineVar(Rf_install("REMOTE_PORT"), Rf_mkString(rportstr.str().c_str()), env); const RequestHeaders& headers = pRequest->headers(); - Rcpp::CharacterVector raw_headers(headers.size()); - Rcpp::CharacterVector raw_header_names(headers.size()); + SEXP raw_headers = PROTECT(Rf_allocVector(STRSXP, headers.size())); + SEXP raw_header_names = PROTECT(Rf_allocVector(STRSXP, headers.size())); + int idx = 0; for (RequestHeaders::const_iterator it = headers.begin(); it != headers.end(); it++) { - int idx = std::distance(headers.begin(), it); - env["HTTP_" + normalizeHeaderName(it->first)] = CharacterVector(it->second); - raw_header_names[idx] = to_lower(it->first); - raw_headers[idx] = it->second; + std::string var_name = "HTTP_" + normalizeHeaderName(it->first); + Rf_defineVar(Rf_install(var_name.c_str()), Rf_mkString(it->second.c_str()), env); + SET_STRING_ELT(raw_header_names, idx, Rf_mkChar(to_lower(it->first).c_str())); + SET_STRING_ELT(raw_headers, idx, Rf_mkChar(it->second.c_str())); + idx++; } - raw_headers.attr("names") = raw_header_names; - - env["HEADERS"] = raw_headers; + Rf_setAttrib(raw_headers, R_NamesSymbol, raw_header_names); + Rf_defineVar(Rf_install("HEADERS"), raw_headers, env); + UNPROTECT(2); } std::shared_ptr listToResponse( std::shared_ptr pRequest, - const Rcpp::List& response) + SEXP response) { ASSERT_MAIN_THREAD() - using namespace Rcpp; - if (response.isNULL() || response.size() == 0) { + SEXP response_sexp = response; + if (Rf_isNull(response_sexp) || Rf_length(response_sexp) == 0) { return std::shared_ptr(); } - CharacterVector names = response.names(); + SEXP names = Rf_getAttrib(response_sexp, R_NamesSymbol); - int status = Rcpp::as(response["status"]); + int status = as_cpp(get_list_element(response_sexp, "status")); std::string statusDesc = getStatusDescription(status); - List responseHeaders = response["headers"]; + SEXP responseHeaders = get_list_element(response_sexp, "headers"); // Self-frees when response is written std::shared_ptr pDataSource; @@ -208,16 +220,26 @@ std::shared_ptr listToResponse( // // See https://tools.ietf.org/html/rfc7231#section-6.3.5 and // https://tools.ietf.org/html/rfc7232#section-4.1 - bool hasBody = response.containsElementNamed("body") && !Rf_isNull(response["body"]); + bool hasBody = list_contains_element(response_sexp, "body") && !Rf_isNull(get_list_element(response_sexp, "body")); + + // Check for bodyFile + bool hasBodyFile = false; + R_xlen_t n = Rf_length(response_sexp); + for (R_xlen_t i = 0; i < n; i++) { + if (strcmp(CHAR(STRING_ELT(names, i)), "bodyFile") == 0) { + hasBodyFile = true; + break; + } + } // The response can either contain: // - bodyFile: String value that names the file that should be streamed // - body: Character vector (which is charToRaw-ed) or raw vector, or NULL - if (std::find(names.begin(), names.end(), "bodyFile") != names.end()) { + if (hasBodyFile) { std::shared_ptr pFDS = std::make_shared(); FileDataSourceResult ret = pFDS->initialize( - Rcpp::as(response["bodyFile"]), - Rcpp::as(response["bodyFileOwned"]) + as_cpp(get_list_element(response_sexp, "bodyFile")), + as_cpp(get_list_element(response_sexp, "bodyFileOwned")) ); if (ret != FDS_OK) { REprintf("%s", pFDS->lastErrorMessage().c_str()); @@ -225,12 +247,16 @@ std::shared_ptr listToResponse( } pDataSource = pFDS; } - else if (hasBody && Rf_isString(response["body"])) { - RawVector responseBytes = Function("charToRaw")(response["body"]); + else if (hasBody && Rf_isString(get_list_element(response_sexp, "body"))) { + // Call charToRaw function + SEXP charToRawFn = PROTECT(Rf_findFun(Rf_install("charToRaw"), R_BaseEnv)); + SEXP call = PROTECT(Rf_lang2(charToRawFn, get_list_element(response_sexp, "body"))); + SEXP responseBytes = PROTECT(Rf_eval(call, R_GlobalEnv)); pDataSource = std::make_shared(responseBytes); + UNPROTECT(3); } else if (hasBody) { - RawVector responseBytes = response["body"]; + SEXP responseBytes = get_list_element(response_sexp, "body"); pDataSource = std::make_shared(responseBytes); } @@ -238,11 +264,12 @@ std::shared_ptr listToResponse( new HttpResponse(pRequest, status, statusDesc, pDataSource), auto_deleter_background ); - CharacterVector headerNames = responseHeaders.names(); - for (R_len_t i = 0; i < responseHeaders.size(); i++) { + SEXP headerNames = Rf_getAttrib(responseHeaders, R_NamesSymbol); + R_xlen_t nHeaders = Rf_length(responseHeaders); + for (R_xlen_t i = 0; i < nHeaders; i++) { pResp->addHeader( - std::string((char*)headerNames[i], headerNames[i].size()), - Rcpp::as(responseHeaders[i])); + std::string(CHAR(STRING_ELT(headerNames, i))), + std::string(CHAR(STRING_ELT(VECTOR_ELT(responseHeaders, i), 0)))); } return pResp; @@ -250,7 +277,7 @@ std::shared_ptr listToResponse( void invokeResponseFun(std::function)> fun, std::shared_ptr pRequest, - Rcpp::List response) + SEXP response) { ASSERT_MAIN_THREAD() // new HttpResponse object. The callback will invoke @@ -265,19 +292,31 @@ void invokeResponseFun(std::function)> fun, // ============================================================================ RWebApplication::RWebApplication( - Rcpp::Function onHeaders, - Rcpp::Function onBodyData, - Rcpp::Function onRequest, - Rcpp::Function onWSOpen, - Rcpp::Function onWSMessage, - Rcpp::Function onWSClose, - Rcpp::List staticPaths, - Rcpp::List staticPathOptions) : + SEXP onHeaders, + SEXP onBodyData, + SEXP onRequest, + SEXP onWSOpen, + SEXP onWSMessage, + SEXP onWSClose, + SEXP staticPaths, + SEXP staticPathOptions) : _onHeaders(onHeaders), _onBodyData(onBodyData), _onRequest(onRequest), _onWSOpen(onWSOpen), _onWSMessage(onWSMessage), _onWSClose(onWSClose) { ASSERT_MAIN_THREAD() + // The R function objects passed in here are stored as bare SEXPs and may be + // GC'd at any time unless we tell R to preserve them. Without this, R can + // collect the closures while the server is still running, leading to + // segfaults or hangs (e.g. when invoking the user's `call` function after + // a fallthrough from the static-path handler). + R_PreserveObject(_onHeaders); + R_PreserveObject(_onBodyData); + R_PreserveObject(_onRequest); + R_PreserveObject(_onWSOpen); + R_PreserveObject(_onWSMessage); + R_PreserveObject(_onWSClose); + _staticPathManager = StaticPathManager(staticPaths, staticPathOptions); } @@ -286,30 +325,29 @@ void RWebApplication::onHeaders(std::shared_ptr pRequest, std::function)> callback) { ASSERT_MAIN_THREAD() - if (_onHeaders.isNULL()) { - std::shared_ptr null_ptr; - callback(null_ptr); - } - requestToEnv(pRequest, &pRequest->env()); + requestToEnv(pRequest, pRequest->env()); // Call the R onHeaders function. If an exception occurs during processing, // catch it and then send a generic error response. - Rcpp::List response; + SEXP response = R_NilValue; try { - response = _onHeaders(pRequest->env()); - } catch (Rcpp::internal::InterruptedException &e) { - debug_log("Interrupt occurred in _onHeaders", LOG_INFO); - response = errorResponse(); + SEXP call = PROTECT(Rf_lang2(_onHeaders, pRequest->env())); + response = PROTECT(Rf_eval(call, R_GlobalEnv)); + UNPROTECT(1); // unprotect call; response stays protected + } catch (std::exception &e) { + debug_log("Exception occurred in _onHeaders", LOG_INFO); + response = PROTECT(errorResponse()); } catch (...) { debug_log("Exception occurred in _onHeaders", LOG_INFO); - response = errorResponse(); + response = PROTECT(errorResponse()); } // new HttpResponse object. The callback will invoke // HttpResponse->writeResponse(), which adds a callback to destroy(), which // deletes the object. std::shared_ptr pResponse = listToResponse(pRequest, response); + UNPROTECT(1); // unprotect response callback(pResponse); } @@ -325,10 +363,12 @@ void RWebApplication::onBodyData(std::shared_ptr pRequest, if (pRequest->isResponseScheduled()) return; - Rcpp::RawVector rawVector(data->size()); - std::copy(data->begin(), data->end(), rawVector.begin()); + SEXP rawVector = PROTECT(Rf_allocVector(RAWSXP, data->size())); + std::copy(data->begin(), data->end(), RAW(rawVector)); try { - _onBodyData(pRequest->env(), rawVector); + SEXP call = PROTECT(Rf_lang3(_onBodyData, pRequest->env(), rawVector)); + Rf_eval(call, R_GlobalEnv); + UNPROTECT(1); } catch (...) { debug_log("Exception occurred in _onBodyData", LOG_INFO); // Send an error message to the client. It's very possible that getResponse() or more @@ -340,17 +380,17 @@ void RWebApplication::onBodyData(std::shared_ptr pRequest, // https://stackoverflow.com/a/18370751/412655 errorCallback(listToResponse(pRequest, errorResponse())); } + UNPROTECT(1); } void RWebApplication::getResponse(std::shared_ptr pRequest, std::function)> callback) { ASSERT_MAIN_THREAD() debug_log("RWebApplication::getResponse", LOG_DEBUG); - using namespace Rcpp; // Pass callback to R: // invokeResponseFun(callback, pRequest, _1) - std::function* callback_wrapper = new std::function( + std::function* callback_wrapper = new std::function( std::bind(invokeResponseFun, callback, pRequest, std::placeholders::_1) ); @@ -360,14 +400,17 @@ void RWebApplication::getResponse(std::shared_ptr pRequest, // the R call/_onRequest() function. We need to signal the HttpRequest // object to let it know that we had an error. if (pRequest->isResponseScheduled()) { - invokeCppCallback(Rcpp::List(), callback_xptr); + invokeCppCallback(PROTECT(Rf_allocVector(VECSXP, 0)), callback_xptr); + UNPROTECT(1); } else { // Call the R call() function, and pass it the callback xptr so it can // asynchronously pass data back to C++. try { - _onRequest(pRequest->env(), callback_xptr); + SEXP call = PROTECT(Rf_lang3(_onRequest, pRequest->env(), callback_xptr)); + Rf_eval(call, R_GlobalEnv); + UNPROTECT(1); // On the R side, httpuv's call() function will catch errors that happen // in the user-defined call() function, but if an error happens outside of @@ -375,12 +418,14 @@ void RWebApplication::getResponse(std::shared_ptr pRequest, // if Ctrl-C is pressed), then it will bubble up to here, where we'll catch // it and deal with it. - } catch (Rcpp::internal::InterruptedException &e) { - debug_log("Interrupt occurred in _onRequest", LOG_INFO); - invokeCppCallback(errorResponse(), callback_xptr); + } catch (std::exception &e) { + debug_log("Exception occurred in _onRequest", LOG_INFO); + invokeCppCallback(PROTECT(errorResponse()), callback_xptr); + UNPROTECT(1); } catch (...) { debug_log("Exception occurred in _onRequest", LOG_INFO); - invokeCppCallback(errorResponse(), callback_xptr); + invokeCppCallback(PROTECT(errorResponse()), callback_xptr); + UNPROTECT(1); } } @@ -395,12 +440,13 @@ void RWebApplication::onWSOpen(std::shared_ptr pRequest, return; } - requestToEnv(pRequest, &pRequest->env()); + requestToEnv(pRequest, pRequest->env()); try { - _onWSOpen( + SEXP call = PROTECT(Rf_lang3(_onWSOpen, externalize_shared_ptr(pConn), - pRequest->env() - ); + pRequest->env())); + Rf_eval(call, R_GlobalEnv); + UNPROTECT(1); } catch(...) { error_callback(); } @@ -413,18 +459,17 @@ void RWebApplication::onWSMessage(std::shared_ptr pConn, { ASSERT_MAIN_THREAD() try { - if (binary) - _onWSMessage( - externalize_shared_ptr(pConn), - binary, - std::vector(data->begin(), data->end()) - ); - else - _onWSMessage( - externalize_shared_ptr(pConn), - binary, - std::string(data->begin(), data->end()) - ); + SEXP conn_xptr = PROTECT(externalize_shared_ptr(pConn)); + SEXP binary_sxp = PROTECT(Rf_ScalarLogical(binary ? TRUE : FALSE)); + SEXP msg_sxp; + if (binary) { + msg_sxp = PROTECT(as_sexp(std::vector(data->begin(), data->end()))); + } else { + msg_sxp = PROTECT(Rf_mkString(std::string(data->begin(), data->end()).c_str())); + } + SEXP call = PROTECT(Rf_lang4(_onWSMessage, conn_xptr, binary_sxp, msg_sxp)); + Rf_eval(call, R_GlobalEnv); + UNPROTECT(5); } catch(...) { error_callback(); } @@ -432,7 +477,10 @@ void RWebApplication::onWSMessage(std::shared_ptr pConn, void RWebApplication::onWSClose(std::shared_ptr pConn) { ASSERT_MAIN_THREAD() - _onWSClose(externalize_shared_ptr(pConn)); + SEXP conn_xptr = PROTECT(externalize_shared_ptr(pConn)); + SEXP call = PROTECT(Rf_lang2(_onWSClose, conn_xptr)); + Rf_eval(call, R_GlobalEnv); + UNPROTECT(2); } diff --git a/src/webapplication.h b/src/webapplication.h index 51e4f262b..d329a984f 100644 --- a/src/webapplication.h +++ b/src/webapplication.h @@ -3,7 +3,10 @@ #include #include -#include +#include +#ifdef length +# undef length +#endif #include "websockets.h" #include "thread.h" #include "staticpath.h" @@ -37,27 +40,33 @@ class WebApplication { class RWebApplication : public WebApplication { private: - Rcpp::Function _onHeaders; - Rcpp::Function _onBodyData; - Rcpp::Function _onRequest; - Rcpp::Function _onWSOpen; - Rcpp::Function _onWSMessage; - Rcpp::Function _onWSClose; + SEXP _onHeaders; + SEXP _onBodyData; + SEXP _onRequest; + SEXP _onWSOpen; + SEXP _onWSMessage; + SEXP _onWSClose; StaticPathManager _staticPathManager; public: - RWebApplication(Rcpp::Function onHeaders, - Rcpp::Function onBodyData, - Rcpp::Function onRequest, - Rcpp::Function onWSOpen, - Rcpp::Function onWSMessage, - Rcpp::Function onWSClose, - Rcpp::List staticPaths, - Rcpp::List staticPathOptions); + RWebApplication(SEXP onHeaders, + SEXP onBodyData, + SEXP onRequest, + SEXP onWSOpen, + SEXP onWSMessage, + SEXP onWSClose, + SEXP staticPaths, + SEXP staticPathOptions); virtual ~RWebApplication() { ASSERT_MAIN_THREAD() + R_ReleaseObject(_onHeaders); + R_ReleaseObject(_onBodyData); + R_ReleaseObject(_onRequest); + R_ReleaseObject(_onWSOpen); + R_ReleaseObject(_onWSMessage); + R_ReleaseObject(_onWSClose); } virtual void onHeaders(std::shared_ptr pRequest, diff --git a/tests/testthat/test-traffic.R b/tests/testthat/test-traffic.R index ed53088b2..ac87c1a7d 100644 --- a/tests/testthat/test-traffic.R +++ b/tests/testthat/test-traffic.R @@ -1,8 +1,12 @@ skip_if_not_possible <- function() { + # @pachadotdev: run sudo pacman -S apache + # this is to run all tests for the WebTechnologies view + # then comment this and use the "temporarily disable" approach for CRAN + # skip_on_cran() + # Temporarily disable these tests because they may not run reliably on # some platforms. skip("") - # skip_on_cran() if (Sys.which("ab")[[1]] == "") { skip("ab (Apache bench) not available for running traffic tests")