diff --git a/DESCRIPTION b/DESCRIPTION index c6d9195f..ced2265f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: htmltools Type: Package Title: Tools for HTML -Version: 0.5.0.9001 +Version: 0.5.0.9002 Authors@R: c( person("Joe", "Cheng", role = "aut", email = "joe@rstudio.com"), person("Carson", "Sievert", role = c("aut", "cre"), email = "carson@rstudio.com", comment = c(ORCID = "0000-0002-4958-2844")), diff --git a/NEWS b/NEWS index 32c1229d..f754c85c 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,4 @@ -htmltools 0.5.0.9000 +htmltools 0.5.0.9002 -------------------------------------------------------------------------------- * Added a new `tagFunction()` for generating `tags` and/or `htmlDependency()`s conditional on the rendering context. For an example, see `?tagFunction`. (#180) @@ -7,6 +7,9 @@ htmltools 0.5.0.9000 * `save_html()` now has a `lang` parameter that can be used to set the lang attribute of ``. (@ColinFay, #185) +* `htmlDependency`, & `renderDependencies` now allow the `script` argument to be given as a named list containing the + elements: `src`, `integrity`, `crossorigin`. + htmltools 0.5.0 -------------------------------------------------------------------------------- diff --git a/R/html_dependency.R b/R/html_dependency.R index 5bc263ee..5fdc3f60 100644 --- a/R/html_dependency.R +++ b/R/html_dependency.R @@ -36,6 +36,31 @@ #' \code{href} for URL. For example, a dependency that was both on disk and at #' a URL might use \code{src = c(file=filepath, href=url)}. #' +#' \code{script} can be given as one of the following: +#' \itemize{ +#' \item a character vector specifying various scripts to include relative to the +#' value of \code{src}. +#' Each is expanded into its own \code{", - sep = "" - )) + html <- c(html, renderScript(dep$script, srcpath, encodeFunc, hrefFilter)) } if (length(dep$attachment) > 0) { @@ -505,6 +525,57 @@ renderDependencies <- function(dependencies, HTML(paste(html, collapse = "\n")) } + + +renderScript <- function(script, srcpath, encodeFunc, hrefFilter) { + # If the input is a named list, transform it to an unnamed list + # whose only element is the input list + if (anyNamed(script)) { + if (anyUnnamed(script)) stop("script inputs cannot mix named and unnamed") + script <- list(script) + } + + # For each element, if it's a scalar string, transform it to a named + # list with one element, "src". + script <- lapply(script, function(item) { + if (length(item) == 1 && is.character(item)) { + item = list(src = item) + } + + if (length(names(item)) == 0) { + stop( + "Elements of script must be named lists, or scalar strings ", + "I got ", deparse(item) + ) + } + + return(item) + }) + + script <- vapply( + script, function(x) { + x$src <- hrefFilter(file.path(srcpath, encodeFunc(x$src))) + paste0( + "", + collapse = "" + ) + }, + FUN.VALUE = character(1) + ) + + return(script) +} + + # html_dependencies_as_character(list( # htmlDependency("foo", "1.0", # c(href="http://foo.com/bar%20baz/"), diff --git a/R/utils.R b/R/utils.R index 4edfe202..9a06ed91 100644 --- a/R/utils.R +++ b/R/utils.R @@ -120,3 +120,31 @@ WSTextWriter <- function(bufferSize=1024) { } ) } + +# Given a vector/list, return TRUE if any elements are named, FALSE otherwise. +anyNamed <- function(x) { + # Zero-length vector + if (length(x) == 0) return(FALSE) + + nms <- names(x) + + # List with no name attribute + if (is.null(nms)) return(FALSE) + + # List with name attribute; check for any "" + any(nzchar(nms)) +} + +# Given a vector/list, return TRUE if any elements are unnamed, FALSE otherwise. +anyUnnamed <- function(x) { + # Zero-length vector + if (length(x) == 0) return(FALSE) + + nms <- names(x) + + # List with no name attribute + if (is.null(nms)) return(TRUE) + + # List with name attribute; check for any "" + any(!nzchar(nms)) +} diff --git a/tests/testthat/test-deps.r b/tests/testthat/test-deps.r index 3e9af2a9..7cb56121 100644 --- a/tests/testthat/test-deps.r +++ b/tests/testthat/test-deps.r @@ -186,3 +186,148 @@ test_that("Modifying children using dependencies", { x <- tagSetChildren(div("foo", a1.1), tagFunction(function() { a1.2 })) expect_identical(findDependencies(x), list(a1.2)) }) + + +test_that("able to resolve HTML scripts supplied with & without integrity", { + src1 <- "https://cdn.com/libs/p1/0.1/" + src2 <- "https://cdn/libs/p2/0.2/" + deps <- list( + htmlDependency( + name = "p1", + version = "0.1", + src = list(href = src1), + script = list( + src = "p1.min.js", + integrity = "longhash", + crossorigin = "anonymous" + ) + ), + htmlDependency( + "p2", version = "0.2", + src = list(href = src2), + script = "p2.min.js" + ) + ) + + expect1 <- paste( + '', + sep = '' + ) + expect2 <- paste( + '', + sep = '' + ) + + expect <- paste(expect1, expect2, sep = '\n') + + class(expect) <- c("html", "character") + + actual <- renderDependencies(deps) + + + + expect_equal(!!strsplit(actual, "\n"), !!strsplit(expect, "\n")) +}) + +test_that( + "can render scripts given as lists of nested lists + scalar strings", { + src = "https://cdn.com/libs/p1/0.1" + nm <- "p1.js" + + d1 <- htmlDependency( + "p1", "0.1", src = list(href = src), + script = list(src = nm) + ) + + deps1 <- list( + d1, + htmlDependency( + "p1", "0.2", src = list(href = src), + script = nm + ), + htmlDependency( + "p1", "0.3", src = list(href = src), + script = list(list(src = nm)) + ) + ) + + out <- renderDependencies(deps1) + + deps2 <- list( + d1, + d1, + d1 + ) + + expect_length(unique(unlist(strsplit(out, "\n"))), 1) + + expect_equal(renderDependencies(deps1), renderDependencies(deps2)) + + nm2 <- "p1-0.1.js" + + deps3 <- list( + htmlDependency( + "p1", "0.1", src = list(href = src), + script = c(nm, nm2) + ) + ) + + out <- renderDependencies(deps3) + + src_urls <- c( + file.path(src, nm), + file.path(src, nm2) + ) + + expect <- paste( + '\n', + '', + sep = "") + + expect_equal(!!as.character(out), !!expect) + + deps4 <- list( + htmlDependency( + "p1", "0.1", src = list(href = src), + script = list(list(src = nm, integrity = "hash"), nm2) + ) + ) + + out <- renderDependencies(deps4) + + expect <- paste( + '\n', + '', + sep = "") + + expect_equal(!!as.character(out), !!expect) + }) + +test_that("html escaping is carried out correctly in script rendering", { + src = "https://cdn.com/libs/p1/0.1" + nm <- "p1.js" + funky_hash <- "" + + deps <- list( + htmlDependency( + "p1", "0.1", src = list(href = src), + script = list(src = nm, integrity = funky_hash) + ) + ) + + src_url <- file.path(src, nm) + + expect <- paste( + '', + sep = "" + ) + + out <- renderDependencies(deps) + expect_equal(!!as.character(out), !!expect) + +})