зеркало из https://github.com/Azure/AzureRMR.git
support paging of results
This commit is contained in:
hong-revo
Родитель
20abbdf72f
Коммит
4511c49a4a
|
|
@ -24,3 +24,4 @@ Collate:
|
|||
'az_subscription.R'
|
||||
'az_template.R'
|
||||
'call_azure_rm.R'
|
||||
'utils.R'
|
||||
|
|
|
|||
|
|
@ -7,4 +7,5 @@ export(az_resource_group)
|
|||
export(az_subscription)
|
||||
export(az_template)
|
||||
export(call_azure_rm)
|
||||
export(call_azure_url)
|
||||
export(get_azure_token)
|
||||
|
|
|
|||
|
|
@ -38,7 +38,7 @@ public=list(
|
|||
{
|
||||
# TODO: allow wait until complete
|
||||
private$rg_op(http_verb="DELETE")
|
||||
message("Resource group '", self$name, "' deleted")
|
||||
message("Resource group '", self$name, "' will be deleted. This operation may take some time to complete.")
|
||||
private$is_valid <- FALSE
|
||||
invisible(NULL)
|
||||
},
|
||||
|
|
@ -52,10 +52,16 @@ public=list(
|
|||
|
||||
list_templates=function()
|
||||
{
|
||||
# TODO: handle paging
|
||||
res <- private$rg_op("providers/Microsoft.Resources/deployments")$value
|
||||
lst <- lapply(res, function(parms) az_template$new(self$token, self$subscription, self$name,
|
||||
deployed_properties=parms))
|
||||
cont <- private$rg_op("providers/Microsoft.Resources/deployments")
|
||||
lst <- lapply(cont$value,
|
||||
function(parms) az_template$new(self$token, self$subscription, self$name, deployed_properties=parms))
|
||||
# keep going until paging is complete
|
||||
while(!is_empty(cont$nextLink))
|
||||
{
|
||||
cont <- call_azure_url(self$token, cont$nextLink)
|
||||
lst <- c(lst, lapply(cont$value,
|
||||
function(parms) az_template$new(self$token, self$subscription, self$name, deployed_properties=parms)))
|
||||
}
|
||||
named_list(lst)
|
||||
},
|
||||
|
||||
|
|
@ -77,9 +83,15 @@ public=list(
|
|||
|
||||
list_resources=function()
|
||||
{
|
||||
# TODO: handle paging
|
||||
res <- private$rg_op("resources")$value
|
||||
lst <- lapply(res, function(parms) az_resource$new(self$token, self$subscription, deployed_properties=parms))
|
||||
cont <- private$rg_op("resources")
|
||||
lst <- lapply(cont$value, function(parms) az_resource$new(self$token, self$subscription, deployed_properties=parms))
|
||||
# keep going until paging is complete
|
||||
while(!is_empty(cont$nextLink))
|
||||
{
|
||||
cont <- call_azure_url(self$token, cont$nextLink)
|
||||
lst <- c(lst, lapply(cont$value,
|
||||
function(parms) az_resource$new(self$token, self$subscription, deployed_properties=parms)))
|
||||
}
|
||||
named_list(lst)
|
||||
},
|
||||
|
||||
|
|
@ -114,7 +126,7 @@ private=list(
|
|||
else
|
||||
{
|
||||
private$validate_parms(parms)
|
||||
self$name <- name
|
||||
self$name <- parms$name
|
||||
}
|
||||
parms
|
||||
},
|
||||
|
|
|
|||
|
|
@ -85,7 +85,7 @@ public=list(
|
|||
{
|
||||
# TODO: allow wait until complete
|
||||
private$res_op(http_verb="DELETE")
|
||||
message("Resource '", self$name, "' deleted")
|
||||
message("Resource '", self$name, "' will be deleted. This operation may take some time to complete.")
|
||||
private$is_valid <- FALSE
|
||||
invisible(NULL)
|
||||
},
|
||||
|
|
|
|||
|
|
@ -73,9 +73,14 @@ public=list(
|
|||
|
||||
list_resource_groups=function()
|
||||
{
|
||||
# TODO: handle paging
|
||||
cont <- call_azure_rm(self$token, self$id, "resourcegroups")$value
|
||||
lst <- lapply(cont, function(parms) az_resource_group$new(self$token, self$id, parms=parms))
|
||||
cont <- call_azure_rm(self$token, self$id, "resourcegroups")
|
||||
lst <- lapply(cont$value, function(parms) az_resource_group$new(self$token, self$id, parms=parms))
|
||||
# keep going until paging is complete
|
||||
while(!is_empty(cont$nextLink))
|
||||
{
|
||||
cont <- call_azure_url(self$token, cont$nextLink)
|
||||
lst <- c(lst, lapply(cont$value, function(parms) az_resource_group$new(self$token, self$id, parms=parms)))
|
||||
}
|
||||
named_list(lst)
|
||||
},
|
||||
|
||||
|
|
@ -91,9 +96,15 @@ public=list(
|
|||
|
||||
list_resources=function()
|
||||
{
|
||||
# TODO: handle paging
|
||||
cont <- call_azure_rm(self$token, self$id, "resources")$value
|
||||
lst <- lapply(cont, function(parms) az_resource$new(self$token, self$id, deployed_properties=parms))
|
||||
cont <- call_azure_rm(self$token, self$id, "resources")
|
||||
lst <- lapply(cont$value, function(parms) az_resource$new(self$token, self$id, deployed_properties=parms))
|
||||
# keep going until paging is complete
|
||||
while(!is_empty(cont$nextLink))
|
||||
{
|
||||
cont <- call_azure_url(self$token, cont$nextLink)
|
||||
lst <- c(lst, lapply(cont$value,
|
||||
function(parms) az_resource$new(self$token, self$id, deployed_properties=parms)))
|
||||
}
|
||||
named_list(lst)
|
||||
}
|
||||
))
|
||||
|
|
|
|||
|
|
@ -4,6 +4,38 @@ call_azure_rm <- function(token, subscription, operation, ...,
|
|||
http_status_handler=c("stop", "warn", "message", "pass"),
|
||||
api_version=getOption("azure_api_version"),
|
||||
auto_refresh=TRUE)
|
||||
{
|
||||
url <- httr::parse_url(token$credentials$resource)
|
||||
url$path <- file.path("subscriptions", subscription, operation, fsep="/")
|
||||
url$query <- list(`api-version`=api_version)
|
||||
|
||||
headers <- process_headers(token, ..., auto_refresh=auto_refresh)
|
||||
verb <- get(match.arg(http_verb), getNamespace("httr"))
|
||||
|
||||
# do actual API call
|
||||
res <- verb(httr::build_url(url), headers, ...)
|
||||
|
||||
process_response(res, match.arg(http_status_handler))
|
||||
}
|
||||
|
||||
|
||||
#' @export
|
||||
call_azure_url <- function(token, url, ...,
|
||||
http_verb=c("GET", "DELETE", "PUT", "POST", "HEAD"),
|
||||
http_status_handler=c("stop", "warn", "message", "pass"),
|
||||
auto_refresh=TRUE)
|
||||
{
|
||||
headers <- process_headers(token, ..., auto_refresh=auto_refresh)
|
||||
verb <- get(match.arg(http_verb), getNamespace("httr"))
|
||||
|
||||
# do actual API call
|
||||
res <- verb(url, headers, ...)
|
||||
|
||||
process_response(res, match.arg(http_status_handler))
|
||||
}
|
||||
|
||||
|
||||
process_headers <- function(token, ..., auto_refresh)
|
||||
{
|
||||
# if token has expired, renew it
|
||||
if(auto_refresh && !token$validate())
|
||||
|
|
@ -13,80 +45,39 @@ call_azure_rm <- function(token, subscription, operation, ...,
|
|||
}
|
||||
|
||||
creds <- token$credentials
|
||||
|
||||
url <- httr::parse_url(creds$resource)
|
||||
url$path <- file.path("subscriptions", subscription, operation, fsep="/")
|
||||
url$query <- list(`api-version`=api_version)
|
||||
|
||||
headers <- c(Host=url$host, Authorization=paste(creds$token_type, creds$access_token))
|
||||
host <- httr::parse_url(creds$resource)$host
|
||||
headers <- c(Host=host, Authorization=paste(creds$token_type, creds$access_token))
|
||||
|
||||
# default content-type is json, set this if encoding not specified
|
||||
dots <- list(...)
|
||||
if(is_empty(dots) || !("encode" %in% names(dots)))
|
||||
headers <- c(headers, `Content-type`="application/json")
|
||||
|
||||
headers <- httr::add_headers(.headers=headers)
|
||||
verb <- get(match.arg(http_verb), getNamespace("httr"))
|
||||
httr::add_headers(.headers=headers)
|
||||
}
|
||||
|
||||
# do actual API call
|
||||
res <- verb(httr::build_url(url), headers, ...)
|
||||
|
||||
catch <- match.arg(http_status_handler)
|
||||
if(catch != "pass")
|
||||
process_response <- function(response, handler)
|
||||
{
|
||||
catch <- get(paste0(catch, "_for_status"), getNamespace("httr"))
|
||||
catch(res, paste0("complete Resource Manager operation. Message:\n",
|
||||
sub("\\.$", "", arm_error_message(res))))
|
||||
cont <- httr::content(res)
|
||||
if(handler != "pass")
|
||||
{
|
||||
handler <- get(paste0(handler, "_for_status"), getNamespace("httr"))
|
||||
handler(response, paste0("complete Resource Manager operation. Message:\n",
|
||||
sub("\\.$", "", arm_error_message(response))))
|
||||
cont <- httr::content(response)
|
||||
if(is.null(cont))
|
||||
cont <- list()
|
||||
attr(cont, "status") <- httr::status_code(res)
|
||||
attr(cont, "status") <- httr::status_code(response)
|
||||
cont
|
||||
}
|
||||
else res
|
||||
else response
|
||||
}
|
||||
|
||||
|
||||
# provide complete error messages from ARM
|
||||
# provide complete error messages from Resource Manager
|
||||
arm_error_message <- function(response)
|
||||
{
|
||||
cont <- httr::content(response)
|
||||
paste0(strwrap(cont$error$message), collapse="\n")
|
||||
}
|
||||
|
||||
|
||||
# check that 1) all required names are present; 2) optional names may be present; 3) no other names are present
|
||||
validate_object_names <- function(x, required, optional=character(0))
|
||||
{
|
||||
valid <- all(required %in% x) && all(x %in% c(required, optional))
|
||||
if(!valid)
|
||||
stop("Invalid object names")
|
||||
}
|
||||
|
||||
|
||||
# set names on a list of objects, where each object contains its name field
|
||||
named_list <- function(lst, name_field="name")
|
||||
{
|
||||
names(lst) <- sapply(lst, `[[`, name_field)
|
||||
dups <- duplicated(tolower(names(lst)))
|
||||
if(any(dups))
|
||||
{
|
||||
duped_names <- names(lst)[dups]
|
||||
warning("Some names are duplicated: ", paste(duped_names, collapse=" "), call.=FALSE)
|
||||
}
|
||||
lst
|
||||
}
|
||||
|
||||
|
||||
# check if a string appears to be a URL (only https allowed)
|
||||
is_url=function(x)
|
||||
{
|
||||
is.character(x) && length(x) == 1 && grepl("^https://", x)
|
||||
}
|
||||
|
||||
|
||||
# TRUE for NULL and length-0 objects
|
||||
is_empty <- function(x)
|
||||
{
|
||||
length(x) == 0
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,35 @@
|
|||
# check that 1) all required names are present; 2) optional names may be present; 3) no other names are present
|
||||
validate_object_names <- function(x, required, optional=character(0))
|
||||
{
|
||||
valid <- all(required %in% x) && all(x %in% c(required, optional))
|
||||
if(!valid)
|
||||
stop("Invalid object names")
|
||||
}
|
||||
|
||||
|
||||
# set names on a list of objects, where each object contains its name field
|
||||
named_list <- function(lst, name_field="name")
|
||||
{
|
||||
names(lst) <- sapply(lst, `[[`, name_field)
|
||||
dups <- duplicated(tolower(names(lst)))
|
||||
if(any(dups))
|
||||
{
|
||||
duped_names <- names(lst)[dups]
|
||||
warning("Some names are duplicated: ", paste(duped_names, collapse=" "), call.=FALSE)
|
||||
}
|
||||
lst
|
||||
}
|
||||
|
||||
|
||||
# check if a string appears to be a URL (only https allowed)
|
||||
is_url=function(x)
|
||||
{
|
||||
is.character(x) && length(x) == 1 && grepl("^https://", x)
|
||||
}
|
||||
|
||||
|
||||
# TRUE for NULL and length-0 objects
|
||||
is_empty <- function(x)
|
||||
{
|
||||
length(x) == 0
|
||||
}
|
||||
Загрузка…
Ссылка в новой задаче