ShinyManager authentication screen does not time out

Question

sorry to be asking this question again, but I really need this problem solved (about to reach my max data limit on shinyapps.io). Here is the link to my previous question Previous Stack Question Here is the link to my demo app. 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.

I have tried everything that was recommended to me from my last question as well as including the timeOut parameter in the shinymanager::secure_server() function.

What seems to be the problem is, shinyapps.io puts a timer for inactivity on the UI. Once the UI is inactive it then starts a timeout on the R process. However, in our case the UI does not start up until authentication. This means our server keeps running.

Something like a set timeout (setTimeout()) would be a great alternative. For example, if the user does not authenticate within 5 minutes, time out. I initially tried a while loop, but it did not turn out as planned.

I am looking for a way to time out the server if there is no activity. Here is a toy example of what my code looks like. Lastly, here is a link to the shinymanager package on github. 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

This app will timeout after 120 seconds, if no credentials are entered

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)