Fix rstudio#2385: R Markdown documents containing subapps not rendering properly

Author: jcheng5

NEWS.md

@@ -1,20 +1,18 @@
-shiny 1.3.1
+shiny 1.3.2
 ===========
 
-## Full changelog
+### Bug fixes
 
-### Breaking changes
+* Static CSS/JS resources in subapps in R Markdown documents did not render properly. ([#2386](https://github.com/rstudio/shiny/pull/2386))
 
-### New features
 
-### Minor new features and improvements
+shiny 1.3.1
+===========
 
 ### Bug fixes
 
 * Fixed a performance issue introduced in v1.3.0 when using large nested lists within Shiny. ([#2377](https://github.com/rstudio/shiny/pull/2377))
 
-### Documentation Updates
-
 
 shiny 1.3.0
 ===========

R/server.R

@@ -23,6 +23,7 @@ registerClient <- function(client) {
 
 
 .globals$resourcePaths <- list()
+.globals$resources <- list()
 
 .globals$showcaseDefault <- 0
 
@@ -69,8 +70,41 @@ addResourcePath <- function(prefix, directoryPath) {
     getShinyOption("server")$setStaticPath(.list = stats::setNames(normalizedPath, prefix))
   }
 
-  # .globals$resourcePaths persists across runs of applications.
+  # .globals$resourcePaths and .globals$resources persist across runs of applications.
   .globals$resourcePaths[[prefix]] <- staticPath(normalizedPath)
+  # This is necessary because resourcePaths is only for serving assets out of C++;
+  # to support subapps, we also need assets to be served out of R, because those
+  # URLs are rewritten by R code (i.e. routeHandler) before they can be matched to
+  # a resource path.
+  .globals$resources[[prefix]] <- list(
+    directoryPath = normalizedPath,
+    func = staticHandler(normalizedPath)
+  )
+}
+
+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))
 }
 
 #' Define Server Functionality
@@ -167,6 +201,7 @@ createAppHandlers <- function(httpHandlers, serverFuncSource) {
     http = joinHandlers(c(
       sessionHandler,
       httpHandlers,
+      resourcePathHandler,
       reactLogHandler
     )),
     ws = function(ws) {