Escape article titles (r-lib#2471)

Fixes r-lib#2286

NEWS.md

@@ -1,5 +1,6 @@
 # pkgdown (development version)
 
+* `build_article()` now escapes html characters in the title (#2286).
 * `build_article()` no longer generates the wrong source link when you build your site outside of the root directory (#2172).
 * `build_reference()` matches usage for S3 and S4 methods to the style used by R 4.0.0 and later (#2187).
 * `<source>` tags now have their `srcref` attributes tweaked in the same way that the `src` attributes of `<img>` tags are (#2402).

R/build-articles.R

@@ -248,7 +248,7 @@ build_article <- function(name,
   as_is <- isTRUE(purrr::pluck(front, "pkgdown", "as_is"))
 
   default_data <- list(
-    pagetitle = front$title,
+    pagetitle = escape_html(front$title),
     toc = toc <- front$toc %||% TRUE,
     opengraph = list(description = front$description %||% pkg$package),
     source = repo_source(pkg, input),

tests/testthat/assets/articles/vignettes/needs-escape.Rmd

@@ -0,0 +1,4 @@
+---
+title: "a <-> b"
+---
+

tests/testthat/assets/reference/DESCRIPTION

@@ -3,4 +3,4 @@ Version: 1.0.0
 Title: A test package
 Description: A test package
 Authors@R: person("Hadley Wickham")
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

tests/testthat/assets/reference/R/funs.R

@@ -27,3 +27,8 @@ NULL
 #' @examples
 #' testpackage:::f()
 f <- function() {runif(5L)}
+
+
+#' g <-> h
+#' @keywords internal
+g <- function() 1

tests/testthat/test-build-articles.R

@@ -214,6 +214,16 @@ test_that("check doesn't include getting started vignette", {
   expect_error(data_articles_index(pkg), NA)
 })
 
+test_that("titles are escaped when needed", {
+  pkg <- local_pkgdown_site(test_path("assets/articles"))
+  suppressMessages(build_article(pkg = pkg, name = "needs-escape"))
+
+  html <- xml2::read_html(file.path(pkg$dst_path, "articles/needs-escape.html"))
+  expect_equal(xpath_text(html, "//title", trim = TRUE), "a <-> b • testpackage")
+  expect_equal(xpath_text(html, "//h1", trim = TRUE), "a <-> b")
+})
+
+
 test_that("output is reproducible by default, i.e. 'seed' is respected", {
   pkg <- local_pkgdown_site(test_path("assets/articles"))
   suppressMessages(build_article(pkg = pkg, name = "random"))

tests/testthat/test-build-reference.R

@@ -104,6 +104,15 @@ test_that("examples are reproducible by default, i.e. 'seed' is respected", {
   expect_snapshot(cat(examples))
 })
 
+test_that("title and page title escapes html", {
+  pkg <- local_pkgdown_site(test_path("assets/reference"))
+  suppressMessages(build_reference(pkg, topics = "g"))
+
+  html <- xml2::read_html(file.path(pkg$dst_path, "reference", "g.html"))
+  expect_equal(xpath_text(html, "//title", trim = TRUE), "g <-> h — g • testpackage")
+  expect_equal(xpath_text(html, "//h1", trim = TRUE), "g <-> h")
+})
+
 test_that("get_rdname handles edge cases", {
   expect_equal(get_rdname(list(file_in = "foo..Rd")), "foo.")
   expect_equal(get_rdname(list(file_in = "foo.rd")), "foo")

tests/testthat/test-check.R

@@ -12,7 +12,7 @@ test_that("fails if article index incomplete", {
   pkg <- local_pkgdown_site(test_path("assets/articles"), meta = "
     articles:
      - title: Title
-       contents: [starts_with('html'), random, standard, toc-false, widget]
+       contents: [starts_with('html'), random, standard, toc-false, widget, needs-escape]
   ")
   expect_snapshot(check_pkgdown(pkg), error = TRUE)
 })