Merge pull request #177 from rstudio/static-serving

Add support for serving static files on background thread

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: httpuv
 Type: Package
 Title: HTTP and WebSocket Server Library
-Version: 1.4.5.9000
+Version: 1.4.5.9001
 Author: Joe Cheng, Hector Corrada Bravo [ctb], Jeroen Ooms [ctb],
     Winston Chang [ctb]
 Copyright: RStudio, Inc.; Joyent, Inc.; Nginx Inc.; Igor Sysoev; Niels Provos;
@@ -21,12 +21,20 @@ Depends:
 Imports:
     Rcpp (>= 0.11.0),
     utils,
+    R6,
     promises,
     later (>= 0.7.3)
 LinkingTo: Rcpp, BH, later
 URL: https://github.com/rstudio/httpuv
 SystemRequirements: GNU make
-RoxygenNote: 6.0.1.9000
+RoxygenNote: 6.1.0.9000
 Suggests:
     testthat,
-    callr
+    callr,
+    curl
+Collate:
+    'RcppExports.R'
+    'httpuv.R'
+    'server.R'
+    'static_paths.R'
+    'utils.R'

NAMESPACE

@@ -1,23 +1,31 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(format,staticPath)
+S3method(format,staticPathOptions)
+S3method(print,staticPath)
+S3method(print,staticPathOptions)
 export(decodeURI)
 export(decodeURIComponent)
 export(encodeURI)
 export(encodeURIComponent)
 export(getRNGState)
 export(interrupt)
 export(ipFamily)
+export(listServers)
 export(rawToBase64)
 export(runServer)
 export(service)
 export(startDaemonizedServer)
 export(startPipeServer)
 export(startServer)
+export(staticPath)
+export(staticPathOptions)
 export(stopAllServers)
 export(stopDaemonizedServer)
 export(stopServer)
 exportClasses(WebSocket)
 import(methods)
+importFrom(R6,R6Class)
 importFrom(Rcpp,evalCpp)
 importFrom(later,run_now)
 importFrom(promises,"%...!%")

NEWS.md

@@ -1,4 +1,4 @@
-httpuv 1.4.5.9000
+httpuv 1.4.5.9001
 ============
 
 * Fixed [#168](https://github.com/rstudio/httpuv/issues/168): A SIGPIPE signal on the httpuv background thread could cause the process to quit. This can happen in some instances when the server is under heavy load. ([#169](https://github.com/rstudio/httpuv/pull/169))

R/RcppExports.R

@@ -9,40 +9,36 @@ closeWS <- function(conn, code, reason) {
     invisible(.Call('_httpuv_closeWS', PACKAGE = 'httpuv', conn, code, reason))
 }
 
-makeTcpServer <- function(host, port, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose) {
-    .Call('_httpuv_makeTcpServer', PACKAGE = 'httpuv', host, port, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose)
+makeTcpServer <- function(host, port, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, staticPaths, staticPathOptions) {
+    .Call('_httpuv_makeTcpServer', PACKAGE = 'httpuv', host, port, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, staticPaths, staticPathOptions)
 }
 
-makePipeServer <- function(name, mask, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose) {
-    .Call('_httpuv_makePipeServer', PACKAGE = 'httpuv', name, mask, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose)
+makePipeServer <- function(name, mask, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, staticPaths, staticPathOptions) {
+    .Call('_httpuv_makePipeServer', PACKAGE = 'httpuv', name, mask, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, staticPaths, staticPathOptions)
 }
 
-#' Stop a server
-#' 
-#' Given a handle that was returned from a previous invocation of 
-#' \code{\link{startServer}} or \code{\link{startPipeServer}}, this closes all
-#' open connections for that server and  unbinds the port.
-#' 
-#' @param handle A handle that was previously returned from
-#'   \code{\link{startServer}} or \code{\link{startPipeServer}}.
-#'
-#' @seealso \code{\link{stopAllServers}} to stop all servers.
-#'
-#' @export
-stopServer <- function(handle) {
-    invisible(.Call('_httpuv_stopServer', PACKAGE = 'httpuv', handle))
+stopServer_ <- function(handle) {
+    invisible(.Call('_httpuv_stopServer_', PACKAGE = 'httpuv', handle))
 }
 
-#' Stop all applications
-#'
-#' This will stop all applications which were created by
-#' \code{\link{startServer}} or \code{\link{startPipeServer}}.
-#'
-#' @seealso \code{\link{stopServer}} to stop a specific server.
-#'
-#' @export
-stopAllServers <- function() {
-    invisible(.Call('_httpuv_stopAllServers', PACKAGE = 'httpuv'))
+getStaticPaths_ <- function(handle) {
+    .Call('_httpuv_getStaticPaths_', PACKAGE = 'httpuv', handle)
+}
+
+setStaticPaths_ <- function(handle, sp) {
+    .Call('_httpuv_setStaticPaths_', PACKAGE = 'httpuv', handle, sp)
+}
+
+removeStaticPaths_ <- function(handle, paths) {
+    .Call('_httpuv_removeStaticPaths_', PACKAGE = 'httpuv', handle, paths)
+}
+
+getStaticPathOptions_ <- function(handle) {
+    .Call('_httpuv_getStaticPathOptions_', PACKAGE = 'httpuv', handle)
+}
+
+setStaticPathOptions_ <- function(handle, opts) {
+    .Call('_httpuv_setStaticPathOptions_', PACKAGE = 'httpuv', handle, opts)
 }
 
 base64encode <- function(x) {

R/httpuv.R

@@ -170,7 +170,9 @@ AppWrapper <- setRefClass(
   fields = list(
     .app = 'ANY',
     .wsconns = 'environment',
-    .supportsOnHeaders = 'logical'
+    .supportsOnHeaders = 'logical',
+    .staticPaths = 'list',
+    .staticPathOptions = 'ANY'
   ),
   methods = list(
     initialize = function(app) {
@@ -181,6 +183,35 @@ AppWrapper <- setRefClass(
 
       # .app$onHeaders can error (e.g. if .app is a reference class)
       .supportsOnHeaders <<- isTRUE(try(!is.null(.app$onHeaders), silent=TRUE))
+
+      # staticPaths are saved in a field on this object, because they are read
+      # from the app object only during initialization. This is the only time
+      # it makes sense to read them from the app object, since they're
+      # subsequently used on the background thread, and for performance
+      # reasons it can't call back into R. Note that if the app object is a
+      # reference object and app$staticPaths is changed later, it will have no
+      # effect on the behavior of the application.
+      #
+      # If .app is a reference class, accessing .app$staticPaths can error if
+      # not present.
+      if (class(try(.app$staticPaths, silent = TRUE)) == "try-error" ||
+          is.null(.app$staticPaths))
+      {
+        .staticPaths <<- list()
+      } else {
+        .staticPaths <<- normalizeStaticPaths(.app$staticPaths)
+      }
+
+      if (class(try(.app$staticPathOptions, silent = TRUE)) == "try-error" ||
+          is.null(.app$staticPathOptions))
+      {
+        # Use defaults
+        .staticPathOptions <<- staticPathOptions()
+      } else if (inherits(.app$staticPathOptions, "staticPathOptions")) {
+        .staticPathOptions <<- normalizeStaticPathOptions(.app$staticPathOptions)
+      } else {
+        stop("staticPathOptions must be an object of class staticPathOptions.")
+      }
     },
     onHeaders = function(req) {
       if (!.supportsOnHeaders)
@@ -384,9 +415,16 @@ WebSocket <- setRefClass(
 #'   If the port cannot be bound (most likely due to permissions or because it
 #'   is already bound), an error is raised.
 #'
+#'   The application can also specify paths on the filesystem which will be
+#'   served from the background thread, without invoking \code{$call()} or
+#'   \code{$onHeaders()}. Files served this way will be only use a C++ code,
+#'   which is faster than going through R, and will not be blocked when R code
+#'   is executing. This can greatly improve performance when serving static
+#'   assets.
+#'
 #'   The \code{app} parameter is where your application logic will be provided 
 #'   to the server. This can be a list, environment, or reference class that 
-#'   contains the following named functions/methods:
+#'   contains the following methods and fields:
 #'   
 #'   \describe{
 #'     \item{\code{call(req)}}{Process the given HTTP request, and return an 
@@ -402,18 +440,33 @@ WebSocket <- setRefClass(
 #'     \item{\code{onWSOpen(ws)}}{Called back when a WebSocket connection is established.
 #'     The given object can be used to be notified when a message is received from
 #'     the client, to send messages to the client, etc. See \code{\link{WebSocket}}.}
+#'     \item{\code{staticPaths}}{
+#'       A named list of paths that will be served without invoking
+#'       \code{call()} or \code{onHeaders}. The name of each one is the URL
+#'       path, and the value is either a string referring to a local path, or an
+#'       object created by the \code{\link{staticPath}} function.
+#'     }
+#'     \item{\code{staticPathOptions}}{
+#'       A set of default options to use when serving static paths. If
+#'       not set or \code{NULL}, then it will use the result from calling
+#'       \code{\link{staticPathOptions}()} with no arguments.
+#'     }
 #'   }
 #'   
 #'   The \code{startPipeServer} variant can be used instead of 
 #'   \code{startServer} to listen on a Unix domain socket or named pipe rather
 #'   than a TCP socket (this is not common).
-#' @seealso \code{\link{stopServer}}, \code{\link{runServer}}
+#'
+#' @return A \code{\link{WebServer}} or \code{\link{PipeServer}} object.
+#'
+#' @seealso \code{\link{stopServer}}, \code{\link{runServer}},
+#'   \code{\link{listServers}}, \code{\link{stopAllServers}}.
 #' @aliases startPipeServer
 #'
 #' @examples
 #' \dontrun{
 #' # A very basic application
-#' handle <- startServer("0.0.0.0", 5000,
+#' s <- startServer("0.0.0.0", 5000,
 #'   list(
 #'     call = function(req) {
 #'       list(
@@ -427,26 +480,38 @@ WebSocket <- setRefClass(
 #'   )
 #' )
 #'
-#' stopServer(handle)
+#' s$stop()
+#'
+#'
+#' # An application that serves static assets at the URL paths /assets and /lib
+#' s <- startServer("0.0.0.0", 5000,
+#'   list(
+#'     call = function(req) {
+#'       list(
+#'         status = 200L,
+#'         headers = list(
+#'           'Content-Type' = 'text/html'
+#'         ),
+#'         body = "Hello world!"
+#'       )
+#'     },
+#'     staticPaths = list(
+#'       "/assets" = "content/assets/"
+#'       "/lib" = staticPath(
+#'         "content/lib",
+#'         indexhtml = FALSE
+#'     ),
+#'     staticPathOptions = staticPathOptions(
+#'       indexhtml = TRUE
+#'     )
+#'   )
+#' )
+#'
+#' s$stop()
 #' }
 #' @export
 startServer <- function(host, port, app) {
-
-  appWrapper <- AppWrapper$new(app)
-  server <- makeTcpServer(
-    host, port,
-    appWrapper$onHeaders,
-    appWrapper$onBodyData,
-    appWrapper$call,
-    appWrapper$onWSOpen,
-    appWrapper$onWSMessage,
-    appWrapper$onWSClose
-  )
-
-  if (is.null(server)) {
-    stop("Failed to create server")
-  }
-  return(server)
+  WebServer$new(host, port, app)
 }
 
 #' @param name A string that indicates the path for the domain socket (on 
@@ -460,21 +525,7 @@ startServer <- function(host, port, app) {
 #' @rdname startServer
 #' @export
 startPipeServer <- function(name, mask, app) {
-
-  appWrapper <- AppWrapper$new(app)
-  if (is.null(mask))
-    mask <- -1
-  server <- makePipeServer(name, mask,
-                           appWrapper$onHeaders,
-                           appWrapper$onBodyData,
-                           appWrapper$call,
-                           appWrapper$onWSOpen,
-                           appWrapper$onWSMessage,
-                           appWrapper$onWSClose)
-  if (is.null(server)) {
-    stop("Failed to create server")
-  }
-  return(server)
+  PipeServer$new(name, mask, app)
 }
 
 #' Process requests
@@ -625,16 +676,6 @@ rawToBase64 <- function(x) {
 #' @export
 startDaemonizedServer <- startServer
 
-#' Stop a running daemonized server in Unix environments (deprecated)
-#'
-#' This function will be removed in a future release of httpuv. Instead, use
-#' \code{\link{stopServer}}.
-#'
-#' @inheritParams stopServer
-#'
-#' @export
-stopDaemonizedServer <- stopServer
-
 
 # Needed so that Rcpp registers the 'httpuv_decodeURIComponent' symbol
 legacy_dummy <- function(value){