ShinyManager 身份验证屏幕不会超时

Question

很抱歉再次问这个问题，但我真的需要解决这个问题（即将达到 shinyapps.io 上的最大数据限制）。这是我之前问题 Previous Stack Question 的 link 这是我的演示应用程序的 link。 Demo App Hosted On ShinyApps.io You will notice the app does not time out. For example here is my logs for this app just for today.

我已经尝试了上一个问题向我推荐的所有方法，并在 shinymanager::secure_server() 函数中包含了 timeOut 参数。

问题似乎在于，shinyapps.io 在 UI 上为 inactivity 设置了一个计时器。一旦 UI 处于非活动状态，它就会在 R 进程上启动超时。但是，在我们的例子中，UI 在身份验证之前不会启动。这意味着我们的服务器保持运行。

设置超时 (setTimeout()) 之类的东西将是一个很好的选择。例如，如果用户在 5 分钟内未进行身份验证，则超时。我最初尝试了 while 循环，但没有按计划进行。

如果没有 activity，我正在寻找一种使服务器超时的方法。这是我的代码的示例。最后，这是 github 上 shinymanager 包的 link。 shinymanager

Ui.R

ui <- dashboardPage(
   #My UI page and functions
 )
shinymanager::secure_app(ui)

Server.R

function(input, output, session){
 auth = secure_server(check_credentials = check_credentials(df)) #df is my client database

 observeEvent(auth$user,{
    #server functions. This only gets run once the user authenticates
  }

}

Answer 1

如果未输入凭据，此应用将在 120 秒后超时

library(shiny)
library(shinymanager)

inactivity <- "function idleTimer() {
var t = setTimeout(logout, 120000);
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, 120000);  // 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)

ShinyManager 身份验证屏幕不会超时

ShinyManager authentication screen does not time out

r

shiny

shinydashboard

shinyjs