R đăng nhập sáng bóng hack

Question

Sau khi thử đánh giá RStudio Shiny Pro Server, tôi không phải là cơ chế quản lý đăng nhập/xác thực vì không có cơ chế quản lý tài khoản người dùng đơn giản để truy cập ứng dụng sáng bóng.

Vì vậy, tôi đang cố gắng tạo cơ chế đăng nhập của riêng mình trong phần Sáng bóng cho mọi mục đích và mục đích hoạt động ok, ngoài việc hiển thị mọi thứ trong khuôn khổ shinydashboard. Mọi thứ dường như bị cắt bỏ trước khi tất cả nội dung được hiển thị. Mã đăng nhập của tôi hơi bị chèn vào https://gist.github.com/withr/9001831, vì vậy, cảm ơn một nhóm ở đó.

Mã của tôi:

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) 

Khi tôi tải ứng dụng nó trông như thế này:

Nếu tôi sau đó thay đổi kích thước màn hình hơi nó tự sửa.

Bất kỳ suy nghĩ về làm thế nào để tránh được những hành vi ban đầu lạ sẽ được đánh giá rất nhiều ..

Answer 1

Tôi nghĩ rằng vấn đề có thể được cố định bằng cách đặt dashboardSidebar và dashboardBody chức năng bên ngoài của renderUI, giống như:

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

Nó sẽ tạo thanh bên trống và sau đó bạn có thể điền bằng hàm renderUI.

Vì bạn có nhiều thành phần trong "sidebarpanel" bạn có thể nhóm sau đó bằng cách thay thế dashboardSidebar chức năng với một chức năng 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")) 
      ) 
     ) 
     } 
     }) 

Remove cũng là dashboardBody từ "cơ thể" làm cho chức năng:

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

Nó sẽ khắc phục được sự cố.

Nhân tiện, có an toàn khi sử dụng loại xác thực đăng nhập này không?