【发布时间】：2021-04-19 20:13:09
【问题描述】：
使用 Shiny App 和 R，我想构建一个只有经过身份验证的用户才能使用的仪表板。该应用程序的结构是：
- 带有用户名框和密码框的简单登录页面，用户在其中输入用户名和密码
- 只有在登录页面上通过身份验证的用户才能访问的仪表板页面
我浏览了几个例子，例如：
https://github.com/treysp/shiny_password
https://github.com/aoles/shinypass
https://gist.github.com/withr/9001831
但在这里我想解决第一个示例时的问题。
我遇到的问题：
当我将dashboardPage() 放入output$ui <- renderUI({ }) 时，它不起作用。所以我删除了renderUI，并将dashboardPage函数直接分配给output$ui，比如output$ui <- dashboardPage()。但不幸的是它仍然返回这个：
Error in tag("section", list(...)) : objet 'user_input_authenticated' introuvable。 （它是法语，但它说它找不到对象）。
这是我的 ui.R 和 server.R。除此之外，您需要从存储库中克隆 admin.R 和 global.R (https://github.com/treysp/shiny_password)。
要创建密码，请使用您想要的用户名和密码运行credentials_init()，然后运行add_users("USER NAME", "PASSWORD")。这两个函数都在 admin.R 中定义。创建密码后，它会存储在credentials/credentials.rds 中，现在您可以使用该应用了。
我想做的是一个带有身份验证的简单仪表板。如果有人帮我解决这个问题，那就太好了。另外，如果除了这些示例之外还有其他解决方案，请告诉我。谢谢。
ui.R（与 Github 存储库中的原始版本相同）
shinyUI(
uiOutput("ui")
)
server.R（为我的自定义使用而修改）
shinyServer(function(input, output, session) {
#### UI code --------------------------------------------------------------
output$ui <- dashboardPage(dashboardHeader(title = "My Page"),
dashboardSidebar(
if (user_input$authenticated == FALSE) {
NULL
} else {
sidebarMenuOutput("sideBar_menu_UI")
}
),
dashboardBody(
if (user_input$authenticated == FALSE) {
##### UI code for login page
uiOutput("uiLogin")
uiOutput("pass")
} else {
#### Your app's UI code goes here!
uiOutput("obs")
plotOutput("distPlot")
}
))
#### YOUR APP'S SERVER CODE GOES HERE ----------------------------------------
# slider input widget
output$obs <- renderUI({
sliderInput("obs", "Number of observations:",
min = 1, max = 1000, value = 500)
})
# render histogram once slider input value exists
output$distPlot <- renderPlot({
req(input$obs)
hist(rnorm(input$obs), main = "")
})
output$sideBar_menu_UI <- renderMenu({
sidebarMenu(id = "sideBar_Menu",
menuItem("Menu 1", tabName="menu1_tab", icon = icon("calendar")),
menuItem("Menu 2", tabName="menu2_tab", icon = icon("database"))
)
})
#### PASSWORD server code ----------------------------------------------------
# reactive value containing user's authentication status
# user_input <- reactiveValues(authenticated = FALSE, valid_credentials = FALSE,
# user_locked_out = FALSE, status = "")
# authenticate user by:
# 1. checking whether their user name and password are in the credentials
# data frame and on the same row (credentials are valid)
# 2. if credentials are valid, retrieve their lockout status from the data frame
# 3. if user has failed login too many times and is not currently locked out,
# change locked out status to TRUE in credentials DF and save DF to file
# 4. if user is not authenticated, determine whether the user name or the password
# is bad (username precedent over pw) or he is locked out. set status value for
# error message code below
observeEvent(input$login_button, {
credentials <- readRDS("credentials/credentials.rds")
row_username <- which(credentials$user == input$user_name)
row_password <- which(credentials$pw == digest(input$password)) # digest() makes md5 hash of password
# if user name row and password name row are same, credentials are valid
# and retrieve locked out status
if (length(row_username) == 1 &&
length(row_password) >= 1 && # more than one user may have same pw
(row_username %in% row_password)) {
user_input$valid_credentials <- TRUE
user_input$user_locked_out <- credentials$locked_out[row_username]
}
# if user is not currently locked out but has now failed login too many times:
# 1. set current lockout status to TRUE
# 2. if username is present in credentials DF, set locked out status in
# credentials DF to TRUE and save DF
if (input$login_button == num_fails_to_lockout &
user_input$user_locked_out == FALSE) {
user_input$user_locked_out <- TRUE
if (length(row_username) == 1) {
credentials$locked_out[row_username] <- TRUE
saveRDS(credentials, "credentials/credentials.rds")
}
}
# if a user has valid credentials and is not locked out, he is authenticated
if (user_input$valid_credentials == TRUE & user_input$user_locked_out == FALSE) {
user_input$authenticated <- TRUE
} else {
user_input$authenticated <- FALSE
}
# if user is not authenticated, set login status variable for error messages below
if (user_input$authenticated == FALSE) {
if (user_input$user_locked_out == TRUE) {
user_input$status <- "locked_out"
} else if (length(row_username) > 1) {
user_input$status <- "credentials_data_error"
} else if (input$user_name == "" || length(row_username) == 0) {
user_input$status <- "bad_user"
} else if (input$password == "" || length(row_password) == 0) {
user_input$status <- "bad_password"
}
}
})
# password entry UI componenets:
# username and password text fields, login button
output$uiLogin <- renderUI({
wellPanel(
textInput("user_name", "User Name:"),
passwordInput("password", "Password:"),
actionButton("login_button", "Log in")
)
})
# red error message if bad credentials
output$pass <- renderUI({
if (user_input$status == "locked_out") {
h5(strong(paste0("Your account is locked because of too many\n",
"failed login attempts. Contact administrator."), style = "color:red"), align = "center")
} else if (user_input$status == "credentials_data_error") {
h5(strong("Credentials data error - contact administrator!", style = "color:red"), align = "center")
} else if (user_input$status == "bad_user") {
h5(strong("User name not found!", style = "color:red"), align = "center")
} else if (user_input$status == "bad_password") {
h5(strong("Incorrect password!", style = "color:red"), align = "center")
} else {
""
}
})
})
【问题讨论】：