R shiny loginハック

Question

RStudio Shiny Pro Serverの評価を試したが、クライアントが光沢のあるアプリケーションにアクセスするためのユーザアカウントを管理する単純なメカニズムではないので、ログイン/認証メカニズムに夢中ではない。

このように私は、shinydashboardフレームワーク内のものを除いて、すべての目的と目的で問題なく動作する独自のログインメカニズムをShiny内に作成しようとしています。すべてのコンテンツが表示される前に、状況が途切れるようです。私のログインコードは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

が、私は問題はrenderUIの外dashboardSidebarとdashboardBody機能を置くことによって固定することができると思います、ただ好き：

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

renderUI関数を使用して後で入力できる空のサイドバーとボディが作成されます。

あなたはdiv機能をdashboardSidebar機能を置き換えることにより、その後「sidebarpanel」のことができます。グループ内の複数のコンポーネントを持っているので：

：「身体」のレンダリング機能から

 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

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

問題を修正する必要があります。

ところで、この種のログイン認証は安全ですか？