tests/testthat/test-static-paths.R

context("static")

index_file_content <- raw_file_content(test_path("apps/content/index.html"))
data_file_content <- raw_file_content(test_path("apps/content/data.txt"))
subdir_index_file_content <- raw_file_content(test_path("apps/content/subdir/index.html"))
index_file_1_content <- raw_file_content(test_path("apps/content_1/index.html"))

test_that("Basic static file serving", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      staticPaths = list(
        # Testing out various leading and trailing slashes
        "/" = test_path("apps/content"),
        "/1" = test_path("apps/content"),
        "/2/" = test_path("apps/content/"),
        "3" = test_path("apps/content"),
        "4/" = test_path("apps/content/")
      ),
      staticPathOptions = staticPathOptions(
        headers = list("Test-Code-Path" = "C++")
      )
    )
  )
  on.exit(s$stop())

  # Fetch index.html
  r <- fetch(local_url("/", s$getPort()), gzip = FALSE)
  expect_equal(r$status_code, 200)
  expect_identical(r$content, index_file_content)

  # index.html for subdirectory
  r_subdir <- fetch(local_url("/subdir", s$getPort()))
  expect_equal(r_subdir$status_code, 200)
  expect_identical(r_subdir$content, subdir_index_file_content)

  h <- parse_headers_list(r$headers)
  expect_equal(as.integer(h$`content-length`), length(index_file_content))
  expect_equal(as.integer(h$`content-length`), length(r$content))
  expect_identical(h$`content-type`, "text/html; charset=utf-8")
  expect_identical(h$`test-code-path`, "C++")
  # Check that response time is within 1 minute of now. (Possible DST problems?)
  expect_true(abs(as.numeric(parse_http_date(h$date)) - as.numeric(Sys.time())) < 60)


  # Testing index for other paths
  r1 <- fetch(local_url("/1", s$getPort()), gzip = FALSE)
  h1 <- parse_headers_list(r1$headers)
  expect_identical(r$content, r1$content)
  expect_identical(h$`content-length`, h1$`content-length`)
  expect_identical(h$`content-type`, h1$`content-type`)

  r2 <- fetch(local_url("/1/", s$getPort()), gzip = FALSE)
  h2 <- parse_headers_list(r2$headers)
  expect_identical(r$content, r2$content)
  expect_identical(h$`content-length`, h2$`content-length`)
  expect_identical(h$`content-type`, h2$`content-type`)

  r3 <- fetch(local_url("/1/index.html", s$getPort()), gzip = FALSE)
  h3 <- parse_headers_list(r3$headers)
  expect_identical(r$content, r3$content)
  expect_identical(h$`content-length`, h3$`content-length`)
  expect_identical(h$`content-type`, h3$`content-type`)

  # Missing file (404)
  r <- fetch(local_url("/foo", s$getPort()), gzip = FALSE)
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 404)
  expect_identical(rawToChar(r$content), "404 Not Found\n")
  expect_equal(h$`content-length`, "14")

  # Missing directory in path (404)
  r <- fetch(local_url("/foo/bar", s$getPort()), gzip = FALSE)
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 404)
  expect_identical(rawToChar(r$content), "404 Not Found\n")
  expect_equal(h$`content-length`, "14")

  # MIME types for other files
  r <- fetch(local_url("/mtcars.csv", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(h$`content-type`, "text/csv")

  r <- fetch(local_url("/data.txt", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(h$`content-type`, "text/plain")
})


test_that("Missing file fallthrough", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      call = function(req) {
        return(list(
          status = 404,
          headers = list("Test-Code-Path" = "R"),
          body = paste0("404 file not found: ", req$PATH_INFO)
        ))
      },
      staticPaths = list(
        # Testing out various leading and trailing slashes
        "/" = staticPath(
          test_path("apps/content"),
          indexhtml = FALSE,
          fallthrough = TRUE
        )
      )
    )
  )
  on.exit(s$stop())

  r <- fetch(local_url("/", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 404)
  expect_identical(h$`test-code-path`, "R")
  expect_identical(rawToChar(r$content), "404 file not found: /")
})


test_that("Longer paths override shorter ones", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      staticPaths = list(
        # Testing out various leading and trailing slashes
        "/" = test_path("apps/content"),
        "/a" = staticPath(
          test_path("apps/content"),
          indexhtml = FALSE
        ),
        "/a/b" = staticPath(
          test_path("apps/content"),
          indexhtml = NULL
        ),
        "/a/b/c" = staticPath(
          test_path("apps/content"),
          indexhtml = TRUE
        )
      )
    )
  )
  on.exit(s$stop())

  r <- fetch(local_url("/", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, index_file_content)

  r <- fetch(local_url("/a/", s$getPort()))
  expect_equal(r$status_code, 404)

  # When NULL, option values are not inherited from the parent dir, "/a";
  # they're inherited from the overall options for the app.
  r <- fetch(local_url("/a/b", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, index_file_content)

  r <- fetch(local_url("/a/b/c", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, index_file_content)
})


test_that("Options and option inheritance", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      call = function(req) {
        return(list(
          status = 404,
          headers = list("Test-Code-Path" = "R"),
          body = paste0("404 file not found: ", req$PATH_INFO)
        ))
      },
      staticPaths = list(
        "/default" = staticPath(test_path("apps/content")),
        # This path overrides options
        "/override" = staticPath(
          test_path("apps/content"),
          indexhtml = FALSE,
          fallthrough = TRUE,
          html_charset = "ISO-8859-1",
          headers = list("Test-Code-Path" = "C++2")
        ),
        # This path unsets some options
        "/unset" = staticPath(
          test_path("apps/content"),
          html_charset = "",
          headers = list()
        )
      ),
      staticPathOptions = staticPathOptions(
        indexhtml = TRUE,
        fallthrough = FALSE,
        headers = list("Test-Code-Path" = "C++")
      )
    )
  )
  on.exit(s$stop())

  r <- fetch(local_url("/default", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 200)
  expect_identical(h$`content-type`, "text/html; charset=utf-8")
  expect_identical(h$`test-code-path`, "C++")
  expect_identical(r$content, index_file_content)

  r <- fetch(local_url("/override", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 404)
  expect_identical(h$`test-code-path`, "R")
  expect_identical(rawToChar(r$content), "404 file not found: /override")

  r <- fetch(local_url("/override/index.html", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 200)
  expect_identical(h$`test-code-path`, "C++2")
  expect_identical(h$`content-type`, "text/html; charset=ISO-8859-1")

  r <- fetch(local_url("/unset", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 200)
  expect_false("test-code-path" %in% names(h))
  expect_identical(h$`content-type`, "text/html")
  expect_identical(r$content, index_file_content)

  r <- fetch(local_url("/unset/index.html", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 200)
  expect_false("test-code-path" %in% names(h))
  expect_identical(h$`content-type`, "text/html")
  expect_identical(r$content, index_file_content)
})


test_that("Excluding subpaths", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      call = function(req) {
        # Return a 403 for the R code path; the C++ code path will return 404
        # for missing files.
        return(list(
          status = 403,
          headers = list("Test-Code-Path" = "R"),
          body = paste0("403 forbidden: ", req$PATH_INFO)
        ))
      },
      staticPaths = list(
        "/" = staticPath(test_path("apps/content")),
        "/exclude" = excludeStaticPath(),
        "/subdi" = excludeStaticPath(),

        "/a" = staticPath(test_path("apps/content")),
        "/a/exclude" = excludeStaticPath(),
        "/a/mtcars.csv" = excludeStaticPath()
      )
    )
  )
  on.exit(s$stop())

  exclude_subdir_index_file_content <- raw_file_content(test_path("apps/content/exclude/subdir/index.html"))

  # Basic test
  r <- fetch(local_url("/", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, index_file_content)
  r <- fetch(local_url("/subdir", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, subdir_index_file_content)
  r <- fetch(local_url("/exclude", s$getPort()))
  expect_equal(r$status_code, 403)
  r <- fetch(local_url("/exclude/index.html", s$getPort()))
  expect_equal(r$status_code, 403)
  r <- fetch(local_url("/exclude/subdir", s$getPort()))
  expect_equal(r$status_code, 403)
  r <- fetch(local_url("/exclude/subdir/index.html", s$getPort()))
  expect_equal(r$status_code, 403)

  # Include directories underneath excluded dir.
  s$setStaticPath("exclude/include" = test_path("apps/content"))
  r <- fetch(local_url("/exclude/include", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, index_file_content)

  s$setStaticPath("exclude/subdir" = test_path("apps/content/exclude/subdir"))
  r <- fetch(local_url("/exclude/subdir", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, exclude_subdir_index_file_content)

  # A file that is not specifically excluded will use the C++ 404 path.
  r <- fetch(local_url("/nonexistent.txt", s$getPort()))
  expect_equal(r$status_code, 404)

  # Fallthrough. Behavior should be unchanged except for non-existent files that
  # are NOT in the excluded path.
  s$setStaticPathOption(fallthrough = TRUE)
  # Now, a file that is not specifically excluded will use the R 403 path
  r <- fetch(local_url("/nonexistent.txt", s$getPort()))
  expect_equal(r$status_code, 403)
  s$setStaticPathOption(fallthrough = FALSE)

  # Partial name matching ("subdi" was excluded) doesn't work.
  r <- fetch(local_url("/subdir", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, subdir_index_file_content)

  # Specific files
  r <- fetch(local_url("/a/", s$getPort()))
  expect_equal(r$status_code, 200)
  r <- fetch(local_url("/a/mtcars.csv", s$getPort()))
  expect_equal(r$status_code, 403)
  # A file that is not specifically excluded will use the C++ 404 path.
  r <- fetch(local_url("/file/nonexistent.txt", s$getPort()))
  expect_equal(r$status_code, 404)
})

test_that("Header validation", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      call = function(req) {
        if (!identical(req$HTTP_TEST_VALIDATION, "aaa")) {
          return(list(
            status = 403,
            headers = list("Test-Code-Path" = "R"),
            body = "403 Forbidden\n"
          ))
        }
        return(list(
          status = 200,
          headers = list("Test-Code-Path" = "R"),
          body = "200 OK\n"
        ))
      },
      staticPaths = list(
        "/default" = staticPath(test_path("apps/content")),
        # This path overrides validation
        "/override" = staticPath(
          test_path("apps/content"),
          validation = c('"Test-Validation-1" == "bbb"')
        ),
        # This path unsets validation
        "/unset" = staticPath(
          test_path("apps/content"),
          validation = character()
        ),
        # Fall through to R
        "/fallthrough" = staticPath(
          test_path("apps/content"),
          fallthrough = TRUE
        )
      ),
      staticPathOptions = staticPathOptions(
        headers = list("Test-Code-Path" = "C++"),
        validation = c('"Test-Validation" == "aaa"')
      )
    )
  )
  on.exit(s$stop())

  r <- fetch(local_url("/default", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 403)
  # This header doesn't get set. Should it?
  expect_false("test-code-path" %in% names(h))
  expect_identical(rawToChar(r$content), "403 Forbidden\n")

  r <- fetch(local_url("/default", s$getPort()),
    handle_setheaders(new_handle(), "test-validation" = "aaa"))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 200)
  expect_identical(h$`test-code-path`, "C++")
  expect_identical(r$content, index_file_content)

  # Check case insensitive
  r <- fetch(local_url("/default", s$getPort()),
    handle_setheaders(new_handle(), "tesT-ValidatioN" = "aaa"))
  expect_equal(r$status_code, 200)

  r <- fetch(local_url("/unset", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 200)
  expect_identical(h$`test-code-path`, "C++")
  expect_identical(r$content, index_file_content)

  # When fallthrough=TRUE, the header validation is still checked before falling
  # through to the R code path.
  r <- fetch(local_url("/fallthrough/missingfile", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 403)
  # This header doesn't get set. Should it?
  expect_false("test-code-path" %in% names(h))
  expect_identical(rawToChar(r$content), "403 Forbidden\n")

  r <- fetch(local_url("/fallthrough/missingfile", s$getPort()),
    handle_setheaders(new_handle(), "test-validation" = "aaa"))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 200)
  expect_identical(h$`test-code-path`, "R")
  expect_identical(rawToChar(r$content), "200 OK\n")
})


test_that("Dynamically changing paths", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      call = function(req) {
        list(
          status = 500,
          headers = list("Test-Code-Path" = "R"),
          body = "500 Internal Server Error\n"
        )
      },
      staticPaths = list(
        "/static" = test_path("apps/content")
      )
    )
  )
  on.exit(s$stop())

  r <- fetch(local_url("/static", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, index_file_content)

  # Replace with different static path and options
  s$setStaticPath(
    "/static" = staticPath(
      test_path("apps/content_1"),
      indexhtml = FALSE
    )
  )

  r <- fetch(local_url("/static", s$getPort()))
  expect_equal(r$status_code, 404)

  r <- fetch(local_url("/static/index.html", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, index_file_1_content)

  # Remove static path
  s$removeStaticPath("/static")

  expect_equal(length(s$getStaticPaths()), 0)

  r <- fetch(local_url("/static", s$getPort()))
  expect_equal(r$status_code, 500)
  h <- parse_headers_list(r$headers)
  expect_identical(h$`test-code-path`, "R")
  expect_identical(rawToChar(r$content), "500 Internal Server Error\n")

  # Add static path
  s$setStaticPath(
    "/static_new" = test_path("apps/content")
  )
  r <- fetch(local_url("/static_new", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(r$content, index_file_content)
})


test_that("Dynamically changing options", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      call = function(req) {
        list(
          status = 500,
          headers = list("Test-Code-Path" = "R"),
          body = "500 Internal Server Error\n"
        )
      },
      staticPaths = list(
        "/static" = test_path("apps/content")
      )
    )
  )
  on.exit(s$stop())

  r <- fetch(local_url("/static", s$getPort()))
  expect_equal(r$status_code, 200)

  s$setStaticPathOption(indexhtml = FALSE)
  r <- fetch(local_url("/static", s$getPort()))
  expect_equal(r$status_code, 404)

  s$setStaticPathOption(fallthrough = TRUE)
  r <- fetch(local_url("/static", s$getPort()))
  expect_equal(r$status_code, 500)

  s$setStaticPathOption(
    indexhtml = TRUE,
    headers = list("Test-Headers" = "aaa"),
    validation = c('"Test-Validation" == "aaa"')
  )
  r <- fetch(local_url("/static", s$getPort()))
  expect_equal(r$status_code, 403)
  r <- fetch(local_url("/static", s$getPort()),
    handle_setheaders(new_handle(), "test-validation" = "aaa"))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 200)
  expect_identical(h$`test-headers`, "aaa")

  # Unset some options
  s$setStaticPathOption(
    headers = list(),
    validation = character()
  )
  r <- fetch(local_url("/static", s$getPort()))
  h <- parse_headers_list(r$headers)
  expect_equal(r$status_code, 200)
  expect_false("test-headers" %in% h)
})


test_that("Escaped characters in paths", {
  # Need to create files with weird names
  static_dir <- tempfile("httpuv_test")
  dir.create(static_dir)
  # Use writeBin() instead of cat() because in Windows, cat() will convert "\n"
  # to "\r\n".
  writeBin(charToRaw("This is file content.\n"), file.path(static_dir, "file with space.txt"))
  on.exit(unlink(static_dir, recursive = TRUE))


  s <- startServer("127.0.0.1", randomPort(),
    list(
      call = function(req) {
        list(
          status = 500,
          headers = list("Test-Code-Path" = "R"),
          body = "500 Internal Server Error\n"
        )
      },
      staticPaths = list(
        "/static" = static_dir
      )
    )
  )
  on.exit(s$stop(), add = TRUE)

  r <- fetch(local_url("/static/file%20with%20space.txt", s$getPort()))
  expect_equal(r$status_code, 200)
  expect_identical(rawToChar(r$content), "This is file content.\n")
})


test_that("Paths with ..", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      call = function(req) {
        list(
          status = 404,
          headers = list("Test-Code-Path" = "R"),
          body = "404 Not Found\n"
        )
      },
      staticPaths = list(
        "/static" = test_path("apps/content")
      )
    )
  )
  on.exit(s$stop())

  # Need to use http_request_con() instead of fetch() to send custom requests
  # with "..".
  res <- http_request_con("GET /", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 404 Not Found")
  expect_true(any(grepl("^Test-Code-Path: R$", res, ignore.case = TRUE)))

  res <- http_request_con("GET /static", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 200 OK")

  # The presence of a ".." path segment results in a 400.
  res <- http_request_con("GET /static/..", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 400 Bad Request")

  res <- http_request_con("GET /static/../", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 400 Bad Request")

  res <- http_request_con("GET /static/../static", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 400 Bad Request")

  # ".." is valid as part of a path segment (but we'll get 404's since the files
  # don't actually exist).
  res <- http_request_con("GET /static/..foo", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 404 Not Found")
  expect_false(any(grepl("^Test-Code-Path: R$", res, ignore.case = TRUE)))

  res <- http_request_con("GET /static/foo..", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 404 Not Found")
  expect_false(any(grepl("^Test-Code-Path: R$", res, ignore.case = TRUE)))

  res <- http_request_con("GET /static/foo../", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 404 Not Found")
  expect_false(any(grepl("^Test-Code-Path: R$", res, ignore.case = TRUE)))


})

test_that("Paths with backslash", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      call = function(req) {
        list(
          status = 400,
          headers = list("Test-Code-Path" = "R"),
          body = "400 Bad Request\n"
        )
      },
      staticPaths = list(
        "/static" = test_path("apps/content")
      )
    )
  )
  on.exit(s$stop())

  # Need to use http_request_con() instead of fetch() to send custom requests
  # with "..".
  # When a backslash is in path, should fall through to R code path.

  # Raw backslash
  res <- http_request_con("GET /static\\index.html", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 400 Bad Request")
  expect_true(any(grepl("^Test-Code-Path: R$", res, ignore.case = TRUE)))

  # Escaped backslash
  res <- http_request_con("GET /static%5cindex.html", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 400 Bad Request")
  expect_true(any(grepl("^Test-Code-Path: R$", res, ignore.case = TRUE)))

  # Raw backslash with ..
  res <- http_request_con("GET /static/..\\index.html", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 400 Bad Request")
  expect_true(any(grepl("^Test-Code-Path: R$", res, ignore.case = TRUE)))

  # Escaped backslash with ..
  res <- http_request_con("GET /static/..%5cindex.html", "127.0.0.1", s$getPort())
  expect_identical(res[1], "HTTP/1.1 400 Bad Request")
  expect_true(any(grepl("^Test-Code-Path: R$", res, ignore.case = TRUE)))
})

test_that("HEAD, POST, PUT requests", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      call = function(req) {
        list(
          status = 404,
          headers = list("Test-Code-Path" = "R"),
          body = "404 Not Found\n"
        )
      },
      staticPaths = list(
        "/static" = test_path("apps/content")
      )
    )
  )
  on.exit(s$stop())

  # The GET results, for comparison to HEAD.
  r_get <- fetch(local_url("/static", s$getPort()), gzip = FALSE)
  h_get <- parse_headers_list(r_get$headers)

  # HEAD is OK.
  # Note the weird interface for a HEAD request:
  # https://github.com/jeroen/curl/issues/24
  r <- fetch(local_url("/static", s$getPort()), new_handle(nobody = TRUE), gzip = FALSE)
  expect_equal(r$status_code, 200)
  expect_true(length(r$content) == 0)  # No message body for HEAD
  h <- parse_headers_list(r$headers)
  # Headers should match GET request, except for date.
  expect_identical(h[setdiff(names(h), "date")], h_get[setdiff(names(h_get), "date")])

  # POST and PUT are not OK
  r <- fetch(local_url("/static", s$getPort()),
    handle_setopt(new_handle(), customrequest = "POST"))
  expect_equal(r$status_code, 400)

  r <- fetch(local_url("/static", s$getPort()),
    handle_setopt(new_handle(), customrequest = "PUT"))
  expect_equal(r$status_code, 400)
})



test_that("Last-Modified and If-Modified-Since headers", {
  s <- startServer("127.0.0.1", randomPort(),
    list(
      staticPaths = list(
        "/" = staticPath(
          test_path("apps/content"),
          headers = list(
            "ETag" = "abc",
            "Cache-Control" = "max-age=12345",
            "Other" = "xyz"
          )
        )
      )
    )
  )
  on.exit(s$stop())

  # mtime of the target file, rounded down to nearest second.
  file_mtime <- as.POSIXct(trunc(file.info(test_path("apps/content/mtcars.csv"))$mtime))

  # First time retrieving: no Last-Modified header.
  r <- fetch(local_url("/mtcars.csv", s$getPort()))
  h <- parse_headers_list(r$headers)
  http_mtime <- r$modified
  expect_equal(file_mtime, http_mtime)


  # Use the Last-Modified value in the If-Modified-Since header.
  r1 <- fetch(local_url("/mtcars.csv", s$getPort()),
    handle_setheaders(new_handle(),
      "If-Modified-Since" = h$`last-modified`
    )
  )
  expect_identical(r1$status_code, 304L)
  expect_true(length(r1$content) == 0)
  h1 <- parse_headers_list(r1$headers)
  # A 304 response should contain only the following headers (and must contain
  # them if the corresponding 200 response would have them):
  # Cache-Control, Content-Location, Date, ETag, Expires, Vary
  # https://httpstatuses.com/304
  expect_identical(h[c("cache-control", "etag")], h1[c("cache-control", "etag")])
  # The Date header differs from the previous response because the request was
  # made at a different time. We just need to check that it's present.
  expect_true("date" %in% names(h1))


  # The mtime plus 1 second should result in a 304.
  r1 <- fetch(local_url("/mtcars.csv", s$getPort()),
    handle_setheaders(new_handle(),
      "If-Modified-Since" = http_date_string(file_mtime + 1)
    )
  )
  expect_identical(r1$status_code, 304L)


  # Last-Modified header minus 1 second should result in a regular 200 response.
  r1 <- fetch(local_url("/mtcars.csv", s$getPort()),
    handle_setheaders(new_handle(),
      "If-Modified-Since" = http_date_string(file_mtime - 1)
    )
  )
  expect_identical(r1$status_code, 200L)
  h1 <- parse_headers_list(r1$headers)
  expect_identical(h[setdiff(names(h), "date")], h1[setdiff(names(h1), "date")])


  # Malformed If-Modified-Since value should be ignored.
  #
  # First, a date far in the future should result in 304. Note that the 2038
  # date is used here because on 32-bit Windows, dates that are beyond
  # 2038-01-19 will overflow and wrap around, and this request will get a 200
  # instead of 304. Other platforms seem not to have this limitation.
  r1 <- fetch(local_url("/mtcars.csv", s$getPort()),
    handle_setheaders(new_handle(),
      "If-Modified-Since" = "Mon, 01 Jan 2038 12:00:00 GMT"
    )
  )
  expect_identical(r1$status_code, 304L)
  # Next, almost the same date, but slightly malformed, should result in 200.
  r1 <- fetch(local_url("/mtcars.csv", s$getPort()),
    handle_setheaders(new_handle(),
      "If-Modified-Since" = "Mon, 01 Jan 2038 12:100:00 GMT"
    )
  )
  expect_identical(r1$status_code, 200L)
})


test_that("Paths with non-ASCII characters", {
  # Workaround for https://github.com/rstudio/httpuv/issues/264
  # On Unix platforms that are using a non-UTF-8 locale, don't do these tests.
  testthat::skip_if(
    .Platform$OS.type == "unix" && !l10n_info()[["UTF-8"]],
    "Skipping non-ASCII path tests on UTF-8 Unix system"
  )

  # "apps/fü", in UTF-8 encoding.
  nonascii_path <- test_path("apps/f\U00FC")
  dir.create(nonascii_path)
  on.exit(unlink(nonascii_path, recursive = TRUE))

  index_file_path <- file.path(nonascii_path, "index.html")
  writeLines("Hello world!", index_file_path)
  file_content <- raw_file_content(index_file_path)

  s <- startServer("0.0.0.0", randomPort(),
    list(
      call = function(req) {
        list(
          status = 200L,
          headers = list('Content-Type' = 'text/html'),
          body = "R code path"
        )
      },
      staticPaths = list(
        "/f\U00FC" = nonascii_path,
        "/foo" = nonascii_path
      )
    )
  )
  on.exit(s$stop(), add = TRUE)

  # URL-encoded non-ASCII URL path, which maps to non-ASCII local path.
  r <- fetch(local_url("/f%C3%BC", s$getPort()))
  expect_identical(r$status_code, 200L)
  expect_identical(r$content, file_content)

  # ASCII URL path, which maps to non-ASCII local path.
  r <- fetch(local_url("/foo", s$getPort()))
  expect_identical(r$status_code, 200L)
  expect_identical(r$content, file_content)
})
rstudio/httpuv documentation built on March 29, 2024, 2:23 p.m.