Force a render when user pkgs don't match the pkgs used in a rendered, shiny-prerendered document

NEWS.md

@@ -11,6 +11,9 @@ rmarkdown 1.11 (unreleased)
 
 * Fixed a regression that caused scrollbars on code blocks when the syntax highlighting theme is not the default (#654, #1399).
 
+* Added checks for shiny-prerendered documents to find all html dependencies, match all execution packages, and match the major R version (#1420).
+
+
 rmarkdown 1.10
 ================================================================================
 
@@ -543,4 +546,3 @@ rmarkdown 0.3.11
 ================================================================================
 
 Initial release to CRAN
-

R/render.R

@@ -360,7 +360,11 @@ render <- function(input,
     # force various output options
     output_options$self_contained <- FALSE
     output_options$dependency_resolver <- function(deps) {
-      shiny_prerendered_dependencies <<- deps
+      shiny_prerendered_dependencies <<- list(
+        deps = deps,
+        packages = get_loaded_packages(),
+        rMajorVersion = R.version$major
+      )
       list()
     }
   }

R/shiny_prerendered.R

@@ -75,49 +75,13 @@ shiny_prerendered_html <- function(input_rmd, encoding, render_args) {
 
   # determine whether we need to render the Rmd in advance
   prerender_option <- tolower(Sys.getenv("RMARKDOWN_RUN_PRERENDER", "1"))
-
-  if (file.access(output_dir, 2) != 0) {
-    if (!file.exists(rendered_html))
-      stop("Unable to write prerendered HTML file to ", rendered_html)
-
-    prerender <- FALSE
-  }
-  else if (identical(prerender_option, "0")) {
-    prerender <- FALSE
-  }
-  else if (identical(prerender_option, "1")) {
-
-    # determine the last modified time of the output file
-    if (file.exists(rendered_html))
-      output_last_modified <- as.integer(file.info(rendered_html)$mtime)
-    else
-      output_last_modified <- 0L
-
-    # short circuit for Rmd modified. if it hasn't been modified since the
-    # html was generated look at external resources
-    input_last_modified <- as.integer(file.info(input_rmd)$mtime)
-    if (input_last_modified > output_last_modified) {
-      prerender <- TRUE
-    }
-    else {
-      # find external resources referenced by the file
-      external_resources <- find_external_resources(input_rmd, encoding)
-
-      # get paths to external resources
-      input_files <- c(input_rmd,
-                       file.path(output_dir, external_resources$path))
-
-      # what's the maximum last_modified time of an input file
-      input_last_modified <- max(as.integer(file.info(input_files)$mtime),
-                                 na.rm = TRUE)
-
-      # render if an input file was modified after the output file
-      prerender <- input_last_modified > output_last_modified
-    }
-  }
-  else {
-    stop("Invalid value '", prerender_option, "' for RMARKDOWN_RUN_PRERENDER")
-  }
+  prerender <- shiny_prerendered_prerender(
+    input_rmd,
+    rendered_html,
+    output_dir,
+    encoding,
+    prerender_option
+  )
 
   # prerender if necessary
   if (prerender) {
@@ -171,17 +135,121 @@ shiny_prerendered_html <- function(input_rmd, encoding, render_args) {
   shinyHTML_with_deps(rendered_html, dependencies)
 }
 
+shiny_prerendered_prerender <- function(
+  input_rmd,
+  rendered_html,
+  output_dir,
+  encoding,
+  prerender_option
+) {
+  if (file.access(output_dir, 2) != 0) {
+    if (!file.exists(rendered_html))
+      stop("Unable to write prerendered HTML file to ", rendered_html)
+    return(FALSE)
+  }
+
+  if (identical(prerender_option, "0")) {
+    return(FALSE)
+  }
+  if (!identical(prerender_option, "1")) {
+    stop("Invalid value '", prerender_option, "' for RMARKDOWN_RUN_PRERENDER")
+  }
+
+  # determine the last modified time of the output file
+  if (file.exists(rendered_html)) {
+    output_last_modified <- as.integer(file.info(rendered_html)$mtime)
+  } else {
+    output_last_modified <- 0L
+  }
+
+  # short circuit for Rmd modified. if it hasn't been modified since the
+  # html was generated look at external resources
+  input_last_modified <- as.integer(file.info(input_rmd)$mtime)
+  if (input_last_modified > output_last_modified) {
+    return(TRUE)
+  }
+
+  # find external resources referenced by the file
+  external_resources <- find_external_resources(input_rmd, encoding)
+
+  # get paths to external resources
+  input_files <- c(input_rmd, file.path(output_dir, external_resources$path))
+
+  # what's the maximum last_modified time of an input file
+  input_last_modified <- max(as.integer(file.info(input_files)$mtime), na.rm = TRUE)
+
+  # render if an input file was modified after the output file
+  if (input_last_modified > output_last_modified) {
+    return(TRUE)
+  }
+
+  html_lines <- readLines(rendered_html, encoding = "UTF-8", warn = FALSE)
+
+  # check that all html dependencies exist
+  dependencies_json <- shiny_prerendered_extract_context(html_lines, "dependencies")
+  dependencies <- jsonlite::unserializeJSON(dependencies_json)
+
+  pkgsSeen <- list()
+  for (dep in dependencies) {
+    if (is.null(dep$package)) {
+      # if the file doesn't exist at all, render again
+      if (!file.exists(dep$src$file)) {
+        # might create a missing file compile-time error,
+        #   but that's better than a missing file prerendered error
+        return(TRUE)
+      }
+    } else {
+      depPkg <- dep$package
+      depVer <- dep$pkgVersion
+      if (is.null(pkgsSeen[[depPkg]])) {
+        # has not seen pkg
+
+        # depVer could be NULL, producing a logical(0)
+        #   means old prerender version, render again
+        if (!isTRUE(get_package_version_string(depPkg) == depVer)) {
+          # was not rendered with the same R package. must render again
+          return (TRUE)
+        }
+        pkgsSeen[[depPkg]] <- depVer
+      }
+    }
+  }
+  # all html dependencies are accounted for
+
+  execution_json <- shiny_prerendered_extract_context(html_lines, "execution_dependencies")
+  execution_info <- jsonlite::unserializeJSON(execution_json)
+
+  # check that the major R versions match
+  if (!identical(R.version$major, execution_info$rMajorVersion)) {
+    return(TRUE)
+  }
+
+  # check for execution package version differences
+  execution_pkgs <- execution_info$packages
+  versions_dont_match <- unlist(Map(
+    execution_pkgs$package,
+    execution_pkgs$version,
+    f = function(package, version) {
+      !identical(get_package_version_string(package), version)
+    }
+  ))
+  if (any(versions_dont_match)) {
+    return(TRUE)
+  }
+  # all execution packages match
+
+  return(FALSE)
+}
+
 
 # Write the dependencies for a shiny_prerendered document.
 shiny_prerendered_append_dependencies <- function(input, # always UTF-8
                                                   shiny_prerendered_dependencies,
                                                   files_dir,
                                                   output_dir) {
 
-
-
   # transform dependencies (if we aren't in debug mode)
-  dependencies <- lapply(shiny_prerendered_dependencies, function(dependency) {
+  dependencies <- lapply(shiny_prerendered_dependencies$deps, function(dependency) {
 
     # no transformation in dev mode (so browser dev tools can map directly
     # to the locations of CSS and JS files in their pkg src directory)
@@ -199,6 +267,8 @@ shiny_prerendered_append_dependencies <- function(input, # always UTF-8
         package_desc <- read.dcf(file.path(package_dir, "DESCRIPTION"),
                                  all = TRUE)
         dependency$package <- package_desc$Package
+        # named to something that doesn't start with 'package' to deter lazy name matching
+        dependency$pkgVersion <- package_desc$Version
         dependency$src$file <- normalized_relative_to(package_dir,
                                                       dependency$src$file)
       }
@@ -225,6 +295,13 @@ shiny_prerendered_append_dependencies <- function(input, # always UTF-8
   # write deps to connection
   dependencies_json <- jsonlite::serializeJSON(dependencies, pretty = FALSE)
   shiny_prerendered_append_context(con, "dependencies", dependencies_json)
+
+  # write r major version and execution package dependencies
+  execution_json <- jsonlite::serializeJSON(
+    shiny_prerendered_dependencies[c("rMajorVersion", "packages")],
+    pretty = FALSE
+  )
+  shiny_prerendered_append_context(con, "execution_dependencies", execution_json)
 }
 
 
@@ -324,7 +401,7 @@ shiny_prerendered_option_hook <- function(input, encoding) {
                                                     options$cache > 0)
       data_file <- to_utf8(data_file, encoding)
       data_dir <- shiny_prerendered_data_dir(input, create = TRUE)
-      index_file <- shiny_prerendred_data_chunks_index(data_dir)
+      index_file <- shiny_prerendered_data_chunks_index(data_dir)
       conn <- file(index_file, open = "ab", encoding = "UTF-8")
       on.exit(close(conn), add = TRUE)
       write(data_file, file = conn, append = TRUE)
@@ -406,7 +483,7 @@ shiny_prerendered_evaluate_hook <- function(input) {
 shiny_prerendered_remove_uncached_data <- function(input) {
   data_dir <- shiny_prerendered_data_dir(input)
   if (dir_exists(data_dir)) {
-    index_file <- shiny_prerendred_data_chunks_index(data_dir)
+    index_file <- shiny_prerendered_data_chunks_index(data_dir)
     if (file.exists(index_file))
       unlink(index_file)
     rdata_files <- list.files(data_dir, pattern = utils::glob2rx("*.RData"))
@@ -562,7 +639,7 @@ shiny_prerendered_data_load <- function(input_rmd, server_envir) {
   data_dir <- shiny_prerendered_data_dir(input_rmd)
   if (dir_exists(data_dir)) {
     # read index of data files
-    index_file <- shiny_prerendred_data_chunks_index(data_dir)
+    index_file <- shiny_prerendered_data_chunks_index(data_dir)
     if (file.exists(index_file)) {
       rdata_files <- readLines(index_file, encoding = "UTF-8")
       # load each of the files in the index
@@ -576,7 +653,7 @@ shiny_prerendered_data_load <- function(input_rmd, server_envir) {
 }
 
 # File used to store names of chunks which had cache=TRUE during the last render
-shiny_prerendred_data_chunks_index <- function(data_dir) {
+shiny_prerendered_data_chunks_index <- function(data_dir) {
   file.path(data_dir, "data_chunks_index.txt")
 }
 
@@ -585,4 +662,3 @@ shiny_prerendered_data_file_name <- function(label, cache) {
   type <- ifelse(cache, ".cached", "")
   sprintf("%s%s.RData", label, type)
 }
-

R/util.R

@@ -513,3 +513,34 @@ package_root <- function(path) {
       length(grep('^Package: ', readLines(desc))) == 0) return(package_root(dir))
   dir
 }
+
+
+# retrieve package version without fear of error
+# loading namespace is ok as these packages have been or will be used
+get_package_version_string <- function(package) {
+  tryCatch(
+    as.character(getNamespaceVersion(package)),
+    error = function(e) {
+      NULL
+    }
+  )
+}
+# find all loaded packages.
+# May contain extra packages, but contains all packages used while knitting
+get_loaded_packages <- function() {
+  base_r_packages <- c(
+    "base", "compiler", "datasets", "graphics", "grDevices",
+    "grid", "methods", "parallel", "splines",
+    "stats", "stats4", "tcltk", "tools", "utils"
+  )
+
+  packages <- sort(setdiff(loadedNamespaces(), base_r_packages))
+  version <- vapply(packages, get_package_version_string, character(1))
+  attached <- paste0("package:", packages) %in% search()
+
+  data.frame(
+    packages = packages[attached],
+    version = version[attached],
+    row.names = NULL, stringsAsFactors = FALSE
+  )
+}