R shiny login hack

问题

Having tried the evaluation of the RStudio Shiny Pro Server I am not super enthused by the login/authentication mechanism as their is no simple mechanism to manage user accounts for clients to access a shiny app.

As such I am attempting to create my own login mechanism within Shiny which for all intents and purposes is working ok, apart from the display of things within the shinydashboard framework. Things seem to cut off before all the content is displayed. My login code is a slight ammend to https://gist.github.com/withr/9001831, so thanks a bunch there.

My code:

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)

When I load the app it looks like this:

If I then resize the screen slightly it fixes itself.

Any thoughts on how to avoid the strange initial behaviour would be greatly appreciated..

回答1:

I think that the problem can be fixed by putting the dashboardSidebar and dashboardBody function outside of the renderUI, just like:

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

It will create a empty side bar and a body that later you can fill using the renderUI function.

Since you have multiple components in "sidebarpanel" you can group then by replacing the dashboardSidebar function with a div function:

      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"))
            )
          )
        }
      })

Remove also the dashboardBody from the "body" render function:

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

It should fix the problem.

By the way, is it safe to use this kind of login authentication?

来源：https://stackoverflow.com/questions/32644018/r-shiny-login-hack