1#' Run a Shiny application from a URL
2#'
3#' `runUrl()` downloads and launches a Shiny application that is hosted at
4#' a downloadable URL. The Shiny application must be saved in a .zip, .tar, or
5#' .tar.gz file. The Shiny application files must be contained in the root
6#' directory or a subdirectory in the archive. For example, the files might be
7#' `myapp/server.r` and `myapp/ui.r`. The functions `runGitHub()`
8#' and `runGist()` are based on `runUrl()`, using URL's from GitHub
9#' (<https://github.com>) and GitHub gists (<https://gist.github.com>),
10#' respectively.
11#' @param url URL of the application.
12#' @param filetype The file type (`".zip"`, `".tar"`, or
13#'   `".tar.gz"`. Defaults to the file extension taken from the url.
14#' @param subdir A subdirectory in the repository that contains the app. By
15#'   default, this function will run an app from the top level of the repo, but
16#'   you can use a path such as `"inst/shinyapp"`.
17#' @param destdir Directory to store the downloaded application files. If `NULL`
18#'   (the default), the application files will be stored in a temporary directory
19#'   and removed when the app exits
20#' @param ... Other arguments to be passed to [runApp()], such as
21#'   `port` and `launch.browser`.
22#' @export
23#' @examples
24#' ## Only run this example in interactive R sessions
25#' if (interactive()) {
26#'   runUrl('https://github.com/rstudio/shiny_example/archive/master.tar.gz')
27#'
28#'   # Can run an app from a subdirectory in the archive
29#'   runUrl("https://github.com/rstudio/shiny_example/archive/master.zip",
30#'     subdir = "inst/shinyapp/")
31#' }
32runUrl <- function(url, filetype = NULL, subdir = NULL, destdir = NULL, ...) {
33
34  if (!is.null(subdir) && ".." %in% strsplit(subdir, '/')[[1]])
35    stop("'..' not allowed in subdir")
36
37  if (is.null(filetype))
38    filetype <- basename(url)
39
40  if (grepl("\\.tar\\.gz$", filetype))
41    fileext <- ".tar.gz"
42  else if (grepl("\\.tar$", filetype))
43    fileext <- ".tar"
44  else if (grepl("\\.zip$", filetype))
45    fileext <- ".zip"
46  else
47    stop("Unknown file extension.")
48
49  message("Downloading ", url)
50  if (is.null(destdir)) {
51    filePath <- tempfile('shinyapp', fileext = fileext)
52    fileDir  <- tempfile('shinyapp')
53  } else {
54    fileDir <- destdir
55    filePath <- paste(destdir, fileext)
56  }
57
58  dir.create(fileDir, showWarnings = FALSE)
59  if (download(url, filePath, mode = "wb", quiet = TRUE) != 0)
60    stop("Failed to download URL ", url)
61  on.exit(unlink(filePath))
62
63  if (fileext %in% c(".tar", ".tar.gz")) {
64    # Regular untar commonly causes two problems on Windows with github tarballs:
65    #   1) If RTools' tar.exe is in the path, you get cygwin path warnings which
66    #      throw list=TRUE off;
67    #   2) If the internal untar implementation is used, it chokes on the 'g'
68    #      type flag that github uses (to stash their commit hash info).
69    # By using our own forked/modified untar2 we sidestep both issues.
70    first <- untar2(filePath, list=TRUE)[1]
71    untar2(filePath, exdir = fileDir)
72
73  } else if (fileext == ".zip") {
74    first <- as.character(utils::unzip(filePath, list=TRUE)$Name)[1]
75    utils::unzip(filePath, exdir = fileDir)
76  }
77
78  if(is.null(destdir)){
79    on.exit(unlink(fileDir, recursive = TRUE), add = TRUE)
80  }
81
82  appdir <- file.path(fileDir, first)
83  if (!utils::file_test('-d', appdir)) appdir <- dirname(appdir)
84
85  if (!is.null(subdir)) appdir <- file.path(appdir, subdir)
86  runApp(appdir, ...)
87}
88
89#' @rdname runUrl
90#' @param gist The identifier of the gist. For example, if the gist is
91#'   https://gist.github.com/jcheng5/3239667, then `3239667`,
92#'   `'3239667'`, and `'https://gist.github.com/jcheng5/3239667'` are
93#'   all valid values.
94#' @export
95#' @examples
96#' ## Only run this example in interactive R sessions
97#' if (interactive()) {
98#'   runGist(3239667)
99#'   runGist("https://gist.github.com/jcheng5/3239667")
100#'
101#'   # Old URL format without username
102#'   runGist("https://gist.github.com/3239667")
103#' }
104#'
105runGist <- function(gist, destdir = NULL, ...) {
106
107  gistUrl <- if (is.numeric(gist) || grepl('^[0-9a-f]+$', gist)) {
108    sprintf('https://gist.github.com/%s/download', gist)
109  } else if(grepl('^https://gist.github.com/([^/]+/)?([0-9a-f]+)$', gist)) {
110    paste(gist, '/download', sep='')
111  } else {
112    stop('Unrecognized gist identifier format')
113  }
114
115  runUrl(gistUrl, filetype = ".zip", destdir = destdir, ...)
116}
117
118
119#' @rdname runUrl
120#' @param repo Name of the repository.
121#' @param username GitHub username. If `repo` is of the form
122#'   `"username/repo"`, `username` will be taken from `repo`.
123#' @param ref Desired git reference. Could be a commit, tag, or branch name.
124#'   Defaults to `"master"`.
125#' @export
126#' @examples
127#' ## Only run this example in interactive R sessions
128#' if (interactive()) {
129#'   runGitHub("shiny_example", "rstudio")
130#'   # or runGitHub("rstudio/shiny_example")
131#'
132#'   # Can run an app from a subdirectory in the repo
133#'   runGitHub("shiny_example", "rstudio", subdir = "inst/shinyapp/")
134#' }
135runGitHub <- function(repo, username = getOption("github.user"),
136                      ref = "master", subdir = NULL, destdir = NULL, ...) {
137
138  if (grepl('/', repo)) {
139    res <- strsplit(repo, '/')[[1]]
140    if (length(res) != 2) stop("'repo' must be of the form 'username/repo'")
141    username <- res[1]
142    repo     <- res[2]
143  }
144
145  url <- paste("https://github.com/", username, "/", repo, "/archive/",
146               ref, ".tar.gz", sep = "")
147
148  runUrl(url, subdir = subdir, destdir = destdir, ...)
149}
150