如何通过httpuv从8080端口访问4040端口的R Shiny应用

问题描述 #

开发的简单R Shiny应用在Linux机器4040端口启动后，访问http://myserver:4040功能正常。使用httpuv设置8080端口转发至4040时，页面可正常加载，但点击按钮无响应，推测是WebSocket部分配置错误。

Shiny应用代码 #

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)

启动命令 #

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

原httpuv转发代码（存在WebSocket问题） #

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)
                     })
                   }
                 )
)

原因分析 #

原转发代码的onWSOpen仅将客户端消息直接回传，未建立与Shiny应用4040端口的WebSocket连接，导致客户端交互消息无法传递到Shiny服务器，服务器的响应也无法返回给客户端，因此按钮点击无反应。同时，HTTP请求转发部分未正确处理Cookie、WebSocket升级请求等关键头信息，可能导致连接建立失败。

解决方案 #

修改httpuv转发代码，实现WebSocket双向转发，并完善HTTP请求的头信息处理：

library(httpuv)
library(httr)

s <- startServer("0.0.0.0", 8080,
                 list(
                   call = function(req) {
                     # 构造转发URL并保留查询参数
                     target_url <- paste0("http://127.0.0.1:4040", req$PATH_INFO)
                     if (!is.null(req$QUERY_STRING) && req$QUERY_STRING != "") {
                       target_url <- paste0(target_url, "?", req$QUERY_STRING)
                     }
                     
                     # 复制原始请求头，排除自动添加的Connection头
                     req_headers <- req$HEADERS
                     req_headers[["Connection"]] <- NULL
                     
                     # 发送请求到Shiny服务器，保留Cookie和原始头信息
                     res <- GET(
                       target_url,
                       add_headers(.headers = req_headers),
                       set_cookies(.cookies = req$COOKIES),
                       config(followlocation = TRUE)
                     )
                     
                     # 提取响应头，优先使用响应中的Content-Type
                     res_headers <- httr::headers(res)
                     content_type <- res_headers[["Content-Type"]] %||% {
                       if (grepl("\\.css$", req$PATH_INFO)) {
                         "text/css"
                       } else if (grepl("\\.js$", req$PATH_INFO)) {
                         "application/javascript"
                       } else {
                         "text/html"
                       }
                     }
                     
                     list(
                       status = httr::status_code(res),
                       headers = c(
                         list('Content-Type' = content_type),
                         # 转发关键响应头，排除已手动设置的字段
                         res_headers[!names(res_headers) %in% c("Content-Type", "Transfer-Encoding")]
                       ),
                       body = content(res, type = "raw")
                     )
                   },
                   onWSOpen = function(client_ws) {
                     # 建立与Shiny服务器的WebSocket连接
                     shiny_ws <- WebSocket$new("ws://127.0.0.1:4040/websocket/", 
                                               headers = client_ws$request$HEADERS)
                     
                     # 客户端消息转发到Shiny服务器
                     client_ws$onMessage(function(binary, message) {
                       shiny_ws$send(message, binary = binary)
                     })
                     
                     # Shiny服务器消息转发到客户端
                     shiny_ws$onMessage(function(binary, message) {
                       client_ws$send(message, binary = binary)
                     })
                     
                     # 双向处理连接关闭，避免资源泄漏
                     client_ws$onClose(function() {
                       shiny_ws$close()
                     })
                     shiny_ws$onClose(function() {
                       client_ws$close()
                     })
                   }
                 )
)

关键修改点 #

• WebSocket双向转发：在onWSOpen中创建与Shiny服务器的WebSocket连接，实现客户端与服务器的消息双向传递。
• 完善HTTP头处理：保留原始请求的Cookie、查询参数，转发响应中的关键头信息，确保会话状态一致。
• 连接清理：添加双向连接关闭的处理逻辑，避免资源泄漏。

验证步骤 #

1. 启动Shiny应用，确保4040端口服务正常。
2. 运行修改后的httpuv转发代码，启动8080端口转发服务。
3. 访问http://myserver:8080，点击按钮，若弹出"Button clicked!"通知，则问题解决。

内容的提问来源于stack exchange，提问作者mosk915