R闪亮登录黑客

Question

尝试过对 RStudio Shiny Pro Server 的评估后，我对 login/authentication 机制不是很感兴趣，因为它们不是管理用户帐户以供客户访问闪亮应用程序的简单机制。

因此，我试图在 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

我认为可以通过将 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"))
            )
          )
        }
      })

同时从 "body" 渲染函数中删除 dashboardBody：

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

应该可以解决问题。

顺便问一下，使用这种登录认证安全吗？

R闪亮登录黑客

R shiny login hack

r

shiny

shiny-server