r - 使用身份验证构建仪表板

问题描述

使用 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。除此之外，您需要从存储库（https://github.com/treysp/shiny_password）中克隆 admin.R 和 global.R 。要创建密码，请运行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 {
      ""
    }
  })  
})

标签： rshiny

r - 使用身份验证构建仪表板

问题描述

解决方案

推荐阅读