Используя 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 {
""
}
})
})