r - 我 Shiny 的应用程序的登录屏幕没有超时

Question

我有一个 Shiny 的应用程序，我在其中添加了身份验证。该应用程序托管在 shinyapps.io 上，我有一些客户在使用该应用程序。然而，一位客户并没有关闭他的浏览器选项卡，而是让登录页面闲置。我发现登录页面没有超时。它一直处于闲置状态，并不断耗尽我的活跃时间。这是我 Shiny 的应用程序日志以及前端身份验证页面的样子。

我正在使用 shinymanager 包。我已将 Shiny 的应用程序设置为闲置 10 分钟后超时。如果您已登录，这会很好用。但是，当您未登录时，它不会超时。

我想知道是否可以在我的代码中实现某些功能，以便在空闲 x 分钟后登录将超时。这是我的代码的可复制玩具示例。因此，如果有人真的想搞砸我，他们可以打开 N 个选项卡并让登录页面闲置。那真的会降低我的表现。

全局.R

library(shiny)
library(shinymanager)


# data.frame with credentials info
credentials <- data.frame(
  user = c("fanny", "victor", "benoit"),
  password = c("azerty", "12345", "azerty"),
  # comment = c("alsace", "auvergne", "bretagne"),
  stringsAsFactors = FALSE
)

ui.R

secure_app(fluidPage(

  # classic app
  headerPanel('Iris k-means clustering'),
  sidebarPanel(
    selectInput('xcol', 'X Variable', names(iris)),
    selectInput('ycol', 'Y Variable', names(iris),
                selected=names(iris)[[2]]),
    numericInput('clusters', 'Cluster count', 3,
                 min = 1, max = 9)
  ),
  mainPanel(
    plotOutput('plot1'),
    verbatimTextOutput("res_auth")
  )

))

服务器.R

function(input, output, session) {

  result_auth <- secure_server(check_credentials = 
check_credentials(credentials))

  output$res_auth <- renderPrint({
    reactiveValuesToList(result_auth)
  })

  # classic app
  selectedData <- reactive({
    iris[, c(input$xcol, input$ycol)]
  })

  clusters <- reactive({
    kmeans(selectedData(), input$clusters)
  })

  output$plot1 <- renderPlot({
    palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
              "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))

    par(mar = c(5.1, 4.1, 0, 1))
    plot(selectedData(),
         col = clusters()$cluster,
         pch = 20, cex = 3)
    points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
  })

}

Answer 1

您可以使用一些js 并将其添加到secure_app 函数中。下面的示例将在 5 秒后使身份验证页面超时

library(shiny)
library(shinymanager)

inactivity <- "function idleTimer() {
var t = setTimeout(logout, 5000);
window.onmousemove = resetTimer; // catches mouse movements
window.onmousedown = resetTimer; // catches mouse movements
window.onclick = resetTimer;     // catches mouse clicks
window.onscroll = resetTimer;    // catches scrolling
window.onkeypress = resetTimer;  //catches keyboard actions

function logout() {
window.close();  //close the window
}

function resetTimer() {
clearTimeout(t);
t = setTimeout(logout, 5000);  // time is in milliseconds (1000 is 1 second)
}
}
idleTimer();"


# data.frame with credentials info
credentials <- data.frame(
  user = c("1", "fanny", "victor", "benoit"),
  password = c("1", "azerty", "12345", "azerty"),
  # comment = c("alsace", "auvergne", "bretagne"), %>% 
  stringsAsFactors = FALSE
)

ui <- secure_app(head_auth = tags$script(inactivity),
  fluidPage(
    # classic app
    headerPanel('Iris k-means clustering'),
    sidebarPanel(
      selectInput('xcol', 'X Variable', names(iris)),
      selectInput('ycol', 'Y Variable', names(iris),
                  selected=names(iris)[[2]]),
      numericInput('clusters', 'Cluster count', 3,
                   min = 1, max = 9)
    ),
    mainPanel(
      plotOutput('plot1'),
      verbatimTextOutput("res_auth")
    )

  ))

server <- function(input, output, session) {

  result_auth <- secure_server(check_credentials = 
                                 check_credentials(credentials))

  output$res_auth <- renderPrint({
    reactiveValuesToList(result_auth)
  })

  # classic app
  selectedData <- reactive({
    iris[, c(input$xcol, input$ycol)]
  })

  clusters <- reactive({
    kmeans(selectedData(), input$clusters)
  })

  output$plot1 <- renderPlot({
    palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
              "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))

    par(mar = c(5.1, 4.1, 0, 1))
    plot(selectedData(),
         col = clusters()$cluster,
         pch = 20, cex = 3)
    points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
  })

}


shinyApp(ui = ui, server = server)