閃亮的密碼在部署時導致斷開連接

Question

我大致按照Starting Shiny app after password input的說明爲我的閃亮應用添加密碼。當我在本地運行應用程序時，它完美地工作，但是當我部署它時，唯一可用的部分是密碼頁面。輸入用戶名和密碼後，應用程序將與服務器斷開連接。爲什麼它會斷開而不是從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} 

Answer 1

我簡化了一下你的代碼，它現在可以按預期：

# 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 
    }) 
})