单击第一个选项卡中的按钮后启动闪亮管理器身份验证，然后显示其他选项卡

Question

我想知道是否可以使用闪亮管理器保护闪亮的应用程序，但可以在输入用户名和密码之前访问应用程序的第一个选项卡，同时隐藏第二个和第三个选项卡？

我想要一个“连接”按钮来启动闪亮管理器页面，然后显示其他选项卡。

有人知道这是否可行，或者我应该使用自己的身份验证表格（这意味着安全性较低......）？

我的尝试：

library(shiny)
library(shinymanager)
library(shinydashboard)
library(shinyWidgets)
library(shinythemes)

credentials <- data.frame(
  user = c("user1"),
  password = c("1"),
  stringsAsFactors = FALSE
)

# user interface
ui <- navbarPage(id="navbarid",
                 "TEST",  theme = shinytheme("cosmo"),
                 header = tagList(
                   useShinydashboard()),

                 tabPanel(
                   "Welcome", fluidRow(align = "center", 
                        column(6, offset=4,
                               box(title = "Authentification", background = "black", 
                                 fluidRow(column(6, align = "center", style='padding-top:20px;',
                                    actionButton(inputId = "connect", label = "Log in")),
                                          column(6, align = "center", style='padding-top:20px;',
                                    actionButton(inputId = "register", label = "Register here"))))))),

                 tabPanel("Tab2", verbatimTextOutput("label1")
                   ),

                 tabPanel("Tab3", verbatimTextOutput("label2")
                 ))

ui <- secure_app(ui)

server <- function(input, output, session) {
  
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )
  
  output$icon1 <- renderText(as.character(icon("sign-in-alt")))
  output$icon2 <- renderText(as.character(icon("users")))

  output$label1 <- renderText("First tab content here")
  output$label2 <- renderText("Second tab content here")
}

shinyApp(ui, server)

我尝试添加

observeEvent(input$connect, {
  res_auth <- secure_server(
    check_credentials = check_credentials(credentials)
  )})

在我的服务器部分的开头，但它不起作用！

Answer 1

以下是我之前的回答（此处和此处）的组合。

我正在使用两个单独的 R 会话 - 两个会话都托管一个闪亮的应用程序。带有公共内容的家长闪亮应用程序照常启动。该应用程序包含一个iframe用于显示通过在子进程中启动的闪亮应用程序的安全内容callr::r_bg。

这种方法当前的缺点是，无法使用shinymanager的注销按钮，因为它正在清除查询字符串（我猜是重新加载shiny会话），这是确定访问哪个选项卡所必需的。

请检查以下内容：

library(shiny)
library(shinymanager)
library(shinydashboard)
library(shinyWidgets)
library(shinythemes)
library(callr)

secured_ui <- secure_app(fluidPage(uiOutput("iframecontent")), fab_position = "none")

secured_server <- function(input, output, session) {
  credentials <- data.frame(
    user = c("admin", "user1", "user2"),
    password = c("admin", "user1", "user2"),
    admin = c(TRUE, FALSE, FALSE),
    permission = c("advanced", "basic", "basic"),
    job = c("CEO", "CTO", "DRH"),
    stringsAsFactors = FALSE)
  
  res_auth <- shinymanager::secure_server(
    check_credentials = shinymanager::check_credentials(credentials)
  )
  
  output$iframecontent <- renderUI({
    currentQueryString <- getQueryString(session)$tab # alternative: parseQueryString(session$clientData$url_search)$tab
    if (is.null(currentQueryString)){
      return(div(h2("There is nothing here", style = "color: red;")))
    } else {
      req(currentQueryString, cancelOutput = TRUE)
      req(res_auth$permission, cancelOutput = TRUE)
      fluidPage(
        if(!is.null(currentQueryString) && currentQueryString == "tab1" && res_auth$permission %in% c("basic", "advanced")){
          div(h2("First tab content here"))
        } else if (!is.null(currentQueryString) && currentQueryString == "tab2" && res_auth$permission == "advanced"){
          div(h2("Second tab content here"))
        } else {
          div(h2("Access not permitted", style = "color: red;"))
        }, theme = shinythemes::shinytheme("cosmo")
      )
    }
  })
}

secured_child_app <- shinyApp(secured_ui, secured_server)

# run secured_child_app in a background R process - not needed when e.g. hosted on shinyapps.io
secured_child_app_process <- callr::r_bg(
  func = function(app) {
    shiny::runApp(
      appDir = app,
      port = 3838L,
      launch.browser = FALSE,
      host = "127.0.0.1" # secured_child_app is accessible only locally (or via the iframe)
    )
  },
  args = list(secured_child_app),
  stdout = "|",
  stderr = "2>&1",
  supervise = TRUE
)

print("Waiting for secured child app to get ready...")
while(!any(grepl("Listening on http", secured_child_app_process$read_output_lines()))){
  Sys.sleep(0.5)
}

public_ui <- navbarPage(id="navbarid",
                        "Secured Tabs Test",
                        theme = shinytheme("cosmo"),
                        header = tagList(useShinydashboard()),
                        tabPanel(
                          "Welcome", h2("Public content here")
                        ),
                        tabPanel("Tab1",
                                 tags$iframe(
                                   src = "http://127.0.0.1:3838/?tab=tab1",
                                   style = "border: none;
                              overflow: hidden;
                              height: calc(100vh - 100px);
                              width : 100vw;
                              position: relative;
                              top:0px;
                              padding:0px;"
                                 )),
                        tabPanel("Tab2", tags$iframe(
                          src = "http://127.0.0.1:3838/?tab=tab2",
                          style = "border: none;
                              overflow: hidden;
                              height: calc(100vh - 100px);
                              width : 100vw;
                              position: relative;
                              top:0px;
                              padding:0px;"
                        ))
)

public_server <- function(input, output, session) {}

public_parent_app <- shinyApp(public_ui, public_server, onStart = function() {
  cat("Doing application setup\n")
  onStop(function() {
    cat("Doing application cleanup\n")
    secured_child_app_process$kill() # kill secured_child_app if public_parent_app is exited - not needed when hosted separately
  })
})

# run public_parent_app
runApp(appDir = public_parent_app,
       port = 3939L,
       launch.browser = TRUE,
       host = "0.0.0.0")