CA-202419: Plumb 'strict' flag down to HVM feature check

Signed-off-by: Euan Harris <[email protected]>

Author: euanh

ocaml/xapi/export.ml

@@ -417,7 +417,7 @@ open Client
 
 let lock_vm ~__context ~vm ~task_id op =
 	(* Note slight race here because we haven't got the master lock *)
-	Xapi_vm_lifecycle.assert_operation_valid ~__context ~self:vm ~op;
+	Xapi_vm_lifecycle.assert_operation_valid ~__context ~self:vm ~op ~strict:true;
 	(* ... small race lives here ... *)
 	Db.VM.add_to_current_operations ~__context ~self:vm ~key:task_id ~value:op;
 	Xapi_vm_lifecycle.update_allowed_operations ~__context ~self:vm

ocaml/xapi/message_forwarding.ml

@@ -1583,7 +1583,7 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
 			let force = try bool_of_string (List.assoc "force" options) with _ -> false in
 			if not force then Cpuid_helpers.assert_vm_is_compatible ~__context ~vm ~host ();
 
-			with_vm_operation ~__context ~self:vm ~doc:"VM.pool_migrate" ~op:`pool_migrate
+			with_vm_operation ~__context ~self:vm ~doc:"VM.pool_migrate" ~op:`pool_migrate ~strict:(not force)
 				(fun () ->
 					(* Make sure the target has enough memory to receive the VM *)
 					let snapshot = Helpers.get_boot_record ~__context ~self:vm in

ocaml/xapi/xapi_vm.ml

@@ -34,7 +34,7 @@ open D
 
 exception InvalidOperation of string
 
-let assert_operation_valid = Xapi_vm_lifecycle.assert_operation_valid
+let assert_operation_valid = Xapi_vm_lifecycle.assert_operation_valid ~strict:true
 
 let update_allowed_operations ~__context ~self =
 	Helpers.log_exn_continue "updating allowed operations of VBDs/VIFs/VDIs in VM.update_allowed_operations"

ocaml/xapi/xapi_vm_helpers.ml

@@ -983,11 +983,11 @@ let vm_fresh_genid ~__context ~self =
 
 (** Add to the VM's current operations, call a function and then remove from the
 	current operations. Ensure the allowed_operations are kept up to date. *)
-let with_vm_operation ~__context ~self ~doc ~op ?policy f =
+let with_vm_operation ~__context ~self ~doc ~op ?(strict=true) ?policy f =
 	let task_id = Ref.string_of (Context.get_task_id __context) in
 	Helpers.retry_with_global_lock ~__context ~doc ?policy
 		(fun () ->
-			Xapi_vm_lifecycle.assert_operation_valid ~__context ~self ~op;
+			Xapi_vm_lifecycle.assert_operation_valid ~__context ~self ~op ~strict;
 			Db.VM.add_to_current_operations ~__context ~self ~key:task_id ~value:op;
 			Xapi_vm_lifecycle.update_allowed_operations ~__context ~self);
 	(* Then do the action with the lock released *)

ocaml/xapi/xapi_vm_lifecycle.ml

@@ -412,8 +412,8 @@ let get_operation_error ~__context ~self ~op ~strict =
 	let all, gm, clone_suspended_vm_enabled, vdis_reset_and_caching = get_info ~__context ~self in
 	check_operation_error __context all gm self clone_suspended_vm_enabled vdis_reset_and_caching op strict
 
-let assert_operation_valid ~__context ~self ~op =
-	match get_operation_error ~__context ~self ~op ~strict:true with
+let assert_operation_valid ~__context ~self ~op ~strict =
+	match get_operation_error ~__context ~self ~op ~strict with
 	| None       -> ()
 	| Some (a,b) -> raise (Api_errors.Server_error (a,b))