Skip to content

Commit

Permalink
Merge pull request #5563 from psafont/test_allowed
Browse files Browse the repository at this point in the history
test: add tests for allowed VM operations
  • Loading branch information
robhoes authored Apr 19, 2024
2 parents 21721ad + 723a498 commit aeee6ce
Show file tree
Hide file tree
Showing 7 changed files with 135 additions and 147 deletions.
18 changes: 18 additions & 0 deletions ocaml/idl/ocaml_backend/gen_api.ml
Original file line number Diff line number Diff line change
Expand Up @@ -72,6 +72,23 @@ let overrides =
)
]

(** Generate enum__all and enum_to_string bindings for all enums *)
let gen_enum_helpers tys =
let gen_string_and_all = function
| DT.Set (DT.Enum (_, elist) as e) ->
let nlist = List.map fst elist in
[
Printf.sprintf "let %s__all = %s" (OU.alias_of_ty e)
(OU.ocaml_list_of_enum nlist)
; (Printf.sprintf "let %s_to_string = %s")
(OU.alias_of_ty e)
(OU.ocaml_to_string_of_enum nlist)
]
| _ ->
[]
in
List.concat_map gen_string_and_all tys

(** Generate a single type declaration for simple types (eg not containing references to record objects) *)
let gen_non_record_type tys =
let rec aux accu = function
Expand Down Expand Up @@ -382,6 +399,7 @@ let gen_client_types highapi =
; gen_non_record_type all_types
; gen_record_type ~with_module:true highapi
(toposort_types highapi all_types)
; gen_enum_helpers all_types
; O.Signature.strings_of (Gen_client.gen_signature highapi)
]
)
Expand Down
13 changes: 12 additions & 1 deletion ocaml/idl/ocaml_backend/ocaml_utils.ml
Original file line number Diff line number Diff line change
Expand Up @@ -58,9 +58,15 @@ let ocaml_of_record_field = function

let ocaml_of_module_name x = String.capitalize_ascii x

let ocaml_map_enum_ sep f list = String.concat sep (List.map f list)

(** Convert an IDL enum into a polymorhic variant. *)
let ocaml_of_enum list =
"[ " ^ String.concat " | " (List.map constructor_of list) ^ " ]"
Printf.sprintf "[%s]" (ocaml_map_enum_ " | " constructor_of list)

(* Create a to_string function for a polymorphic variant. *)
let ocaml_list_of_enum list =
Printf.sprintf "[%s]" (ocaml_map_enum_ "; " constructor_of list)

(** Convert an IDL type to a function name; we need to generate functions to
marshal/unmarshal from XML for each unique IDL type *)
Expand Down Expand Up @@ -90,6 +96,11 @@ let rec alias_of_ty = function
| Option x ->
sprintf "%s_option" (alias_of_ty x)

(** Create the body of a to_string function for an enum *)
let ocaml_to_string_of_enum list =
let single name = Printf.sprintf {|%s -> "%s"|} (constructor_of name) name in
Printf.sprintf "function %s" (ocaml_map_enum_ " | " single list)

(** Convert an IDL type into a string containing OCaml code representing the
type. *)
let rec ocaml_of_ty = function
Expand Down
125 changes: 73 additions & 52 deletions ocaml/tests/test_vm_check_operation_error.ml
Original file line number Diff line number Diff line change
@@ -1,54 +1,6 @@
let all_vm_operations =
[
`assert_operation_valid
; `awaiting_memory_live
; `call_plugin
; `changing_VCPUs
; `changing_VCPUs_live
; `changing_dynamic_range
; `changing_memory_limits
; `changing_memory_live
; `changing_shadow_memory
; `changing_shadow_memory_live
; `changing_static_range
; `changing_NVRAM
; `checkpoint
; `clean_reboot
; `clean_shutdown
; `clone
; `copy
; `create_template
; `csvm
; `data_source_op
; `destroy
; `export
; `get_boot_record
; `hard_reboot
; `hard_shutdown
; `import
; `make_into_template
; `metadata_export
; `migrate_send
; `pause
; `pool_migrate
; `power_state_reset
; `provision
; `query_services
; `resume
; `resume_on
; `revert
; `reverting
; `send_sysrq
; `send_trigger
; `shutdown
; `snapshot
; `snapshot_with_quiesce
; `start
; `start_on
; `suspend
; `unpause
; `update_allowed_operations
]
let vm_op_to_string = API.vm_operations_to_string

let pp_vm_op () = Fmt.(str "%a" (of_to_string vm_op_to_string))

let with_test_vm f =
let __context = Mock.make_context_with_new_db "Mock context" in
Expand All @@ -75,7 +27,7 @@ let test_null_vdi () =
~strict:true
)
)
all_vm_operations
API.vm_operations__all
)

let test_vm_set_nvram_running () =
Expand Down Expand Up @@ -155,6 +107,71 @@ let test_sxm_allowed_when_rum () =
)
)

let test_is_allowed_concurrently (expected, (op, current_ops)) =
let ops_to_str ops =
String.concat "," (List.map (fun (_, op) -> vm_op_to_string op) ops)
in
let name =
match current_ops with
| [] ->
vm_op_to_string op
| lst ->
Printf.sprintf "%a when %s" pp_vm_op op (ops_to_str lst)
in

let test () =
let actual = Xapi_vm_lifecycle.is_allowed_concurrently ~op ~current_ops in
let name =
Printf.sprintf "%a allowed in [%s]" pp_vm_op op (ops_to_str current_ops)
in
Alcotest.(check bool) name expected actual
in
(name, `Quick, test)

let allowed_specs =
let current_of op = ((), op) in
let allow_hard_shutdown =
List.map
(fun op ->
let allowed = match op with `hard_shutdown -> false | _ -> true in
(allowed, (`hard_shutdown, [current_of op]))
)
API.vm_operations__all
in
let allow_hard_reboot =
List.map
(fun op ->
let allowed =
match op with `hard_shutdown | `hard_reboot -> false | _ -> true
in
(allowed, (`hard_reboot, [current_of op]))
)
API.vm_operations__all
in
let allow_clean_shutdown =
List.map
(fun op ->
let allowed = match op with `migrate_send -> true | _ -> false in
(allowed, (`clean_shutdown, [current_of op]))
)
API.vm_operations__all
in
List.concat
[
[
(true, (`snapshot, []))
; (true, (`snapshot, [current_of `checkpoint]))
; (false, (`migrate_send, [current_of `clean_reboot]))
; (true, (`clean_reboot, [current_of `migrate_send]))
]
; allow_hard_shutdown
; allow_clean_shutdown
; allow_hard_reboot
]

let test_allow_concurrently =
List.map test_is_allowed_concurrently allowed_specs

let test =
[
("test_null_vdi", `Quick, test_null_vdi)
Expand All @@ -166,3 +183,7 @@ let test =
; ("test_sxm_allowed_when_rum", `Quick, test_sxm_allowed_when_rum)
; ("test_vm_set_nvram when VM is running", `Quick, test_vm_set_nvram_running)
]

let () =
Alcotest.run "Xapi_vm_lifecycle"
[("is_allowed_concurrently", test_allow_concurrently)]
14 changes: 1 addition & 13 deletions ocaml/xapi/xapi_host_helpers.ml
Original file line number Diff line number Diff line change
Expand Up @@ -26,19 +26,7 @@ let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute

let finally = Xapi_stdext_pervasives.Pervasiveext.finally

let all_operations =
[
`provision
; `evacuate
; `reboot
; `shutdown
; `vm_start
; `vm_resume
; `vm_migrate
; `power_on
; `apply_updates
; `enable
]
let all_operations = API.host_allowed_operations__all

(** Returns a table of operations -> API error options (None if the operation would be ok) *)
let valid_operations ~__context record _ref' =
Expand Down
24 changes: 1 addition & 23 deletions ocaml/xapi/xapi_sr_operations.ml
Original file line number Diff line number Diff line change
Expand Up @@ -26,29 +26,7 @@ open Client

open Record_util

let all_ops : API.storage_operations_set =
[
`scan
; `destroy
; `forget
; `plug
; `unplug
; `vdi_create
; `vdi_destroy
; `vdi_resize
; `vdi_clone
; `vdi_snapshot
; `vdi_mirror
; `vdi_enable_cbt
; `vdi_disable_cbt
; `vdi_data_destroy
; `vdi_list_changed_blocks
; `vdi_set_on_boot
; `vdi_introduce
; `update
; `pbd_create
; `pbd_destroy
]
let all_ops = API.storage_operations__all

(* This list comes from https://github.com/xenserver/xen-api/blob/tampa-bugfix/ocaml/xapi/xapi_sr_operations.ml#L36-L38 *)
let all_rpu_ops : API.storage_operations_set =
Expand Down
21 changes: 1 addition & 20 deletions ocaml/xapi/xapi_vdi_helpers.ml
Original file line number Diff line number Diff line change
Expand Up @@ -26,26 +26,7 @@ module D = Debug.Make (struct let name = "xapi_vdi_helpers" end)

open D

let all_ops : API.vdi_operations_set =
[
`blocked
; `clone
; `copy
; `data_destroy
; `destroy
; `disable_cbt
; `enable_cbt
; `force_unlock
; `forget
; `generate_config
; `list_changed_blocks
; `mirror
; `resize
; `resize_online
; `set_on_boot
; `snapshot
; `update
]
let all_ops = API.vdi_operations__all

(* CA-26514: Block operations on 'unmanaged' VDIs *)
let assert_managed ~__context ~vdi =
Expand Down
67 changes: 29 additions & 38 deletions ocaml/xapi/xapi_vm_lifecycle.ml
Original file line number Diff line number Diff line change
Expand Up @@ -749,50 +749,41 @@ let vtpm_update_allowed_operations ~__context ~self =
let allowed = match state with `Halted -> ops | _ -> [] in
Db.VTPM.set_allowed_operations ~__context ~self ~value:allowed

let ignored_ops =
[
`create_template
; `power_state_reset
; `csvm
; `get_boot_record
; `send_sysrq
; `send_trigger
; `query_services
; `shutdown
; `call_plugin
; `changing_memory_live
; `awaiting_memory_live
; `changing_memory_limits
; `changing_shadow_memory_live
; `changing_VCPUs
; `assert_operation_valid
; `data_source_op
; `update_allowed_operations
; `import
; `reverting
]

let allowable_ops =
List.filter (fun op -> not (List.mem op ignored_ops)) API.vm_operations__all

let update_allowed_operations ~__context ~self =
let check_operation_error = check_operation_error ~__context ~ref:self in
let check accu op =
match check_operation_error ~op ~strict:true with
match check_operation_error ~__context ~ref:self ~op ~strict:true with
| None ->
op :: accu
| _ ->
| Some _err ->
accu
in
let allowed =
List.fold_left check []
[
`snapshot
; `copy
; `clone
; `revert
; `checkpoint
; `snapshot_with_quiesce
; `start
; `start_on
; `pause
; `unpause
; `clean_shutdown
; `clean_reboot
; `hard_shutdown
; `hard_reboot
; `suspend
; `resume
; `resume_on
; `export
; `destroy
; `provision
; `changing_VCPUs_live
; `pool_migrate
; `migrate_send
; `make_into_template
; `changing_static_range
; `changing_shadow_memory
; `changing_dynamic_range
; `changing_NVRAM
; `create_vtpm
; `metadata_export
]
in
let allowed = List.fold_left check [] allowable_ops in
(* FIXME: need to be able to deal with rolling-upgrade for orlando as well *)
let allowed =
if Helpers.rolling_upgrade_in_progress ~__context then
Expand Down

0 comments on commit aeee6ce

Please sign in to comment.