From 3688fc912bcc13add5e692af4809bf9c54693c42 Mon Sep 17 00:00:00 2001 From: Jacob Woliver Date: Wed, 6 Aug 2025 11:55:26 -0400 Subject: [PATCH 1/2] prototype: keyring backend for package manager sso auth flow --- DESCRIPTION | 6 +- NAMESPACE | 7 + R/backend-ppm.R | 327 ++++++++++++++++++++++++++++++++++ R/default_backend.R | 3 +- man/backend_env.Rd | 1 + man/backend_file.Rd | 1 + man/backend_macos.Rd | 1 + man/backend_ppm.Rd | 52 ++++++ man/backend_secret_service.Rd | 1 + man/backend_wincred.Rd | 1 + man/keyring-package.Rd | 2 +- 11 files changed, 399 insertions(+), 3 deletions(-) create mode 100644 R/backend-ppm.R create mode 100644 man/backend_ppm.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 8cce9e7..6aeaf68 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -24,7 +24,11 @@ Imports: R6, tools, utils, - yaml + yaml, + httr2, + jsonlite, + openssl, + RcppTOML, Suggests: callr, covr, diff --git a/NAMESPACE b/NAMESPACE index 2094fb6..b825afd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(backend_env) export(backend_file) export(backend_keyrings) export(backend_macos) +export(backend_ppm) export(backend_secret_service) export(backend_wincred) export(default_backend) @@ -23,6 +24,12 @@ export(keyring_is_locked) export(keyring_list) export(keyring_lock) export(keyring_unlock) +import(R6) +import(RcppTOML) +import(httr2) +import(jsonlite) +import(openssl) +import(utils) importFrom(R6,R6Class) importFrom(utils,URLdecode) importFrom(utils,head) diff --git a/R/backend-ppm.R b/R/backend-ppm.R new file mode 100644 index 0000000..df6806b --- /dev/null +++ b/R/backend-ppm.R @@ -0,0 +1,327 @@ +#' @import R6 +#' @import httr2 +#' @import jsonlite +#' @import openssl +#' @import RcppTOML +#' @import utils +NULL + +#' SSO keyring backend for Posit Package Manager +#' +#' This backend handles the OAuth 2.0 device flow for user authentication +#' and token management with Posit Package Manager. It is designed to work +#' with `pak` for installing packages from PPM repositories that require +#' SSO authentication. +#' +#' This is a "get-only" backend. It does not support setting, deleting, or +#' listing secrets directly. The `get()` method triggers the authentication +#' flow if a valid token is not already available. +#' +#' See [backend] for the documentation of the inherited methods. +#' +#' @family keyring backends +#' @export +backend_ppm <- R6::R6Class("backend_ppm", + inherit = backend, + public = list( + name = "ppm", + ppm_url = NULL, + service_name = NULL, + token_file_path = NULL, + viable = FALSE, + + #' @description Initialize the authenticator. + initialize = function() { + self$ppm_url <- Sys.getenv("PACKAGEMANAGER_ADDRESS", unset = NA) + if (is.na(self$ppm_url) || self$ppm_url == "") { + return(invisible(self)) + } + + # Basic URL parsing to get hostname:port + parsed_url <- regmatches(self$ppm_url, regexec("^(?:https?://)?([^/]+)", self$ppm_url))[[1]] + if (length(parsed_url) < 2) { + return(invisible(self)) + } + self$service_name <- parsed_url[2] + self$token_file_path <- file.path(path.expand("~"), ".ppm", "tokens.toml") + self$viable <- TRUE + + invisible(self) + }, + + #' @description Get the authentication token. This is the main function + #' that triggers the authentication flow if needed. + #' @param service The URL of the repository. + #' @param username The username. Must be `__token__` for this backend. + #' @param keyring The keyring name. This backend does not support multiple + #' keyrings, so this argument is ignored. + #' @return A PPM access token string, or `NULL` on failure or if the + #' request is not applicable to this backend. + get = function(service, username = NULL, keyring = NULL) { + if (!self$viable || !identical(username, "__token__") || !private$.requirements_valid(service)) { + return(NULL) + } + + # Check for an existing, valid token + existing_token <- private$.get_existing_token() + if (!is.null(existing_token) && private$.can_authenticate(existing_token)) { + return(existing_token) + } + + # If no valid token, start the auth flow + tryCatch({ + identity_token <- private$.get_identity_token_from_file() + + if (is.null(identity_token)) { + identity_token <- private$.device_flow() + } + + ppm_token <- private$.identity_to_ppm_token(identity_token) + private$.write_token_to_file(ppm_token) + + return(ppm_token) + }, error = function(e) { + message("Authentication process failed: ", e$message) + return(NULL) + }) + }, + + #' @description This backend does not support setting secrets. + set_with_value = function(service, username = NULL, password = NULL, keyring = NULL) { + stop("The SSO backend is for retrieving tokens and does not support setting secrets.") + }, + + #' @description This backend does not support setting secrets. + set = function(service, username = NULL, keyring = NULL, prompt = "Password: ") { + stop("The SSO backend is for retrieving tokens and does not support setting secrets.") + }, + + #' @description This backend does not support deleting secrets. + delete = function(service, username = NULL, keyring = NULL) { + stop("The SSO backend is for retrieving tokens and does not support deleting secrets.") + }, + + #' @description This backend does not support listing secrets. + list = function(service = NULL, keyring = NULL) { + stop("The SSO backend does not support listing secrets.") + }, + + docs = function() { + modifyList( + super$docs(), + list( + . = "Handles OAuth 2.0 device flow for Posit Package Manager." + ) + ) + } + ), + + private = list( + # Check if the service URL matches the configured PPM address + .requirements_valid = function(service) { + startsWith(service, self$ppm_url) + }, + + # Read token from ~/.ppm/tokens.toml + .get_existing_token = function() { + if (!file.exists(self$token_file_path)) return(NULL) + tryCatch({ + tokens_data <- RcppTOML::parseTOML(self$token_file_path) + if (!is.null(tokens_data$connection)) { + for (conn in tokens_data$connection) { + if (identical(conn$url, self$ppm_url)) { + return(conn$token) + } + } + } + return(NULL) + }, error = function(e) { + return(NULL) + }) + }, + + # Check if a token is valid for authentication + .can_authenticate = function(token) { + req <- request(self$ppm_url) |> + req_auth_bearer_token(token) |> + req_error(is_error = \(resp) FALSE) # Handle errors manually + + resp <- req_perform(req) + + status <- resp_status(resp) + status < 500 && status != 401 && status != 403 + }, + + # Look for a pre-supplied identity token in a file + .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) { + message("Failed to read identity token file: ", e$message) + NULL + }) + }, + + # Main OAuth 2.0 Device Flow logic + .device_flow = function() { + verifier <- new_pkce_verifier() + challenge <- new_pkce_challenge(verifier) + + # 1. Initiate Device Auth + init_url <- paste0(self$ppm_url, "/__api__/device?code_challenge_method=S256&code_challenge=", challenge) + init_resp_body <- request(init_url) |> + req_perform() |> + 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 + init_resp_body$code_verifier <- verifier + token_resp_body <- private$.complete_device_auth( + init_resp_body, + 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 + }, + + # Polls the token endpoint until the user authenticates + .complete_device_auth = function(device_auth_response, interval, expires_in) { + url <- paste0(self$ppm_url, "/__api__/device_access") + start_time <- Sys.time() + + while (as.numeric(Sys.time() - start_time) < expires_in) { + resp <- request(url) |> + req_body_json(device_auth_response) |> + req_error(is_error = \(resp) FALSE) |> # Handle errors manually + req_perform() + + status <- resp_status(resp) + + if (status == 200) { + return(resp_body_json(resp)) + } else if (status == 400) { + error_data <- 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 { + resp_raise_for_status(resp) # Raise for other unexpected errors + } + + Sys.sleep(interval) + } + + stop("Device authorization timed out.") + }, + + # Exchange the identity token for a final PPM access token + .identity_to_ppm_token = function(identity_token) { + url <- paste0(self$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 <- request(url) |> + req_body_form(!!!payload) |> + req_perform() + + token_data <- resp_body_json(resp) + if(is.null(token_data$access_token)) stop("Failed to exchange identity token for PPM token.") + + token_data$access_token + }, + + # Write the acquired token to the ~/.ppm/tokens.toml file + .write_token_to_file = function(token) { + dir.create(dirname(self$token_file_path), showWarnings = FALSE, recursive = TRUE) + + new_connection <- list(url = self$ppm_url, token = token, method = "sso") + + existing_data <- if (file.exists(self$token_file_path)) { + tryCatch(RcppTOML::parseTOML(self$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, self$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, self$token_file_path) + } + ) +) + +#' Generate a URL-safe Base64 string +#' @param x A raw vector or string. +#' @return A URL-safe Base64 encoded string. +#' @noRd +base64url_encode <- function(x) { + encoded <- openssl::base64_encode(x) + # Make it URL-safe + gsub("\\+", "-", gsub("\\/", "_", gsub("=+$", "", encoded))) +} + +#' Create a new PKCE code verifier +#' @return A URL-safe PKCE code verifier string. +#' @noRd +new_pkce_verifier <- function() { + base64url_encode(openssl::rand_bytes(32)) +} + +#' Create a new PKCE code challenge from a verifier +#' @param verifier The PKCE code verifier. +#' @return A URL-safe PKCE code challenge string. +#' @noRd +new_pkce_challenge <- function(verifier) { + hash <- openssl::sha256(charToRaw(verifier)) + base64url_encode(hash) +} + +# Helper for C-style `var %||% default` +`%||%` <- function(a, b) if (is.null(a)) b else a \ No newline at end of file diff --git a/R/default_backend.R b/R/default_backend.R index ba002b1..53751ad 100644 --- a/R/default_backend.R +++ b/R/default_backend.R @@ -134,5 +134,6 @@ known_backends <- list( "macos" = backend_macos, "secret_service" = backend_secret_service, "env" = backend_env, - "file" = backend_file + "file" = backend_file, + "ppm" = backend_ppm ) diff --git a/man/backend_env.Rd b/man/backend_env.Rd index 329a0e2..2c4db89 100644 --- a/man/backend_env.Rd +++ b/man/backend_env.Rd @@ -38,6 +38,7 @@ env$delete("r-keyring-test", username = "donaldduck") Other keyring backends: \code{\link{backend_file}}, \code{\link{backend_macos}}, +\code{\link{backend_ppm}}, \code{\link{backend_secret_service}}, \code{\link{backend_wincred}} } diff --git a/man/backend_file.Rd b/man/backend_file.Rd index b3af6b0..14c4810 100644 --- a/man/backend_file.Rd +++ b/man/backend_file.Rd @@ -21,6 +21,7 @@ kb <- backend_file$new() Other keyring backends: \code{\link{backend_env}}, \code{\link{backend_macos}}, +\code{\link{backend_ppm}}, \code{\link{backend_secret_service}}, \code{\link{backend_wincred}} } diff --git a/man/backend_macos.Rd b/man/backend_macos.Rd index 3e5a5da..c9df335 100644 --- a/man/backend_macos.Rd +++ b/man/backend_macos.Rd @@ -28,6 +28,7 @@ kb$delete_keyring("foobar") Other keyring backends: \code{\link{backend_env}}, \code{\link{backend_file}}, +\code{\link{backend_ppm}}, \code{\link{backend_secret_service}}, \code{\link{backend_wincred}} } diff --git a/man/backend_ppm.Rd b/man/backend_ppm.Rd new file mode 100644 index 0000000..061b8f1 --- /dev/null +++ b/man/backend_ppm.Rd @@ -0,0 +1,52 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/backend-ppm.R +\name{backend_ppm} +\alias{backend_ppm} +\title{SSO keyring backend for Posit Package Manager} +\arguments{ +\item{service}{The URL of the repository.} + +\item{username}{The username. Must be \verb{__token__} for this backend.} + +\item{keyring}{The keyring name. This backend does not support multiple +keyrings, so this argument is ignored.} +} +\value{ +A PPM access token string, or \code{NULL} on failure or if the +request is not applicable to this backend. +} +\description{ +Initialize the authenticator. + +Get the authentication token. This is the main function +that triggers the authentication flow if needed. + +This backend does not support setting secrets. + +This backend does not support setting secrets. + +This backend does not support deleting secrets. + +This backend does not support listing secrets. +} +\details{ +This backend handles the OAuth 2.0 device flow for user authentication +and token management with Posit Package Manager. It is designed to work +with \code{pak} for installing packages from PPM repositories that require +SSO authentication. + +This is a "get-only" backend. It does not support setting, deleting, or +listing secrets directly. The \code{get()} method triggers the authentication +flow if a valid token is not already available. + +See \link{backend} for the documentation of the inherited methods. +} +\seealso{ +Other keyring backends: +\code{\link{backend_env}}, +\code{\link{backend_file}}, +\code{\link{backend_macos}}, +\code{\link{backend_secret_service}}, +\code{\link{backend_wincred}} +} +\concept{keyring backends} diff --git a/man/backend_secret_service.Rd b/man/backend_secret_service.Rd index bd98f20..2f05712 100644 --- a/man/backend_secret_service.Rd +++ b/man/backend_secret_service.Rd @@ -42,6 +42,7 @@ Other keyring backends: \code{\link{backend_env}}, \code{\link{backend_file}}, \code{\link{backend_macos}}, +\code{\link{backend_ppm}}, \code{\link{backend_wincred}} } \concept{keyring backends} diff --git a/man/backend_wincred.Rd b/man/backend_wincred.Rd index dcbc4ca..11145f4 100644 --- a/man/backend_wincred.Rd +++ b/man/backend_wincred.Rd @@ -31,6 +31,7 @@ Other keyring backends: \code{\link{backend_env}}, \code{\link{backend_file}}, \code{\link{backend_macos}}, +\code{\link{backend_ppm}}, \code{\link{backend_secret_service}} } \concept{keyring backends} diff --git a/man/keyring-package.Rd b/man/keyring-package.Rd index 1b6c8c0..ff6cd56 100644 --- a/man/keyring-package.Rd +++ b/man/keyring-package.Rd @@ -93,7 +93,7 @@ Useful links: Other contributors: \itemize{ \item Alec Wong [contributor] - \item Posit Software, PBC (\href{https://ror.org/03wc8by49}{ROR}) [copyright holder, funder] + \item Posit Software, PBC (03wc8by49) [copyright holder, funder] } } From cac487c01496b49814165766bcbd0a59935a8aea Mon Sep 17 00:00:00 2001 From: Jacob Woliver Date: Thu, 23 Oct 2025 11:33:50 -0400 Subject: [PATCH 2/2] update auth endpoint payloads --- DESCRIPTION | 2 +- R/backend-ppm.R | 19 ++++++++++++++----- man/keyring-package.Rd | 2 +- 3 files changed, 16 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6aeaf68..3493290 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -41,6 +41,6 @@ Config/testthat/edition: 3 Config/usethis/last-upkeep: 2025-04-30 Encoding: UTF-8 Roxygen: list(markdown = TRUE, r6 = FALSE) -RoxygenNote: 7.3.2.9000 +RoxygenNote: 7.3.3 SystemRequirements: Optional: libsecret on Linux (libsecret-1-dev on Debian/Ubuntu, libsecret-devel on Fedora/CentOS) diff --git a/R/backend-ppm.R b/R/backend-ppm.R index df6806b..d9768fa 100644 --- a/R/backend-ppm.R +++ b/R/backend-ppm.R @@ -171,8 +171,13 @@ backend_ppm <- R6::R6Class("backend_ppm", challenge <- new_pkce_challenge(verifier) # 1. Initiate Device Auth - init_url <- paste0(self$ppm_url, "/__api__/device?code_challenge_method=S256&code_challenge=", challenge) + init_url <- paste0(self$ppm_url, "/__api__/device") + payload <- list( + code_challenge_method = "S256", + code_challenge = challenge + ) init_resp_body <- request(init_url) |> + req_body_form(!!!payload) |> req_perform() |> resp_body_json() @@ -188,9 +193,9 @@ backend_ppm <- R6::R6Class("backend_ppm", try(utils::browseURL(display_uri), silent = TRUE) # 2. Poll for token - init_resp_body$code_verifier <- verifier token_resp_body <- private$.complete_device_auth( - init_resp_body, + init_resp_body$device_code, + verifier, init_resp_body$interval %||% 5, init_resp_body$expires_in %||% 300 ) @@ -203,13 +208,17 @@ backend_ppm <- R6::R6Class("backend_ppm", }, # Polls the token endpoint until the user authenticates - .complete_device_auth = function(device_auth_response, interval, expires_in) { + .complete_device_auth = function(device_code, verifier, interval, expires_in) { url <- paste0(self$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 <- request(url) |> - req_body_json(device_auth_response) |> + req_body_form(!!!payload) |> req_error(is_error = \(resp) FALSE) |> # Handle errors manually req_perform() diff --git a/man/keyring-package.Rd b/man/keyring-package.Rd index ff6cd56..1b6c8c0 100644 --- a/man/keyring-package.Rd +++ b/man/keyring-package.Rd @@ -93,7 +93,7 @@ Useful links: Other contributors: \itemize{ \item Alec Wong [contributor] - \item Posit Software, PBC (03wc8by49) [copyright holder, funder] + \item Posit Software, PBC (\href{https://ror.org/03wc8by49}{ROR}) [copyright holder, funder] } }