Shiny server session time out doesn't work

后端 未结 3 1458
醉梦人生
醉梦人生 2020-12-02 19:54

I have a shiny app deployed on a Linux server. I want the app to timeout if there is no activity for a minute. Based on what I read, I added the line app_idle_timeout to th

3条回答
  •  清歌不尽
    2020-12-02 20:15

    @Pork Chop, thanks for your very useful answer!

    Just for the sake of completeness, here is a slightly modified version of @Pork Chop's code which doesen't close the browser tab, but instead only closes the session and leaves a message for the user:

    library(shiny)
    library(leaflet)
    
    timeoutSeconds <- 5
    
    inactivity <- sprintf("function idleTimer() {
    var t = setTimeout(logout, %s);
    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() {
    Shiny.setInputValue('timeOut', '%ss')
    }
    
    function resetTimer() {
    clearTimeout(t);
    t = setTimeout(logout, %s);  // time is in milliseconds (1000 is 1 second)
    }
    }
    idleTimer();", timeoutSeconds*1000, timeoutSeconds, timeoutSeconds*1000)
    
    
    ui <- fluidPage(
      tags$script(inactivity),    
      leafletOutput("mymap")
    )
    
    server <- shinyServer(function(input,output,session){
    
      observeEvent(input$timeOut, { 
        print(paste0("Session (", session$token, ") timed out at: ", Sys.time()))
        showModal(modalDialog(
          title = "Timeout",
          paste("Session timeout due to", input$timeOut, "inactivity -", Sys.time()),
          footer = NULL
        ))
        session$close()
      })
    
      points <- eventReactive(input$recalc, {
        cbind(rnorm(40) * 2 + 13, rnorm(40) + 48)
      }, ignoreNULL = FALSE)
    
      output$mymap <- renderLeaflet({
        leaflet() %>%
          addProviderTiles(providers$Stamen.TonerLite, options = providerTileOptions(noWrap = TRUE)) %>% 
          addMarkers(data = points())
      })
    
    })
    
    runApp(list(ui = ui, server = server))
    

    This was very helpful to get here.

提交回复
热议问题