1#' Run Shiny Application 2#' 3#' Runs a Shiny application. This function normally does not return; interrupt R 4#' to stop the application (usually by pressing Ctrl+C or Esc). 5#' 6#' The host parameter was introduced in Shiny 0.9.0. Its default value of 7#' `"127.0.0.1"` means that, contrary to previous versions of Shiny, only 8#' the current machine can access locally hosted Shiny apps. To allow other 9#' clients to connect, use the value `"0.0.0.0"` instead (which was the 10#' value that was hard-coded into Shiny in 0.8.0 and earlier). 11#' 12#' @param appDir The application to run. Should be one of the following: 13#' \itemize{ 14#' \item A directory containing `server.R`, plus, either `ui.R` or 15#' a `www` directory that contains the file `index.html`. 16#' \item A directory containing `app.R`. 17#' \item An `.R` file containing a Shiny application, ending with an 18#' expression that produces a Shiny app object. 19#' \item A list with `ui` and `server` components. 20#' \item A Shiny app object created by [shinyApp()]. 21#' } 22#' @param port The TCP port that the application should listen on. If the 23#' `port` is not specified, and the `shiny.port` option is set (with 24#' `options(shiny.port = XX)`), then that port will be used. Otherwise, 25#' use a random port between 3000:8000, excluding ports that are blocked 26#' by Google Chrome for being considered unsafe: 3659, 4045, 5060, 27#' 5061, 6000, 6566, 6665:6669 and 6697. Up to twenty random 28#' ports will be tried. 29#' @param launch.browser If true, the system's default web browser will be 30#' launched automatically after the app is started. Defaults to true in 31#' interactive sessions only. This value of this parameter can also be a 32#' function to call with the application's URL. 33#' @param host The IPv4 address that the application should listen on. Defaults 34#' to the `shiny.host` option, if set, or `"127.0.0.1"` if not. See 35#' Details. 36#' @param workerId Can generally be ignored. Exists to help some editions of 37#' Shiny Server Pro route requests to the correct process. 38#' @param quiet Should Shiny status messages be shown? Defaults to FALSE. 39#' @param display.mode The mode in which to display the application. If set to 40#' the value `"showcase"`, shows application code and metadata from a 41#' `DESCRIPTION` file in the application directory alongside the 42#' application. If set to `"normal"`, displays the application normally. 43#' Defaults to `"auto"`, which displays the application in the mode given 44#' in its `DESCRIPTION` file, if any. 45#' @param test.mode Should the application be launched in test mode? This is 46#' only used for recording or running automated tests. Defaults to the 47#' `shiny.testmode` option, or FALSE if the option is not set. 48#' 49#' @examples 50#' \dontrun{ 51#' # Start app in the current working directory 52#' runApp() 53#' 54#' # Start app in a subdirectory called myapp 55#' runApp("myapp") 56#' } 57#' 58#' ## Only run this example in interactive R sessions 59#' if (interactive()) { 60#' options(device.ask.default = FALSE) 61#' 62#' # Apps can be run without a server.r and ui.r file 63#' runApp(list( 64#' ui = bootstrapPage( 65#' numericInput('n', 'Number of obs', 100), 66#' plotOutput('plot') 67#' ), 68#' server = function(input, output) { 69#' output$plot <- renderPlot({ hist(runif(input$n)) }) 70#' } 71#' )) 72#' 73#' 74#' # Running a Shiny app object 75#' app <- shinyApp( 76#' ui = bootstrapPage( 77#' numericInput('n', 'Number of obs', 100), 78#' plotOutput('plot') 79#' ), 80#' server = function(input, output) { 81#' output$plot <- renderPlot({ hist(runif(input$n)) }) 82#' } 83#' ) 84#' runApp(app) 85#' } 86#' @export 87runApp <- function(appDir=getwd(), 88 port=getOption('shiny.port'), 89 launch.browser = getOption('shiny.launch.browser', interactive()), 90 host=getOption('shiny.host', '127.0.0.1'), 91 workerId="", quiet=FALSE, 92 display.mode=c("auto", "normal", "showcase"), 93 test.mode=getOption('shiny.testmode', FALSE)) { 94 on.exit({ 95 handlerManager$clear() 96 }, add = TRUE) 97 98 if (isRunning()) { 99 stop("Can't call `runApp()` from within `runApp()`. If your ", 100 "application code contains `runApp()`, please remove it.") 101 } 102 103 # Make warnings print immediately 104 # Set pool.scheduler to support pool package 105 ops <- options( 106 # Raise warn level to 1, but don't lower it 107 warn = max(1, getOption("warn", default = 1)), 108 pool.scheduler = scheduleTask 109 ) 110 on.exit(options(ops), add = TRUE) 111 112 # ============================================================================ 113 # Global onStart/onStop callbacks 114 # ============================================================================ 115 # Invoke user-defined onStop callbacks, before the application's internal 116 # onStop callbacks. 117 on.exit({ 118 .globals$onStopCallbacks$invoke() 119 .globals$onStopCallbacks <- Callbacks$new() 120 }, add = TRUE) 121 122 require(shiny) 123 124 # ============================================================================ 125 # Convert to Shiny app object 126 # ============================================================================ 127 appParts <- as.shiny.appobj(appDir) 128 129 # ============================================================================ 130 # Initialize app state object 131 # ============================================================================ 132 # This is so calls to getCurrentAppState() can be used to find (A) whether an 133 # app is running and (B), get options and data associated with the app. 134 initCurrentAppState(appParts) 135 on.exit(clearCurrentAppState(), add = TRUE) 136 # Any shinyOptions set after this point will apply to the current app only 137 # (and will not persist after the app stops). 138 139 # ============================================================================ 140 # shinyOptions 141 # ============================================================================ 142 # A unique identifier associated with this run of this application. It is 143 # shared across sessions. 144 shinyOptions(appToken = createUniqueId(8)) 145 146 # Set up default cache for app. 147 if (is.null(getShinyOption("cache", default = NULL))) { 148 shinyOptions(cache = cachem::cache_mem(max_size = 200 * 1024^2)) 149 } 150 151 # Extract appOptions (which is a list) and store them as shinyOptions, for 152 # this app. (This is the only place we have to store settings that are 153 # accessible both the UI and server portion of the app.) 154 applyCapturedAppOptions(appParts$appOptions) 155 156 # ============================================================================ 157 # runApp options set via shinyApp(options = list(...)) 158 # ============================================================================ 159 # The lines below set some of the app's running options, which 160 # can be: 161 # - left unspecified (in which case the arguments' default 162 # values from `runApp` kick in); 163 # - passed through `shinyApp` 164 # - passed through `runApp` (this function) 165 # - passed through both `shinyApp` and `runApp` (the latter 166 # takes precedence) 167 # 168 # Matrix of possibilities: 169 # | IN shinyApp | IN runApp | result | check | 170 # |-------------|-----------|--------------|----------------------------------------------------------------------------------------------------------------------------------------| 171 # | no | no | use defaults | exhaust all possibilities: if it's missing (runApp does not specify); THEN if it's not in shinyApp appParts$options; THEN use defaults | 172 # | yes | no | use shinyApp | if it's missing (runApp does not specify); THEN if it's in shinyApp appParts$options; THEN use shinyApp | 173 # | no | yes | use runApp | if it's not missing (runApp specifies), use those | 174 # | yes | yes | use runApp | if it's not missing (runApp specifies), use those | 175 # 176 # I tried to make this as compact and intuitive as possible, 177 # given that there are four distinct possibilities to check 178 appOps <- appParts$options 179 findVal <- function(arg, default) { 180 if (arg %in% names(appOps)) appOps[[arg]] else default 181 } 182 183 if (missing(port)) 184 port <- findVal("port", port) 185 if (missing(launch.browser)) 186 launch.browser <- findVal("launch.browser", launch.browser) 187 if (missing(host)) 188 host <- findVal("host", host) 189 if (missing(quiet)) 190 quiet <- findVal("quiet", quiet) 191 if (missing(display.mode)) 192 display.mode <- findVal("display.mode", display.mode) 193 if (missing(test.mode)) 194 test.mode <- findVal("test.mode", test.mode) 195 196 if (is.null(host) || is.na(host)) host <- '0.0.0.0' 197 198 # ============================================================================ 199 # Hosted environment 200 # ============================================================================ 201 workerId(workerId) 202 203 if (inShinyServer()) { 204 # If SHINY_PORT is set, we're running under Shiny Server. Check the version 205 # to make sure it is compatible. Older versions of Shiny Server don't set 206 # SHINY_SERVER_VERSION, those will return "" which is considered less than 207 # any valid version. 208 ver <- Sys.getenv('SHINY_SERVER_VERSION') 209 if (utils::compareVersion(ver, .shinyServerMinVersion) < 0) { 210 warning('Shiny Server v', .shinyServerMinVersion, 211 ' or later is required; please upgrade!') 212 } 213 } 214 215 # ============================================================================ 216 # Shinytest 217 # ============================================================================ 218 # Set the testmode shinyoption so that this can be read by both the 219 # ShinySession and the UI code (which executes separately from the 220 # ShinySession code). 221 shinyOptions(testmode = test.mode) 222 if (test.mode) { 223 message("Running application in test mode.") 224 } 225 226 # ============================================================================ 227 # Showcase mode 228 # ============================================================================ 229 # Showcase mode is disabled by default; it must be explicitly enabled in 230 # either the DESCRIPTION file for directory-based apps, or via 231 # the display.mode parameter. The latter takes precedence. 232 setShowcaseDefault(0) 233 234 # If appDir specifies a path, and display mode is specified in the 235 # DESCRIPTION file at that path, apply it here. 236 if (is.character(appDir)) { 237 # if appDir specifies a .R file (single-file Shiny app), look for the 238 # DESCRIPTION in the parent directory 239 desc <- file.path.ci( 240 if (tolower(tools::file_ext(appDir)) == "r") 241 dirname(appDir) 242 else 243 appDir, "DESCRIPTION") 244 if (file.exists(desc)) { 245 con <- file(desc, encoding = checkEncoding(desc)) 246 on.exit(close(con), add = TRUE) 247 settings <- read.dcf(con) 248 if ("DisplayMode" %in% colnames(settings)) { 249 mode <- settings[1, "DisplayMode"] 250 if (mode == "Showcase") { 251 setShowcaseDefault(1) 252 if ("IncludeWWW" %in% colnames(settings)) { 253 .globals$IncludeWWW <- as.logical(settings[1, "IncludeWWW"]) 254 if (is.na(.globals$IncludeWWW)) { 255 stop("In your Description file, `IncludeWWW` ", 256 "must be set to `True` (default) or `False`") 257 } 258 } else { 259 .globals$IncludeWWW <- TRUE 260 } 261 } 262 } 263 } 264 } 265 266 ## default is to show the .js, .css and .html files in the www directory 267 ## (if not in showcase mode, this variable will simply be ignored) 268 if (is.null(.globals$IncludeWWW) || is.na(.globals$IncludeWWW)) { 269 .globals$IncludeWWW <- TRUE 270 } 271 272 # If display mode is specified as an argument, apply it (overriding the 273 # value specified in DESCRIPTION, if any). 274 display.mode <- match.arg(display.mode) 275 if (display.mode == "normal") { 276 setShowcaseDefault(0) 277 } 278 else if (display.mode == "showcase") { 279 setShowcaseDefault(1) 280 } 281 282 # ============================================================================ 283 # Server port 284 # ============================================================================ 285 # determine port if we need to 286 if (is.null(port)) { 287 288 # Try up to 20 random ports. If we don't succeed just plow ahead 289 # with the final value we tried, and let the "real" startServer 290 # somewhere down the line fail and throw the error to the user. 291 # 292 # If we (think we) succeed, save the value as .globals$lastPort, 293 # and try that first next time the user wants a random port. 294 295 for (i in 1:20) { 296 if (!is.null(.globals$lastPort)) { 297 port <- .globals$lastPort 298 .globals$lastPort <- NULL 299 } 300 else { 301 # Try up to 20 random ports 302 while (TRUE) { 303 port <- p_randomInt(3000, 8000) 304 # Reject ports in this range that are considered unsafe by Chrome 305 # http://superuser.com/questions/188058/which-ports-are-considered-unsafe-on-chrome 306 # https://github.com/rstudio/shiny/issues/1784 307 # https://chromium.googlesource.com/chromium/src.git/+/refs/heads/main/net/base/port_util.cc 308 if (!port %in% c(3659, 4045, 5060, 5061, 6000, 6566, 6665:6669, 6697)) { 309 break 310 } 311 } 312 } 313 314 # Test port to see if we can use it 315 tmp <- try(startServer(host, port, list()), silent=TRUE) 316 if (!inherits(tmp, 'try-error')) { 317 stopServer(tmp) 318 .globals$lastPort <- port 319 break 320 } 321 } 322 } 323 324 # ============================================================================ 325 # onStart/onStop callbacks 326 # ============================================================================ 327 # Set up the onStop before we call onStart, so that it gets called even if an 328 # error happens in onStart. 329 if (!is.null(appParts$onStop)) 330 on.exit(appParts$onStop(), add = TRUE) 331 if (!is.null(appParts$onStart)) 332 appParts$onStart() 333 334 # ============================================================================ 335 # Start/stop httpuv app 336 # ============================================================================ 337 server <- startApp(appParts, port, host, quiet) 338 339 # Make the httpuv server object accessible. Needed for calling 340 # addResourcePath while app is running. 341 shinyOptions(server = server) 342 343 on.exit({ 344 stopServer(server) 345 }, add = TRUE) 346 347 # ============================================================================ 348 # Launch web browser 349 # ============================================================================ 350 if (!is.character(port)) { 351 browseHost <- host 352 if (identical(host, "0.0.0.0")) { 353 # http://0.0.0.0/ doesn't work on QtWebKit (i.e. RStudio viewer) 354 browseHost <- "127.0.0.1" 355 } else if (identical(host, "::")) { 356 browseHost <- "::1" 357 } 358 359 if (httpuv::ipFamily(browseHost) == 6L) { 360 browseHost <- paste0("[", browseHost, "]") 361 } 362 363 appUrl <- paste("http://", browseHost, ":", port, sep="") 364 if (is.function(launch.browser)) 365 launch.browser(appUrl) 366 else if (launch.browser) 367 utils::browseURL(appUrl) 368 } else { 369 appUrl <- NULL 370 } 371 372 # ============================================================================ 373 # Application hooks 374 # ============================================================================ 375 callAppHook("onAppStart", appUrl) 376 on.exit({ 377 callAppHook("onAppStop", appUrl) 378 }, add = TRUE) 379 380 # ============================================================================ 381 # Run event loop via httpuv 382 # ============================================================================ 383 .globals$reterror <- NULL 384 .globals$retval <- NULL 385 .globals$stopped <- FALSE 386 # Top-level ..stacktraceoff..; matches with ..stacktraceon in observe(), 387 # reactive(), Callbacks$invoke(), and others 388 ..stacktraceoff..( 389 captureStackTraces({ 390 while (!.globals$stopped) { 391 ..stacktracefloor..(serviceApp()) 392 } 393 }) 394 ) 395 396 if (isTRUE(.globals$reterror)) { 397 stop(.globals$retval) 398 } 399 else if (.globals$retval$visible) 400 .globals$retval$value 401 else 402 invisible(.globals$retval$value) 403} 404 405#' Stop the currently running Shiny app 406#' 407#' Stops the currently running Shiny app, returning control to the caller of 408#' [runApp()]. 409#' 410#' @param returnValue The value that should be returned from 411#' [runApp()]. 412#' @export 413stopApp <- function(returnValue = invisible()) { 414 # reterror will indicate whether retval is an error (i.e. it should be passed 415 # to stop() when the serviceApp loop stops) or a regular value (in which case 416 # it should simply be returned with the appropriate visibility). 417 .globals$reterror <- FALSE 418 ..stacktraceoff..( 419 tryCatch( 420 { 421 captureStackTraces( 422 .globals$retval <- withVisible(..stacktraceon..(force(returnValue))) 423 ) 424 }, 425 error = function(e) { 426 .globals$retval <- e 427 .globals$reterror <- TRUE 428 } 429 ) 430 ) 431 432 .globals$stopped <- TRUE 433 httpuv::interrupt() 434} 435 436#' Run Shiny Example Applications 437#' 438#' Launch Shiny example applications, and optionally, your system's web browser. 439#' 440#' @param example The name of the example to run, or `NA` (the default) to 441#' list the available examples. 442#' @param launch.browser If true, the system's default web browser will be 443#' launched automatically after the app is started. Defaults to true in 444#' interactive sessions only. 445#' @param host The IPv4 address that the application should listen on. Defaults 446#' to the `shiny.host` option, if set, or `"127.0.0.1"` if not. 447#' @param display.mode The mode in which to display the example. Defaults to 448#' `showcase`, but may be set to `normal` to see the example without 449#' code or commentary. 450#' @inheritParams runApp 451#' 452#' @examples 453#' ## Only run this example in interactive R sessions 454#' if (interactive()) { 455#' # List all available examples 456#' runExample() 457#' 458#' # Run one of the examples 459#' runExample("01_hello") 460#' 461#' # Print the directory containing the code for all examples 462#' system.file("examples", package="shiny") 463#' } 464#' @export 465runExample <- function(example=NA, 466 port=getOption("shiny.port"), 467 launch.browser = getOption('shiny.launch.browser', interactive()), 468 host=getOption('shiny.host', '127.0.0.1'), 469 display.mode=c("auto", "normal", "showcase")) { 470 examplesDir <- system.file('examples', package='shiny') 471 dir <- resolve(examplesDir, example) 472 if (is.null(dir)) { 473 if (is.na(example)) { 474 errFun <- message 475 errMsg <- '' 476 } 477 else { 478 errFun <- stop 479 errMsg <- paste('Example', example, 'does not exist. ') 480 } 481 482 errFun(errMsg, 483 'Valid examples are "', 484 paste(list.files(examplesDir), collapse='", "'), 485 '"') 486 } 487 else { 488 runApp(dir, port = port, host = host, launch.browser = launch.browser, 489 display.mode = display.mode) 490 } 491} 492 493#' Run a gadget 494#' 495#' Similar to `runApp`, but handles `input$cancel` automatically, and 496#' if running in RStudio, defaults to viewing the app in the Viewer pane. 497#' 498#' @param app Either a Shiny app object as created by 499#' [`shinyApp()`][shiny] et al, or, a UI object. 500#' @param server Ignored if `app` is a Shiny app object; otherwise, passed 501#' along to `shinyApp` (i.e. `shinyApp(ui = app, server = server)`). 502#' @param port See [`runApp()`][shiny]. 503#' @param viewer Specify where the gadget should be displayed--viewer pane, 504#' dialog window, or external browser--by passing in a call to one of the 505#' [viewer()] functions. 506#' @param stopOnCancel If `TRUE` (the default), then an `observeEvent` 507#' is automatically created that handles `input$cancel` by calling 508#' `stopApp()` with an error. Pass `FALSE` if you want to handle 509#' `input$cancel` yourself. 510#' @return The value returned by the gadget. 511#' 512#' @examples 513#' \dontrun{ 514#' library(shiny) 515#' 516#' ui <- fillPage(...) 517#' 518#' server <- function(input, output, session) { 519#' ... 520#' } 521#' 522#' # Either pass ui/server as separate arguments... 523#' runGadget(ui, server) 524#' 525#' # ...or as a single app object 526#' runGadget(shinyApp(ui, server)) 527#' } 528#' @export 529runGadget <- function(app, server = NULL, port = getOption("shiny.port"), 530 viewer = paneViewer(), stopOnCancel = TRUE) { 531 532 if (!is.shiny.appobj(app)) { 533 app <- shinyApp(app, server) 534 } 535 536 if (isTRUE(stopOnCancel)) { 537 app <- decorateServerFunc(app, function(input, output, session) { 538 observeEvent(input$cancel, { 539 stopApp(stop("User cancel", call. = FALSE)) 540 }) 541 }) 542 } 543 544 if (is.null(viewer)) { 545 viewer <- utils::browseURL 546 } 547 548 shiny::runApp(app, port = port, launch.browser = viewer) 549} 550 551# Add custom functionality to a Shiny app object's server func 552decorateServerFunc <- function(appobj, serverFunc) { 553 origServerFuncSource <- appobj$serverFuncSource 554 appobj$serverFuncSource <- function() { 555 origServerFunc <- origServerFuncSource() 556 function(input, output, session) { 557 serverFunc(input, output, session) 558 559 # The clientData and session arguments are optional; check if 560 # each exists 561 args <- argsForServerFunc(origServerFunc, session) 562 do.call(origServerFunc, args) 563 } 564 } 565 appobj 566} 567