1#' Serve static files under a directory 2#' 3#' If there is an \file{index.html} under this directory, it will be displayed; 4#' otherwise the list of files is displayed, with links on their names. After we 5#' run this function, we can go to \samp{http://localhost:port} to browse the 6#' web pages either created from R or read from HTML files. 7#' 8#' \code{httd()} is a pure static server, and \code{httw()} is similar but 9#' watches for changes under the directory: if an HTML file is being viewed in 10#' the browser, and any files are modified under the directory, the HTML page 11#' will be automatically refreshed. 12#' @inheritParams server_config 13#' @param ... server configurations passed to \code{\link{server_config}()} 14#' @export 15#' @references \url{https://github.com/yihui/servr} 16#' @examples #' see https://github.com/yihui/servr for command line usage 17#' # or run inside an R session 18#' if (interactive()) servr::httd() 19httd = function(dir = '.', ...) { 20 dir = normalizePath(dir, mustWork = TRUE) 21 if (dir != '.') { 22 owd = setwd(dir); on.exit(setwd(owd)) 23 } 24 res = server_config(dir, ...) 25 app = list(call = serve_dir(dir)) 26 res$start_server(app) 27 invisible(res) 28} 29 30#' @param watch a directory under which \code{httw()} is to watch for changes; 31#' if it is a relative path, it is relative to the \code{dir} argument 32#' @param pattern a regular expression passed to \code{\link{list.files}()} to 33#' determine the files to watch 34#' @param all_files whether to watch all files including the hidden files 35#' @param filter a function to filter the file paths returned from 36#' \code{list.files()} (e.g., you can exclude certain files from the watch 37#' list) 38#' @param handler a function to be called every time any files are changed or 39#' added under the directory; its argument is a character vector of the 40#' filenames of the files modified or added 41#' @rdname httd 42#' @export 43httw = function( 44 dir = '.', watch = '.', pattern = NULL, all_files = FALSE, filter = NULL, 45 handler = NULL, ... 46) { 47 dynamic_site(dir, ..., build = watch_dir( 48 watch, pattern = pattern, all_files = all_files, filter = filter, handler = handler 49 )) 50} 51 52watch_dir = function( 53 dir = '.', pattern = NULL, all_files = FALSE, filter = NULL, handler = NULL 54) { 55 cwd = getwd() 56 mtime = function(dir) { 57 owd = setwd(cwd); on.exit(setwd(owd), add = TRUE) 58 info = file.info(list.files( 59 dir, pattern, all.files = all_files, full.names = TRUE, recursive = TRUE, 60 no.. = TRUE 61 ))[, 'mtime', drop = FALSE] 62 if (is.function(filter)) info = info[filter(rownames(info)), , drop = FALSE] 63 rownames(info) = gsub('^[.]/', '', rownames(info)) 64 info 65 } 66 info = mtime(dir) 67 function(...) { 68 info2 = mtime(dir) 69 changed = !identical(info, info2) 70 if (changed) { 71 if (is.function(handler)) { 72 f1 = rownames(info) 73 f2 = rownames(info2) 74 f3 = setdiff(f2, f1) # new files 75 f4 = intersect(f1, f2) # old files 76 f5 = f4[info[f4, 1] != info2[f4, 1]] # modified files 77 info <<- info2 78 handler(c(f3, na.omit(f5))) 79 info2 = mtime(dir) 80 } 81 info <<- info2 82 } 83 changed 84 } 85} 86 87#' Server configurations 88#' 89#' The server functions in this package are configured through this function. 90#' @param dir The root directory to serve. 91#' @param port The TCP port number. If it is not explicitly set, the default 92#' value will be looked up in this order: First, the command line argument of 93#' the form \code{-pNNNN} (N is a digit from 0 to 9). If it was passed to R 94#' when R was started, \code{NNNN} will be used as the port number. Second, 95#' the environment variable \code{R_SERVR_PORT}. Third, the global option 96#' \code{servr.port} (e.g., \code{options(servr.port = 4322)}). If none of 97#' these command-line arguments, variables, or options were set, the default 98#' port will be \code{4321}. If this port is not available, a random available 99#' port will be used. 100#' @param browser Whether to launch the default web browser. By default, it is 101#' \code{TRUE} if the R session is \code{\link{interactive}()}, or when a 102#' command line argument \code{-b} was passed to R (see 103#' \code{\link{commandArgs}()}). N.B. the RStudio viewer is used as the web 104#' browser if available. 105#' @param daemon Whether to launch a daemonized server (the server does not 106#' block the current R session) or a blocking server. By default, it is the 107#' global option \code{getOption('servr.daemon')} (e.g., you can set 108#' \code{options(servr.daemon = TRUE)}); if this option was not set, 109#' \code{daemon = TRUE} if a command line argument \code{-d} was passed to R 110#' (through \command{Rscript}), or the server is running in an interactive R 111#' session. 112#' @param interval The time interval used to check if an HTML page needs to be 113#' rebuilt (by default, it is checked every second). 114#' @param baseurl The base URL (the full URL will be 115#' \code{http://host:port/baseurl}). 116#' @param initpath The initial path in the URL (e.g. you can open a specific 117#' HTML file initially). 118#' @param hosturl A function that takes the host address and returns a character 119#' string to be used in the URL, e.g., \code{function(host) { if (host == 120#' '127.0.0.1') 'localhost' else host}} to convert \code{127.0.0.1} to 121#' \code{localhost} in the URL. 122#' @param verbose Whether to print messages when launching the server. 123#' @inheritParams httpuv::startServer 124#' @export 125#' @return A list of configuration information of the form \code{list(host, 126#' port, start_server = function(app) {}, ...)}. 127server_config = function( 128 dir = '.', host = getOption('servr.host', '127.0.0.1'), port, browser, daemon, 129 interval = getOption('servr.interval', 1), baseurl = '', 130 initpath = '', hosturl = identity, verbose = TRUE 131) { 132 cargs = commandArgs(TRUE) 133 if (missing(browser)) browser = interactive() || '-b' %in% cargs || is_rstudio() 134 if (missing(port)) port = if (length(port <- grep('^-p[0-9]{4,}$', cargs, value = TRUE)) == 1) { 135 sub('^-p', '', port) 136 } else { 137 port = Sys.getenv('R_SERVR_PORT', NA) 138 if (is.na(port)) getOption('servr.port', random_port()) else port 139 } 140 port = as.integer(port) 141 if (missing(daemon)) daemon = getOption('servr.daemon', ('-d' %in% cargs) || interactive()) 142 # rstudio viewer cannot display a page served at 0.0.0.0; use 127.0.0.1 instead 143 host2 = if (host == '0.0.0.0' && is_rstudio()) '127.0.0.1' else host 144 url = sprintf('http://%s:%d', hosturl(host2), port) 145 baseurl = gsub('^/+', '', baseurl) 146 if (baseurl != '') url = paste0(url, '/', baseurl) 147 url = paste0(url, if (initpath != '' && !grepl('^/', initpath)) '/', initpath) 148 browsed = FALSE 149 servrEnv$browse = browse = function(reopen = FALSE) { 150 if (browsed && !reopen) return(invisible(url)) 151 if (browser || reopen) browseURL(url, browser = get_browser()) 152 browsed <<- TRUE 153 if (verbose && !reopen) message('Serving the directory ', dir, ' at ', url) 154 } 155 server = NULL 156 list( 157 host = host, port = port, interval = interval, url = url, daemon = daemon, 158 start_server = function(app) { 159 id = startServer(host, port, app) 160 if (verbose && daemon) daemon_hint(id); browse() 161 server <<- id 162 if (!daemon) while (TRUE) { 163 httpuv::service(); Sys.sleep(0.001) 164 } 165 invisible(id) 166 }, 167 stop_server = function() { 168 if (is.null(server)) stop('The server has not been started yet.') 169 stopServer(server) 170 }, 171 browse = browse 172 ) 173} 174 175serve_dir = function(dir = '.') function(req) { 176 owd = setwd(dir); on.exit(setwd(owd), add = TRUE) 177 path = decode_path(req) 178 status = 200L 179 180 if (grepl('^/', path)) { 181 path = paste('.', path, sep = '') # the requested file 182 } else if (path == '') path = '.' 183 body = if (file_test('-d', path)) { 184 # ensure a trailing slash if the requested dir does not have one 185 if (path != '.' && !grepl('/$', path)) return(list( 186 status = 301L, body = '', headers = list( 187 'Location' = sprintf('%s/', req$PATH_INFO) 188 ) 189 )) 190 type = 'text/html' 191 if (file.exists(idx <- file.path(path, 'index.html'))) { 192 readLines(idx, warn = FALSE) 193 } else { 194 d = file.info(list.files(path, all.files = TRUE, full.names = TRUE)) 195 title = escape_html(path) 196 html_doc(c(sprintf('<h1>Index of %s</h1>', title), fileinfo_table(d)), 197 title = title) 198 } 199 } else { 200 # use the custom 404.html only if the path looks like a directory or .html 201 try_404 = function(path) { 202 file.exists('404.html') && grepl('(/|[.]html)$', path, ignore.case = TRUE) 203 } 204 # FIXME: using 302 here because 404.html may contain relative paths, e.g. if 205 # /foo/bar/hi.html gives 404, I cannot just read 404.html and display it, 206 # because it will be treated as /foo/bar/404.html; if 404.html contains 207 # paths like ./css/style.css, I don't know how to let the browser know that 208 # it means /css/style.css instead of /foo/bar/css/style.css 209 if (!file.exists(path)) 210 return(if (try_404(path)) list( 211 status = 302L, body = '', headers = list('Location' = '/404.html') 212 ) else list( 213 status = 404L, headers = list('Content-Type' = 'text/plain'), 214 body = paste2('Not found:', path) 215 )) 216 217 type = guess_type(path) 218 range = req$HTTP_RANGE 219 220 if (is.null(range)) { 221 read_raw(path) 222 } else { 223 range = strsplit(range, split = "(=|-)")[[1]] 224 b2 = as.numeric(range[2]) 225 if (length(range) == 2 && range[1] == "bytes") { 226 # open-ended range request 227 # e.g. Chrome sends the range reuest 'bytes=0-' 228 # http://stackoverflow.com/a/18745164/559676 229 range[3] = file_size(path) - 1 230 } 231 b3 = as.numeric(range[3]) 232 if (length(range) < 3 || (range[1] != "bytes") || (b2 >= b3)) 233 return(list( 234 status = 416L, headers = list('Content-Type' = 'text/plain'), 235 body = 'Requested range not satisfiable\r\n' 236 )) 237 238 status = 206L # partial content 239 # type may also need to be changed 240 # e.g. to "multipart/byteranges" if multipart range support is added at a later date 241 # or possibly to "application/octet-stream" for binary files 242 243 con = file(path, open = "rb", raw = TRUE) 244 on.exit(close(con)) 245 seek(con, where = b2, origin = "start") 246 readBin(con, 'raw', b3 - b2 + 1) 247 } 248 } 249 if (is.character(body) && length(body) > 1) body = paste2(body) 250 list( 251 status = status, body = body, 252 headers = c(list('Content-Type' = type), if (status == 206L) list( 253 'Content-Range' = paste0("bytes ", range[2], "-", range[3], "/", file_size(path)) 254 ), 255 'Accept-Ranges' = 'bytes') # indicates that the server supports range requests 256 ) 257} 258