R闪亮的登录黑客

Question

在尝试了对RStudio Shiny Pro服务器的评估之后,我并不十分热衷于登录/身份验证机制,因为它们不是简单的机制来管理用户帐户以便客户端访问闪亮的应用程序.

因此,我试图在Shiny中创建自己的登录机制,除了shinydashboard框架内的事物显示之外,所有意图和目的都正常工作.在显示所有内容之前,事情似乎已切断.我的登录代码对https://gist.github.com/withr/9001831略有不同,所以非常感谢.

我的代码:

require(shiny)
require(shinydashboard)

my_username <- "test"
my_password <- "abc"

header <- dashboardHeader(title = "my heading")
sidebar <- uiOutput("sidebarpanel")
body <- uiOutput("body")

login <- box(title = "Login",textInput("userName", "Username"),
             passwordInput("passwd", "Password"),
             br(),actionButton("Login", "Log in"))

mainpage <- "some data"

ui <- dashboardPage(header, sidebar, body)

server <- function(input, output, session) {
  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$sidebarpanel <- renderUI({
    if (USER$Logged == TRUE) { 
      dashboardSidebar(
        sidebarUserPanel("myuser",subtitle = a(icon("user"), "Logout", href="__logout__")),
        selectInput("in_var", "myvar", multiple = FALSE,
                  choices = c("option 1","option 2")),
        sidebarMenu(
          menuItem("Item 1", tabName = "t_item1", icon = icon("line-chart")),
          menuItem("Item 2", tabName = "t_item2", icon = icon("dollar")),
          menuItem("Item 3", tabName = "t_item3", icon = icon("credit-card")),
          menuItem("Item 4", tabName = "t_item4", icon = icon("share-alt"))
        ))}
  })

  output$body <- renderUI({
    if (USER$Logged == TRUE) {
      dashboardBody(mainpage)
    }
    else {
      dashboardBody(login)
    }
  })
}

shinyApp(ui, server)

当我加载应用程序时,它看起来像这样:

如果我稍微调整屏幕大小,它会修复自己.

任何关于如何避免奇怪的初始行为的想法将不胜感激..

Answer 1

我认为可以通过将the dashboardSidebar和dashboardBody函数放在外面来解决问题renderUI,就像:

header <- dashboardHeader(title = "my heading")
sidebar <- dashboardSidebar(uiOutput("sidebarpanel"))
body <- dashboardBody( uiOutput("body") )

它将创建一个空的侧栏和一个身体,以后您可以使用该renderUI功能填充.

由于"sidebarpanel"中有多个组件,因此可以通过将dashboardSidebar函数替换为函数进行分组div:

      output$sidebarpanel <- renderUI({
        if (USER$Logged == TRUE) { 
          div(
            sidebarUserPanel("myuser",subtitle = a(icon("user"), "Logout", href="__logout__")),
            selectInput("in_var", "myvar", multiple = FALSE,
                      choices = c("option 1","option 2")),
            sidebarMenu(
              menuItem("Item 1", tabName = "t_item1", icon = icon("line-chart")),
              menuItem("Item 2", tabName = "t_item2", icon = icon("dollar")),
              menuItem("Item 3", tabName = "t_item3", icon = icon("credit-card")),
              menuItem("Item 4", tabName = "t_item4", icon = icon("share-alt"))
            )
          )
        }
      })

还dashboardBody从"body"渲染功能中删除:

output$body <- renderUI({
    if (USER$Logged == TRUE) {
      mainpage
    }
    else {
      login
    }
  })

它应该解决问题.

顺便说一下,使用这种登录验证是否安全？