Login Screen For My Shiny App Does Not Time Out

Question

I have a shiny app where I have added authentication. The app is hosted on shinyapps.io and I have a few clients using the app. However, one client does not close his browser tabs, leaving the login page idle. I have found out that the login page does not time out. It remains idle and constantly eats up my active hours. Here is what my shiny app logs look like plus the front authentication page.

I am using the shinymanager package. I have set the shiny app settings to time out after 10 minutes of being idle. This works great if you are logged in. However, when you are not, it does not time out.

I am wondering if there is something I can implement in my code so that the login will time out if idle for x amount of minutes. Here is a reproducible toy example of my code. So if someone really wanted to screw me they could open N amount of tabs and leave the login page idle. That would really slow down my performance.

gloabal.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")
  )

))

server.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)
  })

}

[Here](https://stackoverflow.com/a/53207050/9841389) you can find an alternative timeout approach. — ismirsehregal, Sep 19 '19 at 07:10
Can you open an issue in the GitHub repo, I'll check it out : https://github.com/datastorm-open/shinymanager/issues — Victorp, Sep 19 '19 at 15:51
Hey @Victorp I have asked the question on the link you provided me. Thank you. I really hope you can fix it as my usage hours is near the limit — Jordan Wrong, Sep 25 '19 at 05:40
@AdamSampson How might I add the timer function where it only calls session$close if the authentication is still not true? Thanks — Jordan Wrong, Oct 03 '19 at 21:10
Thanks Adam. The problem I am having is building the actual timer. Any ideas here? — Jordan Wrong, Oct 04 '19 at 15:37

Pork Chop · Answer 1 · 2019-10-07T07:56:40.483

You can use the some js and add it to the secure_app function. Example below will timeout authentication page after 5 seconds

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)

Hi Pork Chop! Thanks for commenting, however, when I use your code and log into the app it stops app. I am looking to timeout the login screen — Jordan Wrong, Sep 20 '19 at 11:41
Hi @pork chop. I have been reading through your answer on SO. Thanks for providing great answers. I was wondering if you could help me with this problem. I need to create a timer that executes only one time. If the auth is true - do nothing if auth is false session$close. — Jordan Wrong, Oct 04 '19 at 16:51

Login Screen For My Shiny App Does Not Time Out

1 Answers1

Linked