diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 5fb25cd26a0..e21369be258 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -4181,6 +4181,13 @@ module SR = struct , "Exporting a bitmap that shows the changed blocks between two VDIs" ) ; ("vdi_set_on_boot", "Setting the on_boot field of the VDI") + ; ("vdi_blocked", "Blocking other operations for a VDI") + ; ("vdi_copy", "Copying the VDI") + ; ("vdi_force_unlock", "Forcefully unlocking the VDI") + ; ("vdi_forget", "Forgetting about the VDI") + ; ("vdi_generate_config", "Generating the configuration of the VDI") + ; ("vdi_resize_online", "Resizing the VDI online") + ; ("vdi_update", "Refreshing the fields on the VDI") ; ("pbd_create", "Creating a PBD for this SR") ; ("pbd_destroy", "Destroying one of this SR's PBDs") ] diff --git a/ocaml/idl/datamodel_common.ml b/ocaml/idl/datamodel_common.ml index 3fb163cc961..a5fb8bd381a 100644 --- a/ocaml/idl/datamodel_common.ml +++ b/ocaml/idl/datamodel_common.ml @@ -10,7 +10,7 @@ open Datamodel_roles to leave a gap for potential hotfixes needing to increment the schema version.*) let schema_major_vsn = 5 -let schema_minor_vsn = 783 +let schema_minor_vsn = 784 (* Historical schema versions just in case this is useful later *) let rio_schema_major_vsn = 5 diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index 016a90960f3..595289dfd24 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly in ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *) -let last_known_schema_hash = "8fcd8892ec0c7d130b0da44c5fd3990b" +let last_known_schema_hash = "b427bac09aca4eabc9407738a9155326" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/tests/record_util/old_record_util.ml b/ocaml/tests/record_util/old_record_util.ml index c854f27f5aa..855a2b74b7e 100644 --- a/ocaml/tests/record_util/old_record_util.ml +++ b/ocaml/tests/record_util/old_record_util.ml @@ -341,6 +341,21 @@ let sr_operation_to_string : API.storage_operations -> string = function "PBD.create" | `pbd_destroy -> "PBD.destroy" + (* The following ones were added after the file got introduced *) + | `vdi_blocked -> + "VDI.blocked" + | `vdi_copy -> + "VDI.copy" + | `vdi_force_unlock -> + "VDI.force_unlock" + | `vdi_forget -> + "VDI.forget" + | `vdi_generate_config -> + "VDI.generate_config" + | `vdi_resize_online -> + "VDI.resize_online" + | `vdi_update -> + "VDI.update" let vbd_operation_to_string = function | `attach -> diff --git a/ocaml/tests/test_vdi_allowed_operations.ml b/ocaml/tests/test_vdi_allowed_operations.ml index 579cf7331c8..877b4fa48e5 100644 --- a/ocaml/tests/test_vdi_allowed_operations.ml +++ b/ocaml/tests/test_vdi_allowed_operations.ml @@ -30,9 +30,8 @@ let setup_test ~__context ?sm_fun ?vdi_fun () = (vdi_ref, vdi_record) let check_same_error_code = - let open Alcotest in - let open Alcotest_comparators in - check (option error_code) "Same error code" + Alcotest.(check @@ result unit Alcotest_comparators.error_code) + "Same error code" let run_assert_equal_with_vdi ~__context ?(ha_enabled = false) ?sm_fun ?vdi_fun op exc = @@ -52,7 +51,7 @@ let test_ca98944 () = () ) `update - (Some (Api_errors.vdi_in_use, [])) ; + (Error (Api_errors.vdi_in_use, [])) ; (* Should raise vdi_in_use *) run_assert_equal_with_vdi ~__context ~vdi_fun:(fun vdi_ref -> @@ -61,7 +60,7 @@ let test_ca98944 () = () ) `update - (Some (Api_errors.vdi_in_use, [])) ; + (Error (Api_errors.vdi_in_use, [])) ; (* Should raise vdi_in_use *) run_assert_equal_with_vdi ~__context ~vdi_fun:(fun vdi_ref -> @@ -70,7 +69,7 @@ let test_ca98944 () = () ) `update - (Some (Api_errors.vdi_in_use, [])) ; + (Error (Api_errors.vdi_in_use, [])) ; (* Should raise other_operation_in_progress *) run_assert_equal_with_vdi ~__context ~vdi_fun:(fun vdi_ref -> @@ -79,14 +78,14 @@ let test_ca98944 () = () ) `update - (Some (Api_errors.other_operation_in_progress, [])) ; + (Error (Api_errors.other_operation_in_progress, [])) ; (* Should pass *) run_assert_equal_with_vdi ~__context ~vdi_fun:(fun vdi_ref -> make_vbd ~vDI:vdi_ref ~__context ~reserved:false ~currently_attached:false ~current_operations:[] () ) - `forget None + `forget (Ok ()) (* VDI.copy should be allowed if all attached VBDs are read-only. *) let test_ca101669 () = @@ -97,15 +96,15 @@ let test_ca101669 () = make_vbd ~__context ~vDI:vdi_ref ~currently_attached:true ~mode:`RW () ) `copy - (Some (Api_errors.vdi_in_use, [])) ; + (Error (Api_errors.vdi_in_use, [])) ; (* Attempting to copy a RO-attached VDI should pass. *) run_assert_equal_with_vdi ~__context ~vdi_fun:(fun vdi_ref -> make_vbd ~__context ~vDI:vdi_ref ~currently_attached:true ~mode:`RO () ) - `copy None ; + `copy (Ok ()) ; (* Attempting to copy an unattached VDI should pass. *) - run_assert_equal_with_vdi ~__context `copy None ; + run_assert_equal_with_vdi ~__context `copy (Ok ()) ; (* Attempting to copy RW- and RO-attached VDIs should fail with VDI_IN_USE. *) run_assert_equal_with_vdi ~__context ~vdi_fun:(fun vdi_ref -> @@ -115,7 +114,7 @@ let test_ca101669 () = make_vbd ~__context ~vDI:vdi_ref ~currently_attached:true ~mode:`RO () ) `copy - (Some (Api_errors.vdi_in_use, [])) + (Error (Api_errors.vdi_in_use, [])) let test_ca125187 () = let __context = Test_common.make_test_database () in @@ -128,7 +127,7 @@ let test_ca125187 () = Db.VDI.set_current_operations ~__context ~self:vdi_ref ~value:[("mytask", `copy)] ) - `copy None ; + `copy (Ok ()) ; (* A VBD can be plugged to a VDI which is being copied. This is required as * the VBD is plugged after the VDI is marked with the copy operation. *) let _, _ = @@ -162,7 +161,7 @@ let test_ca126097 () = Db.VDI.set_current_operations ~__context ~self:vdi_ref ~value:[("mytask", `copy)] ) - `clone None ; + `clone (Ok ()) ; (* Attempting to snapshot a VDI being copied should be allowed. *) run_assert_equal_with_vdi ~__context ~vdi_fun:(fun vdi_ref -> @@ -173,7 +172,7 @@ let test_ca126097 () = ~value:[("mytask", `copy)] ) `snapshot - (Some (Api_errors.operation_not_allowed, [])) + (Error (Api_errors.operation_not_allowed, [])) (** Tests for the checks related to changed block tracking *) let test_cbt = @@ -189,7 +188,7 @@ let test_cbt = Db.SM.remove_from_features ~__context ~self:sm ~key:"VDI_CONFIG_CBT" ) op - (Some (Api_errors.sr_operation_not_supported, [])) + (Error (Api_errors.sr_operation_not_supported, [])) in let test_sm_feature_check = for_vdi_operations all_cbt_operations test_sm_feature_check @@ -202,7 +201,7 @@ let test_cbt = Db.VDI.set_is_a_snapshot ~__context ~self:vdi ~value:true ) op - (Some (Api_errors.operation_not_allowed, [])) + (Error (Api_errors.operation_not_allowed, [])) ) in let test_cbt_enable_disable_vdi_type_check = @@ -213,21 +212,21 @@ let test_cbt = Db.VDI.set_type ~__context ~self:vdi ~value:`metadata ) op - (Some (Api_errors.vdi_incompatible_type, [])) ; + (Error (Api_errors.vdi_incompatible_type, [])) ; run_assert_equal_with_vdi ~__context ~vdi_fun:(fun vdi -> Db.VDI.set_type ~__context ~self:vdi ~value:`redo_log ) op - (Some (Api_errors.vdi_incompatible_type, [])) ; + (Error (Api_errors.vdi_incompatible_type, [])) ; run_assert_equal_with_vdi ~__context ~vdi_fun:(fun vdi -> Db.VDI.set_type ~__context ~self:vdi ~value:`user) - op None ; + op (Ok ()) ; run_assert_equal_with_vdi ~__context ~vdi_fun:(fun vdi -> Db.VDI.set_type ~__context ~self:vdi ~value:`system ) - op None + op (Ok ()) ) in let test_cbt_enable_disable_not_allowed_for_reset_on_boot = @@ -238,7 +237,7 @@ let test_cbt = Db.VDI.set_on_boot ~__context ~self:vdi ~value:`reset ) op - (Some (Api_errors.vdi_on_boot_mode_incompatible_with_operation, [])) + (Error (Api_errors.vdi_on_boot_mode_incompatible_with_operation, [])) ) in let test_cbt_enable_disable_can_be_performed_live = @@ -249,7 +248,7 @@ let test_cbt = Test_common.make_vbd ~__context ~vDI:vdi ~currently_attached:true ~mode:`RW () ) - op None + op (Ok ()) ) in let test_cbt_metadata_vdi_type_check = @@ -273,7 +272,7 @@ let test_cbt = Db.VDI.set_type ~__context ~self:vdi ~value:`cbt_metadata ) op - (Some (Api_errors.vdi_incompatible_type, [])) + (Error (Api_errors.vdi_incompatible_type, [])) ) in let test_vdi_cbt_enabled_check = @@ -288,7 +287,7 @@ let test_cbt = Db.VDI.set_cbt_enabled ~__context ~self:vdi ~value:true ) op - (Some (Api_errors.vdi_cbt_enabled, [])) + (Error (Api_errors.vdi_cbt_enabled, [])) ) in let test_vdi_data_destroy () = @@ -308,31 +307,31 @@ let test_cbt = ) (* ensure VDI.data_destroy works before introducing errors *) [ - ((fun vdi -> pass_data_destroy vdi), None) + ((fun vdi -> pass_data_destroy vdi), Ok ()) ; ( (fun vdi -> pass_data_destroy vdi ; Db.VDI.set_is_a_snapshot ~__context ~self:vdi ~value:false ) - , Some (Api_errors.operation_not_allowed, []) + , Error (Api_errors.operation_not_allowed, []) ) ; ( (fun vdi -> pass_data_destroy vdi ; let sr = Db.VDI.get_SR ~__context ~self:vdi in Db.SR.set_is_tools_sr ~__context ~self:sr ~value:true ) - , Some (Api_errors.sr_operation_not_supported, []) + , Error (Api_errors.sr_operation_not_supported, []) ) ; ( (fun vdi -> pass_data_destroy vdi ; Db.VDI.set_cbt_enabled ~__context ~self:vdi ~value:false ) - , Some (Api_errors.vdi_no_cbt_metadata, []) + , Error (Api_errors.vdi_no_cbt_metadata, []) ) ; ( (fun vdi -> pass_data_destroy vdi ; Db.VDI.set_type ~__context ~self:vdi ~value:`cbt_metadata ) - , None + , Ok () ) ; (* VDI.data_destroy should wait a bit for the VDIs to be unplugged and destroyed, instead of failing immediately in check_operation_error, @@ -346,7 +345,7 @@ let test_cbt = in pass_data_destroy vdi ) - , None + , Ok () ) ; ( (fun vdi -> (* Set up the fields corresponding to a VM snapshot *) @@ -359,7 +358,7 @@ let test_cbt = in pass_data_destroy vdi ) - , None + , Ok () ) ; ( (fun vdi -> let vM = Test_common.make_vm ~__context () in @@ -369,7 +368,7 @@ let test_cbt = in pass_data_destroy vdi ) - , None + , Ok () ) ] in @@ -389,7 +388,7 @@ let test_cbt = Db.VDI.set_cbt_enabled ~__context ~self:vDI ~value:true ; Db.VDI.set_is_a_snapshot ~__context ~self:vDI ~value:true ) - , None + , Ok () ) in List.iter @@ -407,17 +406,17 @@ let test_cbt = in () ) - , Some (Api_errors.vdi_in_use, []) + , Error (Api_errors.vdi_in_use, []) ) ; (* positive test checks no errors thrown for cbt_metadata or cbt_enabled VDIs *) ( (fun vDI -> Db.VDI.set_cbt_enabled ~__context ~self:vDI ~value:true ; Db.VDI.set_type ~__context ~self:vDI ~value:`cbt_metadata ) - , None + , Ok () ) ; ( (fun vDI -> Db.VDI.set_cbt_enabled ~__context ~self:vDI ~value:true) - , None + , Ok () ) ; test_cbt_enabled_snapshot_vdi_linked_to_vm_snapshot ~vbd_currently_attached:false @@ -467,14 +466,14 @@ let test_operations_restricted_during_rpu = Db.SM.set_features ~__context ~self:sm ~value:[("VDI_MIRROR", 1L)] ) `mirror - (Some (Api_errors.not_supported_during_upgrade, [])) ; + (Error (Api_errors.not_supported_during_upgrade, [])) ; Db.Pool.remove_from_other_config ~__context ~self:pool ~key:Xapi_globs.rolling_upgrade_in_progress ; run_assert_equal_with_vdi ~__context ~sm_fun:(fun sm -> Db.SM.set_features ~__context ~self:sm ~value:[("VDI_MIRROR", 1L)] ) - `mirror None + `mirror (Ok ()) in let test_update_allowed_operations () = let __context = Mock.make_context_with_new_db "Mock context" in @@ -523,7 +522,7 @@ let test_null_vm = () in (* This shouldn't throw an exception *) - let (_ : _ option) = + let (_ : _ result) = Xapi_vdi.check_operation_error ~__context false vdi_record vdi_ref op in () diff --git a/ocaml/xapi-cli-server/record_util.ml b/ocaml/xapi-cli-server/record_util.ml index a7a4dd2ec72..d28b6b5f763 100644 --- a/ocaml/xapi-cli-server/record_util.ml +++ b/ocaml/xapi-cli-server/record_util.ml @@ -160,6 +160,20 @@ let sr_operation_to_string : API.storage_operations -> string = function "VDI.data_destroy" | `vdi_list_changed_blocks -> "VDI.list_changed_blocks" + | `vdi_blocked -> + "VDI.blocked" + | `vdi_copy -> + "VDI.copy" + | `vdi_force_unlock -> + "VDI.force_unlock" + | `vdi_forget -> + "VDI.forget" + | `vdi_generate_config -> + "VDI.generate_config" + | `vdi_resize_online -> + "VDI.resize_online" + | `vdi_update -> + "VDI.update" | `pbd_create -> "PBD.create" | `pbd_destroy -> diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 17ff3de0261..cb0b82aa7fd 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -5501,14 +5501,22 @@ functor in (snapshot, host) in + let op session_id rpc = + let sync_op () = + Client.VDI.pool_migrate ~rpc ~session_id ~vdi ~sr ~options + in + let async_op () = + Client.InternalAsync.VDI.pool_migrate ~rpc ~session_id ~vdi ~sr + ~options + in + Helpers.try_internal_async ~__context API.ref_VDI_of_rpc async_op + sync_op + in VM.reserve_memory_for_vm ~__context ~vm ~host ~snapshot ~host_op:`vm_migrate (fun () -> with_sr_andor_vdi ~__context ~vdi:(vdi, `mirror) ~doc:"VDI.mirror" (fun () -> - do_op_on ~local_fn ~__context ~host (fun session_id rpc -> - Client.VDI.pool_migrate ~rpc ~session_id ~vdi ~sr - ~options - ) + do_op_on ~local_fn ~__context ~host op ) ) ) diff --git a/ocaml/xapi/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml index ab8c543a36a..a2978de0b7f 100644 --- a/ocaml/xapi/xapi_vdi.ml +++ b/ocaml/xapi/xapi_vdi.ml @@ -22,49 +22,49 @@ open D (**************************************************************************************) (* current/allowed operations checking *) +let feature_of_op = + let open Smint in + function + | `forget | `copy | `force_unlock | `blocked -> + None + | `snapshot -> + Some Vdi_snapshot + | `destroy -> + Some Vdi_delete + | `resize -> + Some Vdi_resize + | `update -> + Some Vdi_update + | `resize_online -> + Some Vdi_resize_online + | `generate_config -> + Some Vdi_generate_config + | `clone -> + Some Vdi_clone + | `mirror -> + Some Vdi_mirror + | `enable_cbt | `disable_cbt | `data_destroy | `list_changed_blocks -> + Some Vdi_configure_cbt + | `set_on_boot -> + Some Vdi_reset_on_boot + let check_sm_feature_error (op : API.vdi_operations) sm_features sr = - let required_sm_feature = - Smint.( - match op with - | `forget | `copy | `force_unlock | `blocked -> - None - | `snapshot -> - Some Vdi_snapshot - | `destroy -> - Some Vdi_delete - | `resize -> - Some Vdi_resize - | `update -> - Some Vdi_update - | `resize_online -> - Some Vdi_resize_online - | `generate_config -> - Some Vdi_generate_config - | `clone -> - Some Vdi_clone - | `mirror -> - Some Vdi_mirror - | `enable_cbt | `disable_cbt | `data_destroy | `list_changed_blocks -> - Some Vdi_configure_cbt - | `set_on_boot -> - Some Vdi_reset_on_boot - ) - in - match required_sm_feature with + match feature_of_op op with | None -> - None + Ok () | Some feature -> if Smint.(has_capability feature sm_features) then - None + Ok () else - Some (Api_errors.sr_operation_not_supported, [Ref.string_of sr]) + Error (Api_errors.sr_operation_not_supported, [Ref.string_of sr]) -(** Checks to see if an operation is valid in this state. Returns [Some exception] - if not and [None] if everything is ok. If the [vbd_records] parameter is +(** Checks to see if an operation is valid in this state. Returns [Error exception] + if not and [Ok ()] if everything is ok. If the [vbd_records] parameter is specified, it should contain at least all the VBD records from the database that are linked to this VDI. *) let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) ?vbd_records ha_enabled record _ref' op = + let ( let* ) = Result.bind in let _ref = Ref.string_of _ref' in let current_ops = record.Db_actions.vDI_current_operations in let reset_on_boot = record.Db_actions.vDI_on_boot = `reset in @@ -83,14 +83,18 @@ let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) 5. HA prevents you from deleting statefiles or metadata volumes 6. During rolling pool upgrade, only operations known by older releases are allowed *) - if - Helpers.rolling_upgrade_in_progress ~__context - && not (List.mem op Xapi_globs.rpu_allowed_vdi_operations) - then - Some (Api_errors.not_supported_during_upgrade, []) - else - (* Don't fail with other_operation_in_progress if VDI mirroring is in progress - * and destroy is called as part of VDI mirroring *) + let* () = + if + Helpers.rolling_upgrade_in_progress ~__context + && not (List.mem op Xapi_globs.rpu_allowed_vdi_operations) + then + Error (Api_errors.not_supported_during_upgrade, []) + else + Ok () + in + let* () = + (* Don't fail with other_operation_in_progress if VDI mirroring is in + progress and destroy is called as part of VDI mirroring *) let is_vdi_mirroring_in_progress = List.exists (fun (_, op) -> op = `mirror) current_ops && op = `destroy in @@ -98,373 +102,351 @@ let check_operation_error ~__context ?sr_records:_ ?(pbd_records = []) List.exists (fun (_, op) -> op <> `copy) current_ops && not is_vdi_mirroring_in_progress then - Some (Api_errors.other_operation_in_progress, ["VDI"; _ref]) - else (* check to see whether it's a local cd drive *) - let sr = record.Db_actions.vDI_SR in - let sr_type = Db.SR.get_type ~__context ~self:sr in - let is_tools_sr = Db.SR.get_is_tools_sr ~__context ~self:sr in - (* Check to see if any PBDs are attached *) - let open Xapi_database.Db_filter_types in - let pbds_attached = - match pbd_records with - | [] -> - Db.PBD.get_records_where ~__context - ~expr: - (And - ( Eq (Field "SR", Literal (Ref.string_of sr)) - , Eq (Field "currently_attached", Literal "true") - ) - ) - | _ -> - List.filter - (fun (_, pbd_record) -> - pbd_record.API.pBD_SR = sr - && pbd_record.API.pBD_currently_attached - ) - pbd_records - in - if pbds_attached = [] && List.mem op [`resize] then - Some (Api_errors.sr_no_pbds, [Ref.string_of sr]) - else - (* check to see whether VBDs exist which are using this VDI *) - - (* Only a 'live' operation can be performed if there are active (even RO) devices *) - let my_active_vbd_records = - match vbd_records with - | None -> - List.map snd - (Db.VBD.get_internal_records_where ~__context - ~expr: - (And - ( Eq (Field "VDI", Literal _ref) - , Or - ( Eq (Field "currently_attached", Literal "true") - , Eq (Field "reserved", Literal "true") - ) - ) - ) - ) - | Some records -> - List.map snd - (List.filter - (fun (_, vbd_record) -> - vbd_record.Db_actions.vBD_VDI = _ref' - && (vbd_record.Db_actions.vBD_currently_attached - || vbd_record.Db_actions.vBD_reserved - ) - ) - records - ) - in - let my_active_rw_vbd_records = - List.filter - (fun vbd -> vbd.Db_actions.vBD_mode = `RW) - my_active_vbd_records - in - (* VBD operations (plug/unplug) (which should be transient) cause us to serialise *) - let my_has_current_operation_vbd_records = - match vbd_records with - | None -> - List.map snd - (Db.VBD.get_internal_records_where ~__context - ~expr: - (And - ( Eq (Field "VDI", Literal _ref) - , Not (Eq (Field "current_operations", Literal "()")) - ) - ) - ) - | Some records -> - List.map snd - (List.filter - (fun (_, vbd_record) -> - vbd_record.Db_actions.vBD_VDI = _ref' - && vbd_record.Db_actions.vBD_current_operations <> [] - ) - records - ) - in - (* If the VBD is currently_attached then some operations can still be performed ie: - VDI.clone (if the VM is suspended we have to have the 'allow_clone_suspended_vm'' flag) - VDI.snapshot; VDI.resize_online; 'blocked' (CP-831) - VDI.data_destroy: it is not allowed on VDIs linked to a VM, but the - implementation first waits for the VDI's VBDs to be unplugged and - destroyed, and the checks are performed there. - *) - let operation_can_be_performed_live = - match op with - | `snapshot - | `resize_online - | `blocked - | `clone - | `mirror - | `enable_cbt - | `disable_cbt - | `data_destroy -> - true - | _ -> - false - in - let operation_can_be_performed_with_ro_attach = - operation_can_be_performed_live - || match op with `copy -> true | _ -> false - in - (* NB RO vs RW sharing checks are done in xapi_vbd.ml *) - let blocked_by_attach = - let blocked_by_attach = - if operation_can_be_performed_live then - false - else if operation_can_be_performed_with_ro_attach then - my_active_rw_vbd_records <> [] - else - my_active_vbd_records <> [] - in - let allow_attached_vbds = - (* We use Valid_ref_list.list to ignore exceptions due to invalid references that - could propagate to the message forwarding layer, which calls this - function to check for errors - these exceptions would prevent the - actual XenAPI function from being run. Checks called from the - message forwarding layer should not fail with an exception. *) - let true_for_all_active_vbds f = - Valid_ref_list.for_all f my_active_vbd_records - in - match op with - | `list_changed_blocks -> - let vbd_connected_to_vm_snapshot vbd = - let vm = vbd.Db_actions.vBD_VM in - Db.is_valid_ref __context vm - && Db.VM.get_is_a_snapshot ~__context ~self:vm - in - (* We allow list_changed_blocks on VDIs attached to snapshot VMs, - because VM.checkpoint may set the currently_attached fields of the - snapshot's VBDs to true, and this would block list_changed_blocks. *) - true_for_all_active_vbds vbd_connected_to_vm_snapshot - | _ -> - false - in - blocked_by_attach && not allow_attached_vbds - in - if blocked_by_attach then - Some - ( Api_errors.vdi_in_use - , [_ref; Record_util.vdi_operations_to_string op] + Error (Api_errors.other_operation_in_progress, ["VDI"; _ref]) + else + Ok () + in + (* check to see whether it's a local cd drive *) + let sr = record.Db_actions.vDI_SR in + let sr_type = Db.SR.get_type ~__context ~self:sr in + let is_tools_sr = Db.SR.get_is_tools_sr ~__context ~self:sr in + (* Check to see if any PBDs are attached *) + let open Xapi_database.Db_filter_types in + let pbds_attached = + match pbd_records with + | [] -> + Db.PBD.get_records_where ~__context + ~expr: + (And + ( Eq (Field "SR", Literal (Ref.string_of sr)) + , Eq (Field "currently_attached", Literal "true") + ) ) - else if - (* data_destroy first waits for all the VBDs to disappear in its - implementation, so it is harmless to allow it when any of the VDI's - VBDs have operations in progress. This ensures that we avoid the retry - mechanism of message forwarding and only use the event loop. *) - my_has_current_operation_vbd_records <> [] && op <> `data_destroy - then - Some (Api_errors.other_operation_in_progress, ["VDI"; _ref]) - else - let sm_features = - Xapi_sr_operations.features_of_sr_internal ~__context ~_type:sr_type - in - let sm_feature_error = check_sm_feature_error op sm_features sr in - if sm_feature_error <> None then - sm_feature_error - else - let allowed_for_cbt_metadata_vdi = - match op with - | `clone - | `copy - | `disable_cbt - | `enable_cbt - | `mirror - | `resize - | `resize_online - | `snapshot - | `set_on_boot -> - false - | `blocked - | `data_destroy - | `destroy - | `list_changed_blocks - | `force_unlock - | `forget - | `generate_config - | `update -> - true - in - if - (not allowed_for_cbt_metadata_vdi) - && record.Db_actions.vDI_type = `cbt_metadata - then - Some - ( Api_errors.vdi_incompatible_type - , [_ref; Record_util.vdi_type_to_string `cbt_metadata] - ) - else - let allowed_when_cbt_enabled = - match op with - | `mirror | `set_on_boot -> - false - | `blocked - | `clone - | `copy - | `data_destroy - | `destroy - | `disable_cbt - | `enable_cbt - | `list_changed_blocks - | `force_unlock - | `forget - | `generate_config - | `resize - | `resize_online - | `snapshot - | `update -> - true - in - if - (not allowed_when_cbt_enabled) - && record.Db_actions.vDI_cbt_enabled - then - Some (Api_errors.vdi_cbt_enabled, [_ref]) - else - let check_destroy () = - if sr_type = "udev" then - Some (Api_errors.vdi_is_a_physical_device, [_ref]) - else if is_tools_sr then - Some - (Api_errors.sr_operation_not_supported, [Ref.string_of sr]) - else if List.mem record.Db_actions.vDI_type [`rrd] then - Some (Api_errors.vdi_has_rrds, [_ref]) - else if - ha_enabled - && List.mem record.Db_actions.vDI_type - [`ha_statefile; `redo_log] - then - Some (Api_errors.ha_is_enabled, []) - else if - List.mem record.Db_actions.vDI_type - [`ha_statefile; `metadata] - && Xapi_pool_helpers.ha_enable_in_progress ~__context - then - Some (Api_errors.ha_enable_in_progress, []) - else if - List.mem record.Db_actions.vDI_type - [`ha_statefile; `metadata] - && Xapi_pool_helpers.ha_disable_in_progress ~__context - then - Some (Api_errors.ha_disable_in_progress, []) - else - None - in - match op with - | `forget -> - if - ha_enabled - && List.mem record.Db_actions.vDI_type - [`ha_statefile; `redo_log] - then - Some (Api_errors.ha_is_enabled, []) - else if List.mem record.Db_actions.vDI_type [`rrd] then - Some (Api_errors.vdi_has_rrds, [_ref]) - else - None - | `destroy -> - check_destroy () - | `data_destroy -> - if not record.Db_actions.vDI_is_a_snapshot then - Some - ( Api_errors.operation_not_allowed - , ["VDI is not a snapshot: " ^ _ref] - ) - else if not record.Db_actions.vDI_cbt_enabled then - Some (Api_errors.vdi_no_cbt_metadata, [_ref]) - else - check_destroy () - | `resize -> - if - ha_enabled - && List.mem record.Db_actions.vDI_type - [`ha_statefile; `redo_log] - then - Some (Api_errors.ha_is_enabled, []) - else - None - | `resize_online -> - if - ha_enabled - && List.mem record.Db_actions.vDI_type - [`ha_statefile; `redo_log] - then - Some (Api_errors.ha_is_enabled, []) - else - None - | `snapshot when record.Db_actions.vDI_sharable -> - Some (Api_errors.vdi_is_sharable, [_ref]) - | (`snapshot | `copy) when reset_on_boot -> - Some - ( Api_errors.vdi_on_boot_mode_incompatible_with_operation - , [] + | _ -> + List.filter + (fun (_, pbd_record) -> + pbd_record.API.pBD_SR = sr && pbd_record.API.pBD_currently_attached + ) + pbd_records + in + let* () = + if pbds_attached = [] && List.mem op [`resize] then + Error (Api_errors.sr_no_pbds, [Ref.string_of sr]) + else + Ok () + in + + (* check to see whether VBDs exist which are using this VDI *) + + (* Only a 'live' operation can be performed if there are active (even RO) devices *) + let my_active_vbd_records = + match vbd_records with + | None -> + List.map snd + (Db.VBD.get_internal_records_where ~__context + ~expr: + (And + ( Eq (Field "VDI", Literal _ref) + , Or + ( Eq (Field "currently_attached", Literal "true") + , Eq (Field "reserved", Literal "true") ) - | `snapshot -> - if List.exists (fun (_, op) -> op = `copy) current_ops then - Some - ( Api_errors.operation_not_allowed - , ["Snapshot operation not allowed during copy."] - ) - else - None - | `copy -> - if - List.mem record.Db_actions.vDI_type - [`ha_statefile; `redo_log] - then - Some - ( Api_errors.operation_not_allowed - , [ - "VDI containing HA statefile or redo log cannot be \ - copied (check the VDI's allowed operations)." - ] - ) - else - None - | `enable_cbt | `disable_cbt -> - if record.Db_actions.vDI_is_a_snapshot then - Some - ( Api_errors.operation_not_allowed - , ["VDI is a snapshot: " ^ _ref] - ) - else if - not (List.mem record.Db_actions.vDI_type [`user; `system]) - then - Some - ( Api_errors.vdi_incompatible_type - , [ - _ref - ; Record_util.vdi_type_to_string - record.Db_actions.vDI_type - ] - ) - else if reset_on_boot then - Some - ( Api_errors.vdi_on_boot_mode_incompatible_with_operation - , [] - ) - else - None - | `mirror - | `clone - | `generate_config - | `force_unlock - | `set_on_boot - | `list_changed_blocks - | `blocked - | `update -> - None + ) + ) + ) + | Some records -> + List.map snd + (List.filter + (fun (_, vbd_record) -> + vbd_record.Db_actions.vBD_VDI = _ref' + && (vbd_record.Db_actions.vBD_currently_attached + || vbd_record.Db_actions.vBD_reserved + ) + ) + records + ) + in + let my_active_rw_vbd_records = + List.filter (fun vbd -> vbd.Db_actions.vBD_mode = `RW) my_active_vbd_records + in + (* VBD operations (plug/unplug) (which should be transient) cause us to serialise *) + let my_has_current_operation_vbd_records = + match vbd_records with + | None -> + List.map snd + (Db.VBD.get_internal_records_where ~__context + ~expr: + (And + ( Eq (Field "VDI", Literal _ref) + , Not (Eq (Field "current_operations", Literal "()")) + ) + ) + ) + | Some records -> + List.map snd + (List.filter + (fun (_, vbd_record) -> + vbd_record.Db_actions.vBD_VDI = _ref' + && vbd_record.Db_actions.vBD_current_operations <> [] + ) + records + ) + in + (* If the VBD is currently_attached then some operations can still be + performed ie: VDI.clone (if the VM is suspended we have to have the + 'allow_clone_suspended_vm' flag); VDI.snapshot; VDI.resize_online; + 'blocked' (CP-831); VDI.data_destroy: it is not allowed on VDIs linked + to a VM, but the implementation first waits for the VDI's VBDs to be + unplugged and destroyed, and the checks are performed there. + *) + let operation_can_be_performed_live = + match op with + | `snapshot + | `resize_online + | `blocked + | `clone + | `mirror + | `enable_cbt + | `disable_cbt + | `data_destroy -> + true + | _ -> + false + in + let operation_can_be_performed_with_ro_attach = + operation_can_be_performed_live + || match op with `copy -> true | _ -> false + in + (* NB RO vs RW sharing checks are done in xapi_vbd.ml *) + let blocked_by_attach = + let blocked_by_attach = + if operation_can_be_performed_live then + false + else if operation_can_be_performed_with_ro_attach then + my_active_rw_vbd_records <> [] + else + my_active_vbd_records <> [] + in + let allow_attached_vbds = + (* We use Valid_ref_list.list to ignore exceptions due to invalid + references that could propagate to the message forwarding layer, which + calls this function to check for errors - these exceptions would + prevent the actual XenAPI function from being run. Checks called from + the message forwarding layer should not fail with an exception. *) + let true_for_all_active_vbds f = + Valid_ref_list.for_all f my_active_vbd_records + in + match op with + | `list_changed_blocks -> + let vbd_connected_to_vm_snapshot vbd = + let vm = vbd.Db_actions.vBD_VM in + Db.is_valid_ref __context vm + && Db.VM.get_is_a_snapshot ~__context ~self:vm + in + (* We allow list_changed_blocks on VDIs attached to snapshot VMs, + because VM.checkpoint may set the currently_attached fields of the + snapshot's VBDs to true, and this would block list_changed_blocks. *) + true_for_all_active_vbds vbd_connected_to_vm_snapshot + | _ -> + false + in + blocked_by_attach && not allow_attached_vbds + in + let* () = + if blocked_by_attach then + Error + (Api_errors.vdi_in_use, [_ref; Record_util.vdi_operations_to_string op]) + else if + (* data_destroy first waits for all the VBDs to disappear in its + implementation, so it is harmless to allow it when any of the VDI's + VBDs have operations in progress. This ensures that we avoid the retry + mechanism of message forwarding and only use the event loop. *) + my_has_current_operation_vbd_records <> [] && op <> `data_destroy + then + Error (Api_errors.other_operation_in_progress, ["VDI"; _ref]) + else + Ok () + in + let sm_features = + Xapi_sr_operations.features_of_sr_internal ~__context ~_type:sr_type + in + let* () = check_sm_feature_error op sm_features sr in + let allowed_for_cbt_metadata_vdi = + match op with + | `clone + | `copy + | `disable_cbt + | `enable_cbt + | `mirror + | `resize + | `resize_online + | `snapshot + | `set_on_boot -> + false + | `blocked + | `data_destroy + | `destroy + | `list_changed_blocks + | `force_unlock + | `forget + | `generate_config + | `update -> + true + in + let* () = + if + (not allowed_for_cbt_metadata_vdi) + && record.Db_actions.vDI_type = `cbt_metadata + then + Error + ( Api_errors.vdi_incompatible_type + , [_ref; Record_util.vdi_type_to_string `cbt_metadata] + ) + else + Ok () + in + let allowed_when_cbt_enabled = + match op with + | `mirror | `set_on_boot -> + false + | `blocked + | `clone + | `copy + | `data_destroy + | `destroy + | `disable_cbt + | `enable_cbt + | `list_changed_blocks + | `force_unlock + | `forget + | `generate_config + | `resize + | `resize_online + | `snapshot + | `update -> + true + in + let* () = + if (not allowed_when_cbt_enabled) && record.Db_actions.vDI_cbt_enabled then + Error (Api_errors.vdi_cbt_enabled, [_ref]) + else + Ok () + in + let check_destroy () = + if sr_type = "udev" then + Error (Api_errors.vdi_is_a_physical_device, [_ref]) + else if is_tools_sr then + Error (Api_errors.sr_operation_not_supported, [Ref.string_of sr]) + else if List.mem record.Db_actions.vDI_type [`rrd] then + Error (Api_errors.vdi_has_rrds, [_ref]) + else if + ha_enabled + && List.mem record.Db_actions.vDI_type [`ha_statefile; `redo_log] + then + Error (Api_errors.ha_is_enabled, []) + else if + List.mem record.Db_actions.vDI_type [`ha_statefile; `metadata] + && Xapi_pool_helpers.ha_enable_in_progress ~__context + then + Error (Api_errors.ha_enable_in_progress, []) + else if + List.mem record.Db_actions.vDI_type [`ha_statefile; `metadata] + && Xapi_pool_helpers.ha_disable_in_progress ~__context + then + Error (Api_errors.ha_disable_in_progress, []) + else + Ok () + in + match op with + | `forget -> + if + ha_enabled + && List.mem record.Db_actions.vDI_type [`ha_statefile; `redo_log] + then + Error (Api_errors.ha_is_enabled, []) + else if List.mem record.Db_actions.vDI_type [`rrd] then + Error (Api_errors.vdi_has_rrds, [_ref]) + else + Ok () + | `destroy -> + check_destroy () + | `data_destroy -> + if not record.Db_actions.vDI_is_a_snapshot then + Error + (Api_errors.operation_not_allowed, ["VDI is not a snapshot: " ^ _ref]) + else if not record.Db_actions.vDI_cbt_enabled then + Error (Api_errors.vdi_no_cbt_metadata, [_ref]) + else + check_destroy () + | `resize -> + if + ha_enabled + && List.mem record.Db_actions.vDI_type [`ha_statefile; `redo_log] + then + Error (Api_errors.ha_is_enabled, []) + else + Ok () + | `resize_online -> + if + ha_enabled + && List.mem record.Db_actions.vDI_type [`ha_statefile; `redo_log] + then + Error (Api_errors.ha_is_enabled, []) + else + Ok () + | `snapshot when record.Db_actions.vDI_sharable -> + Error (Api_errors.vdi_is_sharable, [_ref]) + | (`snapshot | `copy) when reset_on_boot -> + Error (Api_errors.vdi_on_boot_mode_incompatible_with_operation, []) + | `snapshot -> + if List.exists (fun (_, op) -> op = `copy) current_ops then + Error + ( Api_errors.operation_not_allowed + , ["Snapshot operation not allowed during copy."] + ) + else + Ok () + | `copy -> + if List.mem record.Db_actions.vDI_type [`ha_statefile; `redo_log] then + Error + ( Api_errors.operation_not_allowed + , [ + "VDI containing HA statefile or redo log cannot be copied (check \ + the VDI's allowed operations)." + ] + ) + else + Ok () + | `enable_cbt | `disable_cbt -> + if record.Db_actions.vDI_is_a_snapshot then + Error (Api_errors.operation_not_allowed, ["VDI is a snapshot: " ^ _ref]) + else if not (List.mem record.Db_actions.vDI_type [`user; `system]) then + Error + ( Api_errors.vdi_incompatible_type + , [_ref; Record_util.vdi_type_to_string record.Db_actions.vDI_type] + ) + else if reset_on_boot then + Error (Api_errors.vdi_on_boot_mode_incompatible_with_operation, []) + else + Ok () + | `mirror + | `clone + | `generate_config + | `force_unlock + | `set_on_boot + | `list_changed_blocks + | `blocked + | `update -> + Ok () let assert_operation_valid ~__context ~self ~(op : API.vdi_operations) = let pool = Helpers.get_pool ~__context in let ha_enabled = Db.Pool.get_ha_enabled ~__context ~self:pool in let all = Db.VDI.get_record_internal ~__context ~self in match check_operation_error ~__context ha_enabled all self op with - | None -> + | Ok () -> () - | Some (a, b) -> + | Error (a, b) -> raise (Api_errors.Server_error (a, b)) let update_allowed_operations_internal ~__context ~self ~sr_records ~pbd_records @@ -501,7 +483,7 @@ let update_allowed_operations_internal ~__context ~self ~sr_records ~pbd_records check_operation_error ~__context ~sr_records ~pbd_records ?vbd_records ha_enabled all self x with - | None -> + | Ok () -> [x] | _ -> [] diff --git a/ocaml/xapi/xapi_vdi.mli b/ocaml/xapi/xapi_vdi.mli index 0731a5f6082..45569a12fde 100644 --- a/ocaml/xapi/xapi_vdi.mli +++ b/ocaml/xapi/xapi_vdi.mli @@ -28,7 +28,7 @@ val check_operation_error : -> Db_actions.vDI_t -> API.ref_VDI -> API.vdi_operations - -> (string * string list) option + -> (unit, string * string list) Result.t (** Checks to see if an operation is valid in this state. Returns Some exception if not and None if everything is ok. *)