通过httpuv从另一个端口访问在一个端口上运行的R闪亮应用程序

Question

我有这个非常简单的闪亮应用程序。

library(shiny)

ui <- fluidPage(
  tags$h1("Test App"),
  actionButton("btn", "Click me")
)

server <- function(input, output, session) {
  observeEvent(input$btn, {
    showNotification("Button clicked!")
  })
}

shinyApp(ui, server)

我在 Linux 机器上的 R 会话中运行它，如下所示：

shiny::runApp("minimal_app.R", port = 4040, host = "0.0.0.0", launch.browser = FALSE)

如果我在浏览器中转到

http://myserver:4040

，应用程序将呈现并正常工作（单击该按钮会显示一条消息，表明该按钮已被单击）。

我想使用

httpuv

软件包，以便我可以转到

http://myserver:8080

并访问在端口 4040 上运行的闪亮应用程序。

这是我用来设置它的代码。

library(httpuv)
library(httr)

s <- startServer("0.0.0.0", 8080,
                 list(
                   call = function(req) {
                     res <- GET(paste0("http://127.0.0.1:4040", req$PATH_INFO))
                     
                     content_type <- if (grepl("\\.css$", req$PATH_INFO)) {
                       "text/css"
                     } else if (grepl("\\.js$", req$PATH_INFO)) {
                       "application/javascript"
                     } else {
                       "text/html"
                     }
                     
                     list(
                       status = 200L,
                       headers = list(
                         'Content-Type' = content_type,
                         'X-Forwarded-Host' = req$HTTP_HOST,
                         'X-Forwarded-For' = req$REMOTE_ADDR
                       ),
                       body = content(res, type = "raw")
                     )
                   },
                   onWSOpen = function(ws) {
                     ws$onMessage(function(binary, message) {
                       ws$send(message)
                     })
                   }
                 )
)

当我运行此代码，然后在浏览器中转到

http://myserver:8080

时，我确实看到了该应用程序，它看起来正确，但它不起作用（单击按钮时没有任何反应）。

由于应用程序最初加载正确，我猜测问题出在 websocket 部分，我可能没有正确执行。 有没有办法让它按照描述的那样工作？

Answer 1

使用@margusl 提供的此链接中找到的示例，我能够使其正常工作。 https://rstudio.github.io/websocket/#websocket-proxy

library(httpuv)
library(httr)

s <- startServer("0.0.0.0", 8080,
                 list(
                   call = function(req) {
                     
                     res <- GET(paste0("http://127.0.0.1:4040", req$PATH_INFO))
                     
                     content_type <- if (grepl("\\.css$", req$PATH_INFO)) {
                       "text/css"
                     } else if (grepl("\\.js$", req$PATH_INFO)) {
                       "application/javascript"
                     } else {
                       "text/html"
                     }
                     
                     list(
                       status = 200L,
                       headers = list(
                         'Content-Type' = content_type,
                         'X-Forwarded-Host' = req$HTTP_HOST,
                         'X-Forwarded-For' = req$REMOTE_ADDR
                       ),
                       body = content(res, type = "raw")
                     )
                   },
                   onWSOpen = function(clientWS) {
                     serverWS <- websocket::WebSocket$new("ws://127.0.0.1:4040")
                     
                     msg_from_client_buffer <- list()
                     # Flush the queued messages from the client
                     flush_msg_from_client_buffer <- function() {
                       for (msg in msg_from_client_buffer) {
                         serverWS$send(msg)
                       }
                       msg_from_client_buffer <<- list()
                     }
                     
                     clientWS$onMessage(function(binary, msgFromClient) {
                       if (serverWS$readyState() == 0) {
                         msg_from_client_buffer[length(msg_from_client_buffer) + 1] <<- msgFromClient
                       } else {
                         serverWS$send(msgFromClient)
                       }
                     })
                     
                     serverWS$onOpen(function(event) {
                       serverWS$onMessage(function(msgFromServer) {
                         clientWS$send(msgFromServer$data)
                       })
                       flush_msg_from_client_buffer()
                     })
                   }
                 )
)