部署时闪亮的密码导致断开连接(shiny password causing disconnect when deployed)

我大致按照密码输入后启动Shiny应用程序的说明向我的闪亮应用程序添加密码。 当我在本地运行应用程序时它非常有效，但是当我部署它时，唯一有效的部分是密码页面。 输入用户名和密码后，应用程序将断开与服务器的连接。 为什么断开连接而不是从ui1切换到ui2？ 我不确定如何使这个可重现，但我的代码看起来大致如下：

UI

#Load Libraries #this is really my whole ui.R file shinyUI(htmlOutput("page"))

server.R

#Load Libraries #Load Functions And Data #Define variables to connect to MySQL databaseName <- "****" table <- "****" options( mysql = list( "host" = "****", "port" = 3306, "user" = "****", "password" = "****" ) ) #SQL Data Retrieval Functions From http://deanattali.com/blog/shiny-persistent-data-storage/ saveData <- function(data) { # Connect to the database db <- dbConnect(MySQL(), dbname = databaseName, host = options()$mysql$host, port = options()$mysql$port, user = options()$mysql$user, password = options()$mysql$password) # Construct the update query by looping over the data fields query <- sprintf( "INSERT INTO %s (%s) VALUES ('%s')", table, paste(names(data), collapse = ", "), paste(data, collapse = "', '") ) # Submit the update query and disconnect dbGetQuery(db, query) dbDisconnect(db) } loadData <- function() { # Connect to the database db <- dbConnect(MySQL(), dbname = databaseName, host = options()$mysql$host, port = options()$mysql$port, user = options()$mysql$user, password = options()$mysql$password) # Construct the fetching query query <- sprintf("SELECT * FROM %s", table) # Submit the fetch query and disconnect data <- dbGetQuery(db, query) dbDisconnect(db) data } #define password #password protection applied based on example here: https://stackoverflow.com/questions/28987622/starting-shiny-app-after-password-input Logged = FALSE; my_username <- "Administrator" my_password <- "****" #Actual UI ui1 <- function(){ tagList( div(id = "login", wellPanel(textInput("userName", "Username"), passwordInput("passwd", "Password"), br(),actionButton("Login", "Log in"))), tags$style(type="text/css", "#login {font-size:10px; text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}") )} ui2 <- fluidPage( shinyjs::useShinyjs(), sidebarPanel( #various elements of a sidebar panel ), mainPanel( #various elements of a main panel ), tabPanel(#tabPanel things), tabPanel(#tabPanel things), tabPanel(#tabPanel things), tabPanel(#tabPanel things) ) #Actual Server server = (function(input, output) { #various reactive page elements such as tables, plots, and conditional panels #Server Side Password activity USER <- reactiveValues(Logged = Logged) observe({ if (USER$Logged == FALSE) { if (!is.null(input$Login)) { if (input$Login > 0) { Username <- isolate(input$userName) Password <- isolate(input$passwd) Id.username <- which(my_username == Username) Id.password <- which(my_password == Password) if (length(Id.username) > 0 & length(Id.password) > 0) { if (Id.username == Id.password) { USER$Logged <- TRUE } } } } } }) observe({ if (USER$Logged == FALSE) { output$page <- renderUI({ div(class="outer",do.call(bootstrapPage,c("",ui1()))) }) } if (USER$Logged == TRUE) { output$page <- renderUI({ ui2 }) print(ui) } }) })

如果这有帮助，这是控制台日志中发生的情况：

jquery.min.js:4 Synchronous XMLHttpRequest on the main thread is deprecated because of its detrimental effects to the end user's experience. For more help, check https://xhr.spec.whatwg.org/. send @ jquery.min.js:4 ajax @ jquery.min.js:4 getSettings @ shinyapps.js:39 (anonymous) @ shinyapps.js:1 rstudio-connect.js:384 Mon Mar 06 2017 17:06:28 GMT-0600 (CST): Connection opened. https://zlevine.shinyapps.io/forcafha/ rstudio-connect.js:384 Mon Mar 06 2017 17:07:05 GMT-0600 (CST): Connection closed. Info: {"type":"close","code":1000,"reason":"Normal closure","wasClean":true}

I'm roughly following the instructions from Starting Shiny app after password input to add a password to my shiny app. It works perfectly when I run the app locally, but when I deploy it the only part that works is the password page. After I enter the username and password the app disconnects from the server. Why is it disconnecting instead of switching from ui1 to ui2? I'm not sure how to make this reproducible, but my code looks approximately like this:

UI

#Load Libraries #this is really my whole ui.R file shinyUI(htmlOutput("page"))

server.R

#Load Libraries #Load Functions And Data #Define variables to connect to MySQL databaseName <- "****" table <- "****" options( mysql = list( "host" = "****", "port" = 3306, "user" = "****", "password" = "****" ) ) #SQL Data Retrieval Functions From http://deanattali.com/blog/shiny-persistent-data-storage/ saveData <- function(data) { # Connect to the database db <- dbConnect(MySQL(), dbname = databaseName, host = options()$mysql$host, port = options()$mysql$port, user = options()$mysql$user, password = options()$mysql$password) # Construct the update query by looping over the data fields query <- sprintf( "INSERT INTO %s (%s) VALUES ('%s')", table, paste(names(data), collapse = ", "), paste(data, collapse = "', '") ) # Submit the update query and disconnect dbGetQuery(db, query) dbDisconnect(db) } loadData <- function() { # Connect to the database db <- dbConnect(MySQL(), dbname = databaseName, host = options()$mysql$host, port = options()$mysql$port, user = options()$mysql$user, password = options()$mysql$password) # Construct the fetching query query <- sprintf("SELECT * FROM %s", table) # Submit the fetch query and disconnect data <- dbGetQuery(db, query) dbDisconnect(db) data } #define password #password protection applied based on example here: https://stackoverflow.com/questions/28987622/starting-shiny-app-after-password-input Logged = FALSE; my_username <- "Administrator" my_password <- "****" #Actual UI ui1 <- function(){ tagList( div(id = "login", wellPanel(textInput("userName", "Username"), passwordInput("passwd", "Password"), br(),actionButton("Login", "Log in"))), tags$style(type="text/css", "#login {font-size:10px; text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}") )} ui2 <- fluidPage( shinyjs::useShinyjs(), sidebarPanel( #various elements of a sidebar panel ), mainPanel( #various elements of a main panel ), tabPanel(#tabPanel things), tabPanel(#tabPanel things), tabPanel(#tabPanel things), tabPanel(#tabPanel things) ) #Actual Server server = (function(input, output) { #various reactive page elements such as tables, plots, and conditional panels #Server Side Password activity USER <- reactiveValues(Logged = Logged) observe({ if (USER$Logged == FALSE) { if (!is.null(input$Login)) { if (input$Login > 0) { Username <- isolate(input$userName) Password <- isolate(input$passwd) Id.username <- which(my_username == Username) Id.password <- which(my_password == Password) if (length(Id.username) > 0 & length(Id.password) > 0) { if (Id.username == Id.password) { USER$Logged <- TRUE } } } } } }) observe({ if (USER$Logged == FALSE) { output$page <- renderUI({ div(class="outer",do.call(bootstrapPage,c("",ui1()))) }) } if (USER$Logged == TRUE) { output$page <- renderUI({ ui2 }) print(ui) } }) })

In case this helps, here's what happens in the console log:

jquery.min.js:4 Synchronous XMLHttpRequest on the main thread is deprecated because of its detrimental effects to the end user's experience. For more help, check https://xhr.spec.whatwg.org/. send @ jquery.min.js:4 ajax @ jquery.min.js:4 getSettings @ shinyapps.js:39 (anonymous) @ shinyapps.js:1 rstudio-connect.js:384 Mon Mar 06 2017 17:06:28 GMT-0600 (CST): Connection opened. https://zlevine.shinyapps.io/forcafha/ rstudio-connect.js:384 Mon Mar 06 2017 17:07:05 GMT-0600 (CST): Connection closed. Info: {"type":"close","code":1000,"reason":"Normal closure","wasClean":true}

最满意答案

我简化了你的代码，它现在按预期工作：

# ui.R shinyUI(fluidPage(shinyjs::useShinyjs(),uiOutput("page")))

*******************************************************************************************

# server.R shinyServer(function(input, output) { Logged = FALSE; my_username <- "Administrator" my_password <- "****" #Actual UI ui1 <-tagList( div(id = "login", wellPanel(textInput("userName", "Username"), passwordInput("passwd", "Password"), br(),actionButton("Login", "Log in"))), tags$style(type="text/css", "#login {font-size:10px; text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}") ) ui2 <- titlePanel("Loggedin!") USER <- reactiveValues(Logged = Logged) observe({ if (USER$Logged == FALSE) { if (!is.null(input$Login)) { if (input$Login > 0) { Username <- isolate(input$userName) Password <- isolate(input$passwd) Id.username <- which(my_username == Username) Id.password <- which(my_password == Password) if (length(Id.username) > 0 & length(Id.password) > 0) { if (Id.username == Id.password) { USER$Logged <- TRUE } } } } } }) output$page <- renderUI({ if (USER$Logged == FALSE) div(class="outer",do.call(bootstrapPage,c("",ui1))) else ui2 }) })

I simplified a bit your code and it now works as expected:

# ui.R shinyUI(fluidPage(shinyjs::useShinyjs(),uiOutput("page")))

*******************************************************************************************

# server.R shinyServer(function(input, output) { Logged = FALSE; my_username <- "Administrator" my_password <- "****" #Actual UI ui1 <-tagList( div(id = "login", wellPanel(textInput("userName", "Username"), passwordInput("passwd", "Password"), br(),actionButton("Login", "Log in"))), tags$style(type="text/css", "#login {font-size:10px; text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}") ) ui2 <- titlePanel("Loggedin!") USER <- reactiveValues(Logged = Logged) observe({ if (USER$Logged == FALSE) { if (!is.null(input$Login)) { if (input$Login > 0) { Username <- isolate(input$userName) Password <- isolate(input$passwd) Id.username <- which(my_username == Username) Id.password <- which(my_password == Password) if (length(Id.username) > 0 & length(Id.password) > 0) { if (Id.username == Id.password) { USER$Logged <- TRUE } } } } } }) output$page <- renderUI({ if (USER$Logged == FALSE) div(class="outer",do.call(bootstrapPage,c("",ui1))) else ui2 }) })