@hadley thank you very much for taking the time to answer here.
By now I managed to find a solution, which seems to solve the problem for my usecase.
I modified the function startDynamicHelp to accept a host argument.
Furthermore, I'm rendering the iframe based on session$clientData$url_hostname, which is giving me the networkinterface used to access the app.
So far my tests were working fine in the local network. Please check the following reprex and let me know if you have any comments.
Cheers!
library(shiny)
startDynamicHelpHost <- function (start = NA, host = "127.0.0.1")
{
if (nzchar(Sys.getenv("R_DISABLE_HTTPD"))) {
tools:::httpdPort(-1L)
warning("httpd server disabled by R_DISABLE_HTTPD",
immediate. = TRUE)
utils::flush.console()
return(invisible(tools:::httpdPort()))
}
port <- tools:::httpdPort()
if (is.na(start)) {
if (port <= 0L)
return(startDynamicHelpHost(start = TRUE, host))
return(invisible(port))
}
if (start && port) {
if (port > 0L)
stop("server already running")
else stop("server could not be started on an earlier attempt")
}
if (!start && (port <= 0L))
stop("no running server to stop")
if (start) {
utils::flush.console()
OK <- FALSE
ports <- getOption("help.ports")
if (is.null(ports)) {
ports <- 10000 + 22000 * ((stats::runif(10) + unclass(Sys.time())/300)%%1)
}
ports <- as.integer(ports)
if (all(ports == 0))
return(invisible(0))
message("starting httpd help server ...", appendLF = FALSE)
for (i in seq_along(ports)) {
status <- .Call(tools:::C_startHTTPD, host,
ports[i])
if (status == 0L) {
OK <- TRUE
tools:::httpdPort(ports[i])
break
}
if (status != -2L)
break
}
if (OK) {
message(" done")
utils::flush.console()
}
else {
warning("failed to start the httpd server",
immediate. = TRUE)
utils::flush.console()
tools:::httpdPort(-1L)
}
}
else {
.Call(C_stopHTTPD)
tools:::httpdPort(0L)
}
invisible(tools:::httpdPort())
}
# try to shut down the dynamic help server if it is running
tryCatch({
tools::startDynamicHelp(start = FALSE)
}, error = function(e){return(e)})
helpPort <- startDynamicHelpHost(start = NA, host = "0.0.0.0")
ui <- fluidPage(
tags$style(type = "text/css", "#helpPageIframe {height: calc(100vh - 80px) !important;}"),
htmlOutput("helpPageIframe")
)
server <- function(input, output, session) {
helpURL <- reactive({
if (helpPort > 0L) {
paste0("http://", session$clientData$url_hostname, ":", helpPort, "/doc/html/index.html")
} else { NULL }
})
output$helpPageIframe <- renderUI({
tags$iframe(src=helpURL(), height="100%", width="100%", frameborder="0", scrolling="yes")
})
}
app <- shinyApp(ui, server)
runApp(app, host = "0.0.0.0", port = 3838, launch.browser = TRUE)