当用户已经在使用 Shiny 应用程序时如何阻止或限制访问

How to block or restrict access when a user is already using a Shiny app

我有一个使用 Ace 编辑器的 Shiny 应用程序。现在我想拥有它,以便当第一个用户使用这个编辑器时,其他用户不能编辑文档,只能查看文档。

如何实现?

密码是:

library(shiny)
library(shinyAce)
library(stringi)

ui <- fluidPage(
  br(),
  uiOutput("aceEditor1"),
  downloadButton('save1', 'Save editor content')
)

server <- function(input, output, session)
{
  output$aceEditor1 <- renderUI(
  {
    aceEditor(outputId = "ace1", 
              value = paste(stri_rand_lipsum(3), collapse="\n\n"),
              mode = "r", 
              height = "500px", 
              fontSize = 17, 
              theme = "chrome", 
              wordWrap = TRUE)
  })

  output$save1 <- downloadHandler (
    filename = function() 
    { 
      "result.txt" 
    },

    content = function(file) 
    { 
       write.table(x = input$ace1, file = file, sep = "", row.names = FALSE, col.names = FALSE, quote = FALSE) 
    }
  )
}

shinyApp(ui = ui, server = server)

您可以通过引入键来实现这一点。本质上,我们创建了一个对所有会话可见的全局键变量。当会话开始时,它获取密钥并将全局变量设置为不可用。

当一个新会话连接时,试图获取密钥,但它不可用。

在服务器功能中,我们可以在执行 "critical section" 段代码之前进行检查。

这基本上是 semiphore 标志如何工作的基础知识。

最后,当第一个会话结束时,它 returns 全局变量的键。

我们还可以更进一步,使用invalidateLater()定期检查密钥是否可用。

先给运行下面的dummy例子运行这个,

write_csv(mtcars,"~/Desktop/data.csv")

应用如下:

library(shiny)


key_available <- TRUE

ui <- fluidPage(
  br(),
  textInput(inputId = "text_input","Text Input"),
  actionButton(inputId = "add_col","Add Column"),
  dataTableOutput("table_output"),
  downloadButton('save1', 'Save editor content')
)

server <- function(input, output, session){

  onSessionEnded(function() key_available <<- TRUE)

  # Session starts, Read data in
  have_key <- FALSE

  observe({
    invalidateLater(1000)

    if(key_available){
      key_available <<- FALSE
      have_key <<- TRUE
    }

  })

  data_reactive <- eventReactive(c(input$add_col),{
    data <- read_csv("~/Desktop/data.csv")
    if(have_key){
      data[[input$text_input]] <- NA
      write_csv(data,"~/Desktop/data.csv")
    }

    return(data)
  })


  output$table_output <- renderDataTable({
    req(data_reactive())
    data_reactive()
    })


}

shinyApp(ui = ui, server = server)

打开第一个浏览器window,在文本框中添加列名,然后点击添加列。

您会注意到该列已添加。您可以继续执行此操作,因为此会话有密钥。

同时打开一个新浏览器window,并尝试执行上述操作将不会成功。但是,如果您关闭第一个浏览器 window,您现在可以在第二个浏览器 window.

上编辑