merged from master

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: shiny
 Type: Package
 Title: Web Application Framework for R
-Version: 1.2.0.9000
+Version: 1.2.0.9001
 Authors@R: c(
     person("Winston", "Chang", role = c("aut", "cre"), email = "winston@rstudio.com"),
     person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"),
@@ -65,7 +65,7 @@ Depends:
 Imports:
     utils,
     grDevices,
-    httpuv (>= 1.4.4),
+    httpuv (>= 1.4.5.9001),
     mime (>= 0.3),
     jsonlite (>= 0.9.16),
     xtable,
@@ -164,3 +164,5 @@ Collate:
     'timer.R'
     'update-input.R'
 RoxygenNote: 6.1.0
+Remotes:
+    rstudio/httpuv

NEWS.md

@@ -1,4 +1,4 @@
-shiny 1.2.0.9000
+shiny 1.2.0.9001
 ================
 
 ## Full changelog
@@ -9,6 +9,8 @@ shiny 1.2.0.9000
 
 * Revamped Shiny's [reactlog](https://github.com/rstudio/reactlog) viewer which debugs reactivity within a shiny application.  This allows users to traverse the reactivity history of a shiny application, filter to the dependency tree of a selected reactive object, and search for matching reactive objects.  See `?showReactLog` for more details and how to enable this feature. ([#2107](https://github.com/rstudio/shiny/pull/2107))
 
+* Shiny now serves static files on a background thread. This means that things like JavaScript and CSS assets can be served without blocking or being blocked by the main R thread, and should result in significantly better performance for heavily loaded servers. ([#2280](https://github.com/rstudio/shiny/pull/2280))
+
 ### Minor new features and improvements
 
 ### Bug fixes

R/app.R

@@ -170,7 +170,14 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
   }
 
   wwwDir <- file.path.ci(appDir, "www")
+  if (dirExists(wwwDir)) {
+    staticPaths <- list("/" = staticPath(wwwDir, indexhtml = FALSE, fallthrough = TRUE))
+  } else {
+    staticPaths <- list()
+  }
+
   fallbackWWWDir <- system.file("www-dir", package = "shiny")
+
   serverSource <- cachedFuncWithFile(appDir, "server.R", case.sensitive = FALSE,
     function(serverR) {
       # If server.R contains a call to shinyServer (which sets .globals$server),
@@ -220,7 +227,8 @@ shinyAppDir_serverR <- function(appDir, options=list()) {
 
   structure(
     list(
-      httpHandler = joinHandlers(c(uiHandler, wwwDir, fallbackWWWDir)),
+      staticPaths = staticPaths,
+      httpHandler = joinHandlers(c(uiHandler, fallbackWWWDir)),
       serverFuncSource = serverFuncSource,
       onStart = onStart,
       onStop = onStop,
@@ -309,6 +317,20 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
   }
 
   wwwDir <- file.path.ci(appDir, "www")
+  if (dirExists(wwwDir)) {
+    # wwwDir is a static path served by httpuv. It does _not_ serve up
+    # index.html, for two reasons. (1) It's possible that the user's
+    # www/index.html file is not actually used as the index, but as a template
+    # that gets processed before being sent; and (2) the index content may be
+    # modified by the hosting environment (as in SockJSAdapter.R).
+    #
+    # The call to staticPath normalizes the path, so that if the working dir
+    # later changes, it will continue to point to the right place.
+    staticPaths <- list("/" = staticPath(wwwDir, indexhtml = FALSE, fallthrough = TRUE))
+  } else {
+    staticPaths <- list()
+  }
+
   fallbackWWWDir <- system.file("www-dir", package = "shiny")
 
   oldwd <- NULL
@@ -327,7 +349,13 @@ shinyAppDir_appR <- function(fileName, appDir, options=list())
 
   structure(
     list(
-      httpHandler = joinHandlers(c(dynHttpHandler, wwwDir, fallbackWWWDir)),
+      # fallbackWWWDir is _not_ listed in staticPaths, because it needs to
+      # come after the uiHandler. It also does not need to be fast, since it
+      # should rarely be hit. The order is wwwDir (in staticPaths), then
+      # uiHandler, then falbackWWWDir (which is served up by the R
+      # staticHandler function).
+      staticPaths = staticPaths,
+      httpHandler = joinHandlers(c(dynHttpHandler, fallbackWWWDir)),
       serverFuncSource = dynServerFuncSource,
       onStart = onStart,
       onStop = onStop,

R/server.R

@@ -22,7 +22,7 @@ registerClient <- function(client) {
 }
 
 
-.globals$resources <- list()
+.globals$resourcePaths <- list()
 
 .globals$showcaseDefault <- 0
 
@@ -41,11 +41,6 @@ registerClient <- function(client) {
 #' @param directoryPath The directory that contains the static resources to be
 #'   served.
 #'
-#' @details You can call \code{addResourcePath} multiple times for a given
-#'   \code{prefix}; only the most recent value will be retained. If the
-#'   normalized \code{directoryPath} is different than the directory that's
-#'   currently mapped to the \code{prefix}, a warning will be issued.
-#'
 #' @seealso \code{\link{singleton}}
 #'
 #' @examples
@@ -66,36 +61,16 @@ addResourcePath <- function(prefix, directoryPath) {
         "`prefix` = '", prefix, "'; `directoryPath` = '" , directoryPath, "'")
     }
   )
-  .globals$resources[[prefix]] <- list(
-    directoryPath = normalizedPath,
-    func = staticHandler(normalizedPath)
-  )
-}
 
+  # If a shiny app is currently running, dynamically register this path with
+  # the corresponding httpuv server object.
+  if (!is.null(getShinyOption("server")))
+  {
+    getShinyOption("server")$setStaticPath(.list = setNames(normalizedPath, prefix))
+  }
 
-resourcePathHandler <- function(req) {
-  if (!identical(req$REQUEST_METHOD, 'GET'))
-    return(NULL)
-
-  path <- req$PATH_INFO
-
-  match <- regexpr('^/([^/]+)/', path, perl=TRUE)
-  if (match == -1)
-    return(NULL)
-  len <- attr(match, 'capture.length')
-  prefix <- substr(path, 2, 2 + len - 1)
-
-  resInfo <- .globals$resources[[prefix]]
-  if (is.null(resInfo))
-    return(NULL)
-
-  suffix <- substr(path, 2 + len, nchar(path))
-
-  subreq <- as.environment(as.list(req, all.names=TRUE))
-  subreq$PATH_INFO <- suffix
-  subreq$SCRIPT_NAME <- paste(subreq$SCRIPT_NAME, substr(path, 1, 2 + len), sep='')
-
-  return(resInfo$func(subreq))
+  # .globals$resourcePaths persists across runs of applications.
+  .globals$resourcePaths[[prefix]] <- normalizedPath
 }
 
 #' Define Server Functionality
@@ -183,8 +158,6 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
   appvars <- new.env()
   appvars$server <- NULL
 
-  sys.www.root <- system.file('www', package='shiny')
-
   # This value, if non-NULL, must be present on all HTTP and WebSocket
   # requests as the Shiny-Shared-Secret header or else access will be
   # denied (403 response for HTTP, and instant close for websocket).
@@ -194,9 +167,8 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
     http = joinHandlers(c(
       sessionHandler,
       httpHandlers,
-      sys.www.root,
-      resourcePathHandler,
-      reactLogHandler)),
+      reactLogHandler
+    )),
     ws = function(ws) {
       if (!is.null(sharedSecret)
           && !identical(sharedSecret, ws$request$HTTP_SHINY_SHARED_SECRET)) {
@@ -418,6 +390,25 @@ startApp <- function(appObj, port, host, quiet) {
   handlerManager$addHandler(appHandlers$http, "/", tail = TRUE)
   handlerManager$addWSHandler(appHandlers$ws, "/", tail = TRUE)
 
+  httpuvApp <- handlerManager$createHttpuvApp()
+  httpuvApp$staticPaths <- c(
+    appObj$staticPaths,
+    list(
+      "shared" = system.file(package = "shiny", "www", "shared")
+    ),
+    .globals$resourcePaths
+  )
+  httpuvApp$staticPathOptions <- httpuv::staticPathOptions(
+    html_charset = "utf-8",
+    headers = list("X-UA-Compatible" = "IE=edge,chrome=1"),
+    validation =
+      if (!is.null(getOption("shiny.sharedSecret"))) {
+        sprintf('"Shiny-Shared-Secret" == "%s"', getOption("shiny.sharedSecret"))
+      } else {
+        character(0)
+      }
+  )
+
   if (is.numeric(port) || is.integer(port)) {
     if (!quiet) {
       hostString <- host
@@ -425,7 +416,7 @@ startApp <- function(appObj, port, host, quiet) {
         hostString <- paste0("[", hostString, "]")
       message('\n', 'Listening on http://', hostString, ':', port)
     }
-    return(startServer(host, port, handlerManager$createHttpuvApp()))
+    return(startServer(host, port, httpuvApp))
   } else if (is.character(port)) {
     if (!quiet) {
       message('\n', 'Listening on domain socket ', port)
@@ -437,7 +428,7 @@ startApp <- function(appObj, port, host, quiet) {
            "configuration (and not domain sockets), then `port` must ",
            "be numeric, not a string.")
     }
-    return(startPipeServer(port, mask, handlerManager$createHttpuvApp()))
+    return(startPipeServer(port, mask, httpuvApp))
   }
 }
 
@@ -778,6 +769,10 @@ runApp <- function(appDir=getwd(),
 
   server <- startApp(appParts, port, host, quiet)
 
+  # Make the httpuv server object accessible. Needed for calling
+  # addResourcePath while app is running.
+  shinyOptions(server = server)
+
   on.exit({
     stopServer(server)
   }, add = TRUE)

inst/www/shared/shiny.js

@@ -12,7 +12,7 @@ function _defineProperty(obj, key, value) { if (key in obj) { Object.definePrope
 
   var exports = window.Shiny = window.Shiny || {};
 
-  exports.version = "1.2.0.9000"; // Version number inserted by Grunt
+  exports.version = "1.2.0.9001"; // Version number inserted by Grunt
 
   var origPushState = window.history.pushState;
   window.history.pushState = function () {

man/addResourcePath.Rd

@@ -20,12 +20,6 @@ Adds a directory of static resources to Shiny's web server, with the given
 path prefix. Primarily intended for package authors to make supporting
 JavaScript/CSS files available to their components.
 }
-\details{
-You can call \code{addResourcePath} multiple times for a given
-  \code{prefix}; only the most recent value will be retained. If the
-  normalized \code{directoryPath} is different than the directory that's
-  currently mapped to the \code{prefix}, a warning will be issued.
-}
 \examples{
 addResourcePath('datasets', system.file('data', package='datasets'))
 }