使用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.(它是法语，但它说它找不到对象(。
这是我的用户界面。R 和服务器。除此之外，您还需要克隆管理员。R 和全局。来自存储库的 R(https://github.com/treysp/shiny_password(。 要创建密码，请运行credentials_init()，然后使用所需的用户名和密码进行add_users("USER NAME", "PASSWORD")。这两个函数都在 admin.R 中定义。创建密码后，该密码将存储在credentials/credentials.rds中，现在您可以使用该应用程序。
我想做的是一个简单的带有身份验证的仪表板。如果有人帮我解决这个问题，那就太好了。另外，如果除了这些示例之外还有其他解决方案，请告诉我。谢谢。
用户界面。R(与 Github 存储库中的原始版本相同(
shinyUI(
uiOutput("ui")
)
服务器。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 manyn",
"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 {
""
}
})
})
一个善良的 githubber @skhan8刚刚提交了一个拉取请求，演示了如何在闪亮的仪表板中使用shiny_password。它将很快合并到主存储库中。