datastorm-open / shinymanager

Simple and secure authentification mechanism for single shiny applications.
https://datastorm-open.github.io/shinymanager/
388 stars 81 forks source link

Session ends automatically after login #146

Closed akeever2 closed 7 months ago

akeever2 commented 2 years ago

I have a shiny app to generate reports. It was working correctly until I added the password authentication. Now immediately after login it produces the following warnings and ends my session:

Listening on http://127.0.0.1:3679 The name provided ('sign-out') is deprecated in Font Awesome 5: please consider using 'sign-out-alt' or 'fas fa-sign-out-alt' instead use the verify_fa = FALSE to deactivate these messages This Font Awesome icon ('close') does not exist: if providing a custom html_dependency these name checks can be deactivated with verify_fa = FALSE Session Ended Warning in normalizePath(path.expand(path), winslash, mustWork) : path[1]="www\file88b844f719a9.Rmd": The system cannot find the file specified Warning: Error in abs_path: The file 'www\file88b844f719a9.Rmd' does not exist. 1: runApp Session Ended

I don't know if it has to do with the code outside the UI that creates temporary files, but that code worked fine before. Here is the code for the app.

# Load the most recent results from the IPM to update Year option slider. 
dynamicData <- function(){
    f <- list.files("www/DeerIPM_Model/Results/", pattern = "saN", full.names = TRUE)
    as.numeric(str_extract(f[which.max(file.mtime(f))], pattern = "\\d+"))
}

# Credentials info for login
credentials <- data.frame(
    user = c("user1"),
    password = c("pword1"), 
    stringsAsFactors = FALSE
)

# Define UI for application - do function(request) to make sure the dynamic function will grab newest results
ui <- function(request){

    fluidPage(

        # Set the theme
        theme = bslib::bs_theme(primary = "#364661", secondary = "#2179C6", 
                                font_scale = 1.3, `enable-rounded` = TRUE, 
                                bootswatch = "lux"),

        # Application title
        titlePanel("IPM Results: Deer report generator"),

        br(),

        # Layout for the report generator
        sidebarLayout(

            # Side panel that has all the user controls
            sidebarPanel(

                # Slider to set the years of results to analyze
                sliderInput(inputId = "yrRange", label = "Year range", min = 2005, 
                            max = dynamicData(), value = c(2005,dynamicData()), step = 1, 
                            sep = ""),

                br(),

                # Check box to select the DMUs
                checkboxGroupInput(inputId = "dmus", label = "DMUs", 
                                   choices = list("E1" = "E1", "E2" = "E2", "E3" = "E3", 
                                                  "M1" = "M1", "M2" = "M2", "M3" = "M3", 
                                                  "M4" = "M4", "W1" = "W1", "W2" = "W2",
                                                  "W3" = "W3")), 

                br(),

                # Check box for whether or not to include statewide estimates
                checkboxInput(inputId = "statewide", label = "Include statewide estimates?",
                              value = TRUE),

                br(),

                # Button to generate report
                actionButton("report", "Generate report")

            ), 

            mainPanel(

                uiOutput("pdfview"),

                uiOutput("downloadbutton")
            )

        )
        # 
    ) # End UI fluid page

} 

# Create temp files to hold the reports for download
report_path <- tempfile(tmpdir = "www", fileext = ".Rmd")
file.copy("MarkdownReport/DeerReportGenerator.Rmd", report_path, overwrite = TRUE)
pdf_path <- tempfile(tmpdir = "www", fileext = ".pdf")

# Wrap UI in secure server
ui <- secure_app(ui)

# Define server logic required to draw a histogram
server <- function(input, output, session) {

    # Password protection things
    result_auth <- secure_server(check_credentials = check_credentials(credentials))

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

    # Server code to generate the Rmarkdown report
    observeEvent(input$report, {

        # Set up parameters to pass to Rmd document
        params <- list(year = input$yrRange, 
                       dmus = input$dmus, 
                       statewide = input$statewide)

        id <- showNotification(
            "Rendering report...", 
            duration = NULL, 
            closeButton = FALSE)

        on.exit(removeNotification(id), add = TRUE)

        # Knit the document, passing in the `params` list, and eval it in a
        # child of the global environment (this isolates the code in the document
        # from the code in this app).
        rmarkdown::render(report_path, output_file = str_sub(pdf_path, 5),
                          params = params,
                          envir = new.env(parent = globalenv()))

        # Display the report on the Shiny app
        output$pdfview <- renderUI({tags$iframe(style="height:800px; width:100%; scrolling=yes", 
                                                src=str_sub(pdf_path, 5))})

    })

    # Code to create the download button to download PDF
    observeEvent(input$report, {
        output$downloadbutton <- renderUI({downloadButton("download", 
                                                          "Download Report")})
    })

    # Download handler to get the file
    output$download <- downloadHandler(
        filename = "DeerReport.pdf", 
        content = function(file){
            file.copy(paste0("www/", str_sub(pdf_path, 5)), file)
        }
    )

    # Clear out any temporary files made during the session
    session$onSessionEnded(function() {
        cat("Session Ended\n")
        unlink(report_path)
        unlink(pdf_path)
    })

}

# Run the application 
shinyApp(ui = ui, server = server)
eleanor-m commented 2 years ago

I have the same problem. I have been connecting to a database before the app starts, then disconnecting in an onStop function within the server. After adding the login stuff, my database connection is closed after the login because the session stops. It seems to me that a new session immediately starts, because the UI still works (e.g. in the example below), but by that time my database connection has been closed. Maybe there's a better way to handle the database connections to avoid this problem in the first place. But I thought I would chime in here with a smaller reproducible example in case it's helpful:

library("shiny")
library("shinymanager")

# Init DB using credentials data
credentials <- data.frame(
  user = c("user1"),
  password = c("user1"),
  admin = c(FALSE),
  stringsAsFactors = FALSE
)

ui <- fluidPage("Example app",
                selectInput("number", "Pick a number", choices = c(1,2,3)),
                textOutput("number_chosen")
                )
ui <- secure_app(ui, enable_admin = TRUE)

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

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

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

  output$number_chosen <- renderText({
    paste("You picked:", input$number)})

  onStop(function() {
    # Here I disconnect from a database
    print("Session stopped")
  })
}

shinyApp(
  ui, 
  server,
  onStart = function() {
    onStop(function() {
      print("Application exit")
    })
  }
)
bthieurmel commented 1 year ago

Have you read and try on README part "troubleshooting" ?