如何为PostgreSQL版Shinymanager启用管理员模式及Cookie认证

问题背景 #

现有部署在AWS上的R Shiny应用，使用PostgreSQL数据库和Shinymanager做身份验证。需求有两个：

1. 官方文档显示Shinymanager管理员模式仅支持SQLite，需实现PostgreSQL下的管理员模式
2. 添加基于Cookie的认证机制，避免页面刷新时重复输入凭据

解决方案 #

1. 启用PostgreSQL下的管理员模式 #

Shinymanager的管理员权限核心是识别用户的管理员身份，我们可以通过自定义认证函数返回用户的管理员状态，再结合应用逻辑实现专属功能：

步骤1：修改认证函数，返回管理员状态

更新my_custom_check_creds函数，从PostgreSQL中读取用户的admin字段并加入返回的user_info：

my_custom_check_creds <- function(dbname, host, port, db_user, db_password) {
  function(user, password) {
    con <- dbConnect(dbDriver("PostgreSQL"), dbname = dbname, 
                     host = host, port = port,
                     user = db_user, password = db_password)
    
    on.exit(dbDisconnect(con))
    
    req <- glue_sql("SELECT * FROM my_table WHERE \"user\" = ({user}) AND \"password\" = ({password})", 
             user = user, password = password, .con = con
    )
    
    req <- dbSendQuery(con, req)
    res <- dbFetch(req)
    if (nrow(res) > 0) {
      # 返回管理员状态到用户信息
      list(result = TRUE, user_info = list(
        user = res$user, 
        is_admin = res$admin, 
        something = 123
      ))
    } else {
      list(result = FALSE)
    }
  }
}

步骤2：在应用中实现管理员专属逻辑

在server中获取用户的管理员状态，添加专属UI或操作：

server <- function(input, output, session) {
  res_auth <- secure_server(
    check_credentials = my_custom_check_creds(
      dbname = "******",
      host = "*****",
      port = ****,
      db_user = "*****",
      db_password = "*******"
    )
  )  
  
  # 获取用户认证信息
  auth_output <- reactive({
    reactiveValuesToList(res_auth)
  })
  
  # 根据管理员状态显示不同内容
  output$auth_output <- renderPrint({
    user_info <- auth_output()$user_info
    if(user_info$is_admin){
      cat("当前用户：", user_info$user, "\n权限：管理员\n")
      # 在此添加管理员专属操作，比如用户管理、系统配置修改等
    } else {
      cat("当前用户：", user_info$user, "\n权限：普通用户\n")
    }
  })
}

如果需要完整的管理员后台界面，可以结合shinymanager的admin_ui，用PostgreSQL替代SQLite实现用户增删改查的读写逻辑。

2. 添加基于Cookie的持久化认证 #

Shinymanager内置Cookie认证支持，只需在secure_app和secure_server中配置参数即可：

步骤1：配置UI端Cookie参数

修改secure_app，设置Cookie名称和过期时间（单位：天）：

ui <- secure_app(ui, 
                 cookie = list(
                   name = "shiny_auth_cookie", 
                   expires = 7, # 7天过期
                   secure = TRUE # 生产环境建议开启，仅HTTPS下传输
                 ))

步骤2：配置Server端Cookie验证

在secure_server中启用Cookie验证，设置加密密钥：

server <- function(input, output, session) {
  res_auth <- secure_server(
    check_credentials = my_custom_check_creds(
      dbname = "******",
      host = "*****",
      port = ****,
      db_user = "*****",
      db_password = "*******"
    ),
    cookie = list(
      name = "shiny_auth_cookie",
      secret = "your_secure_random_secret_key" # 自定义加密密钥，建议用随机字符串
    )
  )  
  # 后续逻辑不变...
}

注意：secret密钥需保密，生产环境建议从环境变量读取，避免硬编码。

完整修改后的代码 #

require(RPostgreSQL)
library(shiny)
library(shinymanager)
library(DBI)
library(glue)

# 数据库连接配置（建议从环境变量或配置文件读取）
dbname = "*****"
host = "localhost"
port = *****
user = "*****"
password = "******"

# 初始化用户表（仅首次运行）
con <- dbConnect(dbDriver("PostgreSQL"), dbname = dbname , host = host, port = port ,
                 user = user, password = password )

DBI::dbWriteTable(con, "my_table", overwrite = TRUE,
                  data.frame(user = c("shiny", "admin"),
                             password = c("shiny", "admin"),
                             admin = c(FALSE, TRUE),
                             stringsAsFactors = FALSE))
dbDisconnect(con)

# 自定义认证函数，返回管理员状态
my_custom_check_creds <- function(dbname, host, port, db_user, db_password) {
  function(user, password) {
    con <- dbConnect(dbDriver("PostgreSQL"), dbname = dbname, 
                     host = host, port = port,
                     user = db_user, password = db_password)
    
    on.exit(dbDisconnect(con))
    
    req <- glue_sql("SELECT * FROM my_table WHERE \"user\" = ({user}) AND \"password\" = ({password})", 
             user = user, password = password, .con = con
    )
    
    req <- dbSendQuery(con, req)
    res <- dbFetch(req)
    if (nrow(res) > 0) {
      list(result = TRUE, user_info = list(
        user = res$user, 
        is_admin = res$admin, 
        something = 123
      ))
    } else {
      list(result = FALSE)
    }
  }
}

# 主UI，启用Cookie认证
ui <- fluidPage(
  tags$h2("My secure application"),
  verbatimTextOutput("auth_output")
)
ui <- secure_app(ui, 
                 cookie = list(
                   name = "shiny_auth_cookie", 
                   expires = 7,
                   secure = TRUE
                 ))

# 主Server，启用管理员权限识别与Cookie验证
server <- function(input, output, session) {
  res_auth <- secure_server(
    check_credentials = my_custom_check_creds(
      dbname = "******",
      host = "*****",
      port = ****,
      db_user = "*****",
      db_password = "*******"
    ),
    cookie = list(
      name = "shiny_auth_cookie",
      secret = "your_secure_random_secret_key" # 替换为自定义密钥
    )
  )  
  
  auth_output <- reactive({
    reactiveValuesToList(res_auth)
  })
  
  # 根据权限显示内容
  output$auth_output <- renderPrint({
    user_info <- auth_output()$user_info
    if(!is.null(user_info)){
      if(user_info$is_admin){
        cat("当前用户：", user_info$user, "\n权限：管理员\n")
        # 可在此添加管理员专属功能，比如用户管理界面
      } else {
        cat("当前用户：", user_info$user, "\n权限：普通用户\n")
      }
    }
  })
}

shinyApp(ui, server)

内容的提问来源于stack exchange，提问作者M.Qasim