1#' Create a staticPath object 2#' 3#' The \code{staticPath} function creates a \code{staticPath} object. Note that 4#' if any of the arguments (other than \code{path}) are \code{NULL}, then that 5#' means that for this particular static path, it should inherit the behavior 6#' from the staticPathOptions set for the application as a whole. 7#' 8#' The \code{excludeStaticPath} function tells the application to ignore a 9#' particular path for static serving. This is useful when you want to include a 10#' path for static serving (like \code{"/"}) but then exclude a subdirectory of 11#' it (like \code{"/dynamic"}) so that the subdirectory will always be passed to 12#' the R code for handling requests. \code{excludeStaticPath} can be used not 13#' only for directories; it can also exclude specific files. 14#' 15#' @param path The local path. 16#' @inheritParams staticPathOptions 17#' 18#' @seealso \code{\link{staticPathOptions}}. 19#' 20#' @export 21staticPath <- function( 22 path, 23 indexhtml = NULL, 24 fallthrough = NULL, 25 html_charset = NULL, 26 headers = NULL, 27 validation = NULL 28) { 29 if (!is.character(path) || length(path) != 1 || path == "") { 30 stop("`path` must be a non-empty string.") 31 } 32 33 path <- normalizePath(path, winslash = "/", mustWork = TRUE) 34 path <- enc2utf8(path) 35 36 structure( 37 list( 38 path = path, 39 options = normalizeStaticPathOptions(staticPathOptions( 40 indexhtml = indexhtml, 41 fallthrough = fallthrough, 42 html_charset = html_charset, 43 headers = headers, 44 validation = validation, 45 exclude = FALSE 46 )) 47 ), 48 class = "staticPath" 49 ) 50} 51 52#' @rdname staticPath 53#' @export 54excludeStaticPath <- function() { 55 structure( 56 list( 57 path = "", 58 options = staticPathOptions( 59 indexhtml = NULL, 60 fallthrough = NULL, 61 html_charset = NULL, 62 headers = NULL, 63 validation = NULL, 64 exclude = TRUE 65 ) 66 ), 67 class = "staticPath" 68 ) 69} 70 71as.staticPath <- function(path) { 72 UseMethod("as.staticPath", path) 73} 74 75as.staticPath.staticPath <- function(path) { 76 path 77} 78 79as.staticPath.character <- function(path) { 80 staticPath(path) 81} 82 83as.staticPath.default <- function(path) { 84 stop("Cannot convert object of class ", class(path), " to a staticPath object.") 85} 86 87#' @export 88print.staticPath <- function(x, ...) { 89 cat(format(x, ...), sep = "\n") 90 invisible(x) 91} 92 93#' @export 94format.staticPath <- function(x, ...) { 95 ret <- paste0( 96 "<staticPath>\n", 97 " Local path: ", x$path, "\n", 98 format_opts(x$options) 99 ) 100} 101 102#' Create options for static paths 103#' 104#' 105#' @param indexhtml If an index.html file is present, should it be served up 106#' when the client requests the static path or any subdirectory? 107#' @param fallthrough With the default value, \code{FALSE}, if a request is made 108#' for a file that doesn't exist, then httpuv will immediately send a 404 109#' response from the background I/O thread, without needing to call back into 110#' the main R thread. This offers the best performance. If the value is 111#' \code{TRUE}, then instead of sending a 404 response, httpuv will call the 112#' application's \code{call} function, and allow it to handle the request. 113#' @param html_charset When HTML files are served, the value that will be 114#' provided for \code{charset} in the Content-Type header. For example, with 115#' the default value, \code{"utf-8"}, the header is \code{Content-Type: 116#' text/html; charset=utf-8}. If \code{""} is used, then no \code{charset} 117#' will be added in the Content-Type header. 118#' @param headers Additional headers and values that will be included in the 119#' response. 120#' @param validation An optional validation pattern. Presently, the only type of 121#' validation supported is an exact string match of a header. For example, if 122#' \code{validation} is \code{'"abc" = "xyz"'}, then HTTP requests must have a 123#' header named \code{abc} (case-insensitive) with the value \code{xyz} 124#' (case-sensitive). If a request does not have a matching header, than httpuv 125#' will give a 403 Forbidden response. If the \code{character(0)} (the 126#' default), then no validation check will be performed. 127#' @param exclude Should this path be excluded from static serving? (This is 128#' only to be used internally, for \code{\link{excludeStaticPath}}.) 129#' 130#' @export 131staticPathOptions <- function( 132 indexhtml = TRUE, 133 fallthrough = FALSE, 134 html_charset = "utf-8", 135 headers = list(), 136 validation = character(0), 137 exclude = FALSE 138) { 139 res <- structure( 140 list( 141 indexhtml = indexhtml, 142 fallthrough = fallthrough, 143 html_charset = html_charset, 144 headers = headers, 145 validation = validation, 146 exclude = exclude 147 ), 148 class = "staticPathOptions" 149 ) 150 151 normalizeStaticPathOptions(res) 152} 153 154#' @export 155print.staticPathOptions <- function(x, ...) { 156 cat(format(x, ...), sep = "\n") 157 invisible(x) 158} 159 160 161#' @export 162format.staticPathOptions <- function(x, ...) { 163 paste0( 164 "<staticPathOptions>\n", 165 format_opts(x, format_empty = "<none>") 166 ) 167} 168 169format_opts <- function(x, format_empty = "<inherit>") { 170 format_option <- function(opt) { 171 if (is.null(opt) || length(opt) == 0) { 172 format_empty 173 174 } else if (!is.null(names(opt))) { 175 # Named character vector 176 lines <- mapply( 177 function(name, value) paste0(' "', name, '" = "', value, '"'), 178 names(opt), 179 opt, 180 SIMPLIFY = FALSE, 181 USE.NAMES = FALSE 182 ) 183 184 lines <- paste(as.character(lines), collapse = "\n") 185 lines <- paste0("\n", lines) 186 lines 187 188 } else { 189 paste(as.character(opt), collapse = " ") 190 } 191 } 192 ret <- paste0( 193 " Use index.html: ", format_option(x$indexhtml), "\n", 194 " Fallthrough to R: ", format_option(x$fallthrough), "\n", 195 " HTML charset: ", format_option(x$html_charset), "\n", 196 " Extra headers: ", format_option(x$headers), "\n", 197 " Validation params: ", format_option(x$validation), "\n", 198 " Exclude path: ", format_option(x$exclude), "\n" 199 ) 200} 201 202 203# This function always returns a named list of staticPath objects. The names 204# will all start with "/". The input can be a named character vector or a 205# named list containing a mix of strings and staticPath objects. This function 206# is idempotent. 207normalizeStaticPaths <- function(paths) { 208 if (is.null(paths) || length(paths) == 0) { 209 return(list()) 210 } 211 212 if (any_unnamed(paths)) { 213 stop("paths must be a named character vector, a named list containing strings and staticPath objects, or NULL.") 214 } 215 216 if (!is.character(paths) && !is.list(paths)) { 217 stop("paths must be a named character vector, a named list containing strings and staticPath objects, or NULL.") 218 } 219 220 # Convert to list of staticPath objects. Need this verbose wrapping of 221 # as.staticPath because of S3 dispatch for non-registered methods. 222 paths <- lapply(paths, function(path) as.staticPath(path)) 223 224 # Make sure URL paths have a leading '/' and no trailing '/'. 225 names(paths) <- vapply(names(paths), function(path) { 226 path <- enc2utf8(path) 227 228 if (path == "") { 229 stop("All paths must be non-empty strings.") 230 } 231 # Ensure there's a leading / for every path 232 if (substr(path, 1, 1) != "/") { 233 path <- paste0("/", path) 234 } 235 # Strip trailing slashes, except when the path is just "/". 236 if (path != "/") { 237 path <- sub("/+$", "", path) 238 } 239 240 path 241 }, "") 242 243 paths 244} 245 246# Takes a staticPathOptions object and modifies it so that the resulting 247# object is easier to work with on the C++ side. The resulting object is not 248# meant to be modified on the R side. This function is idempotent; if the 249# object has already been normalized, it will not be modified. For each entry, 250# a NULL means to inherit. 251normalizeStaticPathOptions <- function(opts) { 252 if (isTRUE(attr(opts, "normalized", exact = TRUE))) { 253 return(opts) 254 } 255 256 # html_charset can accept "" or character(0). But on the C++ side, we want 257 # "". 258 if (!is.null(opts$html_charset)) { 259 if (length(opts$html_charset) == 0) { 260 opts$html_charset <- "" 261 } 262 } 263 264 if (!is.null(opts$exclude)) { 265 if (!is.logical(opts$exclude) || length(opts$exclude) != 1) { 266 stop("`exclude` option must be TRUE or FALSE.") 267 } 268 } 269 270 # Can be a named list of strings, or a named character vector. On the C++ 271 # side, we want a named character vector. 272 if (is.list(opts$headers)) { 273 # Convert list to named character vector 274 opts$headers <- unlist(opts$headers, recursive = FALSE) 275 # Special case: if opts$headers was an empty list before unlist(), it is 276 # now NULL. Replace it with an empty named character vector. 277 if (length(opts$headers) == 0) { 278 opts$headers <- c(a="a")[0] 279 } 280 281 if (!is.character(opts$headers) || any_unnamed(opts$headers)) { 282 stop("`headers` option must be a named list or character vector.") 283 } 284 } 285 286 if (!is.null(opts$validation)) { 287 if (!is.character(opts$validation) || length(opts$validation) > 1) { 288 stop("`validation` option must be a character vector with zero or one element.") 289 } 290 291 # Both "" and character(0) result in character(0). Length-1 strings other 292 # than "" will be parsed. 293 if (length(opts$validation) == 1) { 294 if (opts$validation == "") { 295 opts$validation <- character(0) 296 297 } else { 298 fail <- FALSE 299 tryCatch( 300 p <- parse(text = opts$validation)[[1]], 301 error = function(e) fail <<- TRUE 302 ) 303 if (!fail) { 304 if (length(p) != 3 || 305 p[[1]] != as.symbol("==") || 306 !is.character(p[[2]]) || 307 length(p[[2]]) != 1 || 308 !is.character(p[[3]]) || 309 length(p[[3]]) != 1) 310 { 311 fail <- TRUE 312 } 313 } 314 if (fail) { 315 stop("`validation` must be a string of the form: '\"xxx\" == \"yyy\"'") 316 } 317 318 # Turn it into a char vector for easier processing in C++ 319 opts$validation <- as.character(p) 320 } 321 } 322 } 323 324 attr(opts, "normalized") <- TRUE 325 opts 326} 327