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