r - 在 Shiny 的应用程序和多个页面中进行身份验证

Question

在我正在开发的系统中，我有 3 个不同的参与者(用户、管理员、支持团队)使用 Shiny App。我想知道如何向这三个 Actor 提供身份验证，每个 Actor 都只能访问他们的页面。我发现它可以通过 Shiny 的服务器 Pro 来实现，它不是免费的。有什么办法可以代替使用 Shiny 的服务器专业版。在 UI.R 中，代码如下:

  library(shiny)
library(shinydashboard)
rm(list = ls())


Logged = FALSE;
my_username <- "test"
my_password <- "test"

ui1 <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(


  box(




    ui = (htmlOutput("page"))

   )
  )
)

在 Server.R 中，代码如下:
图书馆( Shiny 的仪表板)

图书馆( Shiny )

server = (function(input, output,session) {

  ui1 <- function(){
    tagList(
      div(id = "login",
          wellPanel(textInput("userName", "Username"),
                    passwordInput("passwd", "Password"),
                    br(),actionButton("Login", "Log in"))),
      tags$style(type="text/css", "#login {font-size:10px;   text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -100px;margin-left: -150px;}")
    )}

  ui2 <- function(){tagList(tabPanel("Test"))}
  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
            } 
          }
        } 
      }
    }    
  })
  observe({
    if (USER$Logged == FALSE) {

      output$page <- renderUI({
        div(class="outer",do.call(bootstrapPage,c("",ui1())))
      })
    }
    if (USER$Logged == TRUE) 
    {
      output$page <- renderUI({
        div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2())))
      })
      print(ui)
    }
  })
})

我想转到仅对 user 进行身份验证的另一个页面。如何将 UI.R 连接到 Shiny 应用程序中的不同页面？ (例如显示页面 USER.R)。

Answer 1

试试这样
我认为它可以帮助你做你想做的事

1) 用户界面:

library(shiny)
library(shinydashboard)
shinyUI( 
  dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    dashboardBody(

        uiOutput("page")

    )
  )

)

2)服务器:

    library(shiny)
    library(shinydashboard)
    source("user.R")
    source("admin.R")

    my_username <- c("test","admin")
    my_password <- c("test","123")
    get_role=function(user){
      if(user=="test") {
        return("TEST")
      }else{
        return("ADMIN")
      }
    }

    get_ui=function(role){
      if(role=="TEST"){
        return(list_field_user)
      }else{
        return(list_field_admin)
      }
    }


    shinyServer(function(input, output,session) {

      USER <- reactiveValues(Logged = FALSE,role=NULL)

      ui1 <- function(){
        tagList(
          div(id = "login",
              wellPanel(textInput("userName", "Username"),
                        passwordInput("passwd", "Password"),
                        br(),actionButton("Login", "Log in")))
          ,tags$style(type="text/css", "#login {font-size:10px;   text-align: left;position:absolute;top: 40%;left: 50%;margin-top: -10px;margin-left: -150px;}")
        )}

      ui2 <- function(){list(tabPanel("Test",get_ui(USER$role)[2:3]),get_ui(USER$role)[[1]])}

      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
                  USER$role=get_role(Username)

              }
            } 
          }
        }
        }
      })
      observe({
        if (USER$Logged == FALSE) {

          output$page <- renderUI({
box(
            div(class="outer",do.call(bootstrapPage,c("",ui1()))))
          })
        }
        if (USER$Logged == TRUE)    {
          output$page <- renderUI({
box(width = 12,
            div(class="outer",do.call(navbarPage,c(inverse=TRUE,title = "Contratulations you got in!",ui2())))
          )})
          #print(ui)
        }
      })
    })

3)用户.r:

 list_field_user = list(tabPanel("test2",fluidRow(column(6,numericInput("inputtest", "test", value = 0),column(6,actionButton(inputId ="test1",label ="go"))))),
                       h1("1234"),h2("234"))

4) 管理员.r

list_field_admin = list( h1("admin"),h2("admin"))

!!!将所有这些文件放在一个目录中

那个简单的例子，但这可以帮助你