From 02a3d63ddcd16f6c890c2294a487c6783a5e050b Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Mon, 19 Sep 2022 23:18:40 -0700 Subject: [PATCH 01/17] add function to get Azure CLI token --- R/utils.R | 175 ++++++++++++++++++------------- tests/testthat/test30_azurecli.R | 4 + 2 files changed, 106 insertions(+), 73 deletions(-) create mode 100644 tests/testthat/test30_azurecli.R diff --git a/R/utils.R b/R/utils.R index 6cfca6c..6e5c283 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,102 +1,101 @@ -select_auth_type <- function(password, username, certificate, auth_type, on_behalf_of) -{ - if(!is.null(auth_type)) - { - if(!auth_type %in% - c("authorization_code", "device_code", "client_credentials", "resource_owner", "on_behalf_of", - "managed")) +select_auth_type <- function(password, username, certificate, auth_type, on_behalf_of) { + if (!is.null(auth_type)) { + if (!auth_type %in% + c( + "authorization_code", "device_code", "client_credentials", + "resource_owner", "on_behalf_of", "managed", "azure_cli" + )) { stop("Invalid authentication method") + } return(auth_type) } got_pwd <- !is.null(password) got_user <- !is.null(username) got_cert <- !is.null(certificate) - got_httpuv <- system.file(package="httpuv") != "" + got_httpuv <- system.file(package = "httpuv") != "" - auth_type <- if(got_pwd && got_user && !got_cert) + auth_type <- if (got_pwd && got_user && !got_cert) { "resource_owner" - else if(!got_pwd && !got_user && !got_cert) - { - if(!got_httpuv) - { + } else if (!got_pwd && !got_user && !got_cert) { + if (!got_httpuv) { message("httpuv not installed, defaulting to device code authentication") "device_code" + } else { + "authorization_code" } - else "authorization_code" - } - else if(!got_pwd && !got_cert && got_user && got_httpuv) + } else if (!got_pwd && !got_cert && got_user && got_httpuv) { "authorization_code" - else if((got_pwd && !got_user) || got_cert) - { - if(is_empty(on_behalf_of)) + } else if ((got_pwd && !got_user) || got_cert) { + if (is_empty(on_behalf_of)) { "client_credentials" - else "on_behalf_of" + } else { + "on_behalf_of" + } + } else { + stop("Can't select authentication method", call. = FALSE) } - else stop("Can't select authentication method", call.=FALSE) message("Using ", auth_type, " flow") auth_type } -process_aad_response <- function(res) -{ +process_aad_response <- function(res) { status <- httr::status_code(res) - if(status >= 300) - { + if (status >= 300) { cont <- httr::content(res) - msg <- if(is.character(cont)) - cont - else if(is.list(cont) && is.character(cont$error_description)) - cont$error_description - else "" + msg <- if (is.character(cont)) { + cont + } else if (is.list(cont) && is.character(cont$error_description)) { + cont$error_description + } else { + "" + } msg <- paste0("obtain Azure Active Directory token. Message:\n", sub("\\.$", "", msg)) - list(token=httr::stop_for_status(status, msg)) + list(token = httr::stop_for_status(status, msg)) + } else { + httr::content(res) } - else httr::content(res) } # need to capture bad scopes before requesting auth code # v2.0 endpoint will show error page rather than redirecting, causing get_azure_token to wait forever -verify_v2_scope <- function(scope) -{ +verify_v2_scope <- function(scope) { # some OpenID scopes get a pass openid_scopes <- c("openid", "email", "profile", "offline_access") - if(scope %in% openid_scopes) - return(scope) + if (scope %in% openid_scopes) { + return(scope) + } # but not all bad_scopes <- c("address", "phone") - if(scope %in% bad_scopes) - stop("Unsupported OpenID scope: ", scope, call.=FALSE) + if (scope %in% bad_scopes) { + stop("Unsupported OpenID scope: ", scope, call. = FALSE) + } # is it a URI or GUID? valid_uri <- !is.null(httr::parse_url(scope)$scheme) valid_guid <- is_guid(sub("/.*$", "", scope)) - if(!valid_uri && !valid_guid) - stop("Invalid scope (must be a URI or GUID): ", scope, call.=FALSE) + if (!valid_uri && !valid_guid) { + stop("Invalid scope (must be a URI or GUID): ", scope, call. = FALSE) + } # if a URI or GUID, check that there is a valid scope in the path - if(valid_uri) - { + if (valid_uri) { uri <- httr::parse_url(scope) - if(uri$path == "") - { - warning("No path supplied for scope ", scope, "; setting to /.default", call.=FALSE) + if (uri$path == "") { + warning("No path supplied for scope ", scope, "; setting to /.default", call. = FALSE) uri$path <- ".default" scope <- httr::build_url(uri) } - } - else - { + } else { path <- sub("^[^/]+/?", "", scope) - if(path == "") - { - warning("No path supplied for scope ", scope, "; setting to /.default", call.=FALSE) + if (path == "") { + warning("No path supplied for scope ", scope, "; setting to /.default", call. = FALSE) scope <- sub("//", "/", paste0(scope, "/.default")) } } @@ -104,46 +103,76 @@ verify_v2_scope <- function(scope) } -aad_uri <- function(aad_host, tenant, version, type, query=list()) -{ +aad_uri <- function(aad_host, tenant, version, type, query = list()) { uri <- httr::parse_url(aad_host) uri$query <- query - uri$path <- if(nchar(uri$path) == 0) - { - if(version == 1) - file.path(tenant, "oauth2", type) - else file.path(tenant, "oauth2/v2.0", type) + uri$path <- if (nchar(uri$path) == 0) { + if (version == 1) { + file.path(tenant, "oauth2", type) + } else { + file.path(tenant, "oauth2/v2.0", type) + } + } else { + file.path(uri$path, type) } - else file.path(uri$path, type) httr::build_url(uri) } -paste_v2_scopes <- function(scope) -{ - paste(scope, collapse=" ") +paste_v2_scopes <- function(scope) { + paste(scope, collapse = " ") } # display confirmation prompt, return TRUE/FALSE (no NA) -get_confirmation <- function(msg, default=TRUE) -{ - ok <- if(getRversion() < numeric_version("3.5.0")) - { - msg <- paste(msg, if(default) "(Yes/no/cancel) " else "(yes/No/cancel) ") +get_confirmation <- function(msg, default = TRUE) { + ok <- if (getRversion() < numeric_version("3.5.0")) { + msg <- paste(msg, if (default) "(Yes/no/cancel) " else "(yes/No/cancel) ") yn <- readline(msg) - if(nchar(yn) == 0) - default - else tolower(substr(yn, 1, 1)) == "y" + if (nchar(yn) == 0) { + default + } else { + tolower(substr(yn, 1, 1)) == "y" + } + } else { + utils::askYesNo(msg, default) } - else utils::askYesNo(msg, default) isTRUE(ok) } -in_shiny <- function() -{ +in_shiny <- function() { ("shiny" %in% loadedNamespaces()) && shiny::isRunning() } + +get_az_cli_token() <- function(scope) { + tryCatch( + { + result <- system2( + "az", + args = c( + "account", "get-access-token", "--output json", + paste0("--resource ", scope) + ), + stdout = TRUE + ) + result <- paste(result, collapse = "") + jsonlite::fromJSON(result) + }, + warning = function(cond) { + not_found <- grepl("az: not found", cond, fixed = TRUE) + not_loggedin <- grepl("az login", cond, fixed = TRUE) | + grepl("az account set", cond, fixed = TRUE) + bad_resource <- grepl("was not found in the tenant", cond, fixed = TRUE) + if (not_found) { + message("Azure CLI not found on path.") + } else if (not_loggedin) { + message("Please run 'az login' to set up account.") + } else { + message("Failed to invoke the Azure CLI.") + } + } + ) +} \ No newline at end of file diff --git a/tests/testthat/test30_azurecli.R b/tests/testthat/test30_azurecli.R new file mode 100644 index 0000000..86d8d59 --- /dev/null +++ b/tests/testthat/test30_azurecli.R @@ -0,0 +1,4 @@ +test_that("azure_cli auth_type can be selected", { + auth_type <- select_auth_type(auth_type = "azure_cli") + expect_equal(auth_type, "azure_cli") +}) \ No newline at end of file From 616c4a302c8219053e0b2b0faa0d943c873b3acf Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Tue, 20 Sep 2022 23:32:17 -0700 Subject: [PATCH 02/17] add AzureTokenCLI class --- R/AzureToken.R | 381 ++++++++++++++++----------------- R/classes.R | 571 ++++++++++++++++++++++++++----------------------- R/token.R | 2 + R/utils.R | 32 +-- 4 files changed, 499 insertions(+), 487 deletions(-) diff --git a/R/AzureToken.R b/R/AzureToken.R index 849ab83..f5fd0f8 100644 --- a/R/AzureToken.R +++ b/R/AzureToken.R @@ -15,207 +15,202 @@ #' @format An R6 object representing an Azure Active Directory token and its associated credentials. `AzureToken` is the base class, and the others inherit from it. #' @export AzureToken <- R6::R6Class("AzureToken", + public = list( + version = NULL, + resource = NULL, + scope = NULL, + aad_host = NULL, + tenant = NULL, + auth_type = NULL, + client = NULL, + token_args = list(), + authorize_args = list(), + credentials = NULL, # returned token details from host + + initialize = function(resource, tenant, app, password = NULL, username = NULL, certificate = NULL, + aad_host = "https://login.microsoftonline.com/", version = 1, + authorize_args = list(), token_args = list(), + use_cache = NULL, auth_info = NULL) { + if (is.null(private$initfunc)) { + stop("Do not call this constructor directly; use get_azure_token() instead") + } -public=list( - - version=NULL, - resource=NULL, - scope=NULL, - aad_host=NULL, - tenant=NULL, - auth_type=NULL, - client=NULL, - token_args=list(), - authorize_args=list(), - credentials=NULL, # returned token details from host - - initialize=function(resource, tenant, app, password=NULL, username=NULL, certificate=NULL, - aad_host="https://login.microsoftonline.com/", version=1, - authorize_args=list(), token_args=list(), - use_cache=NULL, auth_info=NULL) - { - if(is.null(private$initfunc)) - stop("Do not call this constructor directly; use get_azure_token() instead") - - self$version <- normalize_aad_version(version) - if(self$version == 1) - { - if(length(resource) != 1) - stop("Resource for Azure Active Directory v1.0 token must be a single string", call.=FALSE) - self$resource <- resource - } - else self$scope <- sapply(resource, verify_v2_scope, USE.NAMES=FALSE) - - # default behaviour: disable cache if running in shiny - if(is.null(use_cache)) - use_cache <- !in_shiny() - - self$aad_host <- aad_host - self$tenant <- normalize_tenant(tenant) - self$token_args <- token_args - private$use_cache <- use_cache - - # use_cache = NA means return dummy object: initialize fields, but don't contact AAD - if(is.na(use_cache)) - return() - - if(use_cache) - private$load_cached_credentials() - - # time of initial request for token: in case we need to set expiry time manually - request_time <- Sys.time() - if(is.null(self$credentials)) - { - res <- private$initfunc(auth_info) - self$credentials <- process_aad_response(res) - } - private$set_expiry_time(request_time) - - if(private$use_cache) - self$cache() - }, - - cache=function() - { - if(dir.exists(AzureR_dir())) - { - filename <- file.path(AzureR_dir(), self$hash()) - saveRDS(self, filename, version=2) - } - invisible(NULL) - }, - - hash=function() - { - token_hash_internal(self$version, self$aad_host, self$tenant, self$auth_type, self$client, - self$resource, self$scope, self$authorize_args, self$token_args) - }, - - validate=function() - { - if(is.null(self$credentials$expires_on) || is.na(self$credentials$expires_on)) - return(TRUE) - - expdate <- as.POSIXct(as.numeric(self$credentials$expires_on), origin="1970-01-01") - curdate <- Sys.time() - curdate < expdate - }, - - can_refresh=function() - { - TRUE - }, - - refresh=function() - { - request_time <- Sys.time() - res <- if(!is.null(self$credentials$refresh_token)) - { - body <- list(grant_type="refresh_token", - client_id=self$client$client_id, - client_secret=self$client$client_secret, - resource=self$resource, - scope=paste_v2_scopes(self$scope), - client_assertion=self$client$client_assertion, - client_assertion_type=self$client$client_assertion_type, - refresh_token=self$credentials$refresh_token - ) + self$version <- normalize_aad_version(version) + if (self$version == 1) { + if (length(resource) != 1) { + stop("Resource for Azure Active Directory v1.0 token must be a single string", call. = FALSE) + } + self$resource <- resource + } else { + self$scope <- sapply(resource, verify_v2_scope, USE.NAMES = FALSE) + } - uri <- private$aad_uri("token") - httr::POST(uri, body=body, encode="form") - } - else private$initfunc() # reauthenticate if no refresh token (cannot reuse any supplied creds) + # default behaviour: disable cache if running in shiny + if (is.null(use_cache)) { + use_cache <- !in_shiny() + } - creds <- try(process_aad_response(res)) - if(inherits(creds, "try-error")) - { - delete_azure_token(hash=self$hash(), confirm=FALSE) - stop("Unable to refresh token", call.=FALSE) - } + self$aad_host <- aad_host + self$tenant <- normalize_tenant(tenant) + self$token_args <- token_args + private$use_cache <- use_cache - self$credentials <- creds - private$set_expiry_time(request_time) - - if(private$use_cache) - self$cache() - invisible(self) - }, - - print=function() - { - cat(format_auth_header(self)) - invisible(self) - } -), - -private=list( - - use_cache=NULL, - - load_cached_credentials=function() - { - tokenfile <- file.path(AzureR_dir(), self$hash()) - if(!file.exists(tokenfile)) - return(NULL) - - message("Loading cached token") - token <- readRDS(tokenfile) - if(!is_azure_token(token)) - { - file.remove(tokenfile) - stop("Invalid or corrupted cached token", call.=FALSE) - } + # use_cache = NA means return dummy object: initialize fields, but don't contact AAD + if (is.na(use_cache)) { + return() + } - self$credentials <- token$credentials - if(!self$validate()) - self$refresh() - }, - - set_expiry_time=function(request_time) - { - # v2.0 endpoint doesn't provide an expires_on field, set it here - if(is.null(self$credentials$expires_on)) - { - expiry <- try(decode_jwt(self$credentials$access_token)$payload$exp, silent=TRUE) - if(inherits(expiry, "try-error")) - expiry <- try(decode_jwt(self$credentials$id_token)$payload$exp, silent=TRUE) - if(inherits(expiry, "try-error")) - expiry <- NA - - expires_in <- if(!is.null(self$credentials$expires_in)) - as.numeric(self$credentials$expires_in) - else NA - - request_time <- floor(as.numeric(request_time)) - expires_on <- request_time + expires_in - - self$credentials$expires_on <- if(is.na(expiry) && is.na(expires_on)) - { - warning("Could not set expiry time, using default validity period of 1 hour") - as.character(as.numeric(request_time + 3600)) + if (use_cache) { + private$load_cached_credentials() + } + + # time of initial request for token: in case we need to set expiry time manually + request_time <- Sys.time() + if (is.null(self$credentials)) { + res <- private$initfunc(auth_info) + self$credentials <- private$process_response(res) + } + private$set_expiry_time(request_time) + + if (private$use_cache) { + self$cache() + } + }, + cache = function() { + if (dir.exists(AzureR_dir())) { + filename <- file.path(AzureR_dir(), self$hash()) + saveRDS(self, filename, version = 2) + } + invisible(NULL) + }, + hash = function() { + token_hash_internal( + self$version, self$aad_host, self$tenant, self$auth_type, self$client, + self$resource, self$scope, self$authorize_args, self$token_args + ) + }, + validate = function() { + if (is.null(self$credentials$expires_on) || is.na(self$credentials$expires_on)) { + return(TRUE) } - else as.character(as.numeric(min(expiry, expires_on, na.rm=TRUE))) - } - }, - aad_uri=function(type, ...) - { - aad_uri(self$aad_host, self$tenant, self$version, type, list(...)) - }, + expdate <- as.POSIXct(as.numeric(self$credentials$expires_on), origin = "1970-01-01") + curdate <- Sys.time() + curdate < expdate + }, + can_refresh = function() { + TRUE + }, + refresh = function() { + request_time <- Sys.time() + res <- if (!is.null(self$credentials$refresh_token)) { + body <- list( + grant_type = "refresh_token", + client_id = self$client$client_id, + client_secret = self$client$client_secret, + resource = self$resource, + scope = paste_v2_scopes(self$scope), + client_assertion = self$client$client_assertion, + client_assertion_type = self$client$client_assertion_type, + refresh_token = self$credentials$refresh_token + ) + + uri <- private$aad_uri("token") + httr::POST(uri, body = body, encode = "form") + } else { + private$initfunc() + } # reauthenticate if no refresh token (cannot reuse any supplied creds) + + creds <- try(process_aad_response(res)) + if (inherits(creds, "try-error")) { + delete_azure_token(hash = self$hash(), confirm = FALSE) + stop("Unable to refresh token", call. = FALSE) + } - build_access_body=function(body=self$client) - { - stopifnot(is.list(self$token_args)) + self$credentials <- creds + private$set_expiry_time(request_time) - # fill in cert assertion details - body$client_assertion <- build_assertion(body$client_assertion, - self$tenant, body$client_id, self$aad_host, self$version) + if (private$use_cache) { + self$cache() + } + invisible(self) + }, + print = function() { + cat(format_auth_header(self)) + invisible(self) + } + ), + private = list( + use_cache = NULL, + load_cached_credentials = function() { + tokenfile <- file.path(AzureR_dir(), self$hash()) + if (!file.exists(tokenfile)) { + return(NULL) + } - c(body, self$token_args, - if(self$version == 1) - list(resource=self$resource) - else list(scope=paste_v2_scopes(self$scope)) - ) - } -)) + message("Loading cached token") + token <- readRDS(tokenfile) + if (!is_azure_token(token)) { + file.remove(tokenfile) + stop("Invalid or corrupted cached token", call. = FALSE) + } + self$credentials <- token$credentials + if (!self$validate()) { + self$refresh() + } + }, + set_expiry_time = function(request_time) { + # v2.0 endpoint doesn't provide an expires_on field, set it here + if (is.null(self$credentials$expires_on)) { + expiry <- try(decode_jwt(self$credentials$access_token)$payload$exp, silent = TRUE) + if (inherits(expiry, "try-error")) { + expiry <- try(decode_jwt(self$credentials$id_token)$payload$exp, silent = TRUE) + } + if (inherits(expiry, "try-error")) { + expiry <- NA + } + + expires_in <- if (!is.null(self$credentials$expires_in)) { + as.numeric(self$credentials$expires_in) + } else { + NA + } + + request_time <- floor(as.numeric(request_time)) + expires_on <- request_time + expires_in + + self$credentials$expires_on <- if (is.na(expiry) && is.na(expires_on)) { + warning("Could not set expiry time, using default validity period of 1 hour") + as.character(as.numeric(request_time + 3600)) + } else { + as.character(as.numeric(min(expiry, expires_on, na.rm = TRUE))) + } + } + }, + aad_uri = function(type, ...) { + aad_uri(self$aad_host, self$tenant, self$version, type, list(...)) + }, + build_access_body = function(body = self$client) { + stopifnot(is.list(self$token_args)) + + # fill in cert assertion details + body$client_assertion <- build_assertion( + body$client_assertion, + self$tenant, body$client_id, self$aad_host, self$version + ) + + c( + body, self$token_args, + if (self$version == 1) { + list(resource = self$resource) + } else { + list(scope = paste_v2_scopes(self$scope)) + } + ) + }, + process_response = function(res) { + process_aad_response((res)) + } + ) +) \ No newline at end of file diff --git a/R/classes.R b/R/classes.R index 1d51ba6..e9202e6 100644 --- a/R/classes.R +++ b/R/classes.R @@ -1,294 +1,339 @@ #' @rdname AzureToken #' @export -AzureTokenAuthCode <- R6::R6Class("AzureTokenAuthCode", inherit=AzureToken, - -public=list( - - initialize=function(common_args, authorize_args, auth_code) - { - self$auth_type <- "authorization_code" - self$authorize_args <- authorize_args - with(common_args, - private$set_request_credentials(app, password, username)) - do.call(super$initialize, c(common_args, list(auth_info=auth_code))) - - # notify user if no refresh token - if(!is.null(self$credentials) && is.null(self$credentials$refresh_token)) - norenew_alert(self$version) - } -), - -private=list( - - initfunc=function(code=NULL) - { - stopifnot(is.list(self$token_args)) - stopifnot(is.list(self$authorize_args)) - - opts <- utils::modifyList(list( - resource=if(self$version == 1) self$resource else self$scope, - tenant=self$tenant, - app=self$client$client_id, - username=self$client$login_hint, - aad_host=self$aad_host, - version=self$version - ), self$authorize_args) - - auth_uri <- do.call(build_authorization_uri, opts) - redirect <- httr::parse_url(auth_uri)$query$redirect_uri - - if(is.null(code)) - { - if(!requireNamespace("httpuv", quietly=TRUE)) - stop("httpuv package must be installed to use authorization_code method", call.=FALSE) +AzureTokenAuthCode <- R6::R6Class("AzureTokenAuthCode", + inherit = AzureToken, + public = list( + initialize = function(common_args, authorize_args, auth_code) { + self$auth_type <- "authorization_code" + self$authorize_args <- authorize_args + with( + common_args, + private$set_request_credentials(app, password, username) + ) + do.call(super$initialize, c(common_args, list(auth_info = auth_code))) - code <- listen_for_authcode(auth_uri, redirect) + # notify user if no refresh token + if (!is.null(self$credentials) && is.null(self$credentials$refresh_token)) { + norenew_alert(self$version) + } } - - # contact token endpoint for token - access_uri <- private$aad_uri("token") - body <- c(self$client, code=code, redirect_uri=redirect, self$token_args) - - httr::POST(access_uri, body=body, encode="form") - }, - - set_request_credentials=function(app, password, username) - { - object <- list(client_id=app, grant_type="authorization_code") - - if(!is.null(username)) - object$login_hint <- username - if(!is.null(password)) - object$client_secret <- password - - self$client <- object - } -)) + ), + private = list( + initfunc = function(code = NULL) { + stopifnot(is.list(self$token_args)) + stopifnot(is.list(self$authorize_args)) + + opts <- utils::modifyList(list( + resource = if (self$version == 1) self$resource else self$scope, + tenant = self$tenant, + app = self$client$client_id, + username = self$client$login_hint, + aad_host = self$aad_host, + version = self$version + ), self$authorize_args) + + auth_uri <- do.call(build_authorization_uri, opts) + redirect <- httr::parse_url(auth_uri)$query$redirect_uri + + if (is.null(code)) { + if (!requireNamespace("httpuv", quietly = TRUE)) { + stop("httpuv package must be installed to use authorization_code method", call. = FALSE) + } + + code <- listen_for_authcode(auth_uri, redirect) + } + + # contact token endpoint for token + access_uri <- private$aad_uri("token") + body <- c(self$client, code = code, redirect_uri = redirect, self$token_args) + + httr::POST(access_uri, body = body, encode = "form") + }, + set_request_credentials = function(app, password, username) { + object <- list(client_id = app, grant_type = "authorization_code") + + if (!is.null(username)) { + object$login_hint <- username + } + if (!is.null(password)) { + object$client_secret <- password + } + + self$client <- object + } + ) +) #' @rdname AzureToken #' @export -AzureTokenDeviceCode <- R6::R6Class("AzureTokenDeviceCode", inherit=AzureToken, - -public=list( - - initialize=function(common_args, device_creds) - { - self$auth_type <- "device_code" - with(common_args, - private$set_request_credentials(app)) - do.call(super$initialize, c(common_args, list(auth_info=device_creds))) - - # notify user if no refresh token - if(!is.null(self$credentials) && is.null(self$credentials$refresh_token)) - norenew_alert(self$version) - } -), - -private=list( - - initfunc=function(creds=NULL) - { - if(is.null(creds)) - { - creds <- get_device_creds( - if(self$version == 1) self$resource else self$scope, - tenant=self$tenant, - app=self$client$client_id, - aad_host=self$aad_host, - version=self$version +AzureTokenDeviceCode <- R6::R6Class("AzureTokenDeviceCode", + inherit = AzureToken, + public = list( + initialize = function(common_args, device_creds) { + self$auth_type <- "device_code" + with( + common_args, + private$set_request_credentials(app) ) - cat(creds$message, "\n") - } - - # poll token endpoint for token - access_uri <- private$aad_uri("token") - body <- c(self$client, code=creds$device_code) - - poll_for_token(access_uri, body, creds$interval, creds$expires_in) - }, + do.call(super$initialize, c(common_args, list(auth_info = device_creds))) - set_request_credentials=function(app) - { - self$client <- list(client_id=app, grant_type="device_code") - } -)) + # notify user if no refresh token + if (!is.null(self$credentials) && is.null(self$credentials$refresh_token)) { + norenew_alert(self$version) + } + } + ), + private = list( + initfunc = function(creds = NULL) { + if (is.null(creds)) { + creds <- get_device_creds( + if (self$version == 1) self$resource else self$scope, + tenant = self$tenant, + app = self$client$client_id, + aad_host = self$aad_host, + version = self$version + ) + cat(creds$message, "\n") + } + + # poll token endpoint for token + access_uri <- private$aad_uri("token") + body <- c(self$client, code = creds$device_code) + + poll_for_token(access_uri, body, creds$interval, creds$expires_in) + }, + set_request_credentials = function(app) { + self$client <- list(client_id = app, grant_type = "device_code") + } + ) +) #' @rdname AzureToken #' @export -AzureTokenClientCreds <- R6::R6Class("AzureTokenClientCreds", inherit=AzureToken, - -public=list( - - initialize=function(common_args) - { - self$auth_type <- "client_credentials" - with(common_args, - private$set_request_credentials(app, password, certificate)) - do.call(super$initialize, common_args) - } -), - -private=list( - - initfunc=function(init_args) - { - # contact token endpoint directly with client credentials - uri <- private$aad_uri("token") - body <- private$build_access_body() - - httr::POST(uri, body=body, encode="form") - }, - - set_request_credentials=function(app, password, certificate) - { - object <- list(client_id=app, grant_type="client_credentials") - - if(!is.null(password)) - object$client_secret <- password - else if(!is.null(certificate)) - { - object$client_assertion_type <- "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" - object$client_assertion <- certificate # not actual assertion: will be replaced later +AzureTokenClientCreds <- R6::R6Class("AzureTokenClientCreds", + inherit = AzureToken, + public = list( + initialize = function(common_args) { + self$auth_type <- "client_credentials" + with( + common_args, + private$set_request_credentials(app, password, certificate) + ) + do.call(super$initialize, common_args) } - else stop("Must provide either a client secret or certificate for client_credentials grant", - call.=FALSE) - - self$client <- object - } -)) + ), + private = list( + initfunc = function(init_args) { + # contact token endpoint directly with client credentials + uri <- private$aad_uri("token") + body <- private$build_access_body() + + httr::POST(uri, body = body, encode = "form") + }, + set_request_credentials = function(app, password, certificate) { + object <- list(client_id = app, grant_type = "client_credentials") + + if (!is.null(password)) { + object$client_secret <- password + } else if (!is.null(certificate)) { + object$client_assertion_type <- "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" + object$client_assertion <- certificate # not actual assertion: will be replaced later + } else { + stop("Must provide either a client secret or certificate for client_credentials grant", + call. = FALSE + ) + } + + self$client <- object + } + ) +) #' @rdname AzureToken #' @export -AzureTokenOnBehalfOf <- R6::R6Class("AzureTokenOnBehalfOf", inherit=AzureToken, - -public=list( - - initialize=function(common_args, on_behalf_of) - { - self$auth_type <- "on_behalf_of" - with(common_args, - private$set_request_credentials(app, password, certificate, on_behalf_of)) - do.call(super$initialize, common_args) - } -), - -private=list( - - initfunc=function(init_args) - { - # contact token endpoint directly with client credentials - uri <- private$aad_uri("token") - body <- private$build_access_body() - - httr::POST(uri, body=body, encode="form") - }, - - set_request_credentials=function(app, password, certificate, on_behalf_of) - { - if(is_empty(on_behalf_of)) - stop("Must provide an Azure token for on_behalf_of grant", call.=FALSE) - - object <- list(client_id=app, grant_type="urn:ietf:params:oauth:grant-type:jwt-bearer") - - if(!is.null(password)) - object$client_secret <- password - else if(!is.null(certificate)) - { - object$client_assertion_type <- "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" - object$client_assertion <- certificate # not actual assertion: will be replaced later +AzureTokenOnBehalfOf <- R6::R6Class("AzureTokenOnBehalfOf", + inherit = AzureToken, + public = list( + initialize = function(common_args, on_behalf_of) { + self$auth_type <- "on_behalf_of" + with( + common_args, + private$set_request_credentials(app, password, certificate, on_behalf_of) + ) + do.call(super$initialize, common_args) } - else stop("Must provide either a client secret or certificate for on_behalf_of grant", - call.=FALSE) - - object$requested_token_use <- "on_behalf_of" - object$assertion <- extract_jwt(on_behalf_of) - - self$client <- object - } -)) + ), + private = list( + initfunc = function(init_args) { + # contact token endpoint directly with client credentials + uri <- private$aad_uri("token") + body <- private$build_access_body() + + httr::POST(uri, body = body, encode = "form") + }, + set_request_credentials = function(app, password, certificate, on_behalf_of) { + if (is_empty(on_behalf_of)) { + stop("Must provide an Azure token for on_behalf_of grant", call. = FALSE) + } + + object <- list(client_id = app, grant_type = "urn:ietf:params:oauth:grant-type:jwt-bearer") + + if (!is.null(password)) { + object$client_secret <- password + } else if (!is.null(certificate)) { + object$client_assertion_type <- "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" + object$client_assertion <- certificate # not actual assertion: will be replaced later + } else { + stop("Must provide either a client secret or certificate for on_behalf_of grant", + call. = FALSE + ) + } + + object$requested_token_use <- "on_behalf_of" + object$assertion <- extract_jwt(on_behalf_of) + + self$client <- object + } + ) +) #' @rdname AzureToken #' @export -AzureTokenResOwner <- R6::R6Class("AzureTokenResOwner", inherit=AzureToken, - -public=list( - - initialize=function(common_args) - { - self$auth_type <- "resource_owner" - with(common_args, - private$set_request_credentials(app, password, username)) - do.call(super$initialize, common_args) - } -), - -private=list( - - initfunc=function(init_args) - { - # contact token endpoint directly with resource owner username/password - uri <- private$aad_uri("token") - body <- private$build_access_body() - - httr::POST(uri, body=body, encode="form") - }, - - set_request_credentials=function(app, password, username) - { - object <- list(client_id=app, grant_type="password") - - if(is.null(username) && is.null(password)) - stop("Must provide a username and password for resource_owner grant", call.=FALSE) - - object$username <- username - object$password <- password - - self$client <- object - } -)) +AzureTokenResOwner <- R6::R6Class("AzureTokenResOwner", + inherit = AzureToken, + public = list( + initialize = function(common_args) { + self$auth_type <- "resource_owner" + with( + common_args, + private$set_request_credentials(app, password, username) + ) + do.call(super$initialize, common_args) + } + ), + private = list( + initfunc = function(init_args) { + # contact token endpoint directly with resource owner username/password + uri <- private$aad_uri("token") + body <- private$build_access_body() + + httr::POST(uri, body = body, encode = "form") + }, + set_request_credentials = function(app, password, username) { + object <- list(client_id = app, grant_type = "password") + + if (is.null(username) && is.null(password)) { + stop("Must provide a username and password for resource_owner grant", call. = FALSE) + } + + object$username <- username + object$password <- password + + self$client <- object + } + ) +) #' @rdname AzureToken #' @export -AzureTokenManaged <- R6::R6Class("AzureTokenManaged", inherit=AzureToken, - -public=list( - - initialize=function(resource, aad_host, token_args, use_cache) - { - self$auth_type <- "managed" - super$initialize(resource, tenant="common", aad_host=aad_host, token_args=token_args, use_cache=use_cache) - } -), - -private=list( - - initfunc=function(init_args) - { - stopifnot(is.list(self$token_args)) - - uri <- private$aad_uri("token") - query <- utils::modifyList(self$token_args, - list(`api-version`=getOption("azure_imds_version"), resource=self$resource)) +AzureTokenManaged <- R6::R6Class("AzureTokenManaged", + inherit = AzureToken, + public = list( + initialize = function(resource, aad_host, token_args, use_cache) { + self$auth_type <- "managed" + super$initialize(resource, tenant = "common", aad_host = aad_host, token_args = token_args, use_cache = use_cache) + } + ), + private = list( + initfunc = function(init_args) { + stopifnot(is.list(self$token_args)) + + uri <- private$aad_uri("token") + query <- utils::modifyList( + self$token_args, + list(`api-version` = getOption("azure_imds_version"), resource = self$resource) + ) - secret <- Sys.getenv("MSI_SECRET") - headers <- if(secret != "") - httr::add_headers(secret=secret) - else httr::add_headers(metadata="true") + secret <- Sys.getenv("MSI_SECRET") + headers <- if (secret != "") { + httr::add_headers(secret = secret) + } else { + httr::add_headers(metadata = "true") + } - httr::GET(uri, headers, query=query) + httr::GET(uri, headers, query = query) + } + ) +) + +AzureTokenCLI <- R6::R6Class("AzureTokenCLI", + inherit = AzureToken, + public = list( + initialize = function(common_args) { + self$auth_type <- "cli" + do.call(super$initialize, common_args) + } + ), + private = list( + initfunc = function(init_args) { + tryCatch( + { + result <- system2( + "az", + args = c( + "account", "get-access-token", "--output json", + paste0("--resource ", self$resource) + ), + stdout = TRUE + ) + result <- paste(result, collapse = "") + result + # TODO: base class assumes + }, + warning = function(cond) { + not_found <- grepl("az: not found", cond, fixed = TRUE) + not_loggedin <- grepl("az login", cond, fixed = TRUE) | + grepl("az account set", cond, fixed = TRUE) + bad_resource <- grepl( + "was not found in the tenant", + cond, + fixed = TRUE + ) + if (not_found) { + message("Azure CLI not found on path.") + } else if (not_loggedin) { + message("Please run 'az login' to set up account.") + } else { + message("Failed to invoke the Azure CLI.") + } + } + ) + }, + process_response = function(res) { + ret <- jsonlite::parse_json(res) + list( + token_type = ret$tokenType, + access_token = ret$accessToken, + expires_on = as.numeric(as.POSIXct(ret$expiresOn)), + resource = self$resource + ) + } + ) +) + + +norenew_alert <- function(version) { + if (version == 1) { + message("Server did not provide a refresh token: please reauthenticate to refresh.") + } else { + message( + "Server did not provide a refresh token: you will have to reauthenticate to refresh.\n", + "Add the 'offline_access' scope to obtain a refresh token." + ) } -)) - - -norenew_alert <- function(version) -{ - if(version == 1) - message("Server did not provide a refresh token: please reauthenticate to refresh.") - else message("Server did not provide a refresh token: you will have to reauthenticate to refresh.\n", - "Add the 'offline_access' scope to obtain a refresh token.") -} +} \ No newline at end of file diff --git a/R/token.R b/R/token.R index 35ca0dc..69785fc 100644 --- a/R/token.R +++ b/R/token.R @@ -271,6 +271,8 @@ get_azure_token <- function(resource, tenant, app, password=NULL, username=NULL, AzureTokenOnBehalfOf$new(common_args, on_behalf_of), resource_owner= AzureTokenResOwner$new(common_args), + cli= + AzureTokenCLI$new(common_args), stop("Unknown authentication method ", auth_type, call.=FALSE)) } diff --git a/R/utils.R b/R/utils.R index 6e5c283..00348e7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -3,7 +3,7 @@ select_auth_type <- function(password, username, certificate, auth_type, on_beha if (!auth_type %in% c( "authorization_code", "device_code", "client_credentials", - "resource_owner", "on_behalf_of", "managed", "azure_cli" + "resource_owner", "on_behalf_of", "managed", "cli" )) { stop("Invalid authentication method") } @@ -145,34 +145,4 @@ get_confirmation <- function(msg, default = TRUE) { in_shiny <- function() { ("shiny" %in% loadedNamespaces()) && shiny::isRunning() -} - -get_az_cli_token() <- function(scope) { - tryCatch( - { - result <- system2( - "az", - args = c( - "account", "get-access-token", "--output json", - paste0("--resource ", scope) - ), - stdout = TRUE - ) - result <- paste(result, collapse = "") - jsonlite::fromJSON(result) - }, - warning = function(cond) { - not_found <- grepl("az: not found", cond, fixed = TRUE) - not_loggedin <- grepl("az login", cond, fixed = TRUE) | - grepl("az account set", cond, fixed = TRUE) - bad_resource <- grepl("was not found in the tenant", cond, fixed = TRUE) - if (not_found) { - message("Azure CLI not found on path.") - } else if (not_loggedin) { - message("Please run 'az login' to set up account.") - } else { - message("Failed to invoke the Azure CLI.") - } - } - ) } \ No newline at end of file From cee212065507c00e081a642fc9955484f2a55679 Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Wed, 21 Sep 2022 08:05:04 -0700 Subject: [PATCH 03/17] undo auto-formatting on AzureToken.R --- R/AzureToken.R | 390 +++++++++++++++++++++++++------------------------ 1 file changed, 200 insertions(+), 190 deletions(-) diff --git a/R/AzureToken.R b/R/AzureToken.R index f5fd0f8..966e5e0 100644 --- a/R/AzureToken.R +++ b/R/AzureToken.R @@ -15,202 +15,212 @@ #' @format An R6 object representing an Azure Active Directory token and its associated credentials. `AzureToken` is the base class, and the others inherit from it. #' @export AzureToken <- R6::R6Class("AzureToken", - public = list( - version = NULL, - resource = NULL, - scope = NULL, - aad_host = NULL, - tenant = NULL, - auth_type = NULL, - client = NULL, - token_args = list(), - authorize_args = list(), - credentials = NULL, # returned token details from host - - initialize = function(resource, tenant, app, password = NULL, username = NULL, certificate = NULL, - aad_host = "https://login.microsoftonline.com/", version = 1, - authorize_args = list(), token_args = list(), - use_cache = NULL, auth_info = NULL) { - if (is.null(private$initfunc)) { - stop("Do not call this constructor directly; use get_azure_token() instead") - } - - self$version <- normalize_aad_version(version) - if (self$version == 1) { - if (length(resource) != 1) { - stop("Resource for Azure Active Directory v1.0 token must be a single string", call. = FALSE) - } - self$resource <- resource - } else { - self$scope <- sapply(resource, verify_v2_scope, USE.NAMES = FALSE) - } - - # default behaviour: disable cache if running in shiny - if (is.null(use_cache)) { - use_cache <- !in_shiny() - } - - self$aad_host <- aad_host - self$tenant <- normalize_tenant(tenant) - self$token_args <- token_args - private$use_cache <- use_cache - - # use_cache = NA means return dummy object: initialize fields, but don't contact AAD - if (is.na(use_cache)) { - return() - } - if (use_cache) { - private$load_cached_credentials() - } - - # time of initial request for token: in case we need to set expiry time manually - request_time <- Sys.time() - if (is.null(self$credentials)) { - res <- private$initfunc(auth_info) - self$credentials <- private$process_response(res) - } - private$set_expiry_time(request_time) - - if (private$use_cache) { - self$cache() - } - }, - cache = function() { - if (dir.exists(AzureR_dir())) { - filename <- file.path(AzureR_dir(), self$hash()) - saveRDS(self, filename, version = 2) - } - invisible(NULL) - }, - hash = function() { - token_hash_internal( - self$version, self$aad_host, self$tenant, self$auth_type, self$client, - self$resource, self$scope, self$authorize_args, self$token_args +public=list( + + version=NULL, + resource=NULL, + scope=NULL, + aad_host=NULL, + tenant=NULL, + auth_type=NULL, + client=NULL, + token_args=list(), + authorize_args=list(), + credentials=NULL, # returned token details from host + + initialize=function(resource, tenant, app, password=NULL, username=NULL, certificate=NULL, + aad_host="https://login.microsoftonline.com/", version=1, + authorize_args=list(), token_args=list(), + use_cache=NULL, auth_info=NULL) + { + if(is.null(private$initfunc)) + stop("Do not call this constructor directly; use get_azure_token() instead") + + self$version <- normalize_aad_version(version) + if(self$version == 1) + { + if(length(resource) != 1) + stop("Resource for Azure Active Directory v1.0 token must be a single string", call.=FALSE) + self$resource <- resource + } + else self$scope <- sapply(resource, verify_v2_scope, USE.NAMES=FALSE) + + # default behaviour: disable cache if running in shiny + if(is.null(use_cache)) + use_cache <- !in_shiny() + + self$aad_host <- aad_host + self$tenant <- normalize_tenant(tenant) + self$token_args <- token_args + private$use_cache <- use_cache + + # use_cache = NA means return dummy object: initialize fields, but don't contact AAD + if(is.na(use_cache)) + return() + + if(use_cache) + private$load_cached_credentials() + + # time of initial request for token: in case we need to set expiry time manually + request_time <- Sys.time() + if(is.null(self$credentials)) + { + res <- private$initfunc(auth_info) + self$credentials <- private$process_response(res) + } + private$set_expiry_time(request_time) + + if(private$use_cache) + self$cache() + }, + + cache=function() + { + if(dir.exists(AzureR_dir())) + { + filename <- file.path(AzureR_dir(), self$hash()) + saveRDS(self, filename, version=2) + } + invisible(NULL) + }, + + hash=function() + { + token_hash_internal(self$version, self$aad_host, self$tenant, self$auth_type, self$client, + self$resource, self$scope, self$authorize_args, self$token_args) + }, + + validate=function() + { + if(is.null(self$credentials$expires_on) || is.na(self$credentials$expires_on)) + return(TRUE) + + expdate <- as.POSIXct(as.numeric(self$credentials$expires_on), origin="1970-01-01") + curdate <- Sys.time() + curdate < expdate + }, + + can_refresh=function() + { + TRUE + }, + + refresh=function() + { + request_time <- Sys.time() + res <- if(!is.null(self$credentials$refresh_token)) + { + body <- list(grant_type="refresh_token", + client_id=self$client$client_id, + client_secret=self$client$client_secret, + resource=self$resource, + scope=paste_v2_scopes(self$scope), + client_assertion=self$client$client_assertion, + client_assertion_type=self$client$client_assertion_type, + refresh_token=self$credentials$refresh_token ) - }, - validate = function() { - if (is.null(self$credentials$expires_on) || is.na(self$credentials$expires_on)) { - return(TRUE) - } - - expdate <- as.POSIXct(as.numeric(self$credentials$expires_on), origin = "1970-01-01") - curdate <- Sys.time() - curdate < expdate - }, - can_refresh = function() { - TRUE - }, - refresh = function() { - request_time <- Sys.time() - res <- if (!is.null(self$credentials$refresh_token)) { - body <- list( - grant_type = "refresh_token", - client_id = self$client$client_id, - client_secret = self$client$client_secret, - resource = self$resource, - scope = paste_v2_scopes(self$scope), - client_assertion = self$client$client_assertion, - client_assertion_type = self$client$client_assertion_type, - refresh_token = self$credentials$refresh_token - ) - - uri <- private$aad_uri("token") - httr::POST(uri, body = body, encode = "form") - } else { - private$initfunc() - } # reauthenticate if no refresh token (cannot reuse any supplied creds) - - creds <- try(process_aad_response(res)) - if (inherits(creds, "try-error")) { - delete_azure_token(hash = self$hash(), confirm = FALSE) - stop("Unable to refresh token", call. = FALSE) - } - self$credentials <- creds - private$set_expiry_time(request_time) + uri <- private$aad_uri("token") + httr::POST(uri, body=body, encode="form") + } + else private$initfunc() # reauthenticate if no refresh token (cannot reuse any supplied creds) - if (private$use_cache) { - self$cache() - } - invisible(self) - }, - print = function() { - cat(format_auth_header(self)) - invisible(self) + creds <- try(private$process_response(res)) + if(inherits(creds, "try-error")) + { + delete_azure_token(hash=self$hash(), confirm=FALSE) + stop("Unable to refresh token", call.=FALSE) } - ), - private = list( - use_cache = NULL, - load_cached_credentials = function() { - tokenfile <- file.path(AzureR_dir(), self$hash()) - if (!file.exists(tokenfile)) { - return(NULL) - } - message("Loading cached token") - token <- readRDS(tokenfile) - if (!is_azure_token(token)) { - file.remove(tokenfile) - stop("Invalid or corrupted cached token", call. = FALSE) - } + self$credentials <- creds + private$set_expiry_time(request_time) + + if(private$use_cache) + self$cache() + invisible(self) + }, + + print=function() + { + cat(format_auth_header(self)) + invisible(self) + } +), + +private=list( + + use_cache=NULL, + + load_cached_credentials=function() + { + tokenfile <- file.path(AzureR_dir(), self$hash()) + if(!file.exists(tokenfile)) + return(NULL) + + message("Loading cached token") + token <- readRDS(tokenfile) + if(!is_azure_token(token)) + { + file.remove(tokenfile) + stop("Invalid or corrupted cached token", call.=FALSE) + } - self$credentials <- token$credentials - if (!self$validate()) { - self$refresh() + self$credentials <- token$credentials + if(!self$validate()) + self$refresh() + }, + + set_expiry_time=function(request_time) + { + # v2.0 endpoint doesn't provide an expires_on field, set it here + if(is.null(self$credentials$expires_on)) + { + expiry <- try(decode_jwt(self$credentials$access_token)$payload$exp, silent=TRUE) + if(inherits(expiry, "try-error")) + expiry <- try(decode_jwt(self$credentials$id_token)$payload$exp, silent=TRUE) + if(inherits(expiry, "try-error")) + expiry <- NA + + expires_in <- if(!is.null(self$credentials$expires_in)) + as.numeric(self$credentials$expires_in) + else NA + + request_time <- floor(as.numeric(request_time)) + expires_on <- request_time + expires_in + + self$credentials$expires_on <- if(is.na(expiry) && is.na(expires_on)) + { + warning("Could not set expiry time, using default validity period of 1 hour") + as.character(as.numeric(request_time + 3600)) } - }, - set_expiry_time = function(request_time) { - # v2.0 endpoint doesn't provide an expires_on field, set it here - if (is.null(self$credentials$expires_on)) { - expiry <- try(decode_jwt(self$credentials$access_token)$payload$exp, silent = TRUE) - if (inherits(expiry, "try-error")) { - expiry <- try(decode_jwt(self$credentials$id_token)$payload$exp, silent = TRUE) - } - if (inherits(expiry, "try-error")) { - expiry <- NA - } - - expires_in <- if (!is.null(self$credentials$expires_in)) { - as.numeric(self$credentials$expires_in) - } else { - NA - } - - request_time <- floor(as.numeric(request_time)) - expires_on <- request_time + expires_in - - self$credentials$expires_on <- if (is.na(expiry) && is.na(expires_on)) { - warning("Could not set expiry time, using default validity period of 1 hour") - as.character(as.numeric(request_time + 3600)) - } else { - as.character(as.numeric(min(expiry, expires_on, na.rm = TRUE))) - } - } - }, - aad_uri = function(type, ...) { - aad_uri(self$aad_host, self$tenant, self$version, type, list(...)) - }, - build_access_body = function(body = self$client) { - stopifnot(is.list(self$token_args)) - - # fill in cert assertion details - body$client_assertion <- build_assertion( - body$client_assertion, - self$tenant, body$client_id, self$aad_host, self$version - ) - - c( - body, self$token_args, - if (self$version == 1) { - list(resource = self$resource) - } else { - list(scope = paste_v2_scopes(self$scope)) - } - ) - }, - process_response = function(res) { - process_aad_response((res)) + else as.character(as.numeric(min(expiry, expires_on, na.rm=TRUE))) } - ) -) \ No newline at end of file + }, + + aad_uri=function(type, ...) + { + aad_uri(self$aad_host, self$tenant, self$version, type, list(...)) + }, + + build_access_body=function(body=self$client) + { + stopifnot(is.list(self$token_args)) + + # fill in cert assertion details + body$client_assertion <- build_assertion(body$client_assertion, + self$tenant, body$client_id, self$aad_host, self$version) + + c(body, self$token_args, + if(self$version == 1) + list(resource=self$resource) + else list(scope=paste_v2_scopes(self$scope)) + ) + }, + + process_response = function(res) + { + process_aad_response(res) + } +)) + From f87a3d153bc00bb949e1330b9b6849e04f30a7d3 Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Wed, 21 Sep 2022 08:06:22 -0700 Subject: [PATCH 04/17] undo auto-formatting on utils.R --- R/utils.R | 147 +++++++++++++++++++++++++++--------------------------- 1 file changed, 74 insertions(+), 73 deletions(-) diff --git a/R/utils.R b/R/utils.R index 00348e7..6cfca6c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,101 +1,102 @@ -select_auth_type <- function(password, username, certificate, auth_type, on_behalf_of) { - if (!is.null(auth_type)) { - if (!auth_type %in% - c( - "authorization_code", "device_code", "client_credentials", - "resource_owner", "on_behalf_of", "managed", "cli" - )) { +select_auth_type <- function(password, username, certificate, auth_type, on_behalf_of) +{ + if(!is.null(auth_type)) + { + if(!auth_type %in% + c("authorization_code", "device_code", "client_credentials", "resource_owner", "on_behalf_of", + "managed")) stop("Invalid authentication method") - } return(auth_type) } got_pwd <- !is.null(password) got_user <- !is.null(username) got_cert <- !is.null(certificate) - got_httpuv <- system.file(package = "httpuv") != "" + got_httpuv <- system.file(package="httpuv") != "" - auth_type <- if (got_pwd && got_user && !got_cert) { + auth_type <- if(got_pwd && got_user && !got_cert) "resource_owner" - } else if (!got_pwd && !got_user && !got_cert) { - if (!got_httpuv) { + else if(!got_pwd && !got_user && !got_cert) + { + if(!got_httpuv) + { message("httpuv not installed, defaulting to device code authentication") "device_code" - } else { - "authorization_code" } - } else if (!got_pwd && !got_cert && got_user && got_httpuv) { + else "authorization_code" + } + else if(!got_pwd && !got_cert && got_user && got_httpuv) "authorization_code" - } else if ((got_pwd && !got_user) || got_cert) { - if (is_empty(on_behalf_of)) { + else if((got_pwd && !got_user) || got_cert) + { + if(is_empty(on_behalf_of)) "client_credentials" - } else { - "on_behalf_of" - } - } else { - stop("Can't select authentication method", call. = FALSE) + else "on_behalf_of" } + else stop("Can't select authentication method", call.=FALSE) message("Using ", auth_type, " flow") auth_type } -process_aad_response <- function(res) { +process_aad_response <- function(res) +{ status <- httr::status_code(res) - if (status >= 300) { + if(status >= 300) + { cont <- httr::content(res) - msg <- if (is.character(cont)) { - cont - } else if (is.list(cont) && is.character(cont$error_description)) { - cont$error_description - } else { - "" - } + msg <- if(is.character(cont)) + cont + else if(is.list(cont) && is.character(cont$error_description)) + cont$error_description + else "" msg <- paste0("obtain Azure Active Directory token. Message:\n", sub("\\.$", "", msg)) - list(token = httr::stop_for_status(status, msg)) - } else { - httr::content(res) + list(token=httr::stop_for_status(status, msg)) } + else httr::content(res) } # need to capture bad scopes before requesting auth code # v2.0 endpoint will show error page rather than redirecting, causing get_azure_token to wait forever -verify_v2_scope <- function(scope) { +verify_v2_scope <- function(scope) +{ # some OpenID scopes get a pass openid_scopes <- c("openid", "email", "profile", "offline_access") - if (scope %in% openid_scopes) { - return(scope) - } + if(scope %in% openid_scopes) + return(scope) # but not all bad_scopes <- c("address", "phone") - if (scope %in% bad_scopes) { - stop("Unsupported OpenID scope: ", scope, call. = FALSE) - } + if(scope %in% bad_scopes) + stop("Unsupported OpenID scope: ", scope, call.=FALSE) # is it a URI or GUID? valid_uri <- !is.null(httr::parse_url(scope)$scheme) valid_guid <- is_guid(sub("/.*$", "", scope)) - if (!valid_uri && !valid_guid) { - stop("Invalid scope (must be a URI or GUID): ", scope, call. = FALSE) - } + if(!valid_uri && !valid_guid) + stop("Invalid scope (must be a URI or GUID): ", scope, call.=FALSE) # if a URI or GUID, check that there is a valid scope in the path - if (valid_uri) { + if(valid_uri) + { uri <- httr::parse_url(scope) - if (uri$path == "") { - warning("No path supplied for scope ", scope, "; setting to /.default", call. = FALSE) + if(uri$path == "") + { + warning("No path supplied for scope ", scope, "; setting to /.default", call.=FALSE) uri$path <- ".default" scope <- httr::build_url(uri) } - } else { + } + else + { path <- sub("^[^/]+/?", "", scope) - if (path == "") { - warning("No path supplied for scope ", scope, "; setting to /.default", call. = FALSE) + if(path == "") + { + warning("No path supplied for scope ", scope, "; setting to /.default", call.=FALSE) scope <- sub("//", "/", paste0(scope, "/.default")) } } @@ -103,46 +104,46 @@ verify_v2_scope <- function(scope) { } -aad_uri <- function(aad_host, tenant, version, type, query = list()) { +aad_uri <- function(aad_host, tenant, version, type, query=list()) +{ uri <- httr::parse_url(aad_host) uri$query <- query - uri$path <- if (nchar(uri$path) == 0) { - if (version == 1) { - file.path(tenant, "oauth2", type) - } else { - file.path(tenant, "oauth2/v2.0", type) - } - } else { - file.path(uri$path, type) + uri$path <- if(nchar(uri$path) == 0) + { + if(version == 1) + file.path(tenant, "oauth2", type) + else file.path(tenant, "oauth2/v2.0", type) } + else file.path(uri$path, type) httr::build_url(uri) } -paste_v2_scopes <- function(scope) { - paste(scope, collapse = " ") +paste_v2_scopes <- function(scope) +{ + paste(scope, collapse=" ") } # display confirmation prompt, return TRUE/FALSE (no NA) -get_confirmation <- function(msg, default = TRUE) { - ok <- if (getRversion() < numeric_version("3.5.0")) { - msg <- paste(msg, if (default) "(Yes/no/cancel) " else "(yes/No/cancel) ") +get_confirmation <- function(msg, default=TRUE) +{ + ok <- if(getRversion() < numeric_version("3.5.0")) + { + msg <- paste(msg, if(default) "(Yes/no/cancel) " else "(yes/No/cancel) ") yn <- readline(msg) - if (nchar(yn) == 0) { - default - } else { - tolower(substr(yn, 1, 1)) == "y" - } - } else { - utils::askYesNo(msg, default) + if(nchar(yn) == 0) + default + else tolower(substr(yn, 1, 1)) == "y" } + else utils::askYesNo(msg, default) isTRUE(ok) } -in_shiny <- function() { +in_shiny <- function() +{ ("shiny" %in% loadedNamespaces()) && shiny::isRunning() -} \ No newline at end of file +} From eae208da8d05caff89a5bd56a2f05919b687c532 Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Wed, 21 Sep 2022 08:06:51 -0700 Subject: [PATCH 05/17] gitignore user local vscode settings --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 1bd84a9..530fc90 100644 --- a/.gitignore +++ b/.gitignore @@ -263,3 +263,4 @@ __pycache__/ .RHistory misc/ .Rproj.user +.vscode/settings.json \ No newline at end of file From 6a7250bc916825f159fad9ba5d94d13be189f041 Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Wed, 21 Sep 2022 08:13:41 -0700 Subject: [PATCH 06/17] undo auto-formatting in classes.R --- R/classes.R | 524 +++++++++++++++++++++++++++------------------------- 1 file changed, 270 insertions(+), 254 deletions(-) diff --git a/R/classes.R b/R/classes.R index e9202e6..cc63c69 100644 --- a/R/classes.R +++ b/R/classes.R @@ -1,286 +1,304 @@ #' @rdname AzureToken #' @export -AzureTokenAuthCode <- R6::R6Class("AzureTokenAuthCode", - inherit = AzureToken, - public = list( - initialize = function(common_args, authorize_args, auth_code) { - self$auth_type <- "authorization_code" - self$authorize_args <- authorize_args - with( - common_args, - private$set_request_credentials(app, password, username) - ) - do.call(super$initialize, c(common_args, list(auth_info = auth_code))) +AzureTokenAuthCode <- R6::R6Class("AzureTokenAuthCode", inherit=AzureToken, - # notify user if no refresh token - if (!is.null(self$credentials) && is.null(self$credentials$refresh_token)) { - norenew_alert(self$version) - } - } - ), - private = list( - initfunc = function(code = NULL) { - stopifnot(is.list(self$token_args)) - stopifnot(is.list(self$authorize_args)) - - opts <- utils::modifyList(list( - resource = if (self$version == 1) self$resource else self$scope, - tenant = self$tenant, - app = self$client$client_id, - username = self$client$login_hint, - aad_host = self$aad_host, - version = self$version - ), self$authorize_args) - - auth_uri <- do.call(build_authorization_uri, opts) - redirect <- httr::parse_url(auth_uri)$query$redirect_uri - - if (is.null(code)) { - if (!requireNamespace("httpuv", quietly = TRUE)) { - stop("httpuv package must be installed to use authorization_code method", call. = FALSE) - } - - code <- listen_for_authcode(auth_uri, redirect) - } - - # contact token endpoint for token - access_uri <- private$aad_uri("token") - body <- c(self$client, code = code, redirect_uri = redirect, self$token_args) - - httr::POST(access_uri, body = body, encode = "form") - }, - set_request_credentials = function(app, password, username) { - object <- list(client_id = app, grant_type = "authorization_code") +public=list( - if (!is.null(username)) { - object$login_hint <- username - } - if (!is.null(password)) { - object$client_secret <- password - } + initialize=function(common_args, authorize_args, auth_code) + { + self$auth_type <- "authorization_code" + self$authorize_args <- authorize_args + with(common_args, + private$set_request_credentials(app, password, username)) + do.call(super$initialize, c(common_args, list(auth_info=auth_code))) - self$client <- object + # notify user if no refresh token + if(!is.null(self$credentials) && is.null(self$credentials$refresh_token)) + norenew_alert(self$version) + } +), + +private=list( + + initfunc=function(code=NULL) + { + stopifnot(is.list(self$token_args)) + stopifnot(is.list(self$authorize_args)) + + opts <- utils::modifyList(list( + resource=if(self$version == 1) self$resource else self$scope, + tenant=self$tenant, + app=self$client$client_id, + username=self$client$login_hint, + aad_host=self$aad_host, + version=self$version + ), self$authorize_args) + + auth_uri <- do.call(build_authorization_uri, opts) + redirect <- httr::parse_url(auth_uri)$query$redirect_uri + + if(is.null(code)) + { + if(!requireNamespace("httpuv", quietly=TRUE)) + stop("httpuv package must be installed to use authorization_code method", call.=FALSE) + + code <- listen_for_authcode(auth_uri, redirect) } - ) -) + + # contact token endpoint for token + access_uri <- private$aad_uri("token") + body <- c(self$client, code=code, redirect_uri=redirect, self$token_args) + + httr::POST(access_uri, body=body, encode="form") + }, + + set_request_credentials=function(app, password, username) + { + object <- list(client_id=app, grant_type="authorization_code") + + if(!is.null(username)) + object$login_hint <- username + if(!is.null(password)) + object$client_secret <- password + + self$client <- object + } +)) #' @rdname AzureToken #' @export -AzureTokenDeviceCode <- R6::R6Class("AzureTokenDeviceCode", - inherit = AzureToken, - public = list( - initialize = function(common_args, device_creds) { - self$auth_type <- "device_code" - with( - common_args, - private$set_request_credentials(app) - ) - do.call(super$initialize, c(common_args, list(auth_info = device_creds))) +AzureTokenDeviceCode <- R6::R6Class("AzureTokenDeviceCode", inherit=AzureToken, - # notify user if no refresh token - if (!is.null(self$credentials) && is.null(self$credentials$refresh_token)) { - norenew_alert(self$version) - } - } - ), - private = list( - initfunc = function(creds = NULL) { - if (is.null(creds)) { - creds <- get_device_creds( - if (self$version == 1) self$resource else self$scope, - tenant = self$tenant, - app = self$client$client_id, - aad_host = self$aad_host, - version = self$version - ) - cat(creds$message, "\n") - } - - # poll token endpoint for token - access_uri <- private$aad_uri("token") - body <- c(self$client, code = creds$device_code) - - poll_for_token(access_uri, body, creds$interval, creds$expires_in) - }, - set_request_credentials = function(app) { - self$client <- list(client_id = app, grant_type = "device_code") +public=list( + + initialize=function(common_args, device_creds) + { + self$auth_type <- "device_code" + with(common_args, + private$set_request_credentials(app)) + do.call(super$initialize, c(common_args, list(auth_info=device_creds))) + + # notify user if no refresh token + if(!is.null(self$credentials) && is.null(self$credentials$refresh_token)) + norenew_alert(self$version) + } +), + +private=list( + + initfunc=function(creds=NULL) + { + if(is.null(creds)) + { + creds <- get_device_creds( + if(self$version == 1) self$resource else self$scope, + tenant=self$tenant, + app=self$client$client_id, + aad_host=self$aad_host, + version=self$version + ) + cat(creds$message, "\n") } - ) -) + + # poll token endpoint for token + access_uri <- private$aad_uri("token") + body <- c(self$client, code=creds$device_code) + + poll_for_token(access_uri, body, creds$interval, creds$expires_in) + }, + + set_request_credentials=function(app) + { + self$client <- list(client_id=app, grant_type="device_code") + } +)) #' @rdname AzureToken #' @export -AzureTokenClientCreds <- R6::R6Class("AzureTokenClientCreds", - inherit = AzureToken, - public = list( - initialize = function(common_args) { - self$auth_type <- "client_credentials" - with( - common_args, - private$set_request_credentials(app, password, certificate) - ) - do.call(super$initialize, common_args) - } - ), - private = list( - initfunc = function(init_args) { - # contact token endpoint directly with client credentials - uri <- private$aad_uri("token") - body <- private$build_access_body() +AzureTokenClientCreds <- R6::R6Class("AzureTokenClientCreds", inherit=AzureToken, - httr::POST(uri, body = body, encode = "form") - }, - set_request_credentials = function(app, password, certificate) { - object <- list(client_id = app, grant_type = "client_credentials") - - if (!is.null(password)) { - object$client_secret <- password - } else if (!is.null(certificate)) { - object$client_assertion_type <- "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" - object$client_assertion <- certificate # not actual assertion: will be replaced later - } else { - stop("Must provide either a client secret or certificate for client_credentials grant", - call. = FALSE - ) - } - - self$client <- object +public=list( + + initialize=function(common_args) + { + self$auth_type <- "client_credentials" + with(common_args, + private$set_request_credentials(app, password, certificate)) + do.call(super$initialize, common_args) + } +), + +private=list( + + initfunc=function(init_args) + { + # contact token endpoint directly with client credentials + uri <- private$aad_uri("token") + body <- private$build_access_body() + + httr::POST(uri, body=body, encode="form") + }, + + set_request_credentials=function(app, password, certificate) + { + object <- list(client_id=app, grant_type="client_credentials") + + if(!is.null(password)) + object$client_secret <- password + else if(!is.null(certificate)) + { + object$client_assertion_type <- "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" + object$client_assertion <- certificate # not actual assertion: will be replaced later } - ) -) + else stop("Must provide either a client secret or certificate for client_credentials grant", + call.=FALSE) + + self$client <- object + } +)) #' @rdname AzureToken #' @export -AzureTokenOnBehalfOf <- R6::R6Class("AzureTokenOnBehalfOf", - inherit = AzureToken, - public = list( - initialize = function(common_args, on_behalf_of) { - self$auth_type <- "on_behalf_of" - with( - common_args, - private$set_request_credentials(app, password, certificate, on_behalf_of) - ) - do.call(super$initialize, common_args) - } - ), - private = list( - initfunc = function(init_args) { - # contact token endpoint directly with client credentials - uri <- private$aad_uri("token") - body <- private$build_access_body() +AzureTokenOnBehalfOf <- R6::R6Class("AzureTokenOnBehalfOf", inherit=AzureToken, - httr::POST(uri, body = body, encode = "form") - }, - set_request_credentials = function(app, password, certificate, on_behalf_of) { - if (is_empty(on_behalf_of)) { - stop("Must provide an Azure token for on_behalf_of grant", call. = FALSE) - } - - object <- list(client_id = app, grant_type = "urn:ietf:params:oauth:grant-type:jwt-bearer") - - if (!is.null(password)) { - object$client_secret <- password - } else if (!is.null(certificate)) { - object$client_assertion_type <- "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" - object$client_assertion <- certificate # not actual assertion: will be replaced later - } else { - stop("Must provide either a client secret or certificate for on_behalf_of grant", - call. = FALSE - ) - } - - object$requested_token_use <- "on_behalf_of" - object$assertion <- extract_jwt(on_behalf_of) - - self$client <- object +public=list( + + initialize=function(common_args, on_behalf_of) + { + self$auth_type <- "on_behalf_of" + with(common_args, + private$set_request_credentials(app, password, certificate, on_behalf_of)) + do.call(super$initialize, common_args) + } +), + +private=list( + + initfunc=function(init_args) + { + # contact token endpoint directly with client credentials + uri <- private$aad_uri("token") + body <- private$build_access_body() + + httr::POST(uri, body=body, encode="form") + }, + + set_request_credentials=function(app, password, certificate, on_behalf_of) + { + if(is_empty(on_behalf_of)) + stop("Must provide an Azure token for on_behalf_of grant", call.=FALSE) + + object <- list(client_id=app, grant_type="urn:ietf:params:oauth:grant-type:jwt-bearer") + + if(!is.null(password)) + object$client_secret <- password + else if(!is.null(certificate)) + { + object$client_assertion_type <- "urn:ietf:params:oauth:client-assertion-type:jwt-bearer" + object$client_assertion <- certificate # not actual assertion: will be replaced later } - ) -) + else stop("Must provide either a client secret or certificate for on_behalf_of grant", + call.=FALSE) + + object$requested_token_use <- "on_behalf_of" + object$assertion <- extract_jwt(on_behalf_of) + + self$client <- object + } +)) #' @rdname AzureToken #' @export -AzureTokenResOwner <- R6::R6Class("AzureTokenResOwner", - inherit = AzureToken, - public = list( - initialize = function(common_args) { - self$auth_type <- "resource_owner" - with( - common_args, - private$set_request_credentials(app, password, username) - ) - do.call(super$initialize, common_args) - } - ), - private = list( - initfunc = function(init_args) { - # contact token endpoint directly with resource owner username/password - uri <- private$aad_uri("token") - body <- private$build_access_body() +AzureTokenResOwner <- R6::R6Class("AzureTokenResOwner", inherit=AzureToken, - httr::POST(uri, body = body, encode = "form") - }, - set_request_credentials = function(app, password, username) { - object <- list(client_id = app, grant_type = "password") +public=list( + + initialize=function(common_args) + { + self$auth_type <- "resource_owner" + with(common_args, + private$set_request_credentials(app, password, username)) + do.call(super$initialize, common_args) + } +), - if (is.null(username) && is.null(password)) { - stop("Must provide a username and password for resource_owner grant", call. = FALSE) - } +private=list( - object$username <- username - object$password <- password + initfunc=function(init_args) + { + # contact token endpoint directly with resource owner username/password + uri <- private$aad_uri("token") + body <- private$build_access_body() - self$client <- object - } - ) -) + httr::POST(uri, body=body, encode="form") + }, + + set_request_credentials=function(app, password, username) + { + object <- list(client_id=app, grant_type="password") + + if(is.null(username) && is.null(password)) + stop("Must provide a username and password for resource_owner grant", call.=FALSE) + + object$username <- username + object$password <- password + + self$client <- object + } +)) #' @rdname AzureToken #' @export -AzureTokenManaged <- R6::R6Class("AzureTokenManaged", - inherit = AzureToken, - public = list( - initialize = function(resource, aad_host, token_args, use_cache) { - self$auth_type <- "managed" - super$initialize(resource, tenant = "common", aad_host = aad_host, token_args = token_args, use_cache = use_cache) - } - ), - private = list( - initfunc = function(init_args) { - stopifnot(is.list(self$token_args)) +AzureTokenManaged <- R6::R6Class("AzureTokenManaged", inherit=AzureToken, - uri <- private$aad_uri("token") - query <- utils::modifyList( - self$token_args, - list(`api-version` = getOption("azure_imds_version"), resource = self$resource) - ) +public=list( - secret <- Sys.getenv("MSI_SECRET") - headers <- if (secret != "") { - httr::add_headers(secret = secret) - } else { - httr::add_headers(metadata = "true") - } + initialize=function(resource, aad_host, token_args, use_cache) + { + self$auth_type <- "managed" + super$initialize(resource, tenant="common", aad_host=aad_host, token_args=token_args, use_cache=use_cache) + } +), - httr::GET(uri, headers, query = query) - } - ) -) +private=list( + + initfunc=function(init_args) + { + stopifnot(is.list(self$token_args)) + + uri <- private$aad_uri("token") + query <- utils::modifyList(self$token_args, + list(`api-version`=getOption("azure_imds_version"), resource=self$resource)) + + secret <- Sys.getenv("MSI_SECRET") + headers <- if(secret != "") + httr::add_headers(secret=secret) + else httr::add_headers(metadata="true") + httr::GET(uri, headers, query=query) + } +)) + + +#' @rdname AzureToken +#' @export AzureTokenCLI <- R6::R6Class("AzureTokenCLI", inherit = AzureToken, public = list( - initialize = function(common_args) { + initialize = function(common_args) + { self$auth_type <- "cli" do.call(super$initialize, common_args) } ), private = list( - initfunc = function(init_args) { + initfunc = function(init_args) + { tryCatch( { result <- system2( @@ -291,11 +309,11 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", ), stdout = TRUE ) - result <- paste(result, collapse = "") - result - # TODO: base class assumes + # result is a multi-line JSON string, concatenate together + paste(result, collapse = "") }, - warning = function(cond) { + warning = function(cond) + { not_found <- grepl("az: not found", cond, fixed = TRUE) not_loggedin <- grepl("az login", cond, fixed = TRUE) | grepl("az account set", cond, fixed = TRUE) @@ -304,17 +322,18 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", cond, fixed = TRUE ) - if (not_found) { + if (not_found) message("Azure CLI not found on path.") - } else if (not_loggedin) { + else if (not_loggedin) message("Please run 'az login' to set up account.") - } else { + else message("Failed to invoke the Azure CLI.") - } } ) }, - process_response = function(res) { + process_response = function(res) + { + # Parse the JSON from the CLI and fix the names to snake_case ret <- jsonlite::parse_json(res) list( token_type = ret$tokenType, @@ -327,13 +346,10 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", ) -norenew_alert <- function(version) { - if (version == 1) { - message("Server did not provide a refresh token: please reauthenticate to refresh.") - } else { - message( - "Server did not provide a refresh token: you will have to reauthenticate to refresh.\n", - "Add the 'offline_access' scope to obtain a refresh token." - ) - } -} \ No newline at end of file +norenew_alert <- function(version) +{ + if(version == 1) + message("Server did not provide a refresh token: please reauthenticate to refresh.") + else message("Server did not provide a refresh token: you will have to reauthenticate to refresh.\n", + "Add the 'offline_access' scope to obtain a refresh token.") +} From 7961112208f03bbfbeeb3f0ef7805b150a49bc5c Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Wed, 21 Sep 2022 08:15:48 -0700 Subject: [PATCH 07/17] fix test --- tests/testthat/test30_azurecli.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test30_azurecli.R b/tests/testthat/test30_azurecli.R index 86d8d59..119c3a7 100644 --- a/tests/testthat/test30_azurecli.R +++ b/tests/testthat/test30_azurecli.R @@ -1,4 +1,5 @@ -test_that("azure_cli auth_type can be selected", { - auth_type <- select_auth_type(auth_type = "azure_cli") - expect_equal(auth_type, "azure_cli") +test_that("azure_cli auth_type can be selected", +{ + auth_type <- select_auth_type(auth_type = "cli") + expect_equal(auth_type, "cli") }) \ No newline at end of file From 8a422380338c981f07ac78af05011d8ad1abc865 Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Wed, 21 Sep 2022 09:37:38 -0700 Subject: [PATCH 08/17] add "cli" to valid auth_type list --- R/utils.R | 4 ++-- tests/testthat/test30_azurecli.R | 12 +++++++++--- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/R/utils.R b/R/utils.R index 6cfca6c..d10b7c1 100644 --- a/R/utils.R +++ b/R/utils.R @@ -3,8 +3,8 @@ select_auth_type <- function(password, username, certificate, auth_type, on_beha if(!is.null(auth_type)) { if(!auth_type %in% - c("authorization_code", "device_code", "client_credentials", "resource_owner", "on_behalf_of", - "managed")) + c("authorization_code", "device_code", "client_credentials", + "resource_owner", "on_behalf_of", "managed", "cli")) stop("Invalid authentication method") return(auth_type) } diff --git a/tests/testthat/test30_azurecli.R b/tests/testthat/test30_azurecli.R index 119c3a7..a965b8f 100644 --- a/tests/testthat/test30_azurecli.R +++ b/tests/testthat/test30_azurecli.R @@ -1,5 +1,11 @@ -test_that("azure_cli auth_type can be selected", +test_that("cli auth_type can be selected", { - auth_type <- select_auth_type(auth_type = "cli") - expect_equal(auth_type, "cli") + auth_type <- select_auth_type(auth_type = "cli") + expect_equal(auth_type, "cli") +}) + +test_that("the appropriate error is thrown when az is not installed", +{ + # TODO + fail("TODO") }) \ No newline at end of file From ab765254047d0e8d9f490cf67ee36726591cae35 Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Wed, 21 Sep 2022 09:44:14 -0700 Subject: [PATCH 09/17] stub out some test cases --- R/classes.R | 1 + tests/testthat/test30_azurecli.R | 26 +++++++++++++++++++++++++- 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/R/classes.R b/R/classes.R index cc63c69..c24a051 100644 --- a/R/classes.R +++ b/R/classes.R @@ -315,6 +315,7 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", warning = function(cond) { not_found <- grepl("az: not found", cond, fixed = TRUE) + # TODO: handle bash, windows, powershell errors for command not found not_loggedin <- grepl("az login", cond, fixed = TRUE) | grepl("az account set", cond, fixed = TRUE) bad_resource <- grepl( diff --git a/tests/testthat/test30_azurecli.R b/tests/testthat/test30_azurecli.R index a965b8f..7b44f29 100644 --- a/tests/testthat/test30_azurecli.R +++ b/tests/testthat/test30_azurecli.R @@ -4,8 +4,32 @@ test_that("cli auth_type can be selected", expect_equal(auth_type, "cli") }) +test_that("token is successfully retrieved if user is logged in", +{ + fail("TODO") +}) + +test_that("az login is called if the user is not already logged in", +{ + fail("TODO") +}) + +test_that("the output of az login is handled appropriately", +{ + fail("TODO") +}) + test_that("the appropriate error is thrown when az is not installed", { - # TODO + fail("TODO") +}) + +test_that("the appropriate error is thrown when the resource is invalid", +{ + fail("TODO") +}) + +test_that("the appropriate error is thrown when az login fails", +{ fail("TODO") }) \ No newline at end of file From 7d985ea5024e02a3e32432d380967d86ca175a0a Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Wed, 21 Sep 2022 09:46:59 -0700 Subject: [PATCH 10/17] fix not found search string --- R/classes.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/classes.R b/R/classes.R index c24a051..7c91ac5 100644 --- a/R/classes.R +++ b/R/classes.R @@ -314,8 +314,7 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", }, warning = function(cond) { - not_found <- grepl("az: not found", cond, fixed = TRUE) - # TODO: handle bash, windows, powershell errors for command not found + not_found <- grepl("not found", cond, fixed = TRUE) not_loggedin <- grepl("az login", cond, fixed = TRUE) | grepl("az account set", cond, fixed = TRUE) bad_resource <- grepl( From 513168a286867c13ba1d9e935a72a538ad5855de Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Wed, 21 Sep 2022 10:02:58 -0700 Subject: [PATCH 11/17] ignore whole .vscode dir --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 530fc90..61c71cc 100644 --- a/.gitignore +++ b/.gitignore @@ -263,4 +263,4 @@ __pycache__/ .RHistory misc/ .Rproj.user -.vscode/settings.json \ No newline at end of file +.vscode/ From 2a469be416f9f57d71daaebf7f2f6115f166d329 Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Fri, 23 Sep 2022 23:00:00 -0700 Subject: [PATCH 12/17] testing work --- R/classes.R | 14 ++++------ R/utils.R | 14 ++++++++++ tests/testthat/test30_azurecli.R | 46 ++++++++++++++++++++++++++------ 3 files changed, 57 insertions(+), 17 deletions(-) diff --git a/R/classes.R b/R/classes.R index 7c91ac5..f1470cc 100644 --- a/R/classes.R +++ b/R/classes.R @@ -301,16 +301,11 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", { tryCatch( { - result <- system2( - "az", - args = c( - "account", "get-access-token", "--output json", - paste0("--resource ", self$resource) - ), - stdout = TRUE - ) + cmd <- build_access_token_cmd(resource = self$resource, + tenant = self$tenant) + result <- do.call(system2, append(cmd, list(stdout = TRUE))) # result is a multi-line JSON string, concatenate together - paste(result, collapse = "") + paste0(result) }, warning = function(cond) { @@ -334,6 +329,7 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", process_response = function(res) { # Parse the JSON from the CLI and fix the names to snake_case + message(res) ret <- jsonlite::parse_json(res) list( token_type = ret$tokenType, diff --git a/R/utils.R b/R/utils.R index d10b7c1..63ec10d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -147,3 +147,17 @@ in_shiny <- function() { ("shiny" %in% loadedNamespaces()) && shiny::isRunning() } + +build_access_token_cmd <- function(command="az", resource, tenant) +{ + if (Sys.which(command) == "") + { + stop(paste(command, "is not installed.")) + } + args <- c( + "account", "get-access-token", "--output json", + paste("--resource", resource), + paste("--tenant", tenant) + ) + list(command = command, args = args) +} \ No newline at end of file diff --git a/tests/testthat/test30_azurecli.R b/tests/testthat/test30_azurecli.R index 7b44f29..0f909be 100644 --- a/tests/testthat/test30_azurecli.R +++ b/tests/testthat/test30_azurecli.R @@ -4,32 +4,62 @@ test_that("cli auth_type can be selected", expect_equal(auth_type, "cli") }) -test_that("token is successfully retrieved if user is logged in", +test_that("the output of az login is handled appropriately", { - fail("TODO") + res <- paste( + '{ "accessToken": "eyJ0",', + '"expiresOn": "2022-09-23 23:35:16.000000",', + '"tenant": "microsoft.com", "tokenType": "Bearer"}' + ) + TestClass <- R6::R6Class(inherit = AzureTokenCLI, + public = list( + initialize = function() { self$resource <- "foo" }, + run_test = function() { + private$process_response(res) + } + ) + ) + expected <- list(token_type = "Bearer", + access_token = "eyJ0", + expires_on = 1664001316, + resource = "foo") + tc <- TestClass$new() + expect_equal(expected, tc$run_test()) }) -test_that("az login is called if the user is not already logged in", +test_that("the appropriate error is thrown when az is not installed", { - fail("TODO") + expect_error(build_access_token_cmd("bnrwfq", resource = "foo", tenant = "bar"), + regexp = "bnrwfq is not installed.") }) -test_that("the output of az login is handled appropriately", +if (Sys.which("az") == "") + skip("az not installed, skipping tests.") + +# cond <- system2("az", args = c("account show"), stdout = TRUE) +# not_loggedin <- grepl("az login", cond, fixed = TRUE) | +# grepl("az account set", cond, fixed = TRUE) +# if (not_loggedin) +# skip("az not logged in, skipping tests.") + +test_that("the appropriate error is thrown when the resource is invalid", { + fail("TODO") }) -test_that("the appropriate error is thrown when az is not installed", +test_that("the appropriate error is thrown when az login fails", { fail("TODO") }) -test_that("the appropriate error is thrown when the resource is invalid", + +test_that("az login is called if the user is not already logged in", { fail("TODO") }) -test_that("the appropriate error is thrown when az login fails", +test_that("token is successfully retrieved if user is logged in", { fail("TODO") }) \ No newline at end of file From 6505f453da7aac19823606352b77a855f3c6bc46 Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Mon, 10 Oct 2022 16:21:58 -0700 Subject: [PATCH 13/17] save --- R/classes.R | 18 ++--- R/utils.R | 66 +++++++++++++++--- tests/testthat/test30_azurecli.R | 114 ++++++++++++++++++++++++++++--- 3 files changed, 168 insertions(+), 30 deletions(-) diff --git a/R/classes.R b/R/classes.R index f1470cc..990507c 100644 --- a/R/classes.R +++ b/R/classes.R @@ -301,9 +301,11 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", { tryCatch( { - cmd <- build_access_token_cmd(resource = self$resource, - tenant = self$tenant) - result <- do.call(system2, append(cmd, list(stdout = TRUE))) + cmd <- build_access_token_cmd( + resource = self$resource, + tenant = self$tenant + ) + result <- execute_az_token_cmd(cmd) # result is a multi-line JSON string, concatenate together paste0(result) }, @@ -328,15 +330,7 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", }, process_response = function(res) { - # Parse the JSON from the CLI and fix the names to snake_case - message(res) - ret <- jsonlite::parse_json(res) - list( - token_type = ret$tokenType, - access_token = ret$accessToken, - expires_on = as.numeric(as.POSIXct(ret$expiresOn)), - resource = self$resource - ) + process_cli_response(res, self$resource) } ) ) diff --git a/R/utils.R b/R/utils.R index 63ec10d..55bc9e0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -59,6 +59,20 @@ process_aad_response <- function(res) else httr::content(res) } +process_cli_response <- function(res, resource) +{ + # Parse the JSON from the CLI and fix the names to snake_case + ret <- jsonlite::parse_json(res) + tok_data <- list( + token_type = ret$tokenType, + access_token = ret$accessToken, + expires_on = as.numeric(as.POSIXct(ret$expiresOn)) + ) + # CLI doesn't return resource identifier so we need to pass it through + if (!missing(resource)) tok_data$resource <- resource + return(tok_data) +} + # need to capture bad scopes before requesting auth code # v2.0 endpoint will show error page rather than redirecting, causing get_azure_token to wait forever @@ -148,16 +162,52 @@ in_shiny <- function() ("shiny" %in% loadedNamespaces()) && shiny::isRunning() } -build_access_token_cmd <- function(command="az", resource, tenant) +build_az_token_cmd <- function(command = "az", resource, tenant) +{ + args <- c("account", "get-access-token", "--output json") + if (!missing(resource)) args <- c(args, paste("--resource", resource)) + if (!missing(tenant)) args <- c(args, paste("--tenant", tenant)) + list(command = command, args = args) +} + +handle_az_cmd_errors <- function(cond) { - if (Sys.which(command) == "") + not_found <- grepl("not found", cond, fixed = TRUE) + not_loggedin <- grepl("az login", cond, fixed = TRUE) | + grepl("az account set", cond, fixed = TRUE) + if (not_found) + { + msg <- paste("az is not installed or not in PATH.\n", + "Please see: ", + "https://learn.microsoft.com/en-us/cli/azure/install-azure-cli\n", + "for installation instructions." + ) + stop(msg) + } + else if (not_loggedin) { - stop(paste(command, "is not installed.")) + stop("You are not logged into the Azure CLI. Please run 'az login' and try again.") } - args <- c( - "account", "get-access-token", "--output json", - paste("--resource", resource), - paste("--tenant", tenant) + else + { + # Other misc errors, pass through the CLI error message + message("Failed to invoke the Azure CLI.") + stop(cond) + } +} + +execute_az_token_cmd <- function(cmd) +{ + tryCatch( + { + result <- do.call(system2, append(cmd, list(stdout = TRUE))) + # result is a multi-line JSON string, concatenate together + paste0(result) + }, + warning = function(cond) + { + # if an error case, catch it, pass the error string and handle it + handle_az_cmd_errors(cond) + } ) - list(command = command, args = args) } \ No newline at end of file diff --git a/tests/testthat/test30_azurecli.R b/tests/testthat/test30_azurecli.R index 0f909be..480d359 100644 --- a/tests/testthat/test30_azurecli.R +++ b/tests/testthat/test30_azurecli.R @@ -4,13 +4,81 @@ test_that("cli auth_type can be selected", expect_equal(auth_type, "cli") }) -test_that("the output of az login is handled appropriately", +test_that("az account command is assembled properly", +{ + resource <- "my_resource" + tenant <- "microsoft.com" + cmd <- build_az_token_cmd(resource = resource, tenant = tenant) + expect_equal(cmd$command, "az") + expect_equal( + cmd$args, + c( + "account", + "get-access-token", + "--output json", + "--resource my_resource", + "--tenant microsoft.com" + ) + ) +}) + +test_that("az account command is assembled properly even if missing tenant", +{ + resource <- "my_resource" + cmd <- build_az_token_cmd(resource = resource) + expect_equal(cmd$command, "az") + expect_equal( + cmd$args, + c( + "account", + "get-access-token", + "--output json", + "--resource my_resource" + ) + ) +}) + + +test_that("az account command is assembled properly even if missing resource", +{ + tenant <- "microsoft.com" + cmd <- build_az_token_cmd(tenant = tenant) + expect_equal(cmd$command, "az") + expect_equal( + cmd$args, + c( + "account", + "get-access-token", + "--output json", + "--tenant microsoft.com" + ) + ) +}) + +test_that("the token data from az login response is converted to an R list", { res <- paste( '{ "accessToken": "eyJ0",', '"expiresOn": "2022-09-23 23:35:16.000000",', '"tenant": "microsoft.com", "tokenType": "Bearer"}' - ) + ) + expected <- list( + token_type = "Bearer", + access_token = "eyJ0", + expires_on = 1664001316, + resource = "foo" + ) + actual <- process_cli_response(res, resource = "foo") + expect_equal(actual, expected) +}) + +test_that("the token data from az login is handled by AzureTokenCLI", +{ + res <- paste( + '{ "accessToken": "eyJ0",', + '"expiresOn": "2022-09-23 23:35:16.000000",', + '"tenant": "microsoft.com", "tokenType": "Bearer"}' + ) TestClass <- R6::R6Class(inherit = AzureTokenCLI, public = list( initialize = function() { self$resource <- "foo" }, @@ -19,18 +87,44 @@ test_that("the output of az login is handled appropriately", } ) ) - expected <- list(token_type = "Bearer", - access_token = "eyJ0", - expires_on = 1664001316, - resource = "foo") + expected <- list( + token_type = "Bearer", + access_token = "eyJ0", + expires_on = 1664001316, + resource = "foo" + ) tc <- TestClass$new() - expect_equal(expected, tc$run_test()) + expect_equal(tc$run_test(), expected) }) -test_that("the appropriate error is thrown when az is not installed", +test_that("the appropriate error is thrown when the az CLI is not installed", { - expect_error(build_access_token_cmd("bnrwfq", resource = "foo", tenant = "bar"), - regexp = "bnrwfq is not installed.") + expect_error( + execute_az_token_cmd( + build_az_token_cmd( + "bnrwfq", # pass a different command name that is unlikely to exist + resource = "foo", + tenant = "bar" + ) + ), + regexp = "bnrwfq is not installed." + ) +}) + +test_that("invalid scope error is handled", { + msg <- paste0( + "ERROR: AADSTS70011: The provided request must include a 'scope' input parameter. ", + "The provided value for the input parameter 'scope' is not valid. ", + "The scope my_resource/.default offline_access openid profile is not valid. ", + "The scope format is invalid. ", + "Scope must be in a valid URI form or a valid Guid .\n", + "Trace ID: 09da0917-570a-4f10-93f0-a61340d06300\n", + "Correlation ID: 6d2114db-6f1a-43fa-8484-b0a6783cf47b\n", + "Timestamp: 2022-10-10 22:55:14Z\n", + "To re-authenticate, please run:\n", + "az login --scope my_resource/.default" + ) + expect_error(, regexp = "") }) if (Sys.which("az") == "") From 84d66a9fb6a90d6404c508e79f7c21cae2795c8e Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Mon, 10 Oct 2022 22:34:59 -0700 Subject: [PATCH 14/17] tests passing --- R/classes.R | 2 +- R/token.R | 6 ++--- R/utils.R | 37 +++++++++++++++++++++++---- tests/testthat/test30_azurecli.R | 44 +++++++------------------------- 4 files changed, 45 insertions(+), 44 deletions(-) diff --git a/R/classes.R b/R/classes.R index 990507c..39a192e 100644 --- a/R/classes.R +++ b/R/classes.R @@ -301,7 +301,7 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", { tryCatch( { - cmd <- build_access_token_cmd( + cmd <- build_az_token_cmd( resource = self$resource, tenant = self$tenant ) diff --git a/R/token.R b/R/token.R index 69785fc..8132aeb 100644 --- a/R/token.R +++ b/R/token.R @@ -240,7 +240,7 @@ #' #' } #' @export -get_azure_token <- function(resource, tenant, app, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, +get_azure_token <- function(resource, tenant, app=NULL, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, aad_host="https://login.microsoftonline.com/", version=1, authorize_args=list(), token_args=list(), use_cache=NULL, on_behalf_of=NULL, auth_code=NULL, device_creds=NULL) @@ -281,7 +281,7 @@ get_azure_token <- function(resource, tenant, app, password=NULL, username=NULL, #' @param confirm For `delete_azure_token`, whether to prompt for confirmation before deleting a token. #' @rdname get_azure_token #' @export -delete_azure_token <- function(resource, tenant, app, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, +delete_azure_token <- function(resource, tenant, app=NULL, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, aad_host="https://login.microsoftonline.com/", version=1, authorize_args=list(), token_args=list(), on_behalf_of=NULL, hash=NULL, confirm=TRUE) @@ -346,7 +346,7 @@ list_azure_tokens <- function() #' @rdname get_azure_token #' @export -token_hash <- function(resource, tenant, app, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, +token_hash <- function(resource, tenant, app = NULL, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, aad_host="https://login.microsoftonline.com/", version=1, authorize_args=list(), token_args=list(), on_behalf_of=NULL) { diff --git a/R/utils.R b/R/utils.R index 55bc9e0..d89300f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -172,10 +172,12 @@ build_az_token_cmd <- function(command = "az", resource, tenant) handle_az_cmd_errors <- function(cond) { - not_found <- grepl("not found", cond, fixed = TRUE) not_loggedin <- grepl("az login", cond, fixed = TRUE) | grepl("az account set", cond, fixed = TRUE) - if (not_found) + not_found <- grepl("not found", cond, fixed = TRUE) + error_in <- grepl("error in running", cond, fixed = TRUE) + + if (not_found | error_in) { msg <- paste("az is not installed or not in PATH.\n", "Please see: ", @@ -186,7 +188,9 @@ handle_az_cmd_errors <- function(cond) } else if (not_loggedin) { - stop("You are not logged into the Azure CLI. Please run 'az login' and try again.") + stop("You are not logged into the Azure CLI. + Please call AzureAuth::az_login() + or run 'az login' from your shell and try again.") } else { @@ -196,6 +200,25 @@ handle_az_cmd_errors <- function(cond) } } +capt <- function(...) { + print(list(...)) + print("a" %in% list(...)) +} + +az_login <- function(command = "az",...) +{ + args <- list(...) + cmdargs <- list(command = command, args = c("login")) + for (arg in c("username", "password", "tenant", "scope", + "service_principal", "use_device_code")) { + if (arg %in% names(args)) + cmdargs$args <- c(cmdargs$args, paste0("--", arg, " ", args[arg])) + } + cat("Trying to open a web browser to log into Azure CLI...\n") + cat(cmdargs$command, paste(cmdargs$args), "\n") + do.call(system2, cmdargs) +} + execute_az_token_cmd <- function(cmd) { tryCatch( @@ -204,10 +227,14 @@ execute_az_token_cmd <- function(cmd) # result is a multi-line JSON string, concatenate together paste0(result) }, - warning = function(cond) + warning = function() { # if an error case, catch it, pass the error string and handle it - handle_az_cmd_errors(cond) + handle_az_cmd_errors(result) + }, + error = function(cond) + { + handle_az_cmd_errors(cond$message) } ) } \ No newline at end of file diff --git a/tests/testthat/test30_azurecli.R b/tests/testthat/test30_azurecli.R index 480d359..c34a009 100644 --- a/tests/testthat/test30_azurecli.R +++ b/tests/testthat/test30_azurecli.R @@ -38,7 +38,6 @@ test_that("az account command is assembled properly even if missing tenant", ) }) - test_that("az account command is assembled properly even if missing resource", { tenant <- "microsoft.com" @@ -100,14 +99,8 @@ test_that("the token data from az login is handled by AzureTokenCLI", test_that("the appropriate error is thrown when the az CLI is not installed", { expect_error( - execute_az_token_cmd( - build_az_token_cmd( - "bnrwfq", # pass a different command name that is unlikely to exist - resource = "foo", - tenant = "bar" - ) - ), - regexp = "bnrwfq is not installed." + handle_az_cmd_errors("error in running command"), + regexp = "az is not installed or not in PATH." ) }) @@ -124,36 +117,17 @@ test_that("invalid scope error is handled", { "To re-authenticate, please run:\n", "az login --scope my_resource/.default" ) - expect_error(, regexp = "") -}) - -if (Sys.which("az") == "") - skip("az not installed, skipping tests.") - -# cond <- system2("az", args = c("account show"), stdout = TRUE) -# not_loggedin <- grepl("az login", cond, fixed = TRUE) | -# grepl("az account set", cond, fixed = TRUE) -# if (not_loggedin) -# skip("az not logged in, skipping tests.") - -test_that("the appropriate error is thrown when the resource is invalid", -{ - - fail("TODO") + expect_error(handle_az_cmd_errors(msg)) }) -test_that("the appropriate error is thrown when az login fails", +test_that("the appropriate error is thrown when the tenant is invalid", { - fail("TODO") + errmsg <- "Failed to resolve tenant 'faketenant'" + expect_error(handle_az_cmd_errors(errmsg), regexp = "Failed to resolve tenant") }) - -test_that("az login is called if the user is not already logged in", +test_that("the appropriate error is thrown when the user is not logged in", { - fail("TODO") + errmsg <- "ERROR: Please run 'az login' to setup account." + expect_error(handle_az_cmd_errors(errmsg), regexp = "You are not logged in") }) - -test_that("token is successfully retrieved if user is logged in", -{ - fail("TODO") -}) \ No newline at end of file From 54bdefadf044580cd56b2f2424dca19ec69fdbb4 Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Mon, 10 Oct 2022 23:22:54 -0700 Subject: [PATCH 15/17] save --- R/classes.R | 2 +- R/token.R | 25 ++++++++++++++++++++++--- R/utils.R | 24 +++--------------------- vignettes/token.Rmd | 9 +++++++++ 4 files changed, 35 insertions(+), 25 deletions(-) diff --git a/R/classes.R b/R/classes.R index 39a192e..055aaa0 100644 --- a/R/classes.R +++ b/R/classes.R @@ -305,7 +305,7 @@ AzureTokenCLI <- R6::R6Class("AzureTokenCLI", resource = self$resource, tenant = self$tenant ) - result <- execute_az_token_cmd(cmd) + result <- execute_cmd(cmd) # result is a multi-line JSON string, concatenate together paste0(result) }, diff --git a/R/token.R b/R/token.R index 8132aeb..ceb78f7 100644 --- a/R/token.R +++ b/R/token.R @@ -240,7 +240,7 @@ #' #' } #' @export -get_azure_token <- function(resource, tenant, app=NULL, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, +get_azure_token <- function(resource=NULL, tenant=NULL, app=NULL, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, aad_host="https://login.microsoftonline.com/", version=1, authorize_args=list(), token_args=list(), use_cache=NULL, on_behalf_of=NULL, auth_code=NULL, device_creds=NULL) @@ -281,7 +281,7 @@ get_azure_token <- function(resource, tenant, app=NULL, password=NULL, username= #' @param confirm For `delete_azure_token`, whether to prompt for confirmation before deleting a token. #' @rdname get_azure_token #' @export -delete_azure_token <- function(resource, tenant, app=NULL, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, +delete_azure_token <- function(resource=NULL, tenant=NULL, app=NULL, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, aad_host="https://login.microsoftonline.com/", version=1, authorize_args=list(), token_args=list(), on_behalf_of=NULL, hash=NULL, confirm=TRUE) @@ -346,7 +346,7 @@ list_azure_tokens <- function() #' @rdname get_azure_token #' @export -token_hash <- function(resource, tenant, app = NULL, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, +token_hash <- function(resource=NULL, tenant=NULL, app=NULL, password=NULL, username=NULL, certificate=NULL, auth_type=NULL, aad_host="https://login.microsoftonline.com/", version=1, authorize_args=list(), token_args=list(), on_behalf_of=NULL) { @@ -413,3 +413,22 @@ is_azure_v2_token <- function(object) { is_azure_token(object) && object$version == 2 } + +#' @rdname az_login +#' @export +az_login <- function(...) +{ + args <- list(...) + cmdargs <- list(command = "az", args = c("login")) + for (arg in names(args)) + { + argval <- args[[arg]] + # CLI expects dashes, not underscores + argkey <- gsub("_", "-", arg) + if (is.logical(argval)) + cmdargs$args <- c(cmdargs$args, paste0("--", argkey)) + else + cmdargs$args <- c(cmdargs$args, paste0("--", argkey, " ", argval)) + } + execute_cmd(cmdargs) +} \ No newline at end of file diff --git a/R/utils.R b/R/utils.R index d89300f..97b2888 100644 --- a/R/utils.R +++ b/R/utils.R @@ -200,29 +200,11 @@ handle_az_cmd_errors <- function(cond) } } -capt <- function(...) { - print(list(...)) - print("a" %in% list(...)) -} - -az_login <- function(command = "az",...) -{ - args <- list(...) - cmdargs <- list(command = command, args = c("login")) - for (arg in c("username", "password", "tenant", "scope", - "service_principal", "use_device_code")) { - if (arg %in% names(args)) - cmdargs$args <- c(cmdargs$args, paste0("--", arg, " ", args[arg])) - } - cat("Trying to open a web browser to log into Azure CLI...\n") - cat(cmdargs$command, paste(cmdargs$args), "\n") - do.call(system2, cmdargs) -} - -execute_az_token_cmd <- function(cmd) +execute_cmd <- function(cmd) { tryCatch( { + cat(cmd$command, paste(cmd$args), "\n") result <- do.call(system2, append(cmd, list(stdout = TRUE))) # result is a multi-line JSON string, concatenate together paste0(result) @@ -237,4 +219,4 @@ execute_az_token_cmd <- function(cmd) handle_az_cmd_errors(cond$message) } ) -} \ No newline at end of file +} diff --git a/vignettes/token.Rmd b/vignettes/token.Rmd index 5d2deb0..8eb9f83 100644 --- a/vignettes/token.Rmd +++ b/vignettes/token.Rmd @@ -108,6 +108,15 @@ tok2 <- get_azure_token("resource2", "mytenant," "serviceapp_id", password="serviceapp_secret", auth_type="on_behalf_of", on_behalf_of=tok0) ``` +6. The **cli** method uses the + [Azure CLI](https://learn.microsoft.com/en-us/cli/azure/install-azure-cli) + command `az account get-access-token` to retrieve an auth token. It is mostly + useful for interactive programming. + +```r +get_azure_token(auth_type="cli") +``` + If you don't specify the method, `get_azure_token` makes a best guess based on the presence or absence of the other authentication arguments, and whether httpuv is installed. ```r From da439692cac13e0e7f658168c74fe9ad6d8abae2 Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Tue, 11 Oct 2022 08:01:39 -0700 Subject: [PATCH 16/17] add .Renviron to gitignore --- .gitignore | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.gitignore b/.gitignore index 61c71cc..cd9b838 100644 --- a/.gitignore +++ b/.gitignore @@ -264,3 +264,5 @@ __pycache__/ misc/ .Rproj.user .vscode/ + +.Renviron \ No newline at end of file From f93bcb0574ae4a7548304cf1a8aba655ef0a9a4c Mon Sep 17 00:00:00 2001 From: Alex Kyllo Date: Tue, 11 Oct 2022 08:04:55 -0700 Subject: [PATCH 17/17] add lines to readme and news file, bump version --- DESCRIPTION | 2 +- NEWS.md | 5 +++++ README.md | 9 +++++++++ 3 files changed, 15 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b38f82e..3ca6580 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AzureAuth Title: Authentication Services for Azure Active Directory -Version: 1.3.3 +Version: 1.4.0 Authors@R: c( person("Hong", "Ooi", , "hongooi73@gmail.com", role = c("aut", "cre")), person("Tyler", "Littlefield", role="ctb"), diff --git a/NEWS.md b/NEWS.md index f853696..65b0786 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# AzureAuth 1.4.0 + +- Add new CLI auth type, `get_azure_token(auth_type="cli")` to use the Azure CLI + to retrieve a user token. + # AzureAuth 1.3.3 - Documentation update only: diff --git a/README.md b/README.md index b5082ed..aac0c53 100644 --- a/README.md +++ b/README.md @@ -79,6 +79,15 @@ tok2 <- get_azure_token("resource2", "mytenant," "serviceapp_id", password="serviceapp_secret", auth_type="on_behalf_of", on_behalf_of=tok0) ``` +6. The **cli** method uses the + [Azure CLI](https://learn.microsoft.com/en-us/cli/azure/install-azure-cli) + command `az account get-access-token` to retrieve an auth token. It is mostly + useful for interactive programming. + +```r +get_azure_token(auth_type="cli") +``` + If you don't specify the method, `get_azure_token` makes a best guess based on the presence or absence of the other authentication arguments, and whether httpuv is installed. ### Managed identities