R Shiny WebApp中使用AzureAuth包获取访问用户信息的方案

核心问题修正点 #

• 原代码将应用自身ID作为resource参数，无法调用Microsoft Graph接口获取用户信息，需将资源改为Graph服务地址，并配置对应权限
• 原代码将token获取逻辑写在全局环境，多用户访问时会出现token串用问题，需移至server端按会话独立生成
• 缺少对Graph/me接口的调用，该接口可返回当前登录用户的所有基础身份信息

具体实现步骤 #

1. Azure AD应用前置配置 #

• 进入Azure门户的应用注册页面，找到你的应用，在「API权限」中添加Microsoft Graph的委托权限User.Read，该权限默认允许读取当前登录用户的基础身份信息，组织内账号通常无需管理员同意即可使用

2. 修正全局配置参数 #

将原代码中resource参数替换为Graph服务地址，同时在授权URI中添加对应权限范围，修改后的全局代码如下：

load.lib <- c("AzureAuth","shiny","shinyjs","httr","jsonlite")
install.lib <- load.lib[!load.lib %in% installed.packages()]
for(lib in install.lib) install.packages(lib,dependencies=TRUE)
sapply(load.lib,library,character.only=TRUE)

######### Setting the local port ###############
redirect <- "http://localhost:8100"
port <- httr::parse_url(redirect)$port
options(shiny.port=if(is.null(port)) 80 else as.numeric(port))

######### Authentication #######################
tenant <- "your-tenant-here"
app <- "your-app-id-here"
# 修改：资源指定为Microsoft Graph，用于拉取用户信息
resource <- "https://graph.microsoft.com"
graph_scope <- "https://graph.microsoft.com/User.Read"

###############Importing the app R files#########
source("ui.R")
source("server.R")

ui_func <- function(req)
{
  opts <- parseQueryString(req$QUERY_STRING)
  if(is.null(opts$code))
  {
    auth_uri <- build_authorization_uri(
      resource, tenant, app, 
      redirect_uri=redirect, version=2,
      # 添加：申请用户信息读取权限
      scope=graph_scope
    )
    redir_js <- sprintf("location.replace(\"%s\");", auth_uri)
    return(tags$script(HTML(redir_js)))
  }
  return(ui)
}

3. Server端添加token获取、用户信息拉取与存储逻辑 #

将token获取逻辑移至server函数内，每个用户会话独立生成token，认证通过后调用Graph/me接口获取用户信息，提取邮箱后按需求存储：

server <- function(input, output, session) {
  # 每个会话独立获取token，避免多用户信息串流
  token <- get_azure_token(
    resource, tenant, app, 
    auth_type="authorization_code",
    authorize_args=list(redirect_uri=redirect), 
    version=2,
    use_cache=FALSE,
    scope=graph_scope
  )

  # 调用Microsoft Graph /me接口获取当前用户信息
  user_resp <- GET(
    url = "https://graph.microsoft.com/v1.0/me",
    # 指定需要返回的字段，减少冗余数据
    query = list(`$select` = "id,displayName,mail,userPrincipalName"),
    # 携带访问令牌做身份校验
    add_headers(Authorization = paste("Bearer", token$credentials$access_token))
  )
  # 解析接口返回结果
  user_data <- content(user_resp, as = "parsed")

  # 兼容字段：部分租户账号无独立mail字段，此时userPrincipalName即为用户登录邮箱
  user_email <- ifelse(
    !is.null(user_data$mail) && nzchar(user_data$mail),
    user_data$mail,
    user_data$userPrincipalName
  )
  user_display_name <- user_data$displayName
  user_aad_id <- user_data$id

  # ---------------- 存储用户访问记录 ----------------
  # 示例为追加写入本地csv文件，可根据需求替换为写入数据库等逻辑
  access_log <- data.frame(
    access_time = Sys.time(),
    user_email = user_email,
    user_name = user_display_name,
    user_aad_id = user_aad_id,
    session_id = session$token
  )
  write.table(
    access_log, "app_access_log.csv", 
    append = TRUE, sep = ",", row.names = FALSE,
    col.names = !file.exists("app_access_log.csv")
  )

  # 将用户信息存入响应式变量，供应用内其他逻辑调用
  current_user <- reactiveValues(
    email = user_email,
    name = user_display_name,
    aad_id = user_aad_id
  )

  # 后续原有server业务逻辑写在此处
}

# Run the application
shinyApp(ui = ui_func, server = server)

注意事项 #

• 若接口返回权限不足错误，检查Azure AD应用的User.Read权限是否已配置，若租户限制用户自行同意权限，需由全局管理员对该权限做管理员同意
• 禁止将get_azure_token逻辑写在全局环境，否则会导致所有访问用户共用第一个登录者的token，出现身份信息错乱
• 若应用同时需要调用自身后端服务接口，可单独申请对应你应用资源的token，与Graph接口的token分开使用即可

内容的提问来源于stack exchange，提问作者Tanmay Ghanekar