为什么我在目录浏览时使用 Shiny downloadHandler() 函数与shinyFilesButton() 函数的工作方式如此不同？

Question

下面的代码是操作按钮的最小工作示例，用户可以使用

downloadHandler()

保存数字输入，并使用

shinyFilesButton()

删除存储该输入的文件。最终，我希望用户能够像管理 Excel 或 Word 文档一样管理文件：您可以将文档保存到本地计算机，从本地计算机加载文档，以及类似地从本地计算机删除文档;但在这种 R 情况下，只有

.rds

文件包含简单的数字输入（场景）。这在 R Shiny 中可行吗？

这个例子我不明白的是：

1. 对于删除操作按钮（使用

   shinyFilesButton()

   ）来说，它在可浏览的目录方面比保存操作按钮（使用

   downloadHandler()

   ）限制要大得多，而且删除的浏览范围也有差异此代码未保存运行时与保存到计算机上运行时的操作按钮（您可以在 R Studio 控制台窗口的右上角看到“运行应用程序”按钮）。使用

   shinyFilesButton()

   的保存操作在可访问的目录方面是否可以像

   downloadHandler()

   一样灵活
2. 仅供观察，但用户始终可以使用“保存”按钮（使用

   downloadHandler()

   ）突出显示文件并按键盘上的删除按钮来删除文件。但带有

   shinyFilesButton()

   的删除操作按钮更安全，因为它只使

   .rds

   文件可供删除。
3. 我想知道这种文件管理结构给用户带来了哪些安全风险以及如何减轻这些风险。将保存/上传/有资格删除的唯一数据类型是简单的矩阵数字输入和简短的字符串编号列表。

   .rds

   文件不会包含敏感数据或任何类型的客户 ID 信息。它们只是保存和管理以供用户将来复制的场景输入。输入可能会变得非常复杂，因此检索非常重要。

代码：

library(shiny)
library(shinyFiles)

ui <- fluidPage(
  numericInput("obs", "User inputs a value:", 10, min = 1, max = 100),
  downloadButton("save_btn", "Save input"),
  actionButton('modal_delete','Delete saved input')
)

server <- function(input, output, session) {
  output$save_btn <- downloadHandler(
    filename = function() {
      paste0("scenario", ".rds")
    },
    content = function(file) {
      saveRDS(input$obs, file)
    }
  )
  
  observeEvent(input$modal_delete, {
    showModal(modalDialog(
      shinyFilesButton("delete_input","Select file to delete","Select file",multiple = FALSE),
      actionButton("delete_btn", "Delete")
    ))
  })
  
  observeEvent(input$modal_delete, {
    saved_files <- list.files(pattern = "\\.rds$")
    updateSelectInput(session, "delete_input", choices = saved_files)
  })
  
  shinyFileChoose(input, "delete_input", roots = c(wd = getwd(), root = "/"), filetypes = c('', 'rds'))
  
  observe({
    saved_files <- list.files(pattern = "\\.rds$")
    updateSelectInput(session, "delete_input", choices = saved_files)
  })
  
  observeEvent(input$delete_btn, {
    file <- parseFilePaths(roots = c(wd = getwd()), input$delete_input)
    if (file$datapath[1] != "" ||
        !is.null(input$delete_input) || 
        input$delete_input != "") {
      unlink(file$datapath[1])
      saved_files <- list.files(pattern = "\\.rds$")  
      updateSelectInput(session, "delete_input", choices = saved_files)
    } 
    removeModal() 
  })
}

shinyApp(ui, server)

Answer 1

根据 Tarjae 和其他评论，下面是我正在确定的代码。请注意，我删除了所有文件删除功能，因为我发现或尝试的所有内容都非常有限。用户始终可以使用 Windows 通过正常渠道删除已保存的

.rds

文件，就像任何已保存的 Excel

.xls

或 Word

.doc

文件一样。进一步请注意，文件会自动保存为

.rds

，消除了 @Spacedman 提到的重写关键操作文件（例如

.exe

文件）的风险。

library(shiny)
library(shinyMatrix)

ui <- fluidPage(
  h5(strong("Matrix inputs:")),
  matrixInput(
    "base_input", 
    value = matrix(rep(1,2), 2, 1, dimnames = list(c("A","B"),NULL)),
    rows = list(extend = FALSE,  names = TRUE),
    cols = list(extend = FALSE, names = FALSE, editableNames = FALSE),
    class = "numeric"
  ),
  
  h5(strong("Multiplies inputs by 4:")),
  tableOutput("result_table"),
  
  h5(strong("Input scenario manager:")),
  actionButton('clear_btn', 'Clear'),
  downloadButton("save_btn", "Save"),
  actionButton('modal_upload','Upload')
)

server <- function(input, output, session) {
  
  output$save_btn <- downloadHandler(
    filename = function() {
      paste0("scenario", ".rds")
    },
    content = function(file) {
      saveRDS(input$base_input, file)
    }
  )
  
  observeEvent(input$modal_upload, {
    showModal(modalDialog(
      fileInput("upload_file_input", "Choose a file to upload:", accept = c('.rds'))
    ))
  })
  
  observe({
    if (!is.null(input$upload_file_input)) {
      uploaded_values <- readRDS(input$upload_file_input$datapath)
      updateMatrixInput(session, "base_input", value = uploaded_values)
      removeModal()
    }
  })
  
  output$upload_file <- downloadHandler(
    filename = function() {
      input$upload_file_input
    },
    content = function(file) {
      file.copy(input$upload_file_input$datapath, file)
    }
  )
  
  observeEvent(input$clear_btn, {
    default_values <- matrix(rep(1,2), 2, 1, dimnames = list(c("A","B"),NULL))
    updateMatrixInput(session, "base_input", value = default_values)
  })
  
  matrix_data <- reactive({
    matrix_df <- as.data.frame(
      matrix(
        input$base_input * 4, 2, 1, dimnames = list(c("A","B"), NULL)
      )
    )
    colnames(matrix_df) <- "Matrix x 4"
    matrix_df
  })
  
  output$result_table <- renderTable({
    matrix_data()
  }, rownames = TRUE, colnames = TRUE)
}

shinyApp(ui, server)