AzureVM/R/az_vm_resource.R

303 строки
11 KiB
R

#' Virtual machine resource class
#'
#' Class representing a virtual machine resource. In general, the methods in this class should not be called directly, nor should objects be directly instantiated from it. Use the `az_vm_template` class for interacting with VMs instead.
#'
#' @docType class
#' @section Methods:
#' The following methods are available, in addition to those provided by the [AzureRMR::az_resource] class:
#' - `start(wait=TRUE)`: Start the VM. By default, wait until the startup process is complete.
#' - `stop(deallocate=TRUE, wait=FALSE)`: Stop the VM. By default, deallocate it as well.
#' - `restart(wait=TRUE)`: Restart the VM.
#' - `run_deployed_command(command, parameters, script)`: Run a PowerShell command on the VM.
#' - `run_script(script, parameters)`: Run a script on the VM. For a Linux VM, this will be a shell script; for a Windows VM, a PowerShell script. Pass the script as a character vector.
#' - `sync_vm_status()`: Check the status of the VM.
#' - `resize(size, deallocate=FALSE, wait=FALSE)`: Resize the VM. Optionally stop and deallocate it first (may sometimes be necessary).
#' - `redeploy()`: Redeploy the VM.
#' - `reimage()`: Reimage the VM.
#' - `get_public_ip_address(nic=1, config=1)`: Get the public IP address of the VM. Returns NA if the VM is shut down, or is not publicly accessible.
#' - `get_private_ip_address(nic=1, config=1)`: Get the private IP address of the VM.
#' - `get_public_ip_resource(nic=1, config=1)`: Get the Azure resource for the VM's public IP address.
#' - `get_nic(nic=1)`: Get the VM's network interface resource.
#' - `get_vnet(nic=1, config=1)`: Get the VM's virtual network resource.
#' - `get_nsg(nic=1, config=1)`: Get the VM's network security group resource. Note that an NSG can be attached to either the VM's network interface or to its virtual network subnet; if there is an NSG attached to both, this method returns a list containing the two NSG resource objects.
#' - `get_disk(disk="os")`: Get a managed disk resource attached to the VM. The `disk` argument can be "os" for the OS disk, or a number indicating the LUN of a data disk. AzureVM only supports managed disks.
#' - `add_extension(publisher, type, version, settings=list(), protected_settings=list(), key_vault_settings=list())`: Add an extension to the VM.
#' - `do_vm_operation(...)`: Carry out an arbitrary operation on the VM resource. See the `do_operation` method of the [AzureRMR::az_resource] class for more details.
#'
#' @seealso
#' [AzureRMR::az_resource], [get_vm_resource], [az_vm_template]
#'
#' [VM API reference](https://docs.microsoft.com/en-us/rest/api/compute/virtualmachines)
#' @format An R6 object of class `az_vm_resource`, inheriting from `AzureRMR::az_resource`.
#' @export
az_vm_resource <- R6::R6Class("az_vm_resource", inherit=AzureRMR::az_resource,
public=list(
status=NULL,
# need to record these since AzureRMR can't currently get API versions for subresources
nic_api_version="2020-05-01",
ip_api_version="2020-05-01",
sync_vm_status=function()
{
get_status <- function(lst)
{
status <- lapply(lst, `[[`, "code")
names(status) <- sapply(status, function(x) sub("/.*$", "", x))
vapply(status, function(x) sub("^[^/]+/", "", x), FUN.VALUE=character(1))
}
self$sync_fields()
res <- self$do_operation("instanceView")
self$status <- get_status(res$statuses)
self$status
},
start=function(wait=TRUE)
{
self$do_operation("start", http_verb="POST")
if(wait) private$wait_for_success("start")
},
restart=function(wait=TRUE)
{
status <- self$sync_vm_status()
self$do_operation("restart", http_verb="POST")
if(wait) private$wait_for_success("restart")
},
stop=function(deallocate=TRUE, wait=FALSE)
{
self$do_operation("powerOff", http_verb="POST")
if(deallocate)
self$do_operation("deallocate", http_verb="POST")
if(wait)
{
for(i in 1:100)
{
Sys.sleep(5)
self$sync_vm_status()
if(length(self$status) < 2 || self$status[2] %in% c("stopped", "deallocated"))
break
}
if(length(self$status) == 2 && !(self$status[2] %in% c("stopped", "deallocated")))
stop("Unable to shut down VM", call.=FALSE)
}
},
resize=function(size, deallocate=FALSE, wait=FALSE)
{
if(deallocate)
self$stop(deallocate=TRUE, wait=TRUE)
properties <- list(hardwareProfile=list(vmSize=size))
self$do_operation(http_verb="PATCH",
body=list(properties=properties), encode="json")
if(wait)
{
size <- tolower(size)
for(i in 1:100)
{
self$sync_vm_status()
newsize <- tolower(properties$hardwareProfile$vmSize)
if(newsize == size)
break
Sys.sleep(5)
}
if(newsize != size)
stop("Unable to resize VM", call.=FALSE)
}
},
run_deployed_command=function(command, parameters=NULL, script=NULL)
{
body <- list(commandId=command, parameters=parameters, script=script)
self$do_operation("runCommand", body=body, encode="json", http_verb="POST")
},
run_script=function(script, parameters=NULL)
{
os_prof_names <- names(self$properties$osProfile)
windows <- any(grepl("windows", os_prof_names, ignore.case=TRUE))
linux <- any(grepl("linux", os_prof_names, ignore.case=TRUE))
if(!windows && !linux)
stop("Unknown VM operating system", call.=FALSE)
cmd <- if(windows) "RunPowerShellScript" else "RunShellScript"
self$run_deployed_command(cmd, as.list(parameters), as.list(script))
},
get_public_ip_address=function(nic=1, config=1)
{
ip <- self$get_public_ip_resource(nic, config)
if(is.null(ip) || is.null(ip$properties$ipAddress))
return(NA_character_)
ip$properties$ipAddress
},
get_private_ip_address=function(nic=1, config=1)
{
nic <- self$get_nic(nic)
nic$properties$ipConfigurations[[config]]$properties$privateIPAddress
},
get_public_ip_resource=function(nic=1, config=1)
{
nic <- self$get_nic(nic)
ip_id <- nic$properties$ipConfigurations[[config]]$properties$publicIPAddress$id
if(is_empty(ip_id))
return(NULL)
az_resource$new(self$token, self$subscription, id=ip_id, api_version=self$ip_api_version)
},
get_nic=function(nic=1)
{
nic_id <- self$properties$networkProfile$networkInterfaces[[nic]]$id
if(is_empty(nic_id))
stop("Network interface resource not found", call.=FALSE)
az_resource$new(self$token, self$subscription, id=nic_id, api_version=self$nic_api_version)
},
get_vnet=function(nic=1, config=1)
{
nic <- self$get_nic(nic)
subnet_id <- nic$properties$ipConfigurations[[config]]$properties$subnet$id
vnet_id <- sub("/subnets/[^/]+$", "", subnet_id)
az_resource$new(self$token, self$subscription, id=vnet_id)
},
get_nsg=function(nic=1, config=1)
{
vnet <- self$get_vnet(nic, config)
nic <- self$get_nic(nic)
nic_nsg_id <- nic$properties$networkSecurityGroup$id
nic_nsg <- if(!is.null(nic_nsg_id))
az_resource$new(self$token, self$subscription, id=nic_nsg_id)
else NULL
# go through list of subnets, find the one where this VM is located
found <- FALSE
nic_id <- tolower(nic$id)
for(sn in vnet$properties$subnets)
{
nics <- tolower(unlist(sn$properties$ipConfigurations))
if(any(grepl(nic_id, nics, fixed=TRUE)))
{
found <- TRUE
break
}
}
if(!found)
stop("Error locating subnet for this network configuration", call.=FALSE)
subnet_nsg_id <- sn$properties$networkSecurityGroup$id
subnet_nsg <- if(!is.null(subnet_nsg_id))
az_resource$new(self$token, self$subscription, id=subnet_nsg_id)
else NULL
if(is.null(nic_nsg) && is.null(subnet_nsg))
NULL
else if(is.null(nic_nsg) && !is.null(subnet_nsg))
subnet_nsg
else if(!is.null(nic_nsg) && is.null(subnet_nsg))
nic_nsg
else(list(nic_nsg, subnet_nsg))
},
get_disk=function(disk="os")
{
id <- if(disk == "os")
self$properties$storageProfile$osDisk$managedDisk$id
else if(is.numeric(disk))
self$properties$storageProfile$dataDisks[[disk]]$managedDisk$id
else stop("Invalid disk argument: should be 'os', or the data disk number", call.=FALSE)
az_resource$new(self$token, self$subscription, id=id)
},
add_extension=function(publisher, type, version, settings=list(),
protected_settings=list(), key_vault_settings=list())
{
name <- gsub("[[:punct:]]", "", type)
op <- file.path("extensions", name)
props <- list(
publisher=publisher,
type=type,
typeHandlerVersion=version,
autoUpgradeMinorVersion=TRUE,
settings=settings
)
if(!is_empty(protected_settings))
props$protectedSettings <- protected_settings
if(!is_empty(key_vault_settings))
props$protectedSettingsFromKeyVault <- key_vault_settings
self$do_operation(op, body=list(properties=props), http_verb="PUT")
},
redeploy=function()
{
self$do_operation("redeploy", http_verb="POST")
message("Redeployment started. Call the sync_vm_status() method to check progress.")
},
reimage=function()
{
self$do_operation("reimage", http_verb="POST")
message("Reimage started. Call the sync_vm_status() method to check progress.")
},
print=function(...)
{
cat("<Azure virtual machine resource ", self$name, ">\n", sep="")
osProf <- names(self$properties$osProfile)
os <- if(any(grepl("linux", osProf))) "Linux" else if(any(grepl("windows", osProf))) "Windows" else "<unknown>"
prov_status <- if(is_empty(self$status))
"<unknown>"
else paste0(names(self$status), "=", self$status, collapse=", ")
cat(" Operating system:", os, "\n")
cat(" Status:", prov_status, "\n")
cat("---\n")
cat(AzureRMR::format_public_fields(self,
exclude=c("subscription", "resource_group", "type", "name", "status", "is_synced",
"nic_api_version", "ip_api_version")))
cat(AzureRMR::format_public_methods(self))
invisible(NULL)
}
),
private=list(
init_and_deploy=function(...)
{
stop("Do not use 'az_vm_resource' to create a new VM", call.=FALSE)
},
wait_for_success=function(op)
{
for(i in 1:1000)
{
Sys.sleep(5)
self$sync_vm_status()
if(length(self$status) == 2 &&
# self$status[1] == "succeeded" &&
self$status[2] == "running")
break
}
if(length(self$status) < 2 ||
# self$status[1] != "succeeded" ||
self$status[2] != "running")
stop("Unable to ", op, " VM", call.=FALSE)
}
))