r - 连接到特定的shiny session(实现跨浏览器登录)

Question

我有一个 Shiny 的应用程序。用户可以部分完成它，关闭选项卡，稍后再回来，状态将被保留。但是，当用户切换浏览器时，这当然不起作用。

我的最终目标是能够通过 LTI(这是将各种学习工具和平台连接在一起的标准)登录到 Shiny 的应用程序。我当前的计划是制作一个小型外部服务器(或向 Shiny 服务器添加一些内容)来处理 LTI 连接，然后使用正确的 session ID 将浏览器重定向到 Shiny 应用程序。

我想知道:

• session 如何保存在浏览器中 - 似乎没有使用 cookie。是否只是在 HTML 中发送 session ID，然后浏览器缓存它？我知道它通过向 http://example.com/myshinyapp/session/<session_id>/dataobj/restore_state 发出请求来恢复进度。 .
• 有没有办法让特定 session Shiny 加载？我认为人们可能会滥用书签系统，但也许我缺少一个更直接的 HTTP 端点或 R API。

Answer 1

首先，我认为“连接到特定 Shiny session ”的概念很脆弱，因为 Shiny 服务器(无论是shiny-server、shinyapps.io还是商业Posit Connect)可以并根据可配置的不活动级别执行剔除流程。假设一个进程一旦没有连接的用户，它就会处于空闲状态但在很长一段时间内仍然处于事件状态，这是不安全的。

作为替代方案，我建议采用一种机制来定期将状态保存到某些持久存储中，包括磁盘上或 SQL (DBMS) 或 NoSQL(例如 Redis)中。下面的代码类似于书签，但不需要 URL 修改或 cookie，因此可以跨不同的浏览器(因此也可以跨不同的设备)工作。

注释:

• 警告:使用“用户名”作为保存状态的唯一键是基于查找 session$user (部署到服务器时)或“用户” envvar;如果两者都没有找到，则此演示默认允许用户设置自己的用户名。这显然存在安全风险，请不要在生产中使用用户可编辑的用户名。
• 我在 textInput 中向用户显示他们的用户名，这可能没有必要或不需要。
• 这个应用程序很简洁，显然可以进行一些用户体验改进。 (启用|禁用)状态管理按钮的逻辑是好的，它可能需要支持。
• 同样，我使用 shinyjs 是为了方便在此演示中禁用按钮/输入。尽管我认为某种形式的“禁用按钮”和/或界面管理是合理的，但这不是必需的。
• 虽然我尝试对连接问题、故障等保持稳健，但我不保证其对恶意行为者或错误问题的恢复力/稳健性。
• 我假设保存为“状态”的输入集具有无限的生命周期。您可能需要考虑 max-age，在这种情况下，您的访问器可能需要考虑年龄(例如，在插入存储的对象时添加时间戳，并在检索状态时验证该时间戳)。
• 同样，您可能需要考虑状态的版本控制，以便在更新实际应用程序时，您可以调整或取消以前的状态架构。我在这里并没有花太多精力来处理无效/不完整的保存状态；如果您愿意，可以享受其中的乐趣。

我将演示如何使用 Redis 实例 (redux::hiredis())，特别是 Redis 的 hashes 。我假设您有一个可用的或者可以轻松设置一个(它们相对容易设置并且在许多服务器环境中可用)。如果您没有 Redis，我认为下面的访问器可以轻松地适应其他用途，例如 cachem::cache_disk。

首先，我正在使用的访问器:

redis <- redux::hiredis()
topic_prefix <- "saved_states/"
getstates <- function(user, prefix = topic_prefix) {
  stopifnot(
    "'user' must be length-1 character" =
      nzchar(user) && length(user) == 1,
    "'prefix' must be length-1 character" =
      nzchar(prefix) && length(prefix) == 1
  )
  tryCatch(
    unlist(redis$HKEYS(paste0(prefix, user))),
    error = function(e) {
      warning("error getting state: ", conditionMessage(e), call. = FALSE)
      list()
    })
}
getstate <- function(user, key, prefix = topic_prefix) {
  stopifnot(
    "'user' must be length-1 character" =
      nzchar(user) && length(user) == 1,
    "'key' must be length-1 character" =
      nzchar(key) && length(key) == 1,
    "'prefix' must be length-1 character" =
      nzchar(prefix) && length(prefix) == 1
  )
  json <- tryCatch(
    redis$HGET(paste0(prefix, user), key),
    error = function(e) {
      warning("error getting user state: ", conditionMessage(e), call. = FALSE)
      "{}"
    })
  tryCatch(
    jsonlite::fromJSON(json),
    error = function(e) {
      warning("error converting state: ", conditionMessage(e), call. = FALSE)
      list()
    })
}
setstate <- function(user, key, val, prefix = topic_prefix) {
  stopifnot(
    "'user' must be length-1 character" =
      nzchar(user) && length(user) == 1,
    "'key' must be length-1 character" =
      nzchar(key) && length(key) == 1,
    "'prefix' must be length-1 character" =
      nzchar(prefix) && length(prefix) == 1
  ) 
  json <- jsonlite::toJSON(val)
  tryCatch({
    redis$HSET(paste0(prefix, user), key, json)
    TRUE
  }, error = function(e) {
    warning("error saving state: ", conditionMessage(e), call. = FALSE)
    FALSE
  })
}

现在， Shiny 应用程序的其余部分:

library(shiny)
defstate <- c("Previous saved states" = "")
defvals <- list(txt = "Something", num = 42)
ui <- fluidPage(
  shinyjs::useShinyjs(),
  # shinyjs::disabled(
    textInput("user", "Username (insecure)", value = ""),
  # ),
  selectizeInput("state", "States", choices = defstate, selected = ""),
  shinyjs::disabled(actionButton("getstate", "Get states")),
  shinyjs::disabled(actionButton("savestate", "Save this state")),
  shinyjs::disabled(actionButton("delstate", "Delete this state")),
  hr(),
  textInput("txt", "Some text", value = defvals$txt),
  numericInput("num", "A number", value = defvals$num)
)
server <- function(input, output, session) {
  keys <- reactiveValues()
  observe({
    if (!is.null(session$user)) {
      updateTextInput(session, "user", label = "Username (pulled from 'session')",
                      value = session$user)
    } else if (nzchar(user <- Sys.getenv("USER"))) {
      updateTextInput(session, "user", label = "Username (pulled from 'USER' envvar)",
                      value = user)
    } else {
      # this section should likely not exist ...
      warning("RUNNING IN INSECURE MODE, user can change their own username", call. = FALSE)
      updateTextInput(session, "user", label = "Username (INSECURE!)")
      shinyjs::enable(id = "user")
    }
  })
  observeEvent(input$user, {
    fun <- if (isTRUE(nzchar(input$user))) shinyjs::enable else shinyjs::disable
    for (id in c("getstate", "savestate", "delstate")) fun(id)
  })
  observeEvent(list(input$user, input$getstate), {
    req(nzchar(input$user))
    keys[[input$user]] <- (newkeys <- getstates(input$user))
    updateSelectizeInput(
      session, "state",
      choices = c(defstate, setNames(nm = keys[[input$user]])),
      selected = input$state)
  })
  observeEvent(input$state, {
    req(input$state)
    newstate <- getstate(input$user, input$state)
    updateTextInput(session, "txt", value = if (!is.null(newstate$txt)) newstate$txt else defvals$txt)
    updateNumericInput(session, "num", value = if (!is.null(newstate$num)) newstate$num else defvals$num)
  })
  observeEvent(input$delstate, {
    req(length(keys[[input$user]]), nzchar(input$state))
    redis$HDEL(paste0(topic_prefix, input$user), input$state)
    keys[[input$user]] <- setdiff(keys[[input$user]], input$state)
    updateSelectizeInput(session, "state", choices = c(defstate, setNames(nm = keys[[input$user]])), selected = "")
  })
  observeEvent(input$savestate, {
    now <- format(Sys.time(), format = "%Y-%m-%d %H:%M:%S")
    res <- setstate(input$user, now, list(txt = input$txt, num = input$num))
    if (isTRUE(res)) {
      keys[[input$user]] <- unique(c(keys[[input$user]], now))
      updateSelectizeInput(session, "state", choices = c(defstate, setNames(nm = keys[[input$user]])), selected = now)
    }
  })
}
shinyApp(ui, server)

例如，如果我们启动并单击“保存状态”一次，我们会看到如下内容:

如果我们在不同的浏览器(此处为 Chrome)中打开相同的 URL，更新值并保存为新状态，我们将看到:

返回第一个浏览器，立即单击“获取状态”并选择最新的状态，这样我们就可以“导入”其他浏览器的输入。