shinymanager
shinymanager copied to clipboard
Session ends automatically after login
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)
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")
})
}
)
Have you read and try on README part "troubleshooting" ?