diff --git a/DESCRIPTION b/DESCRIPTION index 9ac266a51b..994d5d09e0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -74,6 +74,9 @@ BugReports: https://github.com/r-lib/pak/issues Depends: R (>= 3.5) Imports: + RcppTOML, + openssl, + httr2, tools, utils Suggests: diff --git a/R/ppm-sso.R b/R/ppm-sso.R new file mode 100644 index 0000000000..56b65d0a79 --- /dev/null +++ b/R/ppm-sso.R @@ -0,0 +1,288 @@ +ppm_sso_data <- new.env(parent = emptyenv()) +ppm_sso_data$name <- "ppm" +ppm_sso_data$viable <- FALSE + +ppm_sso_init <- function(url = NULL) { + url <- url %||% Sys.getenv("PACKAGEMANAGER_ADDRESS", NA_character_) + if (!is_string(url)) { + stop( + "Please set the PACKAGEMANAGER_ADDRESS environment variable to ", + "the URL of your RStudio Package Manager instance." + ) + } + + parsed_url <- regmatches( + url, + regexec("^(?:https?://)?([^/]+)", url) + )[[1]] + if (length(parsed_url) < 2) { + stop("Invalid Package Manager URL: ", url) + } + + ppm_sso_data$ppm_url <- url + ppm_sso_data$service_name <- parsed_url[2] + ppm_sso_data$token_file_path <- file.path( + path.expand("~"), + ".ppm", + "tokens.toml" + ) + ppm_sso_data$viable <- TRUE +} + +ppm_sso_login <- function(service) { + if (!ppm_sso_data$viable) { + ppm_sso_init() + } + + if (!ppm_are_requirements_valid(service)) { + stop( + "Package Manager SSO is not properly configured. Please ensure that ", + "the PACKAGEMANAGER_ADDRESS environment variable is set to the URL of ", + "your Posit Package Manager instance." + ) + } + + existing_token <- ppm_sso_get_existing_token() + if (!is.null(existing_token) && ppm_sso_can_authenticate(existing_token)) { + return(existing_token) + } + + identity_token <- ppm_sso_get_identity_token_from_file() %||% + ppm_sso_device_flow() + ppm_token <- ppm_sso_identity_to_ppm_token(identity_token) + ppm_sso_write_token_to_file(ppm_token) + + ppm_token +} + +ppm_are_requirements_valid <- function(service) { + is_string(ppm_sso_data$ppm_url) && startsWith(service, ppm_sso_data$ppm_url) +} + +ppm_sso_get_existing_token <- function() { + if (!file.exists(ppm_sso_data$token_file_path)) { + return(NULL) + } + tryCatch( + { + tokens_data <- RcppTOML::parseTOML(ppm_sso_data$token_file_path) + for (conn in tokens_data$connection) { + if (identical(conn$url, ppm_sso_data$ppm_url)) { + return(conn$token) + } + } + }, + error = function(e) { + NULL + } + ) +} + +ppm_sso_can_authenticate <- function(token) { + req <- httr2::request(ppm_sso_data$ppm_url) |> + httr2::req_auth_bearer_token(token) |> + httr2::req_error(is_error = function(resp) FALSE) # Handle errors manually + + resp <- httr2::req_perform(req) + + status <- httr2::resp_status(resp) + status < 500 && status != 401 && status != 403 +} + +ppm_sso_get_identity_token_from_file <- function() { + token_file <- Sys.getenv("PACKAGEMANAGER_IDENTITY_TOKEN_FILE", unset = NA) + if (is.na(token_file)) { + return(NULL) + } + + tryCatch( + { + trimws(readLines(token_file, n = 1, warn = FALSE)) + }, + error = function(e) { + NULL + } + ) +} + +ppm_sso_device_flow <- function() { + verifier <- ppm_sso_new_pkce_verifier() + challenge <- ppm_sso_new_pkce_challenge(verifier) + + # 1. Initiate Device Auth + init_url <- paste0(ppm_sso_data$ppm_url, "/__api__/device") + payload <- list( + code_challenge_method = "S256", + code_challenge = challenge + ) + init_resp_body <- httr2::request(init_url) |> + httr2::req_body_form(!!!payload) |> + httr2::req_perform() |> + httr2::resp_body_json() + + display_uri <- init_resp_body$verification_uri_complete %||% + init_resp_body$verification_uri + if (is.null(display_uri)) { + stop("No verification URI found in device auth response.") + } + + message("\nPlease open the following URL in your browser:") + message(paste(" ", display_uri)) + message("\nAnd enter the following code when prompted:") + message(paste(" ", init_resp_body$user_code)) + message("\nWaiting for authorization...") + + try(utils::browseURL(display_uri), silent = TRUE) + + # 2. Poll for token + token_resp_body <- ppm_sso_complete_device_auth( + init_resp_body$device_code, + verifier, + init_resp_body$interval %||% 5, + init_resp_body$expires_in %||% 300 + ) + + if (is.null(token_resp_body) || is.null(token_resp_body$id_token)) { + stop("Failed to complete device authorization or obtain identity token.") + } + + token_resp_body$id_token +} + +ppm_sso_identity_to_ppm_token <- function(identity_token) { + url <- paste0(ppm_sso_data$ppm_url, "/__api__/token") + payload <- list( + grant_type = "urn:ietf:params:oauth:grant-type:token-exchange", + subject_token = identity_token, + subject_token_type = "urn:ietf:params:oauth:token-type:id_token" + ) + + resp <- httr2::request(url) |> + httr2::req_body_form(!!!payload) |> + httr2::req_perform() + + token_data <- httr2::resp_body_json(resp) + if (is.null(token_data$access_token)) { + stop("Failed to exchange identity token for PPM token.") + } + + token_data$access_token +} + +ppm_sso_write_token_to_file <- function(token) { + dir.create( + dirname(ppm_sso_data$token_file_path), + showWarnings = FALSE, + recursive = TRUE + ) + + new_connection <- list( + url = ppm_sso_data$ppm_url, + token = token, + method = "sso" + ) + + existing_data <- if (file.exists(ppm_sso_data$token_file_path)) { + tryCatch( + RcppTOML::parseTOML(ppm_sso_data$token_file_path), + error = function(e) { + list(connection = list()) + } + ) + } else { + list(connection = list()) + } + + # Find and update existing entry or add a new one + found <- FALSE + if ( + !is.null(existing_data$connection) && length(existing_data$connection) > 0 + ) { + for (i in seq_along(existing_data$connection)) { + if (identical(existing_data$connection[[i]]$url, ppm_sso_data$ppm_url)) { + existing_data$connection[[i]] <- new_connection + found <- TRUE + break + } + } + } + + if (!found) { + existing_data$connection <- c( + existing_data$connection, + list(new_connection) + ) + } + + # Manually construct TOML output + output_lines <- c() + for (conn in existing_data$connection) { + output_lines <- c( + output_lines, + "[[connection]]", + paste0("url = \"", conn$url, "\""), + paste0("token = \"", conn$token, "\""), + paste0("method = \"", conn$method, "\""), + "" + ) + } + writeLines(output_lines, ppm_sso_data$token_file_path) +} + +ppm_sso_base64url_encode <- function(x) { + encoded <- openssl::base64_encode(x) + # Make it URL-safe + gsub("\\+", "-", gsub("\\/", "_", gsub("=+$", "", encoded))) +} + +ppm_sso_new_pkce_verifier <- function() { + ppm_sso_base64url_encode(openssl::rand_bytes(32)) +} + +ppm_sso_new_pkce_challenge <- function(verifier) { + hash <- openssl::sha256(charToRaw(verifier)) + ppm_sso_base64url_encode(hash) +} + +ppm_sso_complete_device_auth = function( + device_code, + verifier, + interval, + expires_in +) { + url <- paste0(ppm_sso_data$ppm_url, "/__api__/device_access") + start_time <- Sys.time() + payload <- list( + device_code = device_code, + code_verifier = verifier + ) + + while (as.numeric(Sys.time() - start_time) < expires_in) { + resp <- httr2::request(url) |> + httr2::req_body_form(!!!payload) |> + httr2::req_error(is_error = \(resp) FALSE) |> # Handle errors manually + httr2::req_perform() + + status <- httr2::resp_status(resp) + + if (status == 200) { + return(httr2::resp_body_json(resp)) + } else if (status == 400) { + error_data <- httr2::resp_body_json(resp) + error_code <- error_data$error + if (error_code == "access_denied") { + stop("Access denied by user.") + } + if (error_code == "expired_token") { + stop("Device authorization request expired.") + } + # For "authorization_pending" or "slow_down", just wait and retry. + } else { + httr2::resp_raise_for_status(resp) # Raise for other unexpected errors + } + + Sys.sleep(interval) + } + + stop("Device authorization timed out.") +}