Shiny问卷应用Dropbox存储失效：令牌过期解决方案咨询

你遇到的问题确实是短期访问令牌4小时过期导致的：rdrop2默认drop_auth()生成的是短期令牌，无刷新令牌支持，过期后无法自动续期，触发Dropbox API调用失败，进而导致服务器断开连接。以下是具体解决方案：

一、生成带刷新令牌的持久化认证令牌 #

首先需要在本地生成包含刷新令牌的令牌，实现自动续期：

1. 前往Dropbox开发者控制台创建独立应用，获取APP_KEY和APP_SECRET。
2. 在本地R环境执行以下代码生成并保存令牌：

library(rdrop2)

# 替换为你的应用密钥
APP_KEY <- "你的Dropbox应用Key"
APP_SECRET <- "你的Dropbox应用Secret"

# 启用离线访问以获取刷新令牌
token <- drop_auth(
  key = APP_KEY,
  secret = APP_SECRET,
  cache = FALSE,
  scope = "files.content.write files.content.read" # 根据需求调整权限
)

# 保存令牌到本地文件
saveRDS(token, "droptoken.rds")

二、修改应用代码，实现令牌自动刷新 #

调整认证和数据处理逻辑，确保每次调用API时使用有效令牌：

1. 应用启动时初始化令牌 #

library(rdrop2)
library(dplyr)

# 加载本地令牌
token <- readRDS("droptoken.rds")

# 检查令牌是否即将过期，提前刷新
if (token$expires_in <= 3600) { # 提前1小时触发刷新
  token <- drop_auth(
    key = token$app$key,
    secret = token$app$secret,
    refresh_token = token$refresh_token,
    cache = FALSE
  )
  saveRDS(token, "droptoken.rds")
}

# 设置全局默认令牌
drop_auth(dtoken = token)

2. 改造数据保存与加载函数 #

为saveData和loadData添加令牌刷新逻辑：

fields <- c("a", "b", "c")
outputDir <- "responses"
delimiter <- ";"

saveData <- function(data) {
  tryCatch({
    current_token <- readRDS("droptoken.rds")
    # 提前1小时刷新令牌
    if (current_token$expires_in <= 3600) {
      current_token <- drop_auth(
        key = current_token$app$key,
        secret = current_token$app$secret,
        refresh_token = current_token$refresh_token,
        cache = FALSE
      )
      saveRDS(current_token, "droptoken.rds")
    }
    
    # 原有数据处理逻辑
    for (field in fields) {
      data[[field]] <- paste(data[[field]], collapse = delimiter)
    }

    fileName <- sprintf("%s_%s.csv", as.integer(Sys.time()), digest::digest(data))
    filePath <- file.path(tempdir(), fileName)
    write.csv(data, filePath, row.names = FALSE, quote = TRUE)
    
    # 上传时指定有效令牌
    drop_upload(filePath, path = outputDir, dtoken = current_token)
  }, error = function(e) {
    # 错误提示
    showModal(modalDialog(
      title = "提交失败",
      paste("无法保存答案：", e$message),
      footer = modalButton("Close")
    ))
    stop(e)
  })
}

loadData <- function() {
  current_token <- readRDS("droptoken.rds")
  if (current_token$expires_in <= 3600) {
    current_token <- drop_auth(
      key = current_token$app$key,
      secret = current_token$app$secret,
      refresh_token = current_token$refresh_token,
      cache = FALSE
    )
    saveRDS(current_token, "droptoken.rds")
  }
  
  filesInfo <- drop_dir(outputDir, dtoken = current_token)
  filePaths <- filesInfo$path_display
  data <- lapply(filePaths, function(path) {
    drop_read_csv(path, stringsAsFactors = FALSE, dtoken = current_token)
  })
  data <- do.call(rbind, data)
  
  for (field in fields) {
    data[[field]] <- strsplit(data[[field]], delimiter)
  }
  
  data
}

三、部署到shinyapps.io的注意事项 #

• 确保droptoken.rds文件包含在部署包中，不要依赖httr_oauth缓存文件。
• 建议将APP_KEY和APP_SECRET通过shinyapps.io的应用环境变量配置，避免硬编码在代码中。
• 应用启动逻辑中不要重复调用drop_auth()，仅通过加载本地令牌初始化。

内容的提问来源于stack exchange，提问作者Giorgio Zavattoni