PPM SSO Auth

DESCRIPTION

@@ -32,6 +32,7 @@ Suggests:
     keyring,
     pillar,
     pingr,
+    RcppTOML,
     rprojroot,
     sessioninfo,
     spelling,

R/auth.R

@@ -83,7 +83,9 @@ repo_auth <- function(
     url <- res$url[w]
     if (check_credentials) {
       cred <- repo_auth_headers(url, warn = FALSE)
-      if (is.null(cred)) next
+      if (is.null(cred)) {
+        next
+      }
       res$username[w] <- cred$username
       res$has_password[w] <- cred$found
       res$auth_domains[w] <- list(cred$auth_domains)
@@ -197,10 +199,18 @@ repo_auth_headers <- function(
     error = NULL
   )
 
-  pwd <- repo_auth_netrc(parsed_url$host, parsed_url$username)
+  pwd <- repo_auth_sso(parsed_url$repourl, parsed_url$username)
   if (!is.null(pwd)) {
     res$auth_domain <- parsed_url$host
-    res$source <- paste0(".netrc")
+    res$source <- "SSO"
+  }
+
+  if (is.null(pwd)) {
+    pwd <- repo_auth_netrc(parsed_url$host, parsed_url$username)
+    if (!is.null(pwd)) {
+      res$auth_domain <- parsed_url$host
+      res$source <- paste0(".netrc")
+    }
   }
 
   if (is.null(pwd) && !requireNamespace("keyring", quietly = TRUE)) {
@@ -315,7 +325,9 @@ parse_url_basic_auth <- function(url) {
 
 add_auth_status <- function(repos) {
   maybe_has_auth <- grepl("^https?://[^/]*@", repos$url)
-  if (!any(maybe_has_auth)) return(repos)
+  if (!any(maybe_has_auth)) {
+    return(repos)
+  }
 
   key <- random_key()
   on.exit(clear_auth_cache(key), add = TRUE)
@@ -326,7 +338,9 @@ add_auth_status <- function(repos) {
   for (w in which(maybe_has_auth)) {
     url <- repos$url[w]
     creds <- repo_auth_headers(url, warn = FALSE)
-    if (is.null(creds)) next
+    if (is.null(creds)) {
+      next
+    }
     repos$username[w] <- creds$username
     repos$has_password[w] <- creds$found
   }
@@ -342,7 +356,9 @@ repo_auth_netrc <- function(host, username) {
       netrc_path <- path.expand("~/_netrc")
     }
   }
-  if (!file.exists(netrc_path)) return(NULL)
+  if (!file.exists(netrc_path)) {
+    return(NULL)
+  }
 
   # netrc files do not allow port numbers
   host <- sub(":[0-9]+$", "", host)
@@ -453,3 +469,18 @@ repo_auth_netrc <- function(host, username) {
 
   NULL
 }
+
+repo_auth_sso <- function(repourl, username) {
+  ppm_url <- Sys.getenv("PACKAGEMANAGER_ADDRESS", NA_character_)
+  if (is.na(ppm_url)) {
+    return(NULL)
+  }
+
+  if (!startsWith(repourl, ppm_url)) {
+    return(NULL)
+  }
+
+  token <- try_catch_null(ppm_sso_login(service = repourl))
+
+  token
+}

R/ppm-sso-app.R

@@ -0,0 +1,146 @@
+# nocov start
+
+# Fake PPM server that proxies to Auth0, for testing ppm_sso_device_flow().
+# Auth0 device flow does not use PKCE, so we verify the PKCE challenge
+# locally and forward only the device_code to Auth0's /oauth/token.
+ppm_sso_app <- function(
+  auth0_domain,
+  client_id,
+  audience = NULL,
+  scope = "openid profile email"
+) {
+  app <- webfakes::new_app()
+
+  app$use("logger" = webfakes::mw_log())
+  app$use("urlencoded body parser" = webfakes::mw_urlencoded())
+  app$use("json body parser" = webfakes::mw_json())
+
+  app$locals$challenges <- new.env(parent = emptyenv())
+  app$locals$auth0_domain <- auth0_domain
+  app$locals$client_id <- client_id
+  app$locals$audience <- audience
+  app$locals$scope <- scope
+
+  # Bearer-token check used by ppm_sso_can_authenticate(): any token passes.
+  app$get("/", function(req, res) {
+    res$set_status(200L)$send("ok")
+  })
+
+  app$post("/__api__/device", function(req, res) {
+    challenge <- req$form$code_challenge
+    method <- req$form$code_challenge_method %||% "S256"
+    if (!identical(method, "S256")) {
+      return(res$set_status(400L)$send_json(
+        auto_unbox = TRUE,
+        list(error = "unsupported_challenge_method")
+      ))
+    }
+
+    payload <- list(
+      client_id = app$locals$client_id,
+      scope = app$locals$scope,
+      audience = app$locals$audience
+    )
+
+    upstream <- ppm_sso_post_form(
+      paste0("https://", app$locals$auth0_domain, "/oauth/device/code"),
+      payload
+    )
+
+    if (upstream$status >= 400L) {
+      return(res$set_status(upstream$status)$send_json(
+        auto_unbox = TRUE,
+        upstream$body
+      ))
+    }
+
+    assign(upstream$body$device_code, challenge, envir = app$locals$challenges)
+
+    res$send_json(
+      auto_unbox = TRUE,
+      list(
+        device_code = upstream$body$device_code,
+        user_code = upstream$body$user_code,
+        verification_uri = upstream$body$verification_uri,
+        verification_uri_complete = upstream$body$verification_uri_complete,
+        expires_in = upstream$body$expires_in,
+        interval = upstream$body$interval %||% 5L
+      )
+    )
+  })
+
+  app$post("/__api__/device_access", function(req, res) {
+    device_code <- req$form$device_code
+    verifier <- req$form$code_verifier
+
+    if (!exists(device_code, envir = app$locals$challenges, inherits = FALSE)) {
+      return(res$set_status(400L)$send_json(
+        auto_unbox = TRUE,
+        list(error = "expired_token")
+      ))
+    }
+    expected <- get(
+      device_code,
+      envir = app$locals$challenges,
+      inherits = FALSE
+    )
+    actual <- ppm_sso_base64url_encode(ppm_sso_sha256_raw(verifier))
+    if (!identical(expected, actual)) {
+      return(res$set_status(400L)$send_json(
+        auto_unbox = TRUE,
+        list(error = "invalid_grant")
+      ))
+    }
+
+    upstream <- ppm_sso_post_form(
+      paste0("https://", app$locals$auth0_domain, "/oauth/token"),
+      list(
+        grant_type = "urn:ietf:params:oauth:grant-type:device_code",
+        device_code = device_code,
+        client_id = app$locals$client_id
+      )
+    )
+
+    if (upstream$status == 200L) {
+      rm(list = device_code, envir = app$locals$challenges)
+      return(res$send_json(
+        auto_unbox = TRUE,
+        list(id_token = upstream$body$id_token)
+      ))
+    }
+
+    # Auth0 returns 403 for authorization_pending / slow_down; the PPM client
+    # only treats 400 as a soft pending state, so translate the status.
+    res$set_status(400L)$send_json(
+      auto_unbox = TRUE,
+      list(error = upstream$body$error %||% "unknown_error")
+    )
+  })
+
+  # Trivial token exchange: echo subject_token back as access_token.
+  app$post("/__api__/token", function(req, res) {
+    if (
+      !identical(
+        req$form$grant_type,
+        "urn:ietf:params:oauth:grant-type:token-exchange"
+      )
+    ) {
+      return(res$set_status(400L)$send_json(
+        auto_unbox = TRUE,
+        list(error = "unsupported_grant_type")
+      ))
+    }
+    res$send_json(
+      auto_unbox = TRUE,
+      list(
+        access_token = req$form$subject_token,
+        token_type = "Bearer",
+        issued_token_type = "urn:ietf:params:oauth:token-type:access_token"
+      )
+    )
+  })
+
+  app
+}
+
+# nocov end