From 18641b18a9c614c927903fa468945f60636267af Mon Sep 17 00:00:00 2001 From: Thomas Sanders Date: Thu, 31 Mar 2016 12:21:25 +0100 Subject: [PATCH 01/69] CA-205589: Preserve has_vendor_device on DB upgrade We already had a DB upgrade rule to set VM.has_vendor_device to false on upgrade from a pre-Dundee version of the DB schema. Now instead of "pre-Dundee", the rule is applied if the schema version is older than the first tech-preview in which the has_vendor_device field controlled the presence of the device. (In the previous schema version and tech preview, the field was present but had no effect.) Signed-off-by: Thomas Sanders (cherry picked from commit 29983dd0678b1ef6aee5580a95a5b9c86fb35271) --- ocaml/idl/datamodel.ml | 6 ++++++ ocaml/xapi/xapi_db_upgrade.ml | 5 ++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index c14cc5b5165..04ba7ff7590 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -69,6 +69,12 @@ let cream_release_schema_minor_vsn = 73 let indigo_release_schema_major_vsn = 5 let indigo_release_schema_minor_vsn = 74 +(* This is to support upgrade from Dundee tech-preview versions and other nearly-Dundee versions. + * The field has_vendor_device was added while minor vsn was 90, then became meaningful later; + * the first published tech preview in which the feature was active had datamodel minor vsn 91. *) +let meaningful_vm_has_vendor_device_schema_major_vsn = 5 +let meaningful_vm_has_vendor_device_schema_minor_vsn = 91 + let dundee_release_schema_major_vsn = 5 let dundee_release_schema_minor_vsn = 91 diff --git a/ocaml/xapi/xapi_db_upgrade.ml b/ocaml/xapi/xapi_db_upgrade.ml index bb3fbcc47b7..7b465852977 100644 --- a/ocaml/xapi/xapi_db_upgrade.ml +++ b/ocaml/xapi/xapi_db_upgrade.ml @@ -52,6 +52,9 @@ let creedence = Datamodel.creedence_release_schema_major_vsn, Datamodel.creedenc let cream = Datamodel.cream_release_schema_major_vsn, Datamodel.cream_release_schema_minor_vsn let dundee = Datamodel.dundee_release_schema_major_vsn, Datamodel.dundee_release_schema_minor_vsn +(* This is to support upgrade from Dundee tech-preview versions *) +let vsn_with_meaningful_has_vendor_device = Datamodel.meaningful_vm_has_vendor_device_schema_major_vsn, Datamodel.meaningful_vm_has_vendor_device_schema_minor_vsn + let upgrade_alert_priority = { description = "Upgrade alert priority"; version = (fun _ -> true); @@ -377,7 +380,7 @@ let add_default_pif_properties = { let default_has_vendor_device_false = { description = "Defaulting has_vendor_device false"; - version = (fun x -> x < dundee); + version = (fun x -> x < vsn_with_meaningful_has_vendor_device); fn = fun ~__context -> List.iter (fun self -> Db.VM.set_has_vendor_device ~__context ~self ~value:false) From bcae3678b16943463ec4d030a657e12b60db4078 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Wed, 30 Mar 2016 14:33:58 +0100 Subject: [PATCH 02/69] CA-204474: Cancel and wait for outstanding tasks in hard_reboot/shutdown Signed-off-by: Jon Ludlam --- ocaml/xapi/xapi_vm.ml | 76 ++++++++++++++++++++++++++++++++++++++----- 1 file changed, 67 insertions(+), 9 deletions(-) diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 3e678187bb5..fccb215131c 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -205,7 +205,7 @@ let start ~__context ~vm ~start_paused ~force = (* This makes sense here while the available versions are 0, 1 and 2. * If/when we introduce another version, we must reassess this. *) update_vm_virtual_hardware_platform_version ~__context ~vm; - + (* Reset CPU feature set, which will be passed to xenopsd *) Cpuid_helpers.reset_cpu_flags ~__context ~vm; @@ -236,14 +236,54 @@ let start_on ~__context ~vm ~host ~start_paused ~force = assert_host_is_localhost ~__context ~host; start ~__context ~vm ~start_paused ~force -let hard_reboot ~__context ~vm = - update_vm_virtual_hardware_platform_version ~__context ~vm; - Xapi_xenops.reboot ~__context ~self:vm None + +(* Nb, we're not using the snapshots returned in 'Event.from' here because + the tasks might get deleted. The standard mechanism for dealing with + deleted events assumes you have a full database replica locally, and + deletions are handled by checking your valid_ref_counts table against + your local database. In this case, we're only interested in a subset of + events, so this mechanism doesn't work. There will only be a few outstanding + tasks anyway, so we're safe to just iterate through the references when an + event happens - ie, we use the event API simply to wake us up when something + interesting has happened. *) +let wait_for_tasks ~__context ~tasks = + let our_task = Context.get_task_id __context in + let classes = List.map (fun x -> Printf.sprintf "task/%s" (Ref.string_of x)) (our_task::tasks) in + + let rec process token = + TaskHelper.exn_if_cancelling ~__context; (* First check if _we_ have been cancelled *) + let statuses = List.filter_map (fun task -> try Some (Db.Task.get_status ~__context ~self:task) with _ -> None) tasks in + let unfinished = List.exists (fun state -> state = `pending) statuses in + if unfinished + then begin + let from = Helpers.call_api_functions ~__context + (fun rpc session_id -> Client.Event.from ~rpc ~session_id ~classes ~token ~timeout:30.0) in + debug "Using events to wait for tasks: %s" (String.concat "," classes); + let from = Event_types.event_from_of_rpc from in + process from.Event_types.token + end else + () + in + process "" + +let cancel ~__context ~vm ~ops = + let cancelled = List.filter_map (fun (task,op) -> + if List.mem op ops then begin + debug "Cancelling VM.%s for VM.hard_shutdown/reboot" (Record_util.vm_operation_to_string op); + Helpers.call_api_functions ~__context + (fun rpc session_id -> try Client.Task.cancel ~rpc ~session_id ~task:(Ref.of_string task) with _ -> ()); + Some (Ref.of_string task) + end else None + ) (Db.VM.get_current_operations ~__context ~self:vm) in + wait_for_tasks ~__context ~tasks:cancelled + let hard_shutdown ~__context ~vm = + cancel ~__context ~vm ~ops:[ `clean_shutdown; `clean_reboot; `hard_reboot; `pool_migrate; `call_plugin; `suspend ]; Db.VM.set_ha_always_run ~__context ~self:vm ~value:false; debug "Setting ha_always_run on vm=%s as false during VM.hard_shutdown" (Ref.string_of vm); - if Db.VM.get_power_state ~__context ~self:vm = `Suspended then begin + match Db.VM.get_power_state ~__context ~self:vm with + | `Suspended -> begin debug "hard_shutdown: destroying any suspend VDI"; let vdi = Db.VM.get_suspend_VDI ~__context ~self:vm in if vdi <> Ref.null (* avoid spurious but scary messages *) @@ -254,9 +294,27 @@ let hard_shutdown ~__context ~vm = (* Whether or not that worked, forget about the VDI *) Db.VM.set_suspend_VDI ~__context ~self:vm ~value:Ref.null; Xapi_vm_lifecycle.force_state_reset ~__context ~self:vm ~value:`Halted; - end else - Xapi_xenops.shutdown ~__context ~self:vm None; - Xapi_vm_helpers.shutdown_delay ~__context ~vm + end + | `Running + | `Paused -> + Xapi_xenops.shutdown ~__context ~self:vm None; + Xapi_vm_helpers.shutdown_delay ~__context ~vm + | `Halted -> () + +let hard_reboot ~__context ~vm = + cancel ~__context ~vm ~ops:[ `clean_shutdown; `clean_reboot; `pool_migrate; `call_plugin; `suspend ]; + (* Cancelling operations can cause the VM to now be shutdown *) + begin + match Db.VM.get_power_state ~__context ~self:vm with + | `Running + | `Paused -> + Xapi_xenops.shutdown ~__context ~self:vm None; + | `Halted -> + () + | `Suspended -> + raise (Api_errors.Server_error (Api_errors.vm_bad_power_state, [Ref.string_of vm; Record_util.power_to_string `Running; Record_util.power_to_string `Suspended])) + end; + start ~__context ~vm ~start_paused:false ~force:false let clean_reboot ~__context ~vm = update_vm_virtual_hardware_platform_version ~__context ~vm; @@ -282,7 +340,7 @@ let shutdown ~__context ~vm = with e -> warn "Failed to perform clean_shutdown on VM:%s due to exception %s. Now attempting hard_shutdown." (Ref.string_of vm) (Printexc.to_string e); hard_shutdown ~__context ~vm - end + end (***************************************************************************************) From f801bf0ff2a1abad483aeaa28c2afa672f5a225f Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Wed, 30 Mar 2016 14:40:56 +0100 Subject: [PATCH 03/69] CA-204484: Move cancellation logic to slave If a cancel causes the VM to be shutdown, a hard_reboot won't be able to find the host to forward it to. If we forward first, we can be sure the reboot will be able to start the guest. Signed-off-by: Jon Ludlam --- ocaml/xapi/message_forwarding.ml | 23 ----------------------- 1 file changed, 23 deletions(-) diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 39d065f1115..0b61fc3ef84 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -1319,20 +1319,6 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct let local_fn = Local.VM.hard_shutdown ~vm in with_vm_operation ~__context ~self:vm ~doc:"VM.hard_shutdown" ~op:`hard_shutdown (fun () -> - (* Before doing the shutdown we might need to cancel existing operations *) - List.iter (fun (task,op) -> - if List.mem op [ `clean_shutdown; `clean_reboot; `hard_reboot; `pool_migrate; `call_plugin ] then ( - (* At the end of the cancellation, if the VM is on a slave then the task doing - * the cancellation will be marked complete (successful). This would be premature - * for the current task since it still has work to do: first possibly some more - * cancellations, then definitely the VM hard_shutdown. Therefore we must spawn - * a new task to do the cancellation. (But no need to go via API call.) *) - Server_helpers.exec_with_subtask ~__context - ("Cancelling VM." ^ (Record_util.vm_operation_to_string op) ^ " for VM.hard_shutdown") - (fun ~__context -> try Task.cancel ~__context ~task:(Ref.of_string task) with _ -> ()) - ) - ) (Db.VM.get_current_operations ~__context ~self:vm); - (* If VM is actually suspended and we ask to hard_shutdown, we need to forward to any host that can see the VDIs *) let policy = @@ -1367,15 +1353,6 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct let local_fn = Local.VM.hard_reboot ~vm in with_vm_operation ~__context ~self:vm ~doc:"VM.hard_reboot" ~op:`hard_reboot (fun () -> - (* Before doing the reboot we might need to cancel existing operations *) - List.iter (fun (task,op) -> - if List.mem op [ `clean_shutdown; `clean_reboot; `pool_migrate; `call_plugin ] then ( - (* We must do the cancelling in a subtask: see hard_shutdown comment for reason. *) - Server_helpers.exec_with_subtask ~__context - ("Cancelling VM." ^ (Record_util.vm_operation_to_string op) ^ " for VM.hard_reboot") - (fun ~__context -> try Task.cancel ~__context ~task:(Ref.of_string task) with _ -> ()) - ) - ) (Db.VM.get_current_operations ~__context ~self:vm); with_vbds_marked ~__context ~vm ~doc:"VM.hard_reboot" ~op:`attach (fun vbds -> with_vifs_marked ~__context ~vm ~doc:"VM.hard_reboot" ~op:`attach From 10507df4b3a7d34bc91a60b9d6d0b7ca932b45b2 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Thu, 31 Mar 2016 14:11:39 +0100 Subject: [PATCH 04/69] Make sure hard_reboot is only shutdown/start when necessary Signed-off-by: Jon Ludlam --- ocaml/xapi/xapi_vm.ml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index fccb215131c..ed8917c2f15 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -308,13 +308,12 @@ let hard_reboot ~__context ~vm = match Db.VM.get_power_state ~__context ~self:vm with | `Running | `Paused -> - Xapi_xenops.shutdown ~__context ~self:vm None; + Xapi_xenops.reboot ~__context ~self:vm None | `Halted -> - () + start ~__context ~vm ~start_paused:false ~force:false | `Suspended -> raise (Api_errors.Server_error (Api_errors.vm_bad_power_state, [Ref.string_of vm; Record_util.power_to_string `Running; Record_util.power_to_string `Suspended])) - end; - start ~__context ~vm ~start_paused:false ~force:false + end let clean_reboot ~__context ~vm = update_vm_virtual_hardware_platform_version ~__context ~vm; From da47082a1218ff09938a6eeb5c203114478a4534 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Thu, 31 Mar 2016 14:15:33 +0100 Subject: [PATCH 05/69] Bump priority of log message from debug to info Signed-off-by: Jon Ludlam --- ocaml/xapi/xapi_vm.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index ed8917c2f15..fa4aa75f827 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -269,7 +269,7 @@ let wait_for_tasks ~__context ~tasks = let cancel ~__context ~vm ~ops = let cancelled = List.filter_map (fun (task,op) -> if List.mem op ops then begin - debug "Cancelling VM.%s for VM.hard_shutdown/reboot" (Record_util.vm_operation_to_string op); + info "Cancelling VM.%s for VM.hard_shutdown/reboot" (Record_util.vm_operation_to_string op); Helpers.call_api_functions ~__context (fun rpc session_id -> try Client.Task.cancel ~rpc ~session_id ~task:(Ref.of_string task) with _ -> ()); Some (Ref.of_string task) From 767f824c15384702c6bd6cfbb7c8a707ed3437c2 Mon Sep 17 00:00:00 2001 From: Jonathan Davies Date: Tue, 22 Mar 2016 16:43:57 +0000 Subject: [PATCH 06/69] CP-16558: assert_can_set_has_vendor_device: don't refer to *_paths_optimized MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The check in assert_can_set_has_vendor_device of whether any network paths or storage paths are optimized is a guess at best. Remembering whether the PV drivers were present when the VM was last shut down is not a fool-proof way of determining whether they will be present when the VM next boots (e.g. you could have attached the VDI elsewhere.) Whatever kind of check we do will be imperfect. Moreover, this check is not protecting against any bad situations. The PV drivers will not unplug the emulated devices, so the VM will remain functional. This check adds complication to the logic that is used to show the user whether PV drivers are not installed -– see CA-204963. Hence, let's remove the check. Signed-off-by: Jonathan Davies --- ocaml/xapi/xapi_vm.ml | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index fa4aa75f827..6811e4f2e8c 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -1144,17 +1144,7 @@ let assert_can_set_has_vendor_device ~__context ~self ~value = * we allow restoration of a VM from a snapshot. *) then Pool_features.assert_enabled ~__context ~f:Features.PCI_device_for_auto_update; - Xapi_vm_lifecycle.assert_power_state_is ~__context ~self ~expected:`Halted; - - let old_val = Db.VM.get_has_vendor_device ~__context ~self in - if old_val <> value then ( - let vm_gm = Db.VM.get_guest_metrics ~__context ~self in - let network_optimized = try Db.VM_guest_metrics.get_network_paths_optimized ~__context ~self:vm_gm with _ -> false in - let storage_optimized = try Db.VM_guest_metrics.get_storage_paths_optimized ~__context ~self:vm_gm with _ -> false in - if storage_optimized || network_optimized - then - raise (Api_errors.Server_error(Api_errors.vm_pv_drivers_in_use, [ Ref.string_of self ])) - ) + Xapi_vm_lifecycle.assert_power_state_is ~__context ~self ~expected:`Halted let set_has_vendor_device ~__context ~self ~value = assert_can_set_has_vendor_device ~__context ~self ~value; From 8873c4c1c8172d01a248319ae89169950c8a6b1a Mon Sep 17 00:00:00 2001 From: Jonathan Davies Date: Wed, 23 Mar 2016 15:15:10 +0000 Subject: [PATCH 07/69] CA-203169: Add PV_drivers_detected field to VM_guest_metrics This field merely reflects the value of 'pv_drivers_detected' returned by xenopsd from VM.stat. This field can be used by clients as an indication of whether at least one VBD or VIF has successfully connected. Signed-off-by: Jonathan Davies --- ocaml/client_records/records.ml | 2 ++ ocaml/idl/datamodel.ml | 5 +++-- ocaml/xapi/import.ml | 1 + ocaml/xapi/xapi_db_upgrade.ml | 12 ++++++++++++ ocaml/xapi/xapi_guest_agent.ml | 2 +- ocaml/xapi/xapi_vm_helpers.ml | 1 + ocaml/xapi/xapi_xenops.ml | 8 ++++++++ 7 files changed, 28 insertions(+), 3 deletions(-) diff --git a/ocaml/client_records/records.ml b/ocaml/client_records/records.ml index c6a05e6aef4..e983fe23ad1 100644 --- a/ocaml/client_records/records.ml +++ b/ocaml/client_records/records.ml @@ -881,6 +881,8 @@ let vm_record rpc session_id vm = ~get:(fun () -> default nid (may (fun m -> string_of_bool m.API.vM_guest_metrics_network_paths_optimized) (xgm ()) )) (); make_field ~name:"storage-paths-optimized" ~get:(fun () -> default nid (may (fun m -> string_of_bool m.API.vM_guest_metrics_storage_paths_optimized) (xgm ()) )) (); + make_field ~name:"PV-drivers-detected" + ~get:(fun () -> default nid (may (fun m -> string_of_bool m.API.vM_guest_metrics_PV_drivers_detected) (xgm ()) )) (); make_field ~name:"other" ~get:(fun () -> default nid (may (fun m -> Record_util.s2sm_to_string "; " m.API.vM_guest_metrics_other) (xgm ()) )) ~get_map:(fun () -> default [] (may (fun m -> m.API.vM_guest_metrics_other) (xgm()))) (); diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 04ba7ff7590..f6b766baaec 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -18,7 +18,7 @@ open Datamodel_types (* IMPORTANT: Please bump schema vsn if you change/add/remove a _field_. You do not have to bump vsn if you change/add/remove a message *) let schema_major_vsn = 5 -let schema_minor_vsn = 92 +let schema_minor_vsn = 93 (* Historical schema versions just in case this is useful later *) let rio_schema_major_vsn = 5 @@ -76,7 +76,7 @@ let meaningful_vm_has_vendor_device_schema_major_vsn = 5 let meaningful_vm_has_vendor_device_schema_minor_vsn = 91 let dundee_release_schema_major_vsn = 5 -let dundee_release_schema_minor_vsn = 91 +let dundee_release_schema_minor_vsn = 93 (* the schema vsn of the last release: used to determine whether we can upgrade or not.. *) let last_release_schema_major_vsn = cream_release_schema_major_vsn @@ -7457,6 +7457,7 @@ let vm_guest_metrics = field ~qualifier:DynamicRO ~in_product_since:rel_orlando ~default_value:(Some (VBool false)) ~ty:Bool "live" "True if the guest is sending heartbeat messages via the guest agent"; field ~qualifier:DynamicRO ~lifecycle:[Published, rel_dundee, "To be used where relevant and available instead of checking PV driver version."] ~ty:tristate_type ~default_value:(Some (VEnum "unspecified")) "can_use_hotplug_vbd" "The guest's statement of whether it supports VBD hotplug, i.e. whether it is capable of responding immediately to instantiation of a new VBD by bringing online a new PV block device. If the guest states that it is not capable, then the VBD plug and unplug operations will not be allowed while the guest is running."; field ~qualifier:DynamicRO ~lifecycle:[Published, rel_dundee, "To be used where relevant and available instead of checking PV driver version."] ~ty:tristate_type ~default_value:(Some (VEnum "unspecified")) "can_use_hotplug_vif" "The guest's statement of whether it supports VIF hotplug, i.e. whether it is capable of responding immediately to instantiation of a new VIF by bringing online a new PV network device. If the guest states that it is not capable, then the VIF plug and unplug operations will not be allowed while the guest is running."; + field ~qualifier:DynamicRO ~lifecycle:[Published, rel_dundee, ""] ~ty:Bool ~default_value:(Some (VBool false)) "PV_drivers_detected" "At least one of the guest's devices has successfully connected to the backend."; ] () diff --git a/ocaml/xapi/import.ml b/ocaml/xapi/import.ml index 13e47ce8b4e..4f6ccdaf711 100644 --- a/ocaml/xapi/import.ml +++ b/ocaml/xapi/import.ml @@ -551,6 +551,7 @@ module GuestMetrics : HandlerTools = struct ~networks:gm_record.API.vM_guest_metrics_networks ~network_paths_optimized:gm_record.API.vM_guest_metrics_network_paths_optimized ~storage_paths_optimized:gm_record.API.vM_guest_metrics_storage_paths_optimized + ~pV_drivers_detected:gm_record.API.vM_guest_metrics_PV_drivers_detected ~other:gm_record.API.vM_guest_metrics_other ~last_updated:gm_record.API.vM_guest_metrics_last_updated ~other_config:gm_record.API.vM_guest_metrics_other_config diff --git a/ocaml/xapi/xapi_db_upgrade.ml b/ocaml/xapi/xapi_db_upgrade.ml index 7b465852977..c0e24b3e73a 100644 --- a/ocaml/xapi/xapi_db_upgrade.ml +++ b/ocaml/xapi/xapi_db_upgrade.ml @@ -387,6 +387,17 @@ let default_has_vendor_device_false = { (Db.VM.get_all ~__context) } +let default_pv_drivers_detected_false = { + description = "Defaulting PV_drivers_detected false"; + version = (fun x -> x < dundee); + fn = fun ~__context -> + List.iter + (fun self -> + let gm = Db.VM.get_guest_metrics ~__context ~self in + Db.VM_guest_metrics.set_PV_drivers_detected ~__context ~self:gm ~value:false) + (Db.VM.get_all ~__context) +} + let populate_pgpu_vgpu_types = { description = "Populating lists of VGPU types on existing PGPUs"; version = (fun x -> x <= clearwater); @@ -498,6 +509,7 @@ let rules = [ set_vgpu_types; add_default_pif_properties; default_has_vendor_device_false; + default_pv_drivers_detected_false; remove_restricted_pbd_keys; upgrade_recommendations_for_gpu_passthru; ] diff --git a/ocaml/xapi/xapi_guest_agent.ml b/ocaml/xapi/xapi_guest_agent.ml index 0eddff5529b..7fd0951a319 100644 --- a/ocaml/xapi/xapi_guest_agent.ml +++ b/ocaml/xapi/xapi_guest_agent.ml @@ -273,7 +273,7 @@ let all (lookup: string -> string option) (list: string -> string list) ~__conte let new_ref = Ref.make () and new_uuid = Uuid.to_string (Uuid.make_uuid ()) in Db.VM_guest_metrics.create ~__context ~ref:new_ref ~uuid:new_uuid ~os_version:os_version ~pV_drivers_version:pv_drivers_version ~pV_drivers_up_to_date:false ~memory:[] ~disks:[] ~networks:networks ~other:other - ~storage_paths_optimized:false ~network_paths_optimized:false ~last_updated:(Date.of_float last_updated) ~other_config:[] ~live:true ~can_use_hotplug_vbd:`unspecified ~can_use_hotplug_vif:`unspecified; + ~storage_paths_optimized:false ~network_paths_optimized:false ~pV_drivers_detected:false ~last_updated:(Date.of_float last_updated) ~other_config:[] ~live:true ~can_use_hotplug_vbd:`unspecified ~can_use_hotplug_vif:`unspecified; Db.VM.set_guest_metrics ~__context ~self ~value:new_ref; (* We've just set the thing to live, let's make sure it's not in the dead list *) let sl xs = String.concat "; " (List.map (fun (k, v) -> k ^ ": " ^ v) xs) in diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index ba609bcad1f..abd11a2e8f1 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -858,6 +858,7 @@ let copy_guest_metrics ~__context ~vm = ~networks:all.API.vM_guest_metrics_networks ~network_paths_optimized:all.API.vM_guest_metrics_network_paths_optimized ~storage_paths_optimized:all.API.vM_guest_metrics_storage_paths_optimized + ~pV_drivers_detected:all.API.vM_guest_metrics_PV_drivers_detected ~other:all.API.vM_guest_metrics_other ~last_updated:all.API.vM_guest_metrics_last_updated ~other_config:all.API.vM_guest_metrics_other_config diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index a01c1a74857..208044bdf8b 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -1502,6 +1502,13 @@ let update_vm ~__context id = error "Caught %s: while updating VM %s guest_agent" (Printexc.to_string e) id ) state.domids ) info in + let update_pv_drivers_detected () = + Opt.iter + (fun (_, state) -> + let gm = Db.VM.get_guest_metrics ~__context ~self in + debug "xenopsd event: Updating VM %s PV drivers detected %b" id state.pv_drivers_detected; + Db.VM_guest_metrics.set_PV_drivers_detected ~__context ~self:gm ~value:state.pv_drivers_detected + ) info in Opt.iter (fun (_, state) -> List.iter @@ -1510,6 +1517,7 @@ let update_vm ~__context id = debug "xenopsd event: VM %s domid %d uncooperative_balloon_driver = %b" id domid state.uncooperative_balloon_driver; end; if different (fun x -> x.guest_agent) then check_guest_agent (); + if different (fun x -> x.pv_drivers_detected) then update_pv_drivers_detected (); if different (fun x -> x.xsdata_state) then begin try From f99d67e1366c4ac6c041f442226b9ffe040a5976 Mon Sep 17 00:00:00 2001 From: Jonathan Davies Date: Wed, 30 Mar 2016 14:34:56 +0100 Subject: [PATCH 08/69] CA-203169: rip out {storage,network}_paths_optimized fields Since CP-16558, these fields are only used internally by xapi to populate the (deprecated) PV_drivers_up_to_date field. Externally, the only purpose of these fields is for API clients such as XenCenter to indicate whether the VM's I/O paths are optimised. Since we now have the PV_drivers_detected field in VM_guest_metrics, we no longer need these fields. API clients can now use PV_drivers_detected directly. The PV_drivers_up_to_date field can now take its value directly from PV_drivers_detected. Note that the fields are removed rather than deprecated. This is safe because no released versions of xapi contain them. Signed-off-by: Jonathan Davies --- ocaml/client_records/records.ml | 4 --- ocaml/idl/datamodel.ml | 14 ++------ ocaml/xapi/import.ml | 2 -- ocaml/xapi/xapi_guest_agent.ml | 58 ++------------------------------- ocaml/xapi/xapi_vm_helpers.ml | 2 -- ocaml/xapi/xapi_xenops.ml | 3 +- 6 files changed, 7 insertions(+), 76 deletions(-) diff --git a/ocaml/client_records/records.ml b/ocaml/client_records/records.ml index e983fe23ad1..1fefaa53a5b 100644 --- a/ocaml/client_records/records.ml +++ b/ocaml/client_records/records.ml @@ -877,10 +877,6 @@ let vm_record rpc session_id vm = make_field ~name:"networks" ~get:(fun () -> default nid (may (fun m -> Record_util.s2sm_to_string "; " m.API.vM_guest_metrics_networks) (xgm ()) )) ~get_map:(fun () -> default [] (may (fun m -> m.API.vM_guest_metrics_networks) (xgm ()))) (); - make_field ~name:"network-paths-optimized" - ~get:(fun () -> default nid (may (fun m -> string_of_bool m.API.vM_guest_metrics_network_paths_optimized) (xgm ()) )) (); - make_field ~name:"storage-paths-optimized" - ~get:(fun () -> default nid (may (fun m -> string_of_bool m.API.vM_guest_metrics_storage_paths_optimized) (xgm ()) )) (); make_field ~name:"PV-drivers-detected" ~get:(fun () -> default nid (may (fun m -> string_of_bool m.API.vM_guest_metrics_PV_drivers_detected) (xgm ()) )) (); make_field ~name:"other" diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index f6b766baaec..fb57dc939b6 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -7425,19 +7425,9 @@ let vm_guest_metrics = field ~qualifier:DynamicRO ~ty:Bool ~in_oss_since:None ~lifecycle:[ Published, rel_rio, "true if the PV drivers appear to be up to date"; - Deprecated, rel_dundee, "Deprecated in favour of network_paths_optimized and storage_paths_optimized, and redefined in terms of them" + Deprecated, rel_dundee, "Deprecated in favour of PV_drivers_detected, and redefined in terms of it" ] - "PV_drivers_up_to_date" "Logical AND of network_paths_optimized and storage_paths_optimized"; - field ~qualifier:DynamicRO ~ty:Bool ~in_oss_since:None ~default_value:(Some (VBool false)) - ~lifecycle:[ - Published, rel_dundee, "Network paths are optimized with backend"; - ] - "network_paths_optimized" "True if the network paths are optimized with PV driver"; - field ~qualifier:DynamicRO ~ty:Bool ~in_oss_since:None ~default_value:(Some (VBool false)) - ~lifecycle:[ - Published, rel_dundee, "Storage paths are optimized with backend"; - ] - "storage_paths_optimized" "True if the storage paths are optimized with PV driver"; + "PV_drivers_up_to_date" "Logically equivalent to PV_drivers_detected"; field ~qualifier:DynamicRO ~ty:(Map(String, String)) ~lifecycle:[ Published, rel_rio, "free/used/total"; diff --git a/ocaml/xapi/import.ml b/ocaml/xapi/import.ml index 4f6ccdaf711..70bdcde9e09 100644 --- a/ocaml/xapi/import.ml +++ b/ocaml/xapi/import.ml @@ -549,8 +549,6 @@ module GuestMetrics : HandlerTools = struct ~memory:gm_record.API.vM_guest_metrics_memory ~disks:gm_record.API.vM_guest_metrics_disks ~networks:gm_record.API.vM_guest_metrics_networks - ~network_paths_optimized:gm_record.API.vM_guest_metrics_network_paths_optimized - ~storage_paths_optimized:gm_record.API.vM_guest_metrics_storage_paths_optimized ~pV_drivers_detected:gm_record.API.vM_guest_metrics_PV_drivers_detected ~other:gm_record.API.vM_guest_metrics_other ~last_updated:gm_record.API.vM_guest_metrics_last_updated diff --git a/ocaml/xapi/xapi_guest_agent.ml b/ocaml/xapi/xapi_guest_agent.ml index 7fd0951a319..6eefe848e98 100644 --- a/ocaml/xapi/xapi_guest_agent.ml +++ b/ocaml/xapi/xapi_guest_agent.ml @@ -98,33 +98,6 @@ let networks path (list: string -> string list) = |> List.map (fun (path, prefix) -> find_all_ips path prefix) |> List.concat -(* This function is passed the "device/vif" node, a function it can use to - * find the directory listing of sub-nodes and a function to retrieve the value - * with the given path. - * If "state" of all VIFs are "4", the return value is true - * which means the network paths are optimized. - * Or else the return value is false. - *) -let network_paths_optimized path (list: string -> string list) (lookup: string -> string option) = - List.fold_left (fun result vif_id -> - let vif_state = lookup (extend (extend path vif_id) "state") in - result && (vif_state = Some "4") - ) true (list path) - -(* This function is passed the "device/vbd" node, a function it can use to - * find the directory listing of sub-nodes and a function to retrieve the value - * with the given path. - * If "state" of all VBDs (except cdrom) are "4", the return value is true - * which means the storage paths are optimized. - * Or else the return value is false. - *) -let storage_paths_optimized path (list: string -> string list) (lookup: string -> string option) = - List.fold_left (fun result vbd_id -> - let vbd_state = lookup (extend (extend path vbd_id) "state") in - let vbd_type = lookup (extend (extend path vbd_id) "device-type") in - result && (vbd_state = Some "4" || vbd_type = Some "cdrom") - ) true (list path) - (* One key is placed in the other map per control/* key in xenstore. This catches keys like "feature-shutdown" "feature-hibernate" "feature-reboot" "feature-sysrq" *) @@ -145,9 +118,6 @@ type guest_metrics_t = { other: m; memory: m; device_id: m; - network_paths_optimized: bool; - storage_paths_optimized: bool; - pv_drivers_up_to_date: bool; last_updated: float; can_use_hotplug_vbd: API.tristate_type; can_use_hotplug_vif: API.tristate_type; @@ -182,14 +152,10 @@ let all (lookup: string -> string option) (list: string -> string list) ~__conte and networks = to_map (networks "attr" list) and other = List.append (to_map (other all_control)) ts and memory = to_map memory - and network_paths_optimized = network_paths_optimized "device/vif" list lookup - and storage_paths_optimized = storage_paths_optimized "device/vbd" list lookup and last_updated = Unix.gettimeofday () in let can_use_hotplug_vbd = get_tristate "feature/hotplug/vbd" in let can_use_hotplug_vif = get_tristate "feature/hotplug/vif" in - let pv_drivers_up_to_date = network_paths_optimized && storage_paths_optimized in - (* let num = Mutex.execute mutex (fun () -> Hashtbl.fold (fun _ _ c -> 1 + c) cache 0) in debug "Number of entries in hashtbl: %d" num; *) @@ -222,9 +188,6 @@ let all (lookup: string -> string option) (list: string -> string list) ~__conte other = []; memory = []; device_id = []; - network_paths_optimized = false; - storage_paths_optimized = false; - pv_drivers_up_to_date = false; last_updated = 0.0; can_use_hotplug_vbd = `unspecified; can_use_hotplug_vif = `unspecified; @@ -237,7 +200,7 @@ let all (lookup: string -> string option) (list: string -> string list) ~__conte then begin (* Only if the data is valid, cache it (CA-20353) *) - Mutex.execute mutex (fun () -> Hashtbl.replace cache domid {pv_drivers_version; os_version; networks; other; memory; device_id; network_paths_optimized; storage_paths_optimized; pv_drivers_up_to_date; last_updated; can_use_hotplug_vbd; can_use_hotplug_vif;}); + Mutex.execute mutex (fun () -> Hashtbl.replace cache domid {pv_drivers_version; os_version; networks; other; memory; device_id; last_updated; can_use_hotplug_vbd; can_use_hotplug_vif;}); (* We update only if any actual data has changed *) if ( guest_metrics_cached.pv_drivers_version <> pv_drivers_version @@ -248,13 +211,7 @@ let all (lookup: string -> string option) (list: string -> string list) ~__conte || guest_metrics_cached.other <> other || - guest_metrics_cached.device_id <> device_id - || - guest_metrics_cached.network_paths_optimized <> network_paths_optimized - || - guest_metrics_cached.storage_paths_optimized <> storage_paths_optimized - || - guest_metrics_cached.pv_drivers_up_to_date <> pv_drivers_up_to_date) + guest_metrics_cached.device_id <> device_id) || guest_metrics_cached.can_use_hotplug_vbd <> can_use_hotplug_vbd || @@ -273,7 +230,7 @@ let all (lookup: string -> string option) (list: string -> string list) ~__conte let new_ref = Ref.make () and new_uuid = Uuid.to_string (Uuid.make_uuid ()) in Db.VM_guest_metrics.create ~__context ~ref:new_ref ~uuid:new_uuid ~os_version:os_version ~pV_drivers_version:pv_drivers_version ~pV_drivers_up_to_date:false ~memory:[] ~disks:[] ~networks:networks ~other:other - ~storage_paths_optimized:false ~network_paths_optimized:false ~pV_drivers_detected:false ~last_updated:(Date.of_float last_updated) ~other_config:[] ~live:true ~can_use_hotplug_vbd:`unspecified ~can_use_hotplug_vif:`unspecified; + ~pV_drivers_detected:false ~last_updated:(Date.of_float last_updated) ~other_config:[] ~live:true ~can_use_hotplug_vbd:`unspecified ~can_use_hotplug_vif:`unspecified; Db.VM.set_guest_metrics ~__context ~self ~value:new_ref; (* We've just set the thing to live, let's make sure it's not in the dead list *) let sl xs = String.concat "; " (List.map (fun (k, v) -> k ^ ": " ^ v) xs) in @@ -293,15 +250,6 @@ let all (lookup: string -> string option) (list: string -> string list) ~__conte Db.VM_guest_metrics.set_other ~__context ~self:gm ~value:other; Helpers.call_api_functions ~__context (fun rpc session_id -> Client.Client.VM.update_allowed_operations rpc session_id self); end; - if(guest_metrics_cached.network_paths_optimized <> network_paths_optimized) then begin - Db.VM_guest_metrics.set_network_paths_optimized ~__context ~self:gm ~value:network_paths_optimized; - end; - if(guest_metrics_cached.storage_paths_optimized <> storage_paths_optimized) then begin - Db.VM_guest_metrics.set_storage_paths_optimized ~__context ~self:gm ~value:storage_paths_optimized; - end; - if(guest_metrics_cached.pv_drivers_up_to_date <> pv_drivers_up_to_date) then begin - Db.VM_guest_metrics.set_PV_drivers_up_to_date ~__context ~self:gm ~value:pv_drivers_up_to_date; - end; if(guest_metrics_cached.can_use_hotplug_vbd <> can_use_hotplug_vbd) then begin Db.VM_guest_metrics.set_can_use_hotplug_vbd ~__context ~self:gm ~value:can_use_hotplug_vbd; end; diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index abd11a2e8f1..d03d76e39de 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -856,8 +856,6 @@ let copy_guest_metrics ~__context ~vm = ~memory:all.API.vM_guest_metrics_memory ~disks:all.API.vM_guest_metrics_disks ~networks:all.API.vM_guest_metrics_networks - ~network_paths_optimized:all.API.vM_guest_metrics_network_paths_optimized - ~storage_paths_optimized:all.API.vM_guest_metrics_storage_paths_optimized ~pV_drivers_detected:all.API.vM_guest_metrics_PV_drivers_detected ~other:all.API.vM_guest_metrics_other ~last_updated:all.API.vM_guest_metrics_last_updated diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 208044bdf8b..07d0c2c5552 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -1507,7 +1507,8 @@ let update_vm ~__context id = (fun (_, state) -> let gm = Db.VM.get_guest_metrics ~__context ~self in debug "xenopsd event: Updating VM %s PV drivers detected %b" id state.pv_drivers_detected; - Db.VM_guest_metrics.set_PV_drivers_detected ~__context ~self:gm ~value:state.pv_drivers_detected + Db.VM_guest_metrics.set_PV_drivers_detected ~__context ~self:gm ~value:state.pv_drivers_detected; + Db.VM_guest_metrics.set_PV_drivers_up_to_date ~__context ~self:gm ~value:state.pv_drivers_detected ) info in Opt.iter (fun (_, state) -> From ed3d5086a32dd79ffca0f5c7a9feede3812ec12f Mon Sep 17 00:00:00 2001 From: Jonathan Davies Date: Wed, 6 Apr 2016 13:14:31 +0100 Subject: [PATCH 09/69] CA-203169: don't fail DB upgrade from Tech Previews that drop fields Since the previous commit removed some fields from the datamodel, upgrade from the Dundee Tech Preview, which included those fields, will fail. This patch makes the upgrade proceed and silently drop these fields. In general, Tech Preview releases may contain fields that are subsequently dropped. Hence a list of such versions is added to the datamodel. This list is consulted by the unmarshalling code. (This approach is preferred to hard-coding the names of the dropped fields in the unmarshalling code.) Signed-off-by: Jonathan Davies --- ocaml/database/db_xml.ml | 43 ++++++++++++++++++++++++++++++---------- ocaml/idl/datamodel.ml | 14 +++++++++++-- 2 files changed, 44 insertions(+), 13 deletions(-) diff --git a/ocaml/database/db_xml.ml b/ocaml/database/db_xml.ml index d06a0464e73..8eaeae9ffac 100644 --- a/ocaml/database/db_xml.ml +++ b/ocaml/database/db_xml.ml @@ -14,6 +14,7 @@ open Db_cache_types open Pervasiveext module R = Debug.Make(struct let name = "redo_log" end) +module D = Debug.Make(struct let name = "database" end) (** Functions to marshall/unmarshall the database as XML *) @@ -102,6 +103,10 @@ module From = struct raise (Unmarshall_error "Unexpected end of file") end else f accu in + let schema_vsn_of_manifest manifest = + let major_vsn = int_of_string (List.assoc _schema_major_vsn manifest) in + let minor_vsn = int_of_string (List.assoc _schema_minor_vsn manifest) in + (major_vsn, minor_vsn) in let rec f ((tableset, table, tblname, manifest) as acc) = match Xmlm.input input with (* On reading a start tag... *) | `El_start (tag: Xmlm.tag) -> @@ -118,15 +123,32 @@ module From = struct let ctime = match ctime_l with | [(_,ctime_s)] -> Int64.of_string ctime_s | _ -> 0L in let mtime = match mtime_l with | [(_,mtime_s)] -> Int64.of_string mtime_s | _ -> 0L in let row = List.fold_left (fun row ((_, k), v) -> - let table_schema = Schema.Database.find tblname schema.Schema.database in - let column_schema = try - Schema.Table.find k table_schema - with Not_found -> - raise (Unmarshall_error (Printf.sprintf "Unexpected column in table %s: %s" tblname k)) - in - let value = Schema.Value.unmarshal column_schema.Schema.Column.ty (Xml_spaces.unprotect v) in - let empty = column_schema.Schema.Column.empty in - Row.update mtime k empty (fun _ -> value) (Row.add ctime k value row) + let table_schema = Schema.Database.find tblname schema.Schema.database in + try + let column_schema = Schema.Table.find k table_schema in + let value = Schema.Value.unmarshal column_schema.Schema.Column.ty (Xml_spaces.unprotect v) in + let empty = column_schema.Schema.Column.empty in + Row.update mtime k empty (fun _ -> value) (Row.add ctime k value row) + with Not_found -> + (* This means there's an unexpected field, so we should normally fail. However, fields + * present in Tech Preview releases are permitted to disappear on upgrade, so suppress + * such errors on such upgrades. *) + let exc = Unmarshall_error (Printf.sprintf "Unexpected column in table %s: %s" tblname k) in + let (this_maj, this_min) = try + schema_vsn_of_manifest manifest + with Not_found -> + (* Probably the database didn't have a at the start. So at this point + * we don't know the schema version of the database we're loading. *) + D.error "Unmarshalling removed column %s from table %s but don't know schema version because manifest not yet read" k tblname; + raise exc + in + if List.mem (this_maj, this_min) Datamodel.tech_preview_releases then ( + (* Suppress error for fields that only temporarily existed in the datamodel *) + D.warn "Upgrading from Tech Preview schema %d.%d so removing deleted field %s from table %s" this_maj this_min k tblname; + row + ) else + (* For any genuinely unexpected fields, fail *) + raise exc ) Row.empty rest in f (tableset, (Table.update mtime rf Row.empty (fun _ -> row) (Table.add ctime rf row table)), tblname, manifest) | (_, "pair"), [ (_, "key"), k; (_, "value"), v ] -> @@ -148,8 +170,7 @@ module From = struct in let (ts, _, _, manifest) = f (TableSet.empty, Table.empty, "", []) in let g = Int64.of_string (List.assoc _generation_count manifest) in - let major_vsn = int_of_string (List.assoc _schema_major_vsn manifest) in - let minor_vsn = int_of_string (List.assoc _schema_minor_vsn manifest) in + let (major_vsn, minor_vsn) = schema_vsn_of_manifest manifest in let manifest = Manifest.make major_vsn minor_vsn g in ((Database.update_manifest (fun _ -> manifest)) ++ (Database.update_tableset (fun _ -> ts))) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index fb57dc939b6..f73e36cc390 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -69,11 +69,14 @@ let cream_release_schema_minor_vsn = 73 let indigo_release_schema_major_vsn = 5 let indigo_release_schema_minor_vsn = 74 +let dundee_tech_preview_release_schema_major_vsn = 5 +let dundee_tech_preview_release_schema_minor_vsn = 91 + (* This is to support upgrade from Dundee tech-preview versions and other nearly-Dundee versions. * The field has_vendor_device was added while minor vsn was 90, then became meaningful later; * the first published tech preview in which the feature was active had datamodel minor vsn 91. *) -let meaningful_vm_has_vendor_device_schema_major_vsn = 5 -let meaningful_vm_has_vendor_device_schema_minor_vsn = 91 +let meaningful_vm_has_vendor_device_schema_major_vsn = dundee_tech_preview_release_schema_major_vsn +let meaningful_vm_has_vendor_device_schema_minor_vsn = dundee_tech_preview_release_schema_minor_vsn let dundee_release_schema_major_vsn = 5 let dundee_release_schema_minor_vsn = 93 @@ -82,6 +85,13 @@ let dundee_release_schema_minor_vsn = 93 let last_release_schema_major_vsn = cream_release_schema_major_vsn let last_release_schema_minor_vsn = cream_release_schema_minor_vsn +(* List of tech-preview releases. Fields in these releases are not guaranteed to be retained when + * upgrading to a full release. *) +let tech_preview_releases = [ + vgpu_tech_preview_release_schema_major_vsn, vgpu_tech_preview_release_schema_minor_vsn; + dundee_tech_preview_release_schema_major_vsn, dundee_tech_preview_release_schema_minor_vsn; +] + (** Bindings for currently specified releases *) (** Name of variable which refers to reference in the parameter list *) From d62318bd84b9385477d0fa3147052324c07da87a Mon Sep 17 00:00:00 2001 From: Thomas Sanders Date: Wed, 6 Apr 2016 18:49:00 +0100 Subject: [PATCH 10/69] CA-206602: Preserve Host.ssl_legacy on pool-join A new ssl_legacy parameter for the Host constructor message. When a host is joining a pool and calls that constructor on the pool master, supply the ssl_legacy parameter so as to maintain the existing value. Signed-off-by: Thomas Sanders (cherry picked from commit 5374d64ee0f48add0921116c3216e989daaea8ba) Signed-off-by: Thomas Sanders --- ocaml/idl/datamodel.ml | 3 ++- ocaml/test/test_common.ml | 5 +++-- ocaml/xapi/create_misc.ml | 5 +++++ ocaml/xapi/create_misc.mli | 1 + ocaml/xapi/dbsync_slave.ml | 2 +- ocaml/xapi/xapi_host.ml | 4 ++-- ocaml/xapi/xapi_host.mli | 1 + ocaml/xapi/xapi_pool.ml | 1 + 8 files changed, 16 insertions(+), 6 deletions(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index f73e36cc390..4dca4e232e5 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -4081,6 +4081,7 @@ let host_create_params = {param_type=Map(String,String); param_name="license_server"; param_doc="Contact information of the license server"; param_release=midnight_ride_release; param_default=Some(VMap [VString "address", VString "localhost"; VString "port", VString "27000"])}; {param_type=Ref _sr; param_name="local_cache_sr"; param_doc="The SR that is used as a local cache"; param_release=cowley_release; param_default=(Some (VRef (Ref.string_of Ref.null)))}; {param_type=Map(String,String); param_name="chipset_info"; param_doc="Information about chipset features"; param_release=boston_release; param_default=Some(VMap [])}; + {param_type=Bool; param_name="ssl_legacy"; param_doc="Allow SSLv3 protocol and ciphersuites as used by older XenServers. This controls both incoming and outgoing connections."; param_release=dundee_release; param_default=Some (VBool true)}; ] let host_create = call @@ -4669,7 +4670,7 @@ let host = "chipset_info" "Information about chipset features"; field ~qualifier:DynamicRO ~lifecycle:[Published, rel_boston, ""] ~ty:(Set (Ref _pci)) "PCIs" "List of PCI devices in the host"; field ~qualifier:DynamicRO ~lifecycle:[Published, rel_boston, ""] ~ty:(Set (Ref _pgpu)) "PGPUs" "List of physical GPUs in the host"; - field ~qualifier:DynamicRO ~lifecycle:[Published, rel_dundee, ""] ~ty:Bool ~default_value:(Some (VBool true)) "ssl_legacy" "Allow SSLv3 protocol and ciphersuites as used by older XenServers. This controls both incoming and outgoing connections. When this is set to a different value, the host immediately restarts its SSL/TLS listening service; typically this takes less than a second but existing connections to it will be broken. XenAPI login sessions will remain valid."; + field ~qualifier:StaticRO ~lifecycle:[Published, rel_dundee, ""] ~ty:Bool ~default_value:(Some (VBool true)) "ssl_legacy" "Allow SSLv3 protocol and ciphersuites as used by older XenServers. This controls both incoming and outgoing connections. When this is set to a different value, the host immediately restarts its SSL/TLS listening service; typically this takes less than a second but existing connections to it will be broken. XenAPI login sessions will remain valid."; field ~qualifier:RW ~in_product_since:rel_tampa ~default_value:(Some (VMap [])) ~ty:(Map (String, String)) "guest_VCPUs_params" "VCPUs params to apply to all resident guests"; field ~qualifier:RW ~in_product_since:rel_cream ~default_value:(Some (VEnum "enabled")) ~ty:host_display "display" "indicates whether the host is configured to output its console to a physical display device"; field ~qualifier:DynamicRO ~in_product_since:rel_cream ~default_value:(Some (VSet [VInt 0L])) ~ty:(Set (Int)) "virtual_hardware_platform_versions" "The set of versions of the virtual hardware platform that the host can offer to its guests"; diff --git a/ocaml/test/test_common.ml b/ocaml/test/test_common.ml index 2b7259bc11f..0420d4f52db 100644 --- a/ocaml/test/test_common.ml +++ b/ocaml/test/test_common.ml @@ -51,6 +51,7 @@ let make_localhost ~__context = machine_serial_name = None; total_memory_mib = 1024L; dom0_static_max = XenopsMemory.bytes_of_mib 512L; + ssl_legacy = false; } in Dbsync_slave.create_localhost ~__context host_info; @@ -96,9 +97,9 @@ let make_vm ~__context ?(name_label="name_label") ?(name_description="descriptio let make_host ~__context ?(uuid=make_uuid ()) ?(name_label="host") ?(name_description="description") ?(hostname="localhost") ?(address="127.0.0.1") ?(external_auth_type="") ?(external_auth_service_name="") ?(external_auth_configuration=[]) - ?(license_params=[]) ?(edition="free") ?(license_server=[]) ?(local_cache_sr=Ref.null) ?(chipset_info=[]) () = + ?(license_params=[]) ?(edition="free") ?(license_server=[]) ?(local_cache_sr=Ref.null) ?(chipset_info=[]) ?(ssl_legacy=false) () = - Xapi_host.create ~__context ~uuid ~name_label ~name_description ~hostname ~address ~external_auth_type ~external_auth_service_name ~external_auth_configuration ~license_params ~edition ~license_server ~local_cache_sr ~chipset_info + Xapi_host.create ~__context ~uuid ~name_label ~name_description ~hostname ~address ~external_auth_type ~external_auth_service_name ~external_auth_configuration ~license_params ~edition ~license_server ~local_cache_sr ~chipset_info ~ssl_legacy let make_pif ~__context ~network ~host ?(device="eth0") ?(mAC="C0:FF:EE:C0:FF:EE") ?(mTU=1500L) ?(vLAN=(-1L)) ?(physical=true) ?(ip_configuration_mode=`None) ?(iP="") ?(netmask="") diff --git a/ocaml/xapi/create_misc.ml b/ocaml/xapi/create_misc.ml index 9d403386edd..89e0545b01c 100644 --- a/ocaml/xapi/create_misc.ml +++ b/ocaml/xapi/create_misc.ml @@ -42,6 +42,7 @@ type host_info = { machine_serial_name: string option; total_memory_mib: int64; dom0_static_max: int64; + ssl_legacy: bool; } (* NB: this is dom0's view of the world, not Xen's. *) @@ -109,6 +110,10 @@ let read_localhost_info () = machine_serial_name = lookup_inventory_nofail Xapi_inventory._machine_serial_name; total_memory_mib = total_memory_mib; dom0_static_max = dom0_static_max; + ssl_legacy = try ( + bool_of_string ( + Xapi_inventory.lookup Xapi_inventory._stunnel_legacy ~default:"true") + ) with _ -> true; } (** Returns the maximum of two values. *) diff --git a/ocaml/xapi/create_misc.mli b/ocaml/xapi/create_misc.mli index aee0d45ea86..65fb79b982e 100644 --- a/ocaml/xapi/create_misc.mli +++ b/ocaml/xapi/create_misc.mli @@ -26,6 +26,7 @@ type host_info = { machine_serial_name : string option; total_memory_mib : int64; dom0_static_max : int64; + ssl_legacy : bool; } val read_dom0_memory_usage : unit -> int64 option diff --git a/ocaml/xapi/dbsync_slave.ml b/ocaml/xapi/dbsync_slave.ml index e6de1208fd3..4c31a4a58aa 100644 --- a/ocaml/xapi/dbsync_slave.ml +++ b/ocaml/xapi/dbsync_slave.ml @@ -52,7 +52,7 @@ let create_localhost ~__context info = ~hostname:info.hostname ~address:ip ~external_auth_type:"" ~external_auth_service_name:"" ~external_auth_configuration:[] ~license_params:[] ~edition:"" ~license_server:["address", "localhost"; "port", "27000"] - ~local_cache_sr:Ref.null ~chipset_info:[] + ~local_cache_sr:Ref.null ~chipset_info:[] ~ssl_legacy:info.ssl_legacy in () (* TODO cat /proc/stat for btime ? *) diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index 6523de00c30..53fc81740eb 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -565,7 +565,7 @@ let is_host_alive ~__context ~host = false end -let create ~__context ~uuid ~name_label ~name_description ~hostname ~address ~external_auth_type ~external_auth_service_name ~external_auth_configuration ~license_params ~edition ~license_server ~local_cache_sr ~chipset_info = +let create ~__context ~uuid ~name_label ~name_description ~hostname ~address ~external_auth_type ~external_auth_service_name ~external_auth_configuration ~license_params ~edition ~license_server ~local_cache_sr ~chipset_info ~ssl_legacy = let make_new_metrics_object ref = Db.Host_metrics.create ~__context ~ref @@ -606,7 +606,7 @@ let create ~__context ~uuid ~name_label ~name_description ~hostname ~address ~ex ~power_on_mode:"" ~power_on_config:[] ~local_cache_sr - ~ssl_legacy:true + ~ssl_legacy ~guest_VCPUs_params:[] ~display:`enabled ~virtual_hardware_platform_versions:(if host_is_us then Xapi_globs.host_virtual_hardware_platform_versions else [0L]) diff --git a/ocaml/xapi/xapi_host.mli b/ocaml/xapi/xapi_host.mli index aa833fb5165..7636b1bdafe 100644 --- a/ocaml/xapi/xapi_host.mli +++ b/ocaml/xapi/xapi_host.mli @@ -87,6 +87,7 @@ val create : license_server:(string * string) list -> local_cache_sr:[ `SR ] Ref.t -> chipset_info:(string * string) list -> + ssl_legacy:bool -> [ `host ] Ref.t val destroy : __context:Context.t -> self:API.ref_host -> unit val declare_dead : __context:Context.t -> host:API.ref_host -> unit diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index 97261683694..312f2126e9d 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -386,6 +386,7 @@ let rec create_or_get_host_on_master __context rpc session_id (host_ref, host) : * been added to the constructor. *) ~local_cache_sr ~chipset_info:host.API.host_chipset_info + ~ssl_legacy:host.API.host_ssl_legacy in (* Copy other-config into newly created host record: *) From d484adaf3cb63672966143bdb7605d5d41eee9d8 Mon Sep 17 00:00:00 2001 From: Thomas Sanders Date: Thu, 7 Apr 2016 11:44:45 +0100 Subject: [PATCH 11/69] Refactor Pool.enable_ssl_legacy and disable_ssl_legacy Move duplicated code into a shared function. Signed-off-by: Thomas Sanders (cherry picked from commit 322373694a4718f2d95020b5e53db7015a00b7ba) Signed-off-by: Thomas Sanders --- ocaml/xapi/xapi_pool.ml | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index 312f2126e9d..5ec46f7ca30 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -1722,17 +1722,15 @@ let assert_mac_seeds_available ~__context ~self ~seeds = raise (Api_errors.Server_error (Api_errors.duplicate_mac_seed, [StringSet.choose problem_mac_seeds])) -let disable_ssl_legacy ~__context ~self = +let set_ssl_legacy_on_each_host ~__context ~self ~value = let f ~rpc ~session_id ~host = - Client.Host.set_ssl_legacy ~rpc ~session_id ~self:host ~value:false + Client.Host.set_ssl_legacy ~rpc ~session_id ~self:host ~value in Xapi_pool_helpers.call_fn_on_slaves_then_master ~__context f -let enable_ssl_legacy ~__context ~self = - let f ~rpc ~session_id ~host = - Client.Host.set_ssl_legacy ~rpc ~session_id ~self:host ~value:true - in - Xapi_pool_helpers.call_fn_on_slaves_then_master ~__context f +let disable_ssl_legacy = set_ssl_legacy_on_each_host ~value:false + +let enable_ssl_legacy = set_ssl_legacy_on_each_host ~value:true let has_extension ~__context ~self ~name = try From 186c2879aac26ec33f0c918838cda2f0e55a4e5b Mon Sep 17 00:00:00 2001 From: Si Beaumont Date: Tue, 12 Apr 2016 13:49:05 +0100 Subject: [PATCH 12/69] CA-207440: Stop daily-license-check cron spamming dead.letter We're already logging when there's a failure to syslog using `logger`. Signed-off-by: Si Beaumont --- scripts/license-check | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/license-check b/scripts/license-check index 228bc26a7f8..fb32927a6f1 100755 --- a/scripts/license-check +++ b/scripts/license-check @@ -1,6 +1,6 @@ #!/bin/sh -@LIBEXECDIR@/daily-license-check +@LIBEXECDIR@/daily-license-check >/dev/null 2>&1 EXITVALUE=$? if [ $EXITVALUE != 0 ]; then From 3fe595243f7102675fe48dba0a59d77580fca6d8 Mon Sep 17 00:00:00 2001 From: chengz Date: Thu, 7 Apr 2016 02:43:04 +0000 Subject: [PATCH 13/69] CA-206592: Change RBAC of vif-config-ipv* to _R_VM_OP Signed-off-by: chengz --- ocaml/idl/datamodel.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 4dca4e232e5..91d1a7f77ca 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -5436,7 +5436,7 @@ let vif_configure_ipv4 = call {param_type=String; param_name="address"; param_doc="The IPv4 address in / format (for static mode only)"; param_release=dundee_release; param_default=Some(VString "")}; {param_type=String; param_name="gateway"; param_doc="The IPv4 gateway (for static mode only; leave empty to not set a gateway)"; param_release=dundee_release; param_default=Some(VString "")} ] - ~allowed_roles:_R_POOL_OP + ~allowed_roles:_R_VM_OP () let vif_configure_ipv6 = call @@ -5449,7 +5449,7 @@ let vif_configure_ipv6 = call {param_type=String; param_name="address"; param_doc="The IPv6 address in / format (for static mode only)"; param_release=dundee_release; param_default=Some(VString "")}; {param_type=String; param_name="gateway"; param_doc="The IPv6 gateway (for static mode only; leave empty to not set a gateway)"; param_release=dundee_release; param_default=Some(VString "")} ] - ~allowed_roles:_R_POOL_OP + ~allowed_roles:_R_VM_OP () (** A virtual network interface *) From fcc5b58756d5456747c9d06f17858d5d105db64a Mon Sep 17 00:00:00 2001 From: John Else Date: Wed, 13 Apr 2016 15:34:56 +0100 Subject: [PATCH 14/69] CP-16072: Handle extra values in the GVT-g config file The config file now specifies framebuffer size, number of heads and resolution. Signed-off-by: John Else --- ocaml/test/data/gvt-g-whitelist-1234 | 4 ++-- ocaml/test/data/gvt-g-whitelist-mixed | 4 ++-- ocaml/test/test_vgpu_type.ml | 26 ++++++++++++++++++++++++-- ocaml/xapi/xapi_vgpu_type.ml | 16 ++++++++++++++-- 4 files changed, 42 insertions(+), 8 deletions(-) diff --git a/ocaml/test/data/gvt-g-whitelist-1234 b/ocaml/test/data/gvt-g-whitelist-1234 index e9808e6d83a..c272776b271 100644 --- a/ocaml/test/data/gvt-g-whitelist-1234 +++ b/ocaml/test/data/gvt-g-whitelist-1234 @@ -1,2 +1,2 @@ -1234 experimental=0 name='GVT-g on 1234' low_gm_sz=128 high_gm_sz=384 fence_sz=4 monitor_config_file=/path/to/file1 -1234 experimental=1 name='GVT-g on 1234 (experimental)' low_gm_sz=128 high_gm_sz=384 fence_sz=4 monitor_config_file=/path/to/file2 +1234 experimental=0 name='GVT-g on 1234' low_gm_sz=128 high_gm_sz=384 fence_sz=4 framebuffer_sz=128 max_heads=1 resolution=1920x1080 monitor_config_file=/path/to/file1 +1234 experimental=1 name='GVT-g on 1234 (experimental)' low_gm_sz=128 high_gm_sz=384 fence_sz=4 framebuffer_sz=128 max_heads=1 resolution=1920x1080 monitor_config_file=/path/to/file2 diff --git a/ocaml/test/data/gvt-g-whitelist-mixed b/ocaml/test/data/gvt-g-whitelist-mixed index 85944929635..a8aa23808a0 100644 --- a/ocaml/test/data/gvt-g-whitelist-mixed +++ b/ocaml/test/data/gvt-g-whitelist-mixed @@ -1,2 +1,2 @@ -1234 experimental=0 name='GVT-g on 1234' low_gm_sz=128 high_gm_sz=384 fence_sz=4 monitor_config_file=/path/to/file1 -5678 experimental=0 name='GVT-g on 5678' low_gm_sz=128 high_gm_sz=384 fence_sz=4 monitor_config_file=/path/to/file2 +1234 experimental=0 name='GVT-g on 1234' low_gm_sz=128 high_gm_sz=384 fence_sz=4 framebuffer_sz=128 max_heads=1 resolution=1920x1080 monitor_config_file=/path/to/file1 +5678 experimental=0 name='GVT-g on 5678' low_gm_sz=128 high_gm_sz=384 fence_sz=4 framebuffer_sz=128 max_heads=1 resolution=1920x1080 monitor_config_file=/path/to/file2 diff --git a/ocaml/test/test_vgpu_type.ml b/ocaml/test/test_vgpu_type.ml index a1711c611da..53492ae5db0 100644 --- a/ocaml/test/test_vgpu_type.ml +++ b/ocaml/test/test_vgpu_type.ml @@ -18,6 +18,8 @@ open Test_highlevel open Test_vgpu_common open Xapi_vgpu_type +let mib x = List.fold_left Int64.mul x [1024L; 1024L] + module NvidiaTest = struct let string_of_vgpu_conf conf = let open Identifier in @@ -127,7 +129,7 @@ module IntelTest = struct "", None; "nonsense123", None; (* Test some success cases. *) - "1234 experimental=0 name='myvgpu' low_gm_sz=128 high_gm_sz=384 fence_sz=4 monitor_config_file=/my/file", + "1234 experimental=0 name='myvgpu' low_gm_sz=128 high_gm_sz=384 fence_sz=4 framebuffer_sz=128 max_heads=1 resolution=1920x1080 monitor_config_file=/my/file", Some { Intel.identifier = Identifier.({ pdev_id = 0x1234; @@ -138,8 +140,12 @@ module IntelTest = struct }); experimental = false; model_name = "myvgpu"; + framebufferlength = mib 128L; + num_heads = 1L; + max_x = 1920L; + max_y = 1080L; }; - "1234 experimental=1 name='myvgpu' low_gm_sz=128 high_gm_sz=384 fence_sz=4 monitor_config_file=/my/file", + "1234 experimental=1 name='myvgpu' low_gm_sz=128 high_gm_sz=384 fence_sz=4 framebuffer_sz=128 max_heads=1 resolution=1920x1080 monitor_config_file=/my/file", Some { Intel.identifier = Identifier.({ pdev_id = 0x1234; @@ -150,6 +156,10 @@ module IntelTest = struct }); experimental = true; model_name = "myvgpu"; + framebufferlength = mib 128L; + num_heads = 1L; + max_x = 1920L; + max_y = 1080L; }; ] end) @@ -183,6 +193,10 @@ module IntelTest = struct }); experimental = false; model_name = "GVT-g on 1234"; + framebufferlength = mib 128L; + num_heads = 1L; + max_x = 1920L; + max_y = 1080L; }); Intel.({ identifier = Identifier.({ @@ -194,6 +208,10 @@ module IntelTest = struct }); experimental = true; model_name = "GVT-g on 1234 (experimental)"; + framebufferlength = mib 128L; + num_heads = 1L; + max_x = 1920L; + max_y = 1080L; }); ]; ("ocaml/test/data/gvt-g-whitelist-1234", 0x5678), []; @@ -209,6 +227,10 @@ module IntelTest = struct }); experimental = false; model_name = "GVT-g on 1234"; + framebufferlength = mib 128L; + num_heads = 1L; + max_x = 1920L; + max_y = 1080L; }); ]; ] diff --git a/ocaml/xapi/xapi_vgpu_type.ml b/ocaml/xapi/xapi_vgpu_type.ml index 9122a644302..34b42a5dcbc 100644 --- a/ocaml/xapi/xapi_vgpu_type.ml +++ b/ocaml/xapi/xapi_vgpu_type.ml @@ -380,20 +380,28 @@ module Intel = struct type vgpu_conf = { identifier : Identifier.gvt_g_id; experimental : bool; - model_name : string + model_name : string; + framebufferlength : int64; + num_heads : int64; + max_x : int64; + max_y : int64; } let read_whitelist_line ~line = try Some (Scanf.sscanf line - "%04x experimental=%c name='%s@' low_gm_sz=%Ld high_gm_sz=%Ld fence_sz=%Ld monitor_config_file=%s" + "%04x experimental=%c name='%s@' low_gm_sz=%Ld high_gm_sz=%Ld fence_sz=%Ld framebuffer_sz=%Ld max_heads=%Ld resolution=%Ldx%Ld monitor_config_file=%s" (fun pdev_id experimental model_name low_gm_sz high_gm_sz fence_sz + framebuffer_sz + num_heads + max_x + max_y monitor_config_file -> { identifier = Identifier.({ @@ -408,6 +416,10 @@ module Intel = struct | '0' -> false | _ -> true); model_name; + framebufferlength = mib framebuffer_sz; + num_heads; + max_x; + max_y; })) with e-> begin error "Failed to read whitelist line: '%s' %s" From 9f7090136e05db53031b58ca1e14cc188f704726 Mon Sep 17 00:00:00 2001 From: John Else Date: Wed, 13 Apr 2016 16:50:28 +0100 Subject: [PATCH 15/69] CP-16072: Put correct GVT-g metadata in the database Use values read from the config file, rather than using hardcoded values. Signed-off-by: John Else --- ocaml/xapi/xapi_vgpu_type.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ocaml/xapi/xapi_vgpu_type.ml b/ocaml/xapi/xapi_vgpu_type.ml index 34b42a5dcbc..46e0c534386 100644 --- a/ocaml/xapi/xapi_vgpu_type.ml +++ b/ocaml/xapi/xapi_vgpu_type.ml @@ -478,10 +478,10 @@ module Intel = struct { vendor_name; model_name = conf.model_name; - framebuffer_size = mib 256L; - max_heads = 1L; - max_resolution_x = 2560L; - max_resolution_y = 1600L; + framebuffer_size = conf.framebufferlength; + max_heads = conf.num_heads; + max_resolution_x = conf.max_x; + max_resolution_y = conf.max_y; size = vgpu_size; internal_config = [ Xapi_globs.vgt_low_gm_sz, Int64.to_string conf.identifier.low_gm_sz; From e57fa100126f2009170dc49bf8d30171ea98c516 Mon Sep 17 00:00:00 2001 From: Sharad Yadav Date: Thu, 14 Apr 2016 10:24:58 +0100 Subject: [PATCH 16/69] CA-206753: Move task cancellation to message_forwarding We need task cancellation of vm lifecycle operation in message_forwarding in order to aquire lock on VBDs and VIFs for hard_reboot and hard_shutdown operations. And exception raised during shutdown and reboot must wait for the event thread to sync on slave before returning in order to update the state of VM on slave. Signed-off-by: Sharad Yadav --- ocaml/xapi/message_forwarding.ml | 50 ++++++++++++++++++++++++++++++-- ocaml/xapi/xapi_vm.ml | 44 ---------------------------- ocaml/xapi/xapi_xenops.ml | 21 +++++++++----- 3 files changed, 62 insertions(+), 53 deletions(-) diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 0b61fc3ef84..b64fc440727 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -657,6 +657,47 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct (* Defined in Xapi_vm_helpers so it can be used from elsewhere without circular dependency. *) let with_vm_operation = Xapi_vm_helpers.with_vm_operation + (* Nb, we're not using the snapshots returned in 'Event.from' here because + * the tasks might get deleted. The standard mechanism for dealing with + * deleted events assumes you have a full database replica locally, and + * deletions are handled by checking your valid_ref_counts table against + * your local database. In this case, we're only interested in a subset of + * events, so this mechanism doesn't work. There will only be a few outstanding + * tasks anyway, so we're safe to just iterate through the references when an + * event happens - ie, we use the event API simply to wake us up when something + * interesting has happened. *) + + let wait_for_tasks ~__context ~tasks = + let our_task = Context.get_task_id __context in + let classes = List.map (fun x -> Printf.sprintf "task/%s" (Ref.string_of x)) (our_task::tasks) in + + let rec process token = + TaskHelper.exn_if_cancelling ~__context; (* First check if _we_ have been cancelled *) + let statuses = List.filter_map (fun task -> try Some (Db.Task.get_status ~__context ~self:task) with _ -> None) tasks in + let unfinished = List.exists (fun state -> state = `pending) statuses in + if unfinished + then begin + let from = Helpers.call_api_functions ~__context + (fun rpc session_id -> Client.Event.from ~rpc ~session_id ~classes ~token ~timeout:30.0) in + debug "Using events to wait for tasks: %s" (String.concat "," classes); + let from = Event_types.event_from_of_rpc from in + process from.Event_types.token + end else + () + in + process "" + + let cancel ~__context ~vm ~ops = + let cancelled = List.filter_map (fun (task,op) -> + if List.mem op ops then begin + info "Cancelling VM.%s for VM.hard_shutdown/reboot" (Record_util.vm_operation_to_string op); + Helpers.call_api_functions ~__context + (fun rpc session_id -> try Client.Task.cancel ~rpc ~session_id ~task:(Ref.of_string task) with _ -> ()); + Some (Ref.of_string task) + end else None + ) (Db.VM.get_current_operations ~__context ~self:vm) in + wait_for_tasks ~__context ~tasks:cancelled + let unmark_vbds ~__context ~vbds ~doc ~op = let task_id = Ref.string_of (Context.get_task_id __context) in iter_with_drop ~doc:("unmarking VBDs after " ^ doc) @@ -1317,8 +1358,10 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct let hard_shutdown ~__context ~vm = info "VM.hard_shutdown: VM = '%s'" (vm_uuid ~__context vm); let local_fn = Local.VM.hard_shutdown ~vm in + let host = Db.VM.get_resident_on ~__context ~self:vm in with_vm_operation ~__context ~self:vm ~doc:"VM.hard_shutdown" ~op:`hard_shutdown (fun () -> + cancel ~__context ~vm ~ops:[ `clean_shutdown; `clean_reboot; `hard_reboot; `pool_migrate; `call_plugin; `suspend ]; (* If VM is actually suspended and we ask to hard_shutdown, we need to forward to any host that can see the VDIs *) let policy = @@ -1334,7 +1377,8 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct end else (* if we're nt suspended then just forward to host that has vm running on it: *) - forward_vm_op ~vm in + do_op_on ~host:host + in policy ~local_fn ~__context (fun session_id rpc -> Client.VM.hard_shutdown rpc session_id vm) ); let uuid = Db.VM.get_uuid ~__context ~self:vm in @@ -1351,15 +1395,17 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct let hard_reboot ~__context ~vm = info "VM.hard_reboot: VM = '%s'" (vm_uuid ~__context vm); let local_fn = Local.VM.hard_reboot ~vm in + let host = Db.VM.get_resident_on ~__context ~self:vm in with_vm_operation ~__context ~self:vm ~doc:"VM.hard_reboot" ~op:`hard_reboot (fun () -> + cancel ~__context ~vm ~ops:[ `clean_shutdown; `clean_reboot; `pool_migrate; `call_plugin; `suspend ]; with_vbds_marked ~__context ~vm ~doc:"VM.hard_reboot" ~op:`attach (fun vbds -> with_vifs_marked ~__context ~vm ~doc:"VM.hard_reboot" ~op:`attach (fun vifs -> (* CA-31903: we don't need to reserve memory for reboot because the memory settings can't change across reboot. *) - forward_vm_op ~local_fn ~__context ~vm + do_op_on ~host:host ~local_fn ~__context (fun session_id rpc -> Client.VM.hard_reboot rpc session_id vm)))); let uuid = Db.VM.get_uuid ~__context ~self:vm in let message_body = diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 6811e4f2e8c..5b162f64b6d 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -236,50 +236,7 @@ let start_on ~__context ~vm ~host ~start_paused ~force = assert_host_is_localhost ~__context ~host; start ~__context ~vm ~start_paused ~force - -(* Nb, we're not using the snapshots returned in 'Event.from' here because - the tasks might get deleted. The standard mechanism for dealing with - deleted events assumes you have a full database replica locally, and - deletions are handled by checking your valid_ref_counts table against - your local database. In this case, we're only interested in a subset of - events, so this mechanism doesn't work. There will only be a few outstanding - tasks anyway, so we're safe to just iterate through the references when an - event happens - ie, we use the event API simply to wake us up when something - interesting has happened. *) -let wait_for_tasks ~__context ~tasks = - let our_task = Context.get_task_id __context in - let classes = List.map (fun x -> Printf.sprintf "task/%s" (Ref.string_of x)) (our_task::tasks) in - - let rec process token = - TaskHelper.exn_if_cancelling ~__context; (* First check if _we_ have been cancelled *) - let statuses = List.filter_map (fun task -> try Some (Db.Task.get_status ~__context ~self:task) with _ -> None) tasks in - let unfinished = List.exists (fun state -> state = `pending) statuses in - if unfinished - then begin - let from = Helpers.call_api_functions ~__context - (fun rpc session_id -> Client.Event.from ~rpc ~session_id ~classes ~token ~timeout:30.0) in - debug "Using events to wait for tasks: %s" (String.concat "," classes); - let from = Event_types.event_from_of_rpc from in - process from.Event_types.token - end else - () - in - process "" - -let cancel ~__context ~vm ~ops = - let cancelled = List.filter_map (fun (task,op) -> - if List.mem op ops then begin - info "Cancelling VM.%s for VM.hard_shutdown/reboot" (Record_util.vm_operation_to_string op); - Helpers.call_api_functions ~__context - (fun rpc session_id -> try Client.Task.cancel ~rpc ~session_id ~task:(Ref.of_string task) with _ -> ()); - Some (Ref.of_string task) - end else None - ) (Db.VM.get_current_operations ~__context ~self:vm) in - wait_for_tasks ~__context ~tasks:cancelled - - let hard_shutdown ~__context ~vm = - cancel ~__context ~vm ~ops:[ `clean_shutdown; `clean_reboot; `hard_reboot; `pool_migrate; `call_plugin; `suspend ]; Db.VM.set_ha_always_run ~__context ~self:vm ~value:false; debug "Setting ha_always_run on vm=%s as false during VM.hard_shutdown" (Ref.string_of vm); match Db.VM.get_power_state ~__context ~self:vm with @@ -302,7 +259,6 @@ let hard_shutdown ~__context ~vm = | `Halted -> () let hard_reboot ~__context ~vm = - cancel ~__context ~vm ~ops:[ `clean_shutdown; `clean_reboot; `pool_migrate; `call_plugin; `suspend ]; (* Cancelling operations can cause the VM to now be shutdown *) begin match Db.VM.get_power_state ~__context ~self:vm with diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 07d0c2c5552..4bb6a58e9bd 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -2484,9 +2484,13 @@ let reboot ~__context ~self timeout = (* Ensure we have the latest version of the VM metadata before the reboot *) Events_from_xapi.wait ~__context ~self; info "xenops: VM.reboot %s" id; - let module Client = (val make_client queue_name : XENOPS) in - Client.VM.reboot dbg id timeout |> sync_with_task __context queue_name; - Events_from_xenopsd.wait queue_name dbg id (); + let module Client = (val make_client queue_name : XENOPS ) in + let () = Pervasiveext.finally + (fun () -> + Client.VM.reboot dbg id timeout |> sync_with_task __context queue_name) + (fun () -> + Events_from_xenopsd.wait queue_name dbg id ()) + in Xapi_vm_lifecycle.assert_power_state_is ~__context ~self ~expected:`Running ) @@ -2496,12 +2500,15 @@ let shutdown ~__context ~self timeout = (fun () -> assert_resident_on ~__context ~self; let id = id_of_vm ~__context ~self in - let dbg = Context.string_of_task __context in info "xenops: VM.shutdown %s" id; - let module Client = (val make_client queue_name : XENOPS) in - Client.VM.shutdown dbg id timeout |> sync_with_task __context queue_name; - Events_from_xenopsd.wait queue_name dbg id (); + let module Client = (val make_client queue_name : XENOPS ) in + let () = Pervasiveext.finally + (fun () -> + Client.VM.shutdown dbg id timeout |> sync_with_task __context queue_name) + (fun () -> + Events_from_xenopsd.wait queue_name dbg id ()) + in Xapi_vm_lifecycle.assert_power_state_is ~__context ~self ~expected:`Halted; (* force_state_reset called from the xenopsd event loop above *) assert (Db.VM.get_resident_on ~__context ~self = Ref.null); From 6bcf8e034343d866d644f474a6ae99955c797f8f Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Fri, 22 Apr 2016 12:56:50 +0100 Subject: [PATCH 17/69] CA-208493: Revert "CA-111223: CP-8322: Add the 32-bit CLI RPM to the ISO" Remove the 32-bit CLI. This reverts commit f6abb4b9deab26d76ae547ede1c77f16b5a5d40f. --- mk/Makefile | 2 -- 1 file changed, 2 deletions(-) diff --git a/mk/Makefile b/mk/Makefile index 54890b461e8..1062047458f 100644 --- a/mk/Makefile +++ b/mk/Makefile @@ -39,8 +39,6 @@ export PRODUCT_VERSION_TEXT_SHORT build: $(OUTPUT_CLI_RT) $(OUTPUT_SDK) $(MY_SOURCES)/MANIFEST $(call mkdir_clean,$(MY_MAIN_CDFILES)/client_install) install -m 755 $(RPM_RPMSDIR)/$(DOMAIN0_ARCH_OPTIMIZED)/xapi-xe-*.rpm $(MY_MAIN_CDFILES)/client_install/xe-cli-$(PRODUCT_VERSION)-$(BUILD_NUMBER).$(DOMAIN0_ARCH_OPTIMIZED).rpm - # Copy in the 32-bit CLI from clearwater RTM build - install -m 755 $(CARBON_DISTFILES)/xe-cli-32bit/xe-cli-6.2.0-70442c.i686.rpm $(MY_MAIN_CDFILES)/client_install/xe-cli-6.2.0-70442c.i686.rpm # Delete this as soon as xenrt has been updated to fetch the file from # the new place: $(call mkdir_clean,$(MY_LINUX_CDFILES)/client_install) From 4f1eebb39d2351f3149e162f3af7d5dd5f5ce468 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Sun, 24 Apr 2016 22:47:28 +0100 Subject: [PATCH 18/69] CA-208836: Add policy_no_vendor_device to pool Signed-off-by: Jon Ludlam (cherry picked from commit e8b829f4420ce4940179e08e8ed845521a7e14ec) Signed-off-by: Thomas Sanders --- ocaml/idl/datamodel.ml | 1 + ocaml/test/test_common.ml | 4 ++-- ocaml/xapi/dbsync_master.ml | 2 +- 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 91d1a7f77ca..5fd31295ed1 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -6911,6 +6911,7 @@ let pool = ] @ (allowed_and_current_operations pool_operations) @ [ field ~in_oss_since:None ~in_product_since:rel_dundee ~qualifier:DynamicRO ~ty:(Map(String, String)) ~default_value:(Some (VMap [])) "guest_agent_config" "Pool-wide guest agent configuration information" ; field ~qualifier:DynamicRO ~in_product_since:rel_dundee ~default_value:(Some (VMap [])) ~ty:(Map(String, String)) "cpu_info" "Details about the physical CPUs on the pool" + ; field ~qualifier:RW ~in_product_since:rel_dundee ~default_value:(Some (VBool false)) ~ty:Bool "policy_no_vendor_device" "The pool-wide policy for clients on whether to use the vendor device or not on newly created VMs. This field will also be consulted if the 'has_vendor_device' field is not specified in the VM.create call." ]) () diff --git a/ocaml/test/test_common.ml b/ocaml/test/test_common.ml index 0420d4f52db..3557d67dba3 100644 --- a/ocaml/test/test_common.ml +++ b/ocaml/test/test_common.ml @@ -145,7 +145,7 @@ let make_pool ~__context ~master ?(name_label="") ?(name_description="") ?(redo_log_vdi=Ref.null) ?(vswitch_controller="") ?(restrictions=[]) ?(current_operations=[]) ?(allowed_operations=[]) ?(other_config=[Xapi_globs.memory_ratio_hvm; Xapi_globs.memory_ratio_pv]) - ?(ha_cluster_stack="xhad") ?(guest_agent_config=[]) ?(cpu_info=[]) () = + ?(ha_cluster_stack="xhad") ?(guest_agent_config=[]) ?(cpu_info=[]) ?(policy_no_vendor_device=false) () = let pool_ref = Ref.make () in Db.Pool.create ~__context ~ref:pool_ref ~uuid:(make_uuid ()) ~name_label ~name_description @@ -155,7 +155,7 @@ let make_pool ~__context ~master ?(name_label="") ?(name_description="") ~gui_config ~health_check_config ~wlb_url ~wlb_username ~wlb_password ~wlb_enabled ~wlb_verify_cert ~redo_log_enabled ~redo_log_vdi ~vswitch_controller ~current_operations ~allowed_operations - ~restrictions ~other_config ~ha_cluster_stack ~guest_agent_config ~cpu_info; + ~restrictions ~other_config ~ha_cluster_stack ~guest_agent_config ~cpu_info ~policy_no_vendor_device; pool_ref let default_sm_features = [ diff --git a/ocaml/xapi/dbsync_master.ml b/ocaml/xapi/dbsync_master.ml index 290e25bbff8..6130f9a91a6 100644 --- a/ocaml/xapi/dbsync_master.ml +++ b/ocaml/xapi/dbsync_master.ml @@ -41,7 +41,7 @@ let create_pool_record ~__context = ] ~ha_cluster_stack:"xhad" ~guest_agent_config:[] - ~cpu_info:[] + ~cpu_info:[] ~policy_no_vendor_device:false let set_master_ip ~__context = let ip = From 39412bca4f0d31db1c5cef2a9fcda47d53703916 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Sun, 24 Apr 2016 23:03:27 +0100 Subject: [PATCH 19/69] CA-208836: Expose pool.default_vendor_device in the CLI Signed-off-by: Jon Ludlam (cherry picked from commit 1e544e50f81434cf685e82011dd180847fce2be0) Signed-off-by: Thomas Sanders --- ocaml/client_records/records.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/ocaml/client_records/records.ml b/ocaml/client_records/records.ml index 1fefaa53a5b..18119015cc7 100644 --- a/ocaml/client_records/records.ml +++ b/ocaml/client_records/records.ml @@ -534,6 +534,7 @@ let pool_record rpc session_id pool = ~get_map:(fun () -> (x ()).API.pool_guest_agent_config) (); make_field ~name:"cpu_info" ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.pool_cpu_info) ~get_map:(fun () -> (x ()).API.pool_cpu_info) (); + make_field ~name:"policy-no-vendor-device" ~get:(fun () -> string_of_bool (x ()).API.pool_policy_no_vendor_device) ~set:(fun s -> Client.Pool.set_policy_no_vendor_device rpc session_id pool (safe_bool_of_string "policy-no-vendor-device" s)) (); ]} let subject_record rpc session_id subject = From f80ba1e35f64c09a914b1d15d735dba1235ea9bc Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Mon, 25 Apr 2016 00:42:04 +0100 Subject: [PATCH 20/69] CA-208836: Add the ability to customize default values of fields at runtime Signed-off-by: Jon Ludlam (cherry picked from commit d3ff07823341fc9adc050c648b622bb60dff1726) Signed-off-by: Thomas Sanders --- ocaml/idl/datamodel_types.ml | 2 ++ ocaml/idl/datamodel_values.ml | 11 ++++++++--- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/ocaml/idl/datamodel_types.ml b/ocaml/idl/datamodel_types.ml index c299fb133ea..0ec7e542be1 100644 --- a/ocaml/idl/datamodel_types.ml +++ b/ocaml/idl/datamodel_types.ml @@ -105,6 +105,7 @@ type api_value = | VMap of (api_value*api_value) list | VSet of api_value list | VRef of string + | VCustom of string * api_value with rpc (** Each database field has a qualifier associated with it: @@ -304,6 +305,7 @@ let rec type_checks v t = | VSet vl, Set t -> all_true (List.map (fun v->type_checks v t) vl) | VRef r, Ref _ -> true + | VCustom _, _ -> true (* Type checks defered to phase-2 compile time *) | _, _ -> false module TypeToXML = struct diff --git a/ocaml/idl/datamodel_values.ml b/ocaml/idl/datamodel_values.ml index c6a1429efb5..fa03457aa3c 100644 --- a/ocaml/idl/datamodel_values.ml +++ b/ocaml/idl/datamodel_values.ml @@ -34,6 +34,7 @@ let rec to_rpc v = | VMap vvl -> Rpc.Dict (List.map (fun (v1,v2)-> to_string v1, to_rpc v2) vvl) | VSet vl -> Rpc.Enum (List.map (fun v->to_rpc v) vl) | VRef r -> Rpc.String r + | VCustom (_,_) -> failwith "Can't RPC up a custom value" let rec to_xml v = match v with @@ -46,6 +47,7 @@ let rec to_xml v = | VMap vvl -> XMLRPC.To.structure (List.map (fun (v1,v2)-> to_string v1, to_xml v2) vvl) | VSet vl -> XMLRPC.To.array (List.map (fun v->to_xml v) vl) | VRef r -> XMLRPC.To.string r + | VCustom (_,y) -> to_xml y open Printf @@ -60,8 +62,10 @@ let to_ocaml_string v = | Rpc.Dict d -> sprintf "Rpc.Dict [%s]" (String.concat ";" (List.map (fun (n,v) -> sprintf "(\"%s\",%s)" n (aux v)) d)) | Rpc.Enum l -> sprintf "Rpc.Enum [%s]" (String.concat ";" (List.map aux l)) | Rpc.DateTime t -> sprintf "Rpc.DateTime %s" t in - aux (to_rpc v) - + match v with + | VCustom (x,_) -> x + | _ -> aux (to_rpc v) + let rec to_db v = let open Schema.Value in match v with @@ -77,7 +81,8 @@ let rec to_db v = | VSet vl -> Set(List.map to_string vl) | VRef r -> String r - + | VCustom (x,y) -> to_db y + (* Generate suitable "empty" database value of specified type *) let gen_empty_db_val t = let open Schema in From 5ba16fe440cb0a56e078819eadd187c5fa564e57 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Mon, 25 Apr 2016 00:43:14 +0100 Subject: [PATCH 21/69] CA-208836: Default 'has_vendor_device' at runtime. If, during VM.create, no value has been supplied for the 'has_vendor_device' field, xapi will fill in 'true' iff the license allows it and the pool.policy_no_vendor_device is false. Signed-off-by: Jon Ludlam (cherry picked from commit 4c2aff9468e62dd00264936b5489633b7b42346b) Signed-off-by: Thomas Sanders --- ocaml/idl/datamodel.ml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 5fd31295ed1..d5594ccdfb6 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -7380,7 +7380,13 @@ let vm = field ~qualifier:StaticRO ~in_product_since:rel_boston ~default_value:(Some (VInt 0L)) ~ty:Int "version" "The number of times this VM has been recovered"; field ~qualifier:StaticRO ~in_product_since:rel_clearwater ~default_value:(Some (VString "0:0")) ~ty:(String) "generation_id" "Generation ID of the VM"; field ~writer_roles:_R_VM_ADMIN ~qualifier:RW ~in_product_since:rel_cream ~default_value:(Some (VInt 0L)) ~ty:Int "hardware_platform_version" "The host virtual hardware platform version the VM can run on"; - field ~qualifier:StaticRO ~lifecycle:[Published, rel_dundee, ""] ~doc_tags:[Windows] ~default_value:(Some (VBool true)) ~ty:Bool "has_vendor_device" "When an HVM guest starts, this controls the presence of the emulated C000 PCI device which triggers Windows Update to fetch or update PV drivers."; + field ~qualifier:StaticRO ~lifecycle:[Published, rel_dundee, ""] ~doc_tags:[Windows] ~default_value:(Some (VCustom (String.concat "\n" [ + "(Rpc.Bool ("; + "let pool = List.hd (Db_actions.DB_Action.Pool.get_all ~__context) in"; + "let restrictions = Db_actions.DB_Action.Pool.get_restrictions ~__context ~self:pool in "; + "let vendor_device_allowed = try List.assoc \"restrict_pci_device_for_auto_update\" restrictions = \"false\" with _ -> false in"; + "let policy_says_its_ok = not (Db_actions.DB_Action.Pool.get_policy_no_vendor_device ~__context ~self:pool) in"; + "vendor_device_allowed && policy_says_its_ok))"], VBool false))) ~ty:Bool "has_vendor_device" "When an HVM guest starts, this controls the presence of the emulated C000 PCI device which triggers Windows Update to fetch or update PV drivers."; ]) () From e45508d4844f97828902da140160a3793cba4d69 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Mon, 25 Apr 2016 00:48:31 +0100 Subject: [PATCH 22/69] CA-208836: Use pool.policy_no_vendor_device in CLI vm-install The CLI will only request a vendor device on vm-install when the recommendations of the template suggest it _and_ there is no policy to disable it. Signed-off-by: Jon Ludlam (cherry picked from commit 71d30f50ce84842c8c4b081be2c9c150fae14a8e) Signed-off-by: Thomas Sanders --- ocaml/xapi/cli_operations.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/ocaml/xapi/cli_operations.ml b/ocaml/xapi/cli_operations.ml index 1a132668023..72ab73e08e0 100644 --- a/ocaml/xapi/cli_operations.ml +++ b/ocaml/xapi/cli_operations.ml @@ -2397,7 +2397,9 @@ Pool. Please provide an sr-name-label or sr-uuid parameter." in rewrite_provisioning_xml rpc session_id new_vm sr_uuid; let recommendations = Client.VM.get_recommendations rpc session_id template in let licerr = Api_errors.Server_error(Api_errors.license_restriction, [Features.name_of_feature Features.PCI_device_for_auto_update]) in - let want_dev = is_recommended recommendations "has-vendor-device" in + let pool = List.hd (Client.Pool.get_all rpc session_id) in + let policy_vendor_device_is_ok = not (Client.Pool.get_policy_no_vendor_device rpc session_id pool) in + let want_dev = (is_recommended recommendations "has-vendor-device") && policy_vendor_device_is_ok in ( try Client.VM.set_has_vendor_device rpc session_id new_vm want_dev with e when e = licerr -> From 6c952f0e5939d01956aafc4bc85fa1a465d4d528 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Mon, 25 Apr 2016 15:46:28 +0100 Subject: [PATCH 23/69] CA-208836: Add a test for the behaviour of VM.create under different conditions Signed-off-by: Jon Ludlam (cherry picked from commit 31cb70e7f61364fa56fc525d2916d3334640ba02) Signed-off-by: Thomas Sanders --- ocaml/test/has_vendor_device_test.py | 158 +++++++++++++++++++++++++++ 1 file changed, 158 insertions(+) create mode 100644 ocaml/test/has_vendor_device_test.py diff --git a/ocaml/test/has_vendor_device_test.py b/ocaml/test/has_vendor_device_test.py new file mode 100644 index 00000000000..a16058232c8 --- /dev/null +++ b/ocaml/test/has_vendor_device_test.py @@ -0,0 +1,158 @@ +#!/usr/bin/env python + +import xmlrpclib +import sys + +s=xmlrpclib.Server("http://localhost/") +sess=s.session.login_with_password("root","xenroot")['Value'] + +pool = s.pool.get_all(sess)['Value'][0] +restrictions = s.pool.get_restrictions(sess,pool)['Value'] + +base_request = {'user_version':'1', 'is_a_template':False, 'affinity':'', 'memory_static_max':'4', 'memory_static_min':'1', 'memory_dynamic_max':'3', 'memory_dynamic_min':'2', 'VCPUs_params':{}, 'VCPUs_max':'1', 'VCPUs_at_startup':'1', 'name_label':'hello', 'name_description':'hi', 'memory_target':'2', 'actions_after_shutdown':'destroy', 'actions_after_reboot':'restart', 'actions_after_crash':'destroy', 'PV_bootloader':'', 'PV_kernel':'', 'PV_ramdisk':'', 'PV_args':'', 'PV_bootloader_args':'', 'PV_legacy_args':'', 'HVM_boot_policy':'', 'HVM_boot_params':{}, 'HVM_shadow_multiplier':1.0, 'platform':{}, 'PCI_bus':'', 'other_config':{}, 'recommendations':'', 'xenstore_data':{}, 'ha_always_run':False, 'ha_restart_priority':'1', 'tags':[], 'blocked_operations':{}, 'protection_policy':'', 'is_snapshot_from_vmpp':False, 'appliance':'', 'start_delay':'0', 'shutdown_delay':'0', 'order':'0', 'suspend_SR':'', 'version':'0', 'generation_id':'', 'hardware_platform_version':'0'} + +# + +def create(): + res = s.VM.create(sess, base_request) + return res + +def create_with_vd(b): + request = base_request.copy() + request['has_vendor_device']=b + return s.VM.create(sess,request) + +# VD in request | OK by license | pool.policy_no_vendor_device | resulting VM.has_vendor_device +# - | False | False | False +# False | False | False | False +# True | False | False | Failure +# - | False | True | False +# False | False | True | False +# True | False | True | Failure + + +def test_with_restriction(): # OK by license column above + # Expect this to be successful on an unlicensed host, and for the field to be 'false' + print "running restricted tests (license says you're not allowed the vendor device)" + + s.pool.set_policy_no_vendor_device(sess,pool,False) + +# - | False | False | False + res = create() + vm = res['Value'] + expected = False + found = s.VM.get_has_vendor_device(sess,vm)['Value'] + print "Expecting has-vendor-device to be %s: got %s" % (expected,found) + assert(expected == found) + +# False | False | False | False + res = create_with_vd(False) + vm = res['Value'] + expected = False + found = s.VM.get_has_vendor_device(sess,vm)['Value'] + print "Expecting has-vendor-device to be %s: got %s" % (expected,found) + assert(expected == found) + +# True | False | False | Failure + res = create_with_vd(True) + print "Expecting failure: got %s" % res['Status'] + assert(res['Status']=='Failure') + + s.pool.set_policy_no_vendor_device(sess,pool,True) + +# - | False | True | False + res = create() + vm = res['Value'] + expected = False + found = s.VM.get_has_vendor_device(sess,vm)['Value'] + print "Expecting has-vendor-device to be %s: got %s" % (expected,found) + assert(expected == found) + +# False | False | True | False + res = create_with_vd(False) + vm = res['Value'] + expected = False + found = s.VM.get_has_vendor_device(sess,vm)['Value'] + print "Expecting has-vendor-device to be %s: got %s" % (expected,found) + assert(expected == found) + +# True | False | True | Failure + res = create_with_vd(True) + print "Expecting failure: got %s" % res['Status'] + assert(res['Status']=='Failure') + + + +def test_no_restriction(): + print "running unrestricted tests" + +# - | True | False | True +# False | True | False | False +# True | True | False | True +# - | True | True | False +# False | True | True | False +# True | True | True | True + + s.pool.set_policy_no_vendor_device(sess,pool,False) + +# - | True | False | True + res = create() + vm = res['Value'] + expected = True + found = s.VM.get_has_vendor_device(sess,vm)['Value'] + print "Expecting has-vendor-device to be %s: got %s" % (expected,found) + assert(expected == found) + +# False | True | False | False + res = create_with_vd(False) + vm = res['Value'] + expected = False + found = s.VM.get_has_vendor_device(sess,vm)['Value'] + print "Expecting has-vendor-device to be %s: got %s" % (expected,found) + assert(expected == found) + +# True | True | False | True + res = create_with_vd(True) + vm = res['Value'] + expected = True + found = s.VM.get_has_vendor_device(sess,vm)['Value'] + print "Expecting has-vendor-device to be %s: got %s" % (expected,found) + assert(expected == found) + + s.pool.set_policy_no_vendor_device(sess,pool,True) + +# - | True | True | False + res = create() + vm = res['Value'] + expected = False + found = s.VM.get_has_vendor_device(sess,vm)['Value'] + print "Expecting has-vendor-device to be %s: got %s" % (expected,found) + assert(expected == found) + +# False | True | True | False + res = create_with_vd(False) + vm = res['Value'] + expected = False + found = s.VM.get_has_vendor_device(sess,vm)['Value'] + print "Expecting has-vendor-device to be %s: got %s" % (expected,found) + assert(expected == found) + +# True | True | True | True + res = create_with_vd(True) + vm = res['Value'] + expected = True + found = s.VM.get_has_vendor_device(sess,vm)['Value'] + print "Expecting has-vendor-device to be %s: got %s" % (expected,found) + assert(expected == found) + + + +if restrictions['restrict_pci_device_for_auto_update'] == "true": + test_with_restriction() +else: + test_no_restriction() + + + + + From 7e2b9f731a0191b42962865ef7373c2779a12a6a Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Mon, 25 Apr 2016 17:33:55 +0100 Subject: [PATCH 24/69] CA-208836: Respond to PR comments Signed-off-by: Jon Ludlam (cherry picked from commit 75f26d3f0780af9679f7d900b9bd106edabfecd2) Signed-off-by: Thomas Sanders --- ocaml/idl/datamodel.ml | 4 ++-- ocaml/idl/json_backend/main.ml | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index d5594ccdfb6..71a45edb960 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -7381,12 +7381,12 @@ let vm = field ~qualifier:StaticRO ~in_product_since:rel_clearwater ~default_value:(Some (VString "0:0")) ~ty:(String) "generation_id" "Generation ID of the VM"; field ~writer_roles:_R_VM_ADMIN ~qualifier:RW ~in_product_since:rel_cream ~default_value:(Some (VInt 0L)) ~ty:Int "hardware_platform_version" "The host virtual hardware platform version the VM can run on"; field ~qualifier:StaticRO ~lifecycle:[Published, rel_dundee, ""] ~doc_tags:[Windows] ~default_value:(Some (VCustom (String.concat "\n" [ - "(Rpc.Bool ("; + "(try Rpc.Bool ("; "let pool = List.hd (Db_actions.DB_Action.Pool.get_all ~__context) in"; "let restrictions = Db_actions.DB_Action.Pool.get_restrictions ~__context ~self:pool in "; "let vendor_device_allowed = try List.assoc \"restrict_pci_device_for_auto_update\" restrictions = \"false\" with _ -> false in"; "let policy_says_its_ok = not (Db_actions.DB_Action.Pool.get_policy_no_vendor_device ~__context ~self:pool) in"; - "vendor_device_allowed && policy_says_its_ok))"], VBool false))) ~ty:Bool "has_vendor_device" "When an HVM guest starts, this controls the presence of the emulated C000 PCI device which triggers Windows Update to fetch or update PV drivers."; + "vendor_device_allowed && policy_says_its_ok) with e -> D.error \"Failure when defaulting has_vendor_device field: %s\" (Printexc.to_string e); Rpc.Bool false)"], VBool false))) ~ty:Bool "has_vendor_device" "When an HVM guest starts, this controls the presence of the emulated C000 PCI device which triggers Windows Update to fetch or update PV drivers."; ]) () diff --git a/ocaml/idl/json_backend/main.ml b/ocaml/idl/json_backend/main.ml index 6440e0135a3..c560a37a12b 100644 --- a/ocaml/idl/json_backend/main.ml +++ b/ocaml/idl/json_backend/main.ml @@ -92,6 +92,7 @@ let rec string_of_default = function | VMap x -> Printf.sprintf "{%s}" (String.concat ", " (List.map (fun (a, b) -> Printf.sprintf "%s -> %s" (string_of_default a) (string_of_default b)) x)) | VSet x -> Printf.sprintf "{%s}" (String.concat ", " (List.map string_of_default x)) | VRef x -> if x = "" then "Null" else x + | VCustom (_,y) -> string_of_default y let jarray_of_lifecycle lc = JArray (List.map (fun (t, r, d) -> From e5d1bc155f7ba961b7f3f4dc1d72b26c4c849fe1 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Tue, 26 Apr 2016 15:25:56 +0000 Subject: [PATCH 25/69] CA-207609: Add AD feature flag This is just a flag; no restrictions enforced. Signed-off-by: Rob Hoes --- ocaml/xapi/features.ml | 2 ++ ocaml/xapi/features.mli | 1 + 2 files changed, 3 insertions(+) diff --git a/ocaml/xapi/features.ml b/ocaml/xapi/features.ml index 9cc1a00081c..bdd9d91b430 100644 --- a/ocaml/xapi/features.ml +++ b/ocaml/xapi/features.ml @@ -48,6 +48,7 @@ type feature = | PCI_device_for_auto_update | Xen_motion | Guest_ip_setting + | AD with rpc type orientation = Positive | Negative @@ -85,6 +86,7 @@ let keys_of_features = PCI_device_for_auto_update, ("restrict_pci_device_for_auto_update", Negative, "PciAU"); Xen_motion, ("restrict_xen_motion", Negative, "XenMotion"); Guest_ip_setting, ("restrict_guest_ip_setting", Negative, "GuestIP"); + AD, ("restrict_ad", Negative, "AD"); ] let name_of_feature f = diff --git a/ocaml/xapi/features.mli b/ocaml/xapi/features.mli index e30116072fc..e887a7cc36e 100644 --- a/ocaml/xapi/features.mli +++ b/ocaml/xapi/features.mli @@ -48,6 +48,7 @@ type feature = | PCI_device_for_auto_update (** Enable making new VMs with the PCI device that triggers Windows Update. *) | Xen_motion (** Enable XenMotion feature *) | Guest_ip_setting (** Enable use of Guest ip seting *) + | AD (** Enable use of Active Directory *) (** Convert RPC into {!feature}s *) val feature_of_rpc : Rpc.t -> feature From d3bc93d58a5d5752362bd9f1b3c01dad76d95714 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Tue, 26 Apr 2016 14:43:31 +0100 Subject: [PATCH 26/69] Undeprecate VM.create Signed-off-by: Rob Hoes --- ocaml/idl/datamodel.ml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 71a45edb960..7a7139b66c5 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -7238,12 +7238,6 @@ let vm = ~lifecycle:[ Published, rel_rio, ""; ] - ~msg_lifecycles:[ - ("create", [ - Published, rel_rio, ""; - Deprecated, rel_dundee, "Use VM.clone, copy or import instead: see description for details."; - ]); - ] ~messages_default_allowed_roles:_R_VM_ADMIN ~messages:[ vm_snapshot; vm_snapshot_with_quiesce; vm_clone; vm_copy; vm_revert; vm_checkpoint; vm_provision; vm_start; vm_start_on; vm_pause; vm_unpause; vm_cleanShutdown;vm_shutdown; From 0bad53c12620cee3d67b3356c48a6a7b1c268188 Mon Sep 17 00:00:00 2001 From: Thomas Sanders Date: Tue, 26 Apr 2016 11:02:21 +0100 Subject: [PATCH 27/69] CA-208614: On pool-join, copy ssl_legacy from master. When a host is about to join a new pool, it tells its soon-to-be new pool-master to create a Host DB entry for it; now the host tells the master to set the Host.ssl_legacy the same as the new master's value (rather than preserving the host's value). Also the host updates its local (non-DB) setting so that on next xapi start (before it contacts the master to query the DB) it will use the new setting. Signed-off-by: Thomas Sanders (cherry picked from commit 1139b9934375f5d9c632f93d5c0a7da93683d766) Signed-off-by: Thomas Sanders --- ocaml/xapi/xapi_pool.ml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index 5ec46f7ca30..f5934a66a75 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -367,6 +367,12 @@ let rec create_or_get_host_on_master __context rpc session_id (host_ref, host) : create_or_get_sr_on_master __context rpc session_id (my_local_cache_sr, my_local_cache_sr_rec) end in + (* Look up the value on the master of the pool we are about to join *) + let master_ssl = Client.Host.get_ssl_legacy ~rpc ~session_id ~self:(get_master rpc session_id) in + (* Set value in inventory (to control initial behaviour on next xapi start) + * but not in the database of the current pool (the one we're about to leave) *) + Xapi_inventory.update Xapi_inventory._stunnel_legacy (string_of_bool master_ssl); + debug "Creating host object on master"; let ref = Client.Host.create ~rpc ~session_id ~uuid:my_uuid @@ -386,7 +392,7 @@ let rec create_or_get_host_on_master __context rpc session_id (host_ref, host) : * been added to the constructor. *) ~local_cache_sr ~chipset_info:host.API.host_chipset_info - ~ssl_legacy:host.API.host_ssl_legacy + ~ssl_legacy:master_ssl in (* Copy other-config into newly created host record: *) From b9e5c926ec599aceabf962b793b20dbbe20d1793 Mon Sep 17 00:00:00 2001 From: Thomas Sanders Date: Tue, 3 May 2016 17:48:44 +0100 Subject: [PATCH 28/69] CA-209875: iLO plugin: TLS-only, set ciphersuites. The iLO plugin was just using the defaults from the M2Crypto python library (which wraps OpenSSL). Now we enforce TLS (no SSL) and specify a list of ciphersuites. Signed-off-by: Thomas Sanders (cherry picked from commit ba612a79e8fe9baeed7eca59a2cbca43705d3dcd) --- scripts/poweron/iLO.py | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/scripts/poweron/iLO.py b/scripts/poweron/iLO.py index 252c7bfadc3..bc74eaa82e4 100644 --- a/scripts/poweron/iLO.py +++ b/scripts/poweron/iLO.py @@ -26,7 +26,18 @@ def iLO(power_on_ip, user, password): xmlWithlogin=getXmlWithLogin(user,password)+'\r\n' ''' Send and receive ''' - ctx = M2Crypto.SSL.Context() + # "tlsv1" means v1.0 only, not 1.1, 1.2 etc. + # It would be nice to specify all protocols ("sslv23") and then use + # options to disable sslv2 and sslv3, but such a Context fails to + # connect to the iLO server if the cipher_list is specified (even + # though the same kind of Context can connect to a XenServer). + ctx = M2Crypto.SSL.Context("tlsv1") + # Setting options just in case. + ctx.set_options( + M2Crypto.m2.SSL_OP_NO_SSLv2 | + M2Crypto.m2.SSL_OP_NO_SSLv3 + ) + ctx.set_cipher_list("!SSLv2:RSA+AES128-SHA256:RSA+AES256-SHA:RSA+AES128-SHA:RSA+RC4-SHA") ctx.set_session_timeout(500) s = M2Crypto.SSL.Connection(ctx) s.set_post_connection_check_callback(None) From b5c7862043d5476fe8a09f65b4b442e99f7638a5 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Fri, 20 May 2016 16:01:50 +0100 Subject: [PATCH 29/69] CP-17414: Add AD feature check to host.enable_external_auth This indirectly applies to pool.enabled_external_auth as well. The feature check is done only if `auth_type = "AD"`. The check is in Message_forwarding, so that it is done on the master, for efficiency. Signed-off-by: Rob Hoes --- ocaml/xapi/message_forwarding.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index b64fc440727..eb2be407513 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -2398,6 +2398,9 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct let enable_external_auth ~__context ~host ~config ~service_name ~auth_type = info "Host.enable_external_auth: host = '%s'; service_name = '%s'; auth_type = '%s'" (host_uuid ~__context host) service_name auth_type; + (* First assert that the AD feature is enabled if AD is requested *) + if auth_type = Extauth.auth_type_AD_Likewise then + Pool_features.assert_enabled ~__context ~f:Features.AD; let local_fn = Local.Host.enable_external_auth ~host ~config ~service_name ~auth_type in do_op_on ~local_fn ~__context ~host (fun session_id rpc -> Client.Host.enable_external_auth rpc session_id host config service_name auth_type) From d84ed5dc371600448bffc28dd3698977c9e9d8a7 Mon Sep 17 00:00:00 2001 From: Rob Hoes Date: Fri, 20 May 2016 16:25:15 +0100 Subject: [PATCH 30/69] CP-17414: Add AD feature check to subject.create If at least one of the hosts uses AD external auth, then assert that the AD feature is enabled. Signed-off-by: Rob Hoes --- ocaml/xapi/xapi_subject.ml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ocaml/xapi/xapi_subject.ml b/ocaml/xapi/xapi_subject.ml index 6430c41b7ad..6e1221ce2ea 100644 --- a/ocaml/xapi/xapi_subject.ml +++ b/ocaml/xapi/xapi_subject.ml @@ -33,6 +33,11 @@ let asynchronously_run_hook_script_after_subject_add = At_least_once_more.make "running after-subject-add hook script" run_hook_script_after_subject_add let create ~__context ~subject_identifier ~other_config = + (* If at least one of the hosts uses AD external auth, then assert that the AD feature is enabled *) + let hosts = Db.Host.get_all ~__context in + let auth_types = List.map (fun self -> Db.Host.get_external_auth_type ~__context ~self) hosts in + if List.exists (fun x -> x = Extauth.auth_type_AD_Likewise) auth_types then + Pool_features.assert_enabled ~__context ~f:Features.AD; (* we need to find if subject is already in the pool *) let subjects = Db.Subject.get_all_records ~__context in From 1955d22e20fdf2e853f5fc318d21b2d40d302b99 Mon Sep 17 00:00:00 2001 From: Phus Lu Date: Wed, 25 May 2016 06:05:43 +0100 Subject: [PATCH 31/69] CA-208537: vdi-copy between local SRs proposes unwanted ciphers Enable TLSv1.2 capability for sparse_dd. Signed-off-by: Phus Lu (cherry picked from commit 5e00eba5ecc783a9de6086fbd4e3759bb05c04e7) Signed-off-by: Phus Lu --- ocaml/xapi/sparse_dd_wrapper.ml | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/ocaml/xapi/sparse_dd_wrapper.ml b/ocaml/xapi/sparse_dd_wrapper.ml index ffa0a357abf..6b69181db07 100644 --- a/ocaml/xapi/sparse_dd_wrapper.ml +++ b/ocaml/xapi/sparse_dd_wrapper.ml @@ -70,8 +70,15 @@ let dd_internal progress_cb base prezeroed infile outfile size = "-machine"; "-src"; infile; "-dest"; outfile; - "-size"; Int64.to_string size - ] @ (if prezeroed then [ "-prezeroed" ] else [] + "-size"; Int64.to_string size; + "-good-ciphersuites"; (match !Xapi_globs.ciphersuites_good_outbound with + | Some s -> s + | None -> raise (Api_errors.Server_error + (Api_errors.internal_error,["Vdi_copy found no good ciphersuites in Xapi_globs."])) + ); + "-legacy-ciphersuites"; !Xapi_globs.ciphersuites_legacy_outbound + ] @ (if Stunnel.is_legacy_protocol_and_ciphersuites_allowed () then [ "-ssl-legacy" ] else [] + ) @ (if prezeroed then [ "-prezeroed" ] else [] ) @ (Opt.default [] (Opt.map (fun x -> [ "-base"; x ]) base)) in debug "%s %s" sparse_dd_path (String.concat " " args); let pid = Forkhelpers.safe_close_and_exec None (Some pipe_write) (Some log_fd) [] From 3f634bf8b65d2656ec537a529121e43d14d8c782 Mon Sep 17 00:00:00 2001 From: Thomas Sanders Date: Fri, 1 Jul 2016 17:02:47 +0100 Subject: [PATCH 32/69] CA-214121: Move gpg pubkeys from xapi-core to -gpg-keys Also mark them %config(noreplace) in the RPM specfile, and include the new xapi-gpg-keys package on the installation ISO. This means that future upgrades of the xapi-core package will not do anything to these gpg key-related files. Unfortunately the first upgrade from the original Dundee xapi-core will delete the files though, so if they need to be preserved then this must be handled separately. Signed-off-by: Thomas Sanders (cherry picked from commit 9269963c72ad679e34727ca9067a851f8d535c7e) --- mk/Makefile | 1 + xapi.spec.in | 17 ++++++++++++++--- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/mk/Makefile b/mk/Makefile index 1062047458f..3185b29cff5 100644 --- a/mk/Makefile +++ b/mk/Makefile @@ -86,6 +86,7 @@ $(OUTPUT_CLI_RT) $(OUTPUT_SDK): $(MY_MAIN_PACKAGES)/.dirstamp $(RPM_DIRECTORIES) cp $(RPM_RPMSDIR)/$(DOMAIN0_ARCH_OPTIMIZED)/xapi-tests-*.rpm $(MY_MAIN_PACKAGES) cp $(RPM_RPMSDIR)/*/xapi-www-*.rpm $(MY_MAIN_PACKAGES) cp $(RPM_RPMSDIR)/$(DOMAIN0_ARCH_OPTIMIZED)/xapi-xe-*.rpm $(MY_MAIN_PACKAGES) + cp $(RPM_RPMSDIR)/$(DOMAIN0_ARCH_OPTIMIZED)/xapi-gpg-keys-*.rpm $(MY_MAIN_PACKAGES) .PHONY: clean clean: diff --git a/xapi.spec.in b/xapi.spec.in index 32c1ab45420..a728574c3a6 100644 --- a/xapi.spec.in +++ b/xapi.spec.in @@ -75,6 +75,15 @@ BuildRequires: systemd %description core This package contains the xapi toolstack. +%package gpg-keys +Summary: gpg public keyring and trust DB +Group: System/Hypervisor + +%description gpg-keys +GPG public keyring (and trust DB) used for verifying the +signatures of hotfix packages and of file-based licences. +(There is also an empty private keyring.) + %package xe Summary: The xapi toolstack CLI Group: System/Hypervisor @@ -242,9 +251,6 @@ rm -rf $RPM_BUILD_ROOT @OPTDIR@/bin/xe-enable-ipv6 /etc/bash_completion.d/xe-switch-network-backend @OPTDIR@/bin/xsh -@OPTDIR@/gpg/pubring.gpg -@OPTDIR@/gpg/secring.gpg -@OPTDIR@/gpg/trustdb.gpg /etc/xensource/bugtool/xapi.xml /etc/xensource/bugtool/xapi/stuff.xml /etc/xensource/bugtool/xenopsd.xml @@ -321,6 +327,11 @@ rm -rf $RPM_BUILD_ROOT /usr/bin/xe /etc/bash_completion.d/xe +%files gpg-keys +%config(noreplace) @OPTDIR@/gpg/pubring.gpg +%config(noreplace) @OPTDIR@/gpg/secring.gpg +%config(noreplace) @OPTDIR@/gpg/trustdb.gpg + %files tests %defattr(-,root,root,-) @OPTDIR@/debug/cli-rt-domu-shar.sh From 876bc760bab0442cf3218b02169f2b45ec3899cf Mon Sep 17 00:00:00 2001 From: Phus Lu Date: Mon, 11 Jul 2016 12:36:48 +0100 Subject: [PATCH 33/69] CA-208537: Revert "CA-208537: vdi-copy between local SRs proposes unwanted ciphers" This reverts commit 1955d22e20fdf2e853f5fc318d21b2d40d302b99. For Jiffy hotfix --- ocaml/xapi/sparse_dd_wrapper.ml | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/ocaml/xapi/sparse_dd_wrapper.ml b/ocaml/xapi/sparse_dd_wrapper.ml index 6b69181db07..ffa0a357abf 100644 --- a/ocaml/xapi/sparse_dd_wrapper.ml +++ b/ocaml/xapi/sparse_dd_wrapper.ml @@ -70,15 +70,8 @@ let dd_internal progress_cb base prezeroed infile outfile size = "-machine"; "-src"; infile; "-dest"; outfile; - "-size"; Int64.to_string size; - "-good-ciphersuites"; (match !Xapi_globs.ciphersuites_good_outbound with - | Some s -> s - | None -> raise (Api_errors.Server_error - (Api_errors.internal_error,["Vdi_copy found no good ciphersuites in Xapi_globs."])) - ); - "-legacy-ciphersuites"; !Xapi_globs.ciphersuites_legacy_outbound - ] @ (if Stunnel.is_legacy_protocol_and_ciphersuites_allowed () then [ "-ssl-legacy" ] else [] - ) @ (if prezeroed then [ "-prezeroed" ] else [] + "-size"; Int64.to_string size + ] @ (if prezeroed then [ "-prezeroed" ] else [] ) @ (Opt.default [] (Opt.map (fun x -> [ "-base"; x ]) base)) in debug "%s %s" sparse_dd_path (String.concat " " args); let pid = Forkhelpers.safe_close_and_exec None (Some pipe_write) (Some log_fd) [] From 9fbf4939235f8f6d98b6cb71e58e8bdfe95ad413 Mon Sep 17 00:00:00 2001 From: Jonathan Davies Date: Mon, 4 Jul 2016 20:08:37 +0000 Subject: [PATCH 34/69] CA-214975: don't reset VDIs on assume-failed Since xapi's DB GC's logic to determine whether a host has failed takes a while to see the first heartbeat from each host, it calls the host-post-declare-scripts with reason="assume-failed" on each host. This means that the "assume-failed" logic is called for every slave after every toolstack start on the master. Even if "assume-failed" is used on appropriate occasions, resetting the VDIs is still dangerous because any VMs running on a slave will be treated as not being attached, which can cause the SM layer to make invalid assumptions, possibly leading to data loss and corruption. Signed-off-by: Jonathan Davies Signed-off-by: Jon Ludlam Reviewed-by: Alex Brett --- scripts/10resetvdis | 1 - 1 file changed, 1 deletion(-) diff --git a/scripts/10resetvdis b/scripts/10resetvdis index c5cef8662fc..fb8303420a0 100755 --- a/scripts/10resetvdis +++ b/scripts/10resetvdis @@ -28,7 +28,6 @@ case "$REASON" in reset ;; assume-failed) - reset ;; clean-shutdown) ;; From 7bcf0fbcc10bff90b65168ad85524febfca0c341 Mon Sep 17 00:00:00 2001 From: John Else Date: Fri, 29 Apr 2016 15:03:25 +0100 Subject: [PATCH 35/69] CA-209507: Clean up VGPU.scheduled_to_be_resident_on if VM.start fails Without this, the VGPU will be (incorrectly) accounted for in PGPU free space calculations, even though the VM is not running or starting up. Signed-off-by: John Else --- ocaml/xapi/message_forwarding.ml | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index eb2be407513..695370f4555 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -873,8 +873,12 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct (fun () -> finally_clear_host_operation ~__context ~host:suitable_host ?host_op (); (* In certain cases, VM might have been destroyed as a consequence of operation *) - if Db.is_valid_ref __context vm then - Db.VM.set_scheduled_to_be_resident_on ~__context ~self:vm ~value:Ref.null)) + if Db.is_valid_ref __context vm then begin + Db.VM.set_scheduled_to_be_resident_on ~__context ~self:vm ~value:Ref.null; + List.iter + (fun vgpu -> Db.VGPU.set_scheduled_to_be_resident_on ~__context ~self:vgpu ~value:Ref.null) + (Db.VM.get_VGPUs ~__context ~self:vm) + end)) (* Used by VM.start_on, VM.resume_on, VM.migrate to verify a host has enough resource and to 'allocate_vm_to_host' (ie set the 'scheduled_to_be_resident_on' field) *) @@ -892,7 +896,10 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct Helpers.with_global_lock (fun () -> finally_clear_host_operation ~__context ~host ?host_op (); - Db.VM.set_scheduled_to_be_resident_on ~__context ~self:vm ~value:Ref.null)) + Db.VM.set_scheduled_to_be_resident_on ~__context ~self:vm ~value:Ref.null; + List.iter + (fun vgpu -> Db.VGPU.set_scheduled_to_be_resident_on ~__context ~self:vgpu ~value:Ref.null) + (Db.VM.get_VGPUs ~__context ~self:vm))) (** Used by VM.set_memory_dynamic_range to reserve enough memory for From efba18b083157f3326597bdbb9303a9425e1db07 Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 3 May 2016 17:49:38 +0100 Subject: [PATCH 36/69] CA-209507: Pull out duplicated code into a function Signed-off-by: John Else --- ocaml/xapi/message_forwarding.ml | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 695370f4555..7579257ce6e 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -853,6 +853,16 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct choose_host_for_vm. *) + (* Clear scheduled_to_be_resident_on for a VM and all its vGPUs. *) + let clear_scheduled_to_be_resident_on ~__context ~vm = + Db.VM.set_scheduled_to_be_resident_on ~__context ~self:vm ~value:Ref.null; + List.iter + (fun vgpu -> + Db.VGPU.set_scheduled_to_be_resident_on ~__context + ~self:vgpu + ~value:Ref.null) + (Db.VM.get_VGPUs ~__context ~self:vm) + (* Used by VM.start and VM.resume to choose a host with enough resource and to 'allocate_vm_to_host' (ie set the 'scheduled_to_be_resident_on' field) *) let forward_to_suitable_host ~local_fn ~__context ~vm ~snapshot ?host_op op = @@ -873,12 +883,8 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct (fun () -> finally_clear_host_operation ~__context ~host:suitable_host ?host_op (); (* In certain cases, VM might have been destroyed as a consequence of operation *) - if Db.is_valid_ref __context vm then begin - Db.VM.set_scheduled_to_be_resident_on ~__context ~self:vm ~value:Ref.null; - List.iter - (fun vgpu -> Db.VGPU.set_scheduled_to_be_resident_on ~__context ~self:vgpu ~value:Ref.null) - (Db.VM.get_VGPUs ~__context ~self:vm) - end)) + if Db.is_valid_ref __context vm + then clear_scheduled_to_be_resident_on ~__context ~vm)) (* Used by VM.start_on, VM.resume_on, VM.migrate to verify a host has enough resource and to 'allocate_vm_to_host' (ie set the 'scheduled_to_be_resident_on' field) *) @@ -896,10 +902,7 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct Helpers.with_global_lock (fun () -> finally_clear_host_operation ~__context ~host ?host_op (); - Db.VM.set_scheduled_to_be_resident_on ~__context ~self:vm ~value:Ref.null; - List.iter - (fun vgpu -> Db.VGPU.set_scheduled_to_be_resident_on ~__context ~self:vgpu ~value:Ref.null) - (Db.VM.get_VGPUs ~__context ~self:vm))) + clear_scheduled_to_be_resident_on ~__context ~vm)) (** Used by VM.set_memory_dynamic_range to reserve enough memory for From 07b784460cea50d1e821a4ba6697be616d315ba9 Mon Sep 17 00:00:00 2001 From: John Else Date: Fri, 29 Apr 2016 13:03:44 +0100 Subject: [PATCH 37/69] gpumon: Fix pattern match ambiguity Make sure threads call register_thread. Previously this was only called by threads entering the critical section after the first. Signed-off-by: John Else --- ocaml/xapi/xapi_gpumon.ml | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/ocaml/xapi/xapi_gpumon.ml b/ocaml/xapi/xapi_gpumon.ml index d9d25b00ba7..c790e2fec4e 100644 --- a/ocaml/xapi/xapi_gpumon.ml +++ b/ocaml/xapi/xapi_gpumon.ml @@ -83,10 +83,12 @@ let with_gpumon_stopped ~f = (* Stop gpumon if it's running, then register this thread. *) Mutex.execute m (fun () -> - match get_pid (), !restart_gpumon with - | Some pid, _ -> (restart_gpumon := Some true; stop ()) - | None, None -> restart_gpumon := Some false - | None, _ -> (); + begin + match get_pid (), !restart_gpumon with + | Some pid, _ -> (restart_gpumon := Some true; stop ()) + | None, None -> restart_gpumon := Some false + | None, _ -> () + end; register_thread thread_id); Pervasiveext.finally f From e2636aaf1acba6fe1bc706e97cb48d8ec0f241ab Mon Sep 17 00:00:00 2001 From: John Else Date: Fri, 29 Apr 2016 14:48:13 +0100 Subject: [PATCH 38/69] Use polymorphic variant to track gpumon's state No semantic change, but the code should hopefully be a bit clearer. Signed-off-by: John Else --- ocaml/xapi/xapi_gpumon.ml | 38 +++++++++++++++++++++----------------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/ocaml/xapi/xapi_gpumon.ml b/ocaml/xapi/xapi_gpumon.ml index c790e2fec4e..d0d6a8e6cf2 100644 --- a/ocaml/xapi/xapi_gpumon.ml +++ b/ocaml/xapi/xapi_gpumon.ml @@ -59,34 +59,38 @@ let are_threads_registered () = let state = !registered_threads in not (IntSet.is_empty state) -(* None - * - means no threads which require gpumon to be stopped are running. - * Some true - * - means gpumon must be started when the last thread - * leaves with_gpumon_stopped. - * Some false - * - means gpumon should not be started when the last thread - * leaves with_gpumon_stopped. *) -let restart_gpumon = ref None +(* + * `unmanaged + * - no threads which care about the state of gpumon are running + * `should_start + * - gpumon should be started when the last thread exits with_gpumon_stopped + * `should_not_start + * - gpumon should not be started when the last thread exits with_gpumon_stopped +*) +let gpumon_state : [ + `unmanaged | + `should_start | + `should_not_start +] ref = ref `unmanaged let m = Mutex.create () (* gpumon must be stopped while any thread is running the function f * passed to this function. * * The first thread to enter this function will stop gpumon if it is running, - * and set the restart_gpumon flag accordingly. + * and set the gpumon_state flag accordingly. * * The last thread to leave this function will start gpumon, if - * restart_gpumon is set to Some true. *) + * gpumon_state is set to `should_start. *) let with_gpumon_stopped ~f = let thread_id = Thread.(id (self ())) in (* Stop gpumon if it's running, then register this thread. *) Mutex.execute m (fun () -> begin - match get_pid (), !restart_gpumon with - | Some pid, _ -> (restart_gpumon := Some true; stop ()) - | None, None -> restart_gpumon := Some false + match get_pid (), !gpumon_state with + | Some pid, _ -> (gpumon_state := `should_start; stop ()) + | None, `unmanaged -> gpumon_state := `should_not_start | None, _ -> () end; register_thread thread_id); @@ -98,7 +102,7 @@ let with_gpumon_stopped ~f = Mutex.execute m (fun () -> deregister_thread thread_id; - match are_threads_registered (), !restart_gpumon with + match are_threads_registered (), !gpumon_state with | true, _ -> () - | false, Some true -> (start (); restart_gpumon := None) - | false, _ -> restart_gpumon := None)) + | false, `should_start -> (start (); gpumon_state := `unmanaged) + | false, _ -> gpumon_state := `unmanaged)) From abf02ccdb12539ebf6aa80178d22e3bed30f1c07 Mon Sep 17 00:00:00 2001 From: John Else Date: Fri, 29 Apr 2016 15:21:36 +0100 Subject: [PATCH 39/69] Make use of some OCaml 4.* functions Signed-off-by: John Else --- ocaml/xapi/xapi_gpumon.ml | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/ocaml/xapi/xapi_gpumon.ml b/ocaml/xapi/xapi_gpumon.ml index d0d6a8e6cf2..11234812b04 100644 --- a/ocaml/xapi/xapi_gpumon.ml +++ b/ocaml/xapi/xapi_gpumon.ml @@ -15,8 +15,6 @@ module D = Debug.Make(struct let name="xapi" end) open D -open Fun -open Xstringext open Threadext let service = "/sbin/service" @@ -26,9 +24,8 @@ let pidfile = "/var/run/xcp-rrdd-gpumon.pid" let get_pid () = try let pid = - (* TODO: Use String.trim when porting this to OCaml 4.x *) Unixext.string_of_file pidfile - |> String.strip String.isspace + |> String.trim |> int_of_string in Unix.kill pid 0; From 77a48058f11cae600c78c105065942dede0c3ca8 Mon Sep 17 00:00:00 2001 From: John Else Date: Fri, 29 Apr 2016 16:36:03 +0100 Subject: [PATCH 40/69] Add generic Daemon_manager module Signed-off-by: John Else --- ocaml/xapi/OMakefile | 1 + ocaml/xapi/daemon_manager.ml | 90 +++++++++++++++++++++++++++++++++++ ocaml/xapi/daemon_manager.mli | 50 +++++++++++++++++++ 3 files changed, 141 insertions(+) create mode 100644 ocaml/xapi/daemon_manager.ml create mode 100644 ocaml/xapi/daemon_manager.mli diff --git a/ocaml/xapi/OMakefile b/ocaml/xapi/OMakefile index 0c9ca823313..26b0f412ca5 100644 --- a/ocaml/xapi/OMakefile +++ b/ocaml/xapi/OMakefile @@ -68,6 +68,7 @@ XAPI_MODULES = $(COMMON) \ network \ ../util/table \ balloon \ + daemon_manager \ map_check \ system_domains \ local_work_queue \ diff --git a/ocaml/xapi/daemon_manager.ml b/ocaml/xapi/daemon_manager.ml new file mode 100644 index 00000000000..0c3948a0e68 --- /dev/null +++ b/ocaml/xapi/daemon_manager.ml @@ -0,0 +1,90 @@ +(* + * Copyright (C) Citrix Systems Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +open Threadext + +module IntSet = Set.Make(struct type t = int let compare = compare end) + +type daemon_check = + | Pidfile of string + | Function of (unit -> bool) + +type daemon_state = [ + `unmanaged | + `should_start | + `should_not_start +] + +module type DAEMON = sig + val check : daemon_check + + val start : unit -> unit + + val stop : unit -> unit +end + +module Make(D : DAEMON) = struct + let registered_threads = ref IntSet.empty + + let register_thread id = + let registered = !registered_threads in + registered_threads := (IntSet.add id registered) + + let deregister_thread id = + let registered = !registered_threads in + registered_threads := (IntSet.remove id registered) + + let are_threads_registered () = + let registered = !registered_threads in + not (IntSet.is_empty registered) + + let daemon_state : daemon_state ref = ref `unmanaged + let m = Mutex.create () + + let is_running () = + match D.check with + | Pidfile file -> begin + try + let pid = Unixext.string_of_file file |> String.trim |> int_of_string in + Unix.kill pid 0; + true + with _ -> false + end + | Function f -> f () + + let with_daemon_stopped f = + let thread_id = Thread.(id (self ())) in + (* Stop the daemon if it's running, then register this thread. *) + Mutex.execute m + (fun () -> + begin + match is_running (), !daemon_state with + | true, _ -> (daemon_state := `should_start; D.stop ()) + | false, `unmanaged -> daemon_state := `should_not_start + | false, _ -> () + end; + register_thread thread_id); + Pervasiveext.finally + f + (* Deregister this thread, and if there are no more threads registered, + * start the daemon if it was running in the first place. *) + (fun () -> + Mutex.execute m + (fun () -> + deregister_thread thread_id; + match are_threads_registered (), !daemon_state with + | true, _ -> () + | false, `should_start -> (D.start (); daemon_state := `unmanaged) + | false, _ -> daemon_state := `unmanaged)) +end diff --git a/ocaml/xapi/daemon_manager.mli b/ocaml/xapi/daemon_manager.mli new file mode 100644 index 00000000000..0c56d75357c --- /dev/null +++ b/ocaml/xapi/daemon_manager.mli @@ -0,0 +1,50 @@ +(* + * Copyright (C) Citrix Systems Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +type daemon_check = + | Pidfile of string + (** Check whether the daemon is running by reading a pidfile, and checking + that the PID points to a running process. *) + | Function of (unit -> bool) + (** Generic user-defined check, *) + +type daemon_state = [ + `unmanaged | + (** No threads which care about the state of the daemon are running. *) + `should_start | + (** Daemon should be started when the last thread exits + with_daemon_stopped. *) + `should_not_start + (** Daemon should not be started when the last thread exits + with_daemon_stopped. *) +] +(** Tristate value for representing the state of a daemon we want to manage. *) + +module type DAEMON = sig + val check : daemon_check + (** A way to check whether the daemon is running. *) + + val start : unit -> unit + (** Function which will start the daemon. *) + + val stop : unit -> unit + (** Function which will stop the daemon. *) +end + +module Make : functor (D : DAEMON) -> sig + val with_daemon_stopped : (unit -> 'a) -> 'a + (** If the daemon is running, stop it while [f] runs and restart it once [f] + has returned. If multiple threads call [with_daemon_stopped] in parallel, + the daemon will not be restarted until all threads have left [f]. *) +end From 2744c968acc6001b39407da2f22238b9ff17cca3 Mon Sep 17 00:00:00 2001 From: John Else Date: Fri, 29 Apr 2016 17:01:35 +0100 Subject: [PATCH 41/69] Make Xapi_gpumon use Daemon_manager Signed-off-by: John Else --- ocaml/xapi/xapi_gpumon.ml | 91 +++++--------------------------------- ocaml/xapi/xapi_gpumon.mli | 2 +- ocaml/xapi/xapi_vm.ml | 2 +- 3 files changed, 12 insertions(+), 83 deletions(-) diff --git a/ocaml/xapi/xapi_gpumon.ml b/ocaml/xapi/xapi_gpumon.ml index 11234812b04..8e12660824f 100644 --- a/ocaml/xapi/xapi_gpumon.ml +++ b/ocaml/xapi/xapi_gpumon.ml @@ -15,91 +15,20 @@ module D = Debug.Make(struct let name="xapi" end) open D -open Threadext - let service = "/sbin/service" let gpumon = "xcp-rrdd-gpumon" let pidfile = "/var/run/xcp-rrdd-gpumon.pid" -let get_pid () = - try - let pid = - Unixext.string_of_file pidfile - |> String.trim - |> int_of_string - in - Unix.kill pid 0; - Some pid - with _ -> - None - -let start () = - debug "Starting %s" gpumon; - ignore (Forkhelpers.execute_command_get_output service [gpumon; "start"]) - -let stop () = - debug "Stopping %s" gpumon; - ignore (Forkhelpers.execute_command_get_output service [gpumon; "stop"]) - -module IntSet = Set.Make(struct type t = int let compare = compare end) -let registered_threads = ref IntSet.empty - -let register_thread id = - let state = !registered_threads in - registered_threads := (IntSet.add id state) +module Gpumon = Daemon_manager.Make(struct + let check = Daemon_manager.Pidfile pidfile -let deregister_thread id = - let state = !registered_threads in - registered_threads := (IntSet.remove id state) + let start () = + debug "Starting %s" gpumon; + ignore (Forkhelpers.execute_command_get_output service [gpumon; "start"]) -let are_threads_registered () = - let state = !registered_threads in - not (IntSet.is_empty state) + let stop () = + debug "Stopping %s" gpumon; + ignore (Forkhelpers.execute_command_get_output service [gpumon; "stop"]) +end) -(* - * `unmanaged - * - no threads which care about the state of gpumon are running - * `should_start - * - gpumon should be started when the last thread exits with_gpumon_stopped - * `should_not_start - * - gpumon should not be started when the last thread exits with_gpumon_stopped -*) -let gpumon_state : [ - `unmanaged | - `should_start | - `should_not_start -] ref = ref `unmanaged -let m = Mutex.create () - -(* gpumon must be stopped while any thread is running the function f - * passed to this function. - * - * The first thread to enter this function will stop gpumon if it is running, - * and set the gpumon_state flag accordingly. - * - * The last thread to leave this function will start gpumon, if - * gpumon_state is set to `should_start. *) -let with_gpumon_stopped ~f = - let thread_id = Thread.(id (self ())) in - (* Stop gpumon if it's running, then register this thread. *) - Mutex.execute m - (fun () -> - begin - match get_pid (), !gpumon_state with - | Some pid, _ -> (gpumon_state := `should_start; stop ()) - | None, `unmanaged -> gpumon_state := `should_not_start - | None, _ -> () - end; - register_thread thread_id); - Pervasiveext.finally - f - (* Deregister this thread, and if there are no more threads registered, - * start gpumon if it was running in the first place. *) - (fun () -> - Mutex.execute m - (fun () -> - deregister_thread thread_id; - match are_threads_registered (), !gpumon_state with - | true, _ -> () - | false, `should_start -> (start (); gpumon_state := `unmanaged) - | false, _ -> gpumon_state := `unmanaged)) +let with_gpumon_stopped = Gpumon.with_daemon_stopped diff --git a/ocaml/xapi/xapi_gpumon.mli b/ocaml/xapi/xapi_gpumon.mli index edb5ba41b4c..622738d221a 100644 --- a/ocaml/xapi/xapi_gpumon.mli +++ b/ocaml/xapi/xapi_gpumon.mli @@ -14,4 +14,4 @@ (** Stop gpumon if it's running, perform f, then start gpumon if * no other threads which require gpumon to be stopped are running. *) -val with_gpumon_stopped : f:(unit -> 'a) -> 'a +val with_gpumon_stopped : (unit -> 'a) -> 'a diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 5b162f64b6d..0558bb8713e 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -216,7 +216,7 @@ let start ~__context ~vm ~start_paused ~force = | [] -> Xapi_xenops.start ~__context ~self:vm start_paused | _ -> Xapi_gpumon.with_gpumon_stopped - ~f:(fun () -> Xapi_xenops.start ~__context ~self:vm start_paused) + (fun () -> Xapi_xenops.start ~__context ~self:vm start_paused) end; Xapi_vm_helpers.start_delay ~__context ~vm From 2105b8f3e4ac2308e64c8c93a4906fc394ef7e00 Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 3 May 2016 11:27:10 +0100 Subject: [PATCH 42/69] Add tests for Daemon_manager Signed-off-by: John Else --- ocaml/test/OMakefile | 1 + ocaml/test/suite.ml | 1 + ocaml/test/test_daemon_manager.ml | 106 ++++++++++++++++++++++++++++++ 3 files changed, 108 insertions(+) create mode 100644 ocaml/test/test_daemon_manager.ml diff --git a/ocaml/test/OMakefile b/ocaml/test/OMakefile index da32cff0853..01d34d51a2d 100644 --- a/ocaml/test/OMakefile +++ b/ocaml/test/OMakefile @@ -33,6 +33,7 @@ OCAML_OBJS = \ test_helpers \ test_datamodel_utils \ test_db_lowlevel \ + test_daemon_manager \ test_http \ test_pool_db_backup \ test_xapi_db_upgrade \ diff --git a/ocaml/test/suite.ml b/ocaml/test/suite.ml index 5d939866e4a..4a42b97e2e9 100644 --- a/ocaml/test/suite.ml +++ b/ocaml/test/suite.ml @@ -24,6 +24,7 @@ let base_suite = Test_helpers.test; Test_datamodel_utils.test; Test_db_lowlevel.test; + Test_daemon_manager.test; Test_http.test; Test_pool_db_backup.test; Test_xapi_db_upgrade.test; diff --git a/ocaml/test/test_daemon_manager.ml b/ocaml/test/test_daemon_manager.ml new file mode 100644 index 00000000000..876a9c363c5 --- /dev/null +++ b/ocaml/test/test_daemon_manager.ml @@ -0,0 +1,106 @@ +(* + * Copyright (C) Citrix Systems Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +open OUnit + +module Mock_daemon = struct + let running = ref true + + let times_called_start = ref 0 + let times_called_stop = ref 0 + + let reset ~is_running = + running := is_running; + times_called_start := 0; + times_called_stop := 0 + + let check = Daemon_manager.Function (fun () -> !running) + + let start () = + incr times_called_start; + running := true + + let stop () = + incr times_called_stop; + running := false +end + +module Mock_manager = Daemon_manager.Make(Mock_daemon) + +(* Test that the daemon is restarted, and that the return value of the function + passed to with_daemon_stopped is propagated. *) +let test_basic_operation () = + Mock_daemon.reset ~is_running:true; + let result = Mock_manager.with_daemon_stopped (fun () -> 123) in + assert_equal result 123; + assert_equal !Mock_daemon.times_called_start 1; + assert_equal !Mock_daemon.times_called_stop 1 + +(* Two sequential calls to with_daemon_stopped should restart the daemon + twice. *) +let test_two_restarts () = + Mock_daemon.reset ~is_running:true; + Mock_manager.with_daemon_stopped (fun () -> ()); + Mock_manager.with_daemon_stopped (fun () -> ()); + assert_equal !Mock_daemon.times_called_start 2; + assert_equal !Mock_daemon.times_called_stop 2 + +(* Test that if the daemon is stopped, calling with_daemon_stopped does not + attempt to stop or start it. *) +let test_already_stopped () = + Mock_daemon.reset ~is_running:false; + let result = Mock_manager.with_daemon_stopped (fun () -> 123) in + assert_equal result 123; + assert_equal !Mock_daemon.times_called_start 0; + assert_equal !Mock_daemon.times_called_stop 0 + +(* Test that an exception is propagated by with_daemon_stopped. *) +let test_exception () = + Mock_daemon.reset ~is_running:true; + assert_raises (Failure "fail") + (fun () -> Mock_manager.with_daemon_stopped (fun () -> failwith "fail")); + assert_equal !Mock_daemon.times_called_start 1; + assert_equal !Mock_daemon.times_called_stop 1 + +let spawn_threads_and_wait task count = + let rec spawn_threads task count acc = + if count > 0 then begin + let thread = Thread.create task () in + spawn_threads task (count - 1) (thread :: acc) + end + else acc + in + spawn_threads task count [] + |> List.iter Thread.join + +(* Run with_daemon_stopped multiple times in parallel. The daemon should only + be restarted once. *) +let test_threads () = + Mock_daemon.reset ~is_running:true; + let delay_thread () = + Mock_manager.with_daemon_stopped (fun () -> Thread.delay 5.0) + in + spawn_threads_and_wait delay_thread 5; + assert_equal !Mock_daemon.times_called_start 1; + assert_equal !Mock_daemon.times_called_stop 1 + +let test = + "daemon_manager" >::: + [ + "test_basic_operation" >:: test_basic_operation; + "test_two_restarts" >:: test_two_restarts; + "test_already_stopped" >:: test_already_stopped; + "test_exception" >:: test_exception; + "test_threads" >:: test_threads; + ] From ee7e9c73906c6ec4c93eb4fabfc1962b24c1a828 Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 10 May 2016 17:03:50 +0100 Subject: [PATCH 43/69] Add timeout support to Daemon_manager Signed-off-by: John Else --- ocaml/xapi/daemon_manager.ml | 21 ++++++++++++++++++--- ocaml/xapi/daemon_manager.mli | 9 +++++++-- ocaml/xapi/xapi_gpumon.mli | 2 +- 3 files changed, 26 insertions(+), 6 deletions(-) diff --git a/ocaml/xapi/daemon_manager.ml b/ocaml/xapi/daemon_manager.ml index 0c3948a0e68..8cce227dfc8 100644 --- a/ocaml/xapi/daemon_manager.ml +++ b/ocaml/xapi/daemon_manager.ml @@ -63,14 +63,29 @@ module Make(D : DAEMON) = struct end | Function f -> f () - let with_daemon_stopped f = + let start = D.start + + let stop ?timeout () = + match timeout with + | Some t -> begin + let start = Unix.gettimeofday () in + try D.stop () + with e -> + while (Unix.gettimeofday () -. start < t) && (is_running ()) do + Thread.delay 1.0 + done; + if is_running () then raise e + end + | None -> D.stop () + + let with_daemon_stopped ?timeout f = let thread_id = Thread.(id (self ())) in (* Stop the daemon if it's running, then register this thread. *) Mutex.execute m (fun () -> begin match is_running (), !daemon_state with - | true, _ -> (daemon_state := `should_start; D.stop ()) + | true, _ -> (daemon_state := `should_start; stop ?timeout ()) | false, `unmanaged -> daemon_state := `should_not_start | false, _ -> () end; @@ -85,6 +100,6 @@ module Make(D : DAEMON) = struct deregister_thread thread_id; match are_threads_registered (), !daemon_state with | true, _ -> () - | false, `should_start -> (D.start (); daemon_state := `unmanaged) + | false, `should_start -> (start (); daemon_state := `unmanaged) | false, _ -> daemon_state := `unmanaged)) end diff --git a/ocaml/xapi/daemon_manager.mli b/ocaml/xapi/daemon_manager.mli index 0c56d75357c..dc611826f91 100644 --- a/ocaml/xapi/daemon_manager.mli +++ b/ocaml/xapi/daemon_manager.mli @@ -43,8 +43,13 @@ module type DAEMON = sig end module Make : functor (D : DAEMON) -> sig - val with_daemon_stopped : (unit -> 'a) -> 'a + val with_daemon_stopped : ?timeout:float -> (unit -> 'a) -> 'a (** If the daemon is running, stop it while [f] runs and restart it once [f] has returned. If multiple threads call [with_daemon_stopped] in parallel, - the daemon will not be restarted until all threads have left [f]. *) + the daemon will not be restarted until all threads have left [f]. + + If the time out is set, [with_daemon_stopped] will catch any exceptions + from [stop ()] and keep checking whether the daemon is running, until the + timeout expires. If the daemon is still running after the timeout, the + original exception will be thrown. *) end diff --git a/ocaml/xapi/xapi_gpumon.mli b/ocaml/xapi/xapi_gpumon.mli index 622738d221a..b91c38a81b3 100644 --- a/ocaml/xapi/xapi_gpumon.mli +++ b/ocaml/xapi/xapi_gpumon.mli @@ -14,4 +14,4 @@ (** Stop gpumon if it's running, perform f, then start gpumon if * no other threads which require gpumon to be stopped are running. *) -val with_gpumon_stopped : (unit -> 'a) -> 'a +val with_gpumon_stopped : ?timeout:float -> (unit -> 'a) -> 'a From 55d9b72faf1764d7415f09d59e41b8a069a814d3 Mon Sep 17 00:00:00 2001 From: John Else Date: Wed, 11 May 2016 14:06:55 +0100 Subject: [PATCH 44/69] Add tests for timeout handling Signed-off-by: John Else --- ocaml/test/test_daemon_manager.ml | 52 ++++++++++++++++++++++++++++++- 1 file changed, 51 insertions(+), 1 deletion(-) diff --git a/ocaml/test/test_daemon_manager.ml b/ocaml/test/test_daemon_manager.ml index 876a9c363c5..2be83d96c7d 100644 --- a/ocaml/test/test_daemon_manager.ml +++ b/ocaml/test/test_daemon_manager.ml @@ -14,14 +14,25 @@ open OUnit +type stop_failure = { + error: exn; + (** The exception thrown when trying to stop the daemon. *) + time_until_stopped: float; + (** The mock daemon will be marked as not running [t] seconds after the + exception is thrown. *) +} + module Mock_daemon = struct let running = ref true + let stop_failure : stop_failure option ref = ref None + let times_called_start = ref 0 let times_called_stop = ref 0 let reset ~is_running = running := is_running; + stop_failure := None; times_called_start := 0; times_called_stop := 0 @@ -33,7 +44,21 @@ module Mock_daemon = struct let stop () = incr times_called_stop; - running := false + match !stop_failure with + | Some {error; time_until_stopped} -> begin + (* Raise the exception after spawning a thread which will set running to + false after a specified time. *) + let (_: Thread.t) = + Thread.create + (fun () -> + Thread.delay time_until_stopped; + running := false) + () + in + raise error + end + | None -> + running := false end module Mock_manager = Daemon_manager.Make(Mock_daemon) @@ -95,6 +120,29 @@ let test_threads () = assert_equal !Mock_daemon.times_called_start 1; assert_equal !Mock_daemon.times_called_stop 1 +(* The daemon initially fails to stop, but it stops within the timeout. *) +let test_timeout_succeed () = + Mock_daemon.reset ~is_running:true; + Mock_daemon.stop_failure := Some { + error = Failure "stop failed"; + time_until_stopped = 2.0; + }; + Mock_manager.with_daemon_stopped ~timeout:5.0 (fun () -> ()); + assert_equal !Mock_daemon.times_called_start 1; + assert_equal !Mock_daemon.times_called_stop 1 + +(* The daemon does not stop within the timeout, so the exception is raised. *) +let test_timeout_fail () = + Mock_daemon.reset ~is_running:true; + Mock_daemon.stop_failure := Some { + error = Failure "stop failed"; + time_until_stopped = 5.0; + }; + assert_raises (Failure "stop failed") + (fun () -> Mock_manager.with_daemon_stopped ~timeout:2.0 (fun () -> ())); + assert_equal !Mock_daemon.times_called_start 0; + assert_equal !Mock_daemon.times_called_stop 1 + let test = "daemon_manager" >::: [ @@ -103,4 +151,6 @@ let test = "test_already_stopped" >:: test_already_stopped; "test_exception" >:: test_exception; "test_threads" >:: test_threads; + "test_timeout_succeed" >:: test_timeout_succeed; + "test_timeout_fail" >:: test_timeout_fail; ] From af9b2d0a91f95a48bbbfdf0d28b8072773dc0e18 Mon Sep 17 00:00:00 2001 From: John Else Date: Wed, 11 May 2016 14:29:05 +0100 Subject: [PATCH 45/69] CA-209508: Use timeout when attempting to stop gpumon Signed-off-by: John Else --- ocaml/xapi/xapi_globs.ml | 5 +++++ ocaml/xapi/xapi_vm.ml | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index beaaf0d491f..d0357658e50 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/ocaml/xapi/xapi_globs.ml @@ -909,6 +909,8 @@ let default_xenopsd = ref "org.xen.xapi.xenops.xenlight" let ciphersuites_good_outbound = ref None let ciphersuites_legacy_outbound = ref "" +let gpumon_stop_timeout = ref 60.0 + (* Fingerprint of default patch key *) let citrix_patch_key = "NERDNTUzMDMwRUMwNDFFNDI4N0M4OEVCRUFEMzlGOTJEOEE5REUyNg==" (* Used only for testing hotfixes *) @@ -1000,6 +1002,9 @@ let other_options = [ "ciphersuites-legacy-outbound", Arg.Set_string ciphersuites_legacy_outbound, (fun () -> !ciphersuites_legacy_outbound), "For backwards compatibility: to be used in addition to ciphersuites-good-outbound for outgoing TLS connections"; + + "gpumon-stop-timeout", Arg.Set_float gpumon_stop_timeout, + (fun () -> string_of_float !gpumon_stop_timeout), "Time to wait after attempting to stop gpumon when launching a vGPU-enabled VM."; ] let all_options = options_of_xapi_globs_spec @ other_options diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 0558bb8713e..47e6a817393 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -215,7 +215,7 @@ let start ~__context ~vm ~start_paused ~force = match vmr.API.vM_VGPUs with | [] -> Xapi_xenops.start ~__context ~self:vm start_paused | _ -> - Xapi_gpumon.with_gpumon_stopped + Xapi_gpumon.with_gpumon_stopped ~timeout:!Xapi_globs.gpumon_stop_timeout (fun () -> Xapi_xenops.start ~__context ~self:vm start_paused) end; Xapi_vm_helpers.start_delay ~__context ~vm From 32928da89e0a644f24814afa3ecee335d9d04310 Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 17 May 2016 08:37:10 +0100 Subject: [PATCH 46/69] Add "_nolock" to names of functions which need mutex protection Signed-off-by: John Else --- ocaml/xapi/daemon_manager.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/ocaml/xapi/daemon_manager.ml b/ocaml/xapi/daemon_manager.ml index 8cce227dfc8..452130c0dec 100644 --- a/ocaml/xapi/daemon_manager.ml +++ b/ocaml/xapi/daemon_manager.ml @@ -37,15 +37,15 @@ end module Make(D : DAEMON) = struct let registered_threads = ref IntSet.empty - let register_thread id = + let register_thread_nolock id = let registered = !registered_threads in registered_threads := (IntSet.add id registered) - let deregister_thread id = + let deregister_thread_nolock id = let registered = !registered_threads in registered_threads := (IntSet.remove id registered) - let are_threads_registered () = + let are_threads_registered_nolock () = let registered = !registered_threads in not (IntSet.is_empty registered) @@ -89,7 +89,7 @@ module Make(D : DAEMON) = struct | false, `unmanaged -> daemon_state := `should_not_start | false, _ -> () end; - register_thread thread_id); + register_thread_nolock thread_id); Pervasiveext.finally f (* Deregister this thread, and if there are no more threads registered, @@ -97,8 +97,8 @@ module Make(D : DAEMON) = struct (fun () -> Mutex.execute m (fun () -> - deregister_thread thread_id; - match are_threads_registered (), !daemon_state with + deregister_thread_nolock thread_id; + match are_threads_registered_nolock (), !daemon_state with | true, _ -> () | false, `should_start -> (start (); daemon_state := `unmanaged) | false, _ -> daemon_state := `unmanaged)) From 998d19dcf99bc4d5c7c1fb5a565496a4a9f2dc41 Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 17 May 2016 08:38:12 +0100 Subject: [PATCH 47/69] Remove some unnecessary let .. in bindings Signed-off-by: John Else --- ocaml/xapi/daemon_manager.ml | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/ocaml/xapi/daemon_manager.ml b/ocaml/xapi/daemon_manager.ml index 452130c0dec..4338a281752 100644 --- a/ocaml/xapi/daemon_manager.ml +++ b/ocaml/xapi/daemon_manager.ml @@ -38,16 +38,13 @@ module Make(D : DAEMON) = struct let registered_threads = ref IntSet.empty let register_thread_nolock id = - let registered = !registered_threads in - registered_threads := (IntSet.add id registered) + registered_threads := (IntSet.add id !registered_threads) let deregister_thread_nolock id = - let registered = !registered_threads in - registered_threads := (IntSet.remove id registered) + registered_threads := (IntSet.remove id !registered_threads) let are_threads_registered_nolock () = - let registered = !registered_threads in - not (IntSet.is_empty registered) + not (IntSet.is_empty !registered_threads) let daemon_state : daemon_state ref = ref `unmanaged let m = Mutex.create () From aaa737bb3dfe01ce9b5abebb4f71e7d976af5bee Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 17 May 2016 08:40:46 +0100 Subject: [PATCH 48/69] Remove type daemon_state from the interface We don't actually need to expose it. Signed-off-by: John Else --- ocaml/xapi/daemon_manager.ml | 6 ++++++ ocaml/xapi/daemon_manager.mli | 12 ------------ 2 files changed, 6 insertions(+), 12 deletions(-) diff --git a/ocaml/xapi/daemon_manager.ml b/ocaml/xapi/daemon_manager.ml index 4338a281752..5038e48789b 100644 --- a/ocaml/xapi/daemon_manager.ml +++ b/ocaml/xapi/daemon_manager.ml @@ -22,9 +22,15 @@ type daemon_check = type daemon_state = [ `unmanaged | + (** No threads which care about the state of the daemon are running. *) `should_start | + (** Daemon should be started when the last thread exits + with_daemon_stopped. *) `should_not_start + (** Daemon should not be started when the last thread exits + with_daemon_stopped. *) ] +(** Tristate value for representing the state of a daemon we want to manage. *) module type DAEMON = sig val check : daemon_check diff --git a/ocaml/xapi/daemon_manager.mli b/ocaml/xapi/daemon_manager.mli index dc611826f91..7fa834f0a2a 100644 --- a/ocaml/xapi/daemon_manager.mli +++ b/ocaml/xapi/daemon_manager.mli @@ -19,18 +19,6 @@ type daemon_check = | Function of (unit -> bool) (** Generic user-defined check, *) -type daemon_state = [ - `unmanaged | - (** No threads which care about the state of the daemon are running. *) - `should_start | - (** Daemon should be started when the last thread exits - with_daemon_stopped. *) - `should_not_start - (** Daemon should not be started when the last thread exits - with_daemon_stopped. *) -] -(** Tristate value for representing the state of a daemon we want to manage. *) - module type DAEMON = sig val check : daemon_check (** A way to check whether the daemon is running. *) From 5b5d120d8ddd2d4096a056a4cf9a89b19b7e104d Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 17 May 2016 08:58:55 +0100 Subject: [PATCH 49/69] Make comment more ocamldoc-friendly Signed-off-by: John Else --- ocaml/xapi/daemon_manager.mli | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ocaml/xapi/daemon_manager.mli b/ocaml/xapi/daemon_manager.mli index 7fa834f0a2a..f50173f5df0 100644 --- a/ocaml/xapi/daemon_manager.mli +++ b/ocaml/xapi/daemon_manager.mli @@ -36,8 +36,8 @@ module Make : functor (D : DAEMON) -> sig has returned. If multiple threads call [with_daemon_stopped] in parallel, the daemon will not be restarted until all threads have left [f]. - If the time out is set, [with_daemon_stopped] will catch any exceptions - from [stop ()] and keep checking whether the daemon is running, until the - timeout expires. If the daemon is still running after the timeout, the - original exception will be thrown. *) + If [timeout] is set, [with_daemon_stopped] will catch any exceptions from + [stop ()] and keep checking whether the daemon is running, until [timeout] + expires. If the daemon is still running after [timeout], the original + exception will be thrown. *) end From e9b8802499259df7d1eba6ede6129a2d1cd2852a Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 17 May 2016 09:08:18 +0100 Subject: [PATCH 50/69] Use underscores for gpumon_stop_timeout Signed-off-by: John Else --- ocaml/xapi/xapi_globs.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index d0357658e50..128f2aaa89c 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/ocaml/xapi/xapi_globs.ml @@ -1003,7 +1003,7 @@ let other_options = [ "ciphersuites-legacy-outbound", Arg.Set_string ciphersuites_legacy_outbound, (fun () -> !ciphersuites_legacy_outbound), "For backwards compatibility: to be used in addition to ciphersuites-good-outbound for outgoing TLS connections"; - "gpumon-stop-timeout", Arg.Set_float gpumon_stop_timeout, + "gpumon_stop_timeout", Arg.Set_float gpumon_stop_timeout, (fun () -> string_of_float !gpumon_stop_timeout), "Time to wait after attempting to stop gpumon when launching a vGPU-enabled VM."; ] From af29a0dc011c5ee863e5b2174e59bd4dcd146c70 Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 17 May 2016 09:11:36 +0100 Subject: [PATCH 51/69] Use 10 second timeout Signed-off-by: John Else --- ocaml/xapi/xapi_globs.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index 128f2aaa89c..9563c233058 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/ocaml/xapi/xapi_globs.ml @@ -909,7 +909,7 @@ let default_xenopsd = ref "org.xen.xapi.xenops.xenlight" let ciphersuites_good_outbound = ref None let ciphersuites_legacy_outbound = ref "" -let gpumon_stop_timeout = ref 60.0 +let gpumon_stop_timeout = ref 10.0 (* Fingerprint of default patch key *) let citrix_patch_key = "NERDNTUzMDMwRUMwNDFFNDI4N0M4OEVCRUFEMzlGOTJEOEE5REUyNg==" From 084bb2df8f3f2ed478a8e711119393aa40df3123 Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 17 May 2016 09:11:55 +0100 Subject: [PATCH 52/69] Add gpumon_stop_timeout to xapi.conf Signed-off-by: John Else --- scripts/xapi.conf | 3 +++ 1 file changed, 3 insertions(+) diff --git a/scripts/xapi.conf b/scripts/xapi.conf index 0641a2f8e5d..547fd810bb0 100644 --- a/scripts/xapi.conf +++ b/scripts/xapi.conf @@ -265,6 +265,9 @@ sm-plugins=ext nfs iscsi lvmoiscsi dummy file hba rawhba udev iso lvm lvmohba lv # time after which we assume a xapi restart attempt has failed # ha_xapi_restart_timeout = 300 +# time to wait for gpumon to exit if attempting to kill it initially failed +# gpumon_stop_timeout = 10 + # time between writing RRD data to disk (the data is primarily stored in # RAM) # rrd_backup_interval = 86400 # 1 day in seconds From 876d438ae6b373938035276e5996fe1e9db9fc56 Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 17 May 2016 09:15:39 +0100 Subject: [PATCH 53/69] Use systemctl rather than service to restart gpumon Signed-off-by: John Else --- ocaml/xapi/xapi_gpumon.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ocaml/xapi/xapi_gpumon.ml b/ocaml/xapi/xapi_gpumon.ml index 8e12660824f..da3f9d62ab5 100644 --- a/ocaml/xapi/xapi_gpumon.ml +++ b/ocaml/xapi/xapi_gpumon.ml @@ -15,7 +15,7 @@ module D = Debug.Make(struct let name="xapi" end) open D -let service = "/sbin/service" +let systemctl = "/usr/bin/systemctl" let gpumon = "xcp-rrdd-gpumon" let pidfile = "/var/run/xcp-rrdd-gpumon.pid" @@ -24,11 +24,11 @@ module Gpumon = Daemon_manager.Make(struct let start () = debug "Starting %s" gpumon; - ignore (Forkhelpers.execute_command_get_output service [gpumon; "start"]) + ignore (Forkhelpers.execute_command_get_output systemctl ["start"; gpumon]) let stop () = debug "Stopping %s" gpumon; - ignore (Forkhelpers.execute_command_get_output service [gpumon; "stop"]) + ignore (Forkhelpers.execute_command_get_output systemctl ["stop"; gpumon]) end) let with_gpumon_stopped = Gpumon.with_daemon_stopped From bb4b5a32afe8067649a92bbc79b4bef98d2474fd Mon Sep 17 00:00:00 2001 From: John Else Date: Tue, 17 May 2016 14:57:31 +0100 Subject: [PATCH 54/69] Use systemctl to check gpumon's status Signed-off-by: John Else --- ocaml/xapi/xapi_gpumon.ml | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/ocaml/xapi/xapi_gpumon.ml b/ocaml/xapi/xapi_gpumon.ml index da3f9d62ab5..a8e8b88bef6 100644 --- a/ocaml/xapi/xapi_gpumon.ml +++ b/ocaml/xapi/xapi_gpumon.ml @@ -17,10 +17,15 @@ open D let systemctl = "/usr/bin/systemctl" let gpumon = "xcp-rrdd-gpumon" -let pidfile = "/var/run/xcp-rrdd-gpumon.pid" module Gpumon = Daemon_manager.Make(struct - let check = Daemon_manager.Pidfile pidfile + let check = Daemon_manager.Function (fun () -> + try + ignore + (Forkhelpers.execute_command_get_output systemctl + ["is-active"; "-q"; gpumon]); + true + with _ -> false) let start () = debug "Starting %s" gpumon; From e9e797e762944e166b34c7c1d54fcb5d352f914f Mon Sep 17 00:00:00 2001 From: Phus Lu Date: Wed, 25 May 2016 06:05:43 +0100 Subject: [PATCH 55/69] CA-208537: vdi-copy between local SRs proposes unwanted ciphers Enable TLSv1.2 capability for sparse_dd. Signed-off-by: Phus Lu (cherry picked from commit 5e00eba5ecc783a9de6086fbd4e3759bb05c04e7) Signed-off-by: Phus Lu --- ocaml/xapi/sparse_dd_wrapper.ml | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/ocaml/xapi/sparse_dd_wrapper.ml b/ocaml/xapi/sparse_dd_wrapper.ml index ffa0a357abf..6b69181db07 100644 --- a/ocaml/xapi/sparse_dd_wrapper.ml +++ b/ocaml/xapi/sparse_dd_wrapper.ml @@ -70,8 +70,15 @@ let dd_internal progress_cb base prezeroed infile outfile size = "-machine"; "-src"; infile; "-dest"; outfile; - "-size"; Int64.to_string size - ] @ (if prezeroed then [ "-prezeroed" ] else [] + "-size"; Int64.to_string size; + "-good-ciphersuites"; (match !Xapi_globs.ciphersuites_good_outbound with + | Some s -> s + | None -> raise (Api_errors.Server_error + (Api_errors.internal_error,["Vdi_copy found no good ciphersuites in Xapi_globs."])) + ); + "-legacy-ciphersuites"; !Xapi_globs.ciphersuites_legacy_outbound + ] @ (if Stunnel.is_legacy_protocol_and_ciphersuites_allowed () then [ "-ssl-legacy" ] else [] + ) @ (if prezeroed then [ "-prezeroed" ] else [] ) @ (Opt.default [] (Opt.map (fun x -> [ "-base"; x ]) base)) in debug "%s %s" sparse_dd_path (String.concat " " args); let pid = Forkhelpers.safe_close_and_exec None (Some pipe_write) (Some log_fd) [] From 59bf551a5a7fcd90cf332d51cbb1ee1aff47b25e Mon Sep 17 00:00:00 2001 From: Zheng Li Date: Thu, 11 Aug 2016 15:13:30 +0100 Subject: [PATCH 56/69] CA-216934: forward name_label/description setting to the right hosts In SMAPIv3 plugins model, SR should own its own metadata rather than relying on the central xapi database. As such, the setting of name_lael/description of a SR should be forwareded to the host where the SR is currently in use. Signed-off-by: Zheng Li --- ocaml/xapi/message_forwarding.ml | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 7579257ce6e..79b5095cf8a 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -3110,12 +3110,16 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct let set_name_label ~__context ~sr ~value = info "SR.set_name_label: SR = '%s' name-label = '%s'" (sr_uuid ~__context sr) value; - Local.SR.set_name_label ~__context ~sr ~value + let local_fn = Local.SR.set_name_label ~sr ~value in + forward_sr_op ~local_fn ~__context ~self:sr + (fun session_id rpc -> Client.SR.set_name_label rpc session_id sr value) let set_name_description ~__context ~sr ~value = info "SR.set_name_description: SR = '%s' name-description = '%s'" (sr_uuid ~__context sr) value; - Local.SR.set_name_description ~__context ~sr ~value + let local_fn = Local.SR.set_name_description ~sr ~value in + forward_sr_op ~local_fn ~__context ~self:sr + (fun session_id rpc -> Client.SR.set_name_description rpc session_id sr value) let assert_can_host_ha_statefile ~__context ~sr = info "SR.assert_can_host_ha_statefile: SR = '%s'" (sr_uuid ~__context sr); From 6b16f16d8e501d66271ec255648b36656570009e Mon Sep 17 00:00:00 2001 From: Huan Xie Date: Mon, 29 Aug 2016 11:34:39 +0100 Subject: [PATCH 57/69] CA-219436: Fix raw iscsi sr live-migrate VM with raw iSCSI SR cannot live migrate as there are more strict checks on the supported operations, this fix will check config item relax_xsm_sr_check, if it's true, check source and destination SR's uuid, if they are the same, mark it as support live migrate. Signed-off-by: Huan Xie --- ocaml/xapi/xapi_vm_migrate.ml | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/ocaml/xapi/xapi_vm_migrate.ml b/ocaml/xapi/xapi_vm_migrate.ml index 34cc482d790..40d7f630f1c 100644 --- a/ocaml/xapi/xapi_vm_migrate.ml +++ b/ocaml/xapi/xapi_vm_migrate.ml @@ -95,7 +95,21 @@ open Fun let assert_sr_support_migration ~__context ~vdi_map ~remote = (* Get destination host SM record *) let sm_record = XenAPI.SM.get_all_records remote.rpc remote.session in - List.iter (fun (vdi, sr) -> + let is_sr_matching local_vdi_ref remote_sr_ref = + let source_sr_ref = Db.VDI.get_SR ~__context ~self:local_vdi_ref in + (* relax_xsm_sr_check is used to enable XSM to out-of-pool SRs with matching UUID *) + if !Xapi_globs.relax_xsm_sr_check then + begin + let source_sr_uuid = Db.SR.get_uuid ~__context ~self:source_sr_ref in + let dest_sr_uuid = XenAPI.SR.get_uuid remote.rpc remote.session remote_sr_ref in + dest_sr_uuid = source_sr_uuid + end + else + (* Don't fail if source and destination SR for all VDIs are same *) + source_sr_ref = remote_sr_ref + in + List.filter (fun (vdi,sr) -> not (is_sr_matching vdi sr)) vdi_map + |> List.iter (fun (vdi, sr) -> (* Check VDIs must not be present on SR which doesn't have snapshot capability *) let source_sr = Db.VDI.get_SR ~__context ~self:vdi in let sr_record = Db.SR.get_record_internal ~__context ~self:source_sr in @@ -111,7 +125,7 @@ let assert_sr_support_migration ~__context ~vdi_map ~remote = in if not (List.exists (fun cp -> cp = Smint.(string_of_capability Vdi_snapshot)) sm_capabilities) then raise (Api_errors.Server_error(Api_errors.sr_does_not_support_migration, [Ref.string_of sr])) - ) vdi_map + ) let assert_licensed_storage_motion ~__context = Pool_features.assert_enabled ~__context ~f:Features.Storage_motion From 860d54d131a265d877c4425029913bb6db646829 Mon Sep 17 00:00:00 2001 From: Bob Ball Date: Wed, 6 Jul 2016 16:43:01 +0100 Subject: [PATCH 58/69] CA-215192: Expose vif-move to the CLI Add vif-move command, including sanity checking that the requested network can be seen from the host running the VM (if it's running) Signed-off-by: Bob Ball --- ocaml/idl/datamodel.ml | 12 +++- ocaml/xapi/cli_frontend.ml | 8 +++ ocaml/xapi/cli_operations.ml | 7 +++ ocaml/xapi/message_forwarding.ml | 6 ++ ocaml/xapi/xapi_bond.ml | 16 ++--- ocaml/xapi/xapi_network_attach_helpers.ml | 69 ++++++++++++++++++++++ ocaml/xapi/xapi_network_attach_helpers.mli | 5 ++ ocaml/xapi/xapi_vif.ml | 24 +++++++- ocaml/xapi/xapi_vif.mli | 12 +++- ocaml/xapi/xapi_vm_helpers.ml | 69 +--------------------- 10 files changed, 148 insertions(+), 80 deletions(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 7a7139b66c5..03df910bb81 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -5334,6 +5334,16 @@ let vif_unplug_force = call ~allowed_roles:_R_VM_ADMIN () +(* NOTE: Update release when merging to lcm branch *) +let vif_move = call + ~name:"move" + ~in_product_since:rel_dundee + ~doc:"Move the specified VIF to the specified network, even while the VM is running" + ~params:[Ref _vif, "self", "The VIF to move"; + Ref _network, "network", "The network to move it to"] + ~allowed_roles:_R_VM_ADMIN + () + let vif_operations = Enum ("vif_operations", [ "attach", "Attempting to attach this VIF to a VM"; @@ -5459,7 +5469,7 @@ let vif = ~doccomments:[] ~messages_default_allowed_roles:_R_VM_ADMIN ~doc_tags:[Networking] - ~messages:[vif_plug; vif_unplug; vif_unplug_force; vif_set_locking_mode; + ~messages:[vif_plug; vif_unplug; vif_unplug_force; vif_move; vif_set_locking_mode; vif_set_ipv4_allowed; vif_add_ipv4_allowed; vif_remove_ipv4_allowed; vif_set_ipv6_allowed; vif_add_ipv6_allowed; vif_remove_ipv6_allowed; vif_configure_ipv4; vif_configure_ipv6] ~contents: diff --git a/ocaml/xapi/cli_frontend.ml b/ocaml/xapi/cli_frontend.ml index 7bd3035fa1a..a7c6ea8625b 100644 --- a/ocaml/xapi/cli_frontend.ml +++ b/ocaml/xapi/cli_frontend.ml @@ -1998,6 +1998,14 @@ add a mapping of 'path' -> '/tmp', the command line should contain the argument implementation=No_fd Cli_operations.vif_configure_ipv6; flags=[]; }; + "vif-move", + { + reqd=["uuid";"network-uuid"]; + optn=[]; + help="Move the VIF to another network."; + implementation=No_fd Cli_operations.vif_move; + flags=[]; + }; "vm-create", { reqd=["name-label"]; diff --git a/ocaml/xapi/cli_operations.ml b/ocaml/xapi/cli_operations.ml index 72ab73e08e0..9e23e57b23b 100644 --- a/ocaml/xapi/cli_operations.ml +++ b/ocaml/xapi/cli_operations.ml @@ -1590,6 +1590,13 @@ let vif_configure_ipv6 printer rpc session_id params = if mode = `Static && address = "" then failwith "Required parameter not found: address"; Client.VIF.configure_ipv6 rpc session_id vif mode address gateway +let vif_move printer rpc session_id params = + let uuid = List.assoc "uuid" params in + let network_uuid = List.assoc "network-uuid" params in + let vif = Client.VIF.get_by_uuid rpc session_id uuid in + let network = Client.Network.get_by_uuid rpc session_id network_uuid in + Client.VIF.move rpc session_id vif network + let net_create printer rpc session_id params = let network = List.assoc "name-label" params in let descr = List.assoc_default "name-description" params "" in diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 79b5095cf8a..7643843a840 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -2731,6 +2731,12 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct let unplug ~__context ~self = unplug_common ~__context ~self ~force:false let unplug_force ~__context ~self = unplug_common ~__context ~self ~force:true + let move ~__context ~self ~network = + info "VIF.move: VIF = '%s' network = '%s'" (vif_uuid ~__context self) (network_uuid ~__context network); + let local_fn = Local.VIF.move ~self ~network in + let remote_fn = (fun session_id rpc -> Client.VIF.move rpc session_id self network) in + forward_vif_op ~local_fn ~__context ~self remote_fn + let set_locking_mode ~__context ~self ~value = info "VIF.set_locking_mode: VIF = '%s'; value = '%s'" (vif_uuid ~__context self) (Record_util.vif_locking_mode_to_string value); let local_fn = Local.VIF.set_locking_mode ~self ~value in diff --git a/ocaml/xapi/xapi_bond.ml b/ocaml/xapi/xapi_bond.ml index ced42cd50cb..16a3304d069 100644 --- a/ocaml/xapi/xapi_bond.ml +++ b/ocaml/xapi/xapi_bond.ml @@ -113,7 +113,7 @@ let move_vlan ~__context host new_slave old_vlan = let new_network = Db.PIF.get_network ~__context ~self:new_master in (* Move VIFs to other VLAN's network *) let vifs = get_local_vifs ~__context host [network] in - ignore (List.map (Xapi_vif.move ~__context ~network:new_network) vifs); + ignore (List.map (Xapi_vif.move_internal ~__context ~network:new_network) vifs); new_vlan, new_master | [] -> (* VLAN with this tag not yet on bond *) @@ -134,12 +134,12 @@ let move_vlan ~__context host new_slave old_vlan = debug "Plugging new VLAN"; Nm.bring_pif_up ~__context new_master; - (* Call Xapi_vif.move on VIFs of running VMs to make sure they end up on the right vSwitch *) + (* Call Xapi_vif.move_internal on VIFs of running VMs to make sure they end up on the right vSwitch *) let vifs = Db.Network.get_VIFs ~__context ~self:network in let vifs = List.filter (fun vif -> Db.VM.get_resident_on ~__context ~self:(Db.VIF.get_VM ~__context ~self:vif) = host) vifs in - ignore (List.map (Xapi_vif.move ~__context ~network:network) vifs); + ignore (List.map (Xapi_vif.move_internal ~__context ~network:network) vifs); end let move_tunnel ~__context host new_transport_PIF old_tunnel = @@ -162,12 +162,12 @@ let move_tunnel ~__context host new_transport_PIF old_tunnel = debug "Plugging moved tunnel"; Nm.bring_pif_up ~__context new_access_PIF; - (* Call Xapi_vif.move to make sure vifs end up on the right vSwitch *) + (* Call Xapi_vif.move_internal to make sure vifs end up on the right vSwitch *) let vifs = Db.Network.get_VIFs ~__context ~self:network in let vifs = List.filter (fun vif -> Db.VM.get_resident_on ~__context ~self:(Db.VIF.get_VM ~__context ~self:vif) = host) vifs in - ignore (List.map (Xapi_vif.move ~__context ~network:network) vifs); + ignore (List.map (Xapi_vif.move_internal ~__context ~network:network) vifs); end let move_management ~__context from_pif to_pif = @@ -201,7 +201,7 @@ let fix_bond ~__context ~bond = (* Move VIFs from members to master *) debug "Checking VIFs to move from slaves to master"; - List.iter (Xapi_vif.move ~__context ~network) local_vifs; + List.iter (Xapi_vif.move_internal ~__context ~network) local_vifs; begin match List.filter (fun p -> Db.PIF.get_management ~__context ~self:p) members with | management_pif :: _ -> @@ -395,7 +395,7 @@ let create ~__context ~network ~members ~mAC ~mode ~properties = (* Move VIFs from members to master *) debug "Check VIFs to move from slaves to master"; - List.iter (Xapi_vif.move ~__context ~network) local_vifs; + List.iter (Xapi_vif.move_internal ~__context ~network) local_vifs; TaskHelper.set_progress ~__context 0.8; (* Set disallow_unplug on the master, if one of the slaves had disallow_unplug = true (see above), @@ -448,7 +448,7 @@ let destroy ~__context ~self = (* Move VIFs from master to slaves *) debug "Check VIFs to move from master to slaves"; - List.iter (Xapi_vif.move ~__context ~network:primary_slave_network) local_vifs; + List.iter (Xapi_vif.move_internal ~__context ~network:primary_slave_network) local_vifs; TaskHelper.set_progress ~__context 0.4; (* Move VLANs down *) diff --git a/ocaml/xapi/xapi_network_attach_helpers.ml b/ocaml/xapi/xapi_network_attach_helpers.ml index 8a2ce96315d..4e6c31871b2 100644 --- a/ocaml/xapi/xapi_network_attach_helpers.ml +++ b/ocaml/xapi/xapi_network_attach_helpers.ml @@ -12,6 +12,7 @@ * GNU Lesser General Public License for more details. *) +open Listext module D=Debug.Make(struct let name="xapi" end) open D @@ -70,3 +71,71 @@ let assert_can_attach_network_on_host ~__context ~self ~host = let local_pifs = get_local_pifs ~__context ~network:self ~host in List.iter (fun pif -> assert_no_slave ~__context pif) local_pifs +let assert_can_see_named_networks ~__context ~vm ~host reqd_nets = + let is_network_available_on host net = + (* has the network been actualised by one or more PIFs? *) + let pifs = Db.Network.get_PIFs ~__context ~self:net in + if pifs <> [] then begin + (* network is only available if one of *) + (* the PIFs connects to the target host *) + let hosts = + List.map (fun self -> Db.PIF.get_host ~__context ~self) pifs in + List.mem host hosts + end else begin + let other_config = Db.Network.get_other_config ~__context ~self:net in + if List.mem_assoc Xapi_globs.assume_network_is_shared other_config && (List.assoc Xapi_globs.assume_network_is_shared other_config = "true") then begin + debug "other_config:%s is set on Network %s" Xapi_globs.assume_network_is_shared (Ref.string_of net); + true + end else begin + (* find all the VIFs on this network and whose VM's are running. *) + (* XXX: in many environments this will perform O (Vms) calls to *) + (* VM.getRecord. *) + let vifs = Db.Network.get_VIFs ~__context ~self:net in + let vms = List.map (fun self -> Db.VIF.get_VM ~__context ~self) vifs in + let vms = List.map (fun self -> Db.VM.get_record ~__context ~self) vms in + let vms = List.filter (fun vm -> vm.API.vM_power_state = `Running) vms in + let hosts = List.map (fun vm -> vm.API.vM_resident_on) vms in + (* either not pinned to any host OR pinned to this host already *) + hosts = [] || (List.mem host hosts) + end + end + in + + let avail_nets = List.filter (is_network_available_on host) reqd_nets in + let not_available = List.set_difference reqd_nets avail_nets in + + List.iter + (fun net -> warn "Host %s cannot see Network %s" + (Helpers.checknull + (fun () -> Db.Host.get_name_label ~__context ~self:host)) + (Helpers.checknull + (fun () -> Db.Network.get_name_label ~__context ~self:net))) + not_available; + if not_available <> [] then + raise (Api_errors.Server_error (Api_errors.vm_requires_net, [ + Ref.string_of vm; + Ref.string_of (List.hd not_available) + ])); + + (* Also, for each of the available networks, we need to ensure that we can bring it + * up on the specified host; i.e. it doesn't need an enslaved PIF. *) + List.iter + (fun network-> + try + assert_can_attach_network_on_host + ~__context + ~self:network + ~host + (* throw exception more appropriate to this context: *) + with exn -> + debug + "Caught exception while checking if network %s could be attached on host %s:%s" + (Ref.string_of network) + (Ref.string_of host) + (ExnHelper.string_of_exn exn); + raise (Api_errors.Server_error ( + Api_errors.host_cannot_attach_network, [ + Ref.string_of host; Ref.string_of network ])) + ) + avail_nets + diff --git a/ocaml/xapi/xapi_network_attach_helpers.mli b/ocaml/xapi/xapi_network_attach_helpers.mli index d62016fa5b3..f7edea88a72 100644 --- a/ocaml/xapi/xapi_network_attach_helpers.mli +++ b/ocaml/xapi/xapi_network_attach_helpers.mli @@ -37,6 +37,11 @@ val assert_no_slave : [ `PIF ] Ref.t -> unit +(** Raises an exception if any network cannot be seen *) +val assert_can_see_named_networks : + __context:Context.t -> + vm:[ `VM ]Ref.t -> host:[ `host ] Ref.t -> [ `network ] Ref.t list -> unit + (** Raises an exception if the network cannot be attached. *) val assert_can_attach_network_on_host : __context:Context.t -> diff --git a/ocaml/xapi/xapi_vif.ml b/ocaml/xapi/xapi_vif.ml index d05352afb77..d98dda9f68f 100644 --- a/ocaml/xapi/xapi_vif.ml +++ b/ocaml/xapi/xapi_vif.ml @@ -53,13 +53,33 @@ let refresh_filtering_rules ~__context ~self = (* This function moves a dom0 vif device from one bridge to another, without involving the guest, * so it also works on guests that do not support hot(un)plug of VIFs. *) -let move ~__context ~network vif = +let move_internal ~__context ~network ?active vif = debug "Moving VIF %s to network %s" (Db.VIF.get_uuid ~__context ~self:vif) (Db.Network.get_uuid ~__context ~self:network); + let active = + match active with + | None -> device_active ~__context ~self:vif + | Some x -> x + in Db.VIF.set_network ~__context ~self:vif ~value:network; - if device_active ~__context ~self:vif + if active then Xapi_xenops.vif_move ~__context ~self:vif network +let move ~__context ~self ~network = + let active = device_active ~__context ~self in + if active + then begin + let vm = Db.VIF.get_VM ~__context ~self in + let host = Db.VM.get_resident_on ~__context ~self:vm in + try Xapi_network_attach_helpers.assert_can_see_named_networks ~__context ~vm:vm ~host:host [network] with + | Api_errors.Server_error (name, _) + when name = Api_errors.vm_requires_net -> + raise (Api_errors.Server_error ( + Api_errors.host_cannot_attach_network, [ + Ref.string_of host; Ref.string_of network ])) + end; + move_internal ~__context ~network ~active self + let change_locking_config ~__context ~self ~licence_check f = if licence_check then assert_locking_licensed ~__context; f (); diff --git a/ocaml/xapi/xapi_vif.mli b/ocaml/xapi/xapi_vif.mli index 0db01de0b28..ba2ac7a6800 100644 --- a/ocaml/xapi/xapi_vif.mli +++ b/ocaml/xapi/xapi_vif.mli @@ -61,12 +61,20 @@ val destroy : __context:Context.t -> self:[ `VIF ] Ref.t -> unit (** {2 Helper Functions} *) (** Move a VIF to another Network. *) -val move : +val move_internal : __context:Context.t -> network:[ `network ] Ref.t -> + ?active:bool -> [ `VIF ] Ref.t -> unit - + +(** Move a VIF to another Network. *) +val move : + __context:Context.t -> + self:[ `VIF ] Ref.t -> + network:[ `network ] Ref.t -> + unit + (** Throw error if the given operation is not in the list of allowed operations. * Implemented by {!Xapi_vif_helpers.assert_operation_valid} *) val assert_operation_valid : diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index d03d76e39de..01cde2a63f0 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -18,6 +18,7 @@ open Xstringext open Printf open Xapi_vm_memory_constraints +open Xapi_network_attach_helpers open Listext open Fun module XenAPI = Client.Client @@ -276,73 +277,7 @@ let assert_can_see_networks ~__context ~self ~host = let vifs = Db.VM.get_VIFs ~__context ~self in let reqd_nets = List.map (fun self -> Db.VIF.get_network ~__context ~self) vifs in - - let is_network_available_on host net = - (* has the network been actualised by one or more PIFs? *) - let pifs = Db.Network.get_PIFs ~__context ~self:net in - if pifs <> [] then begin - (* network is only available if one of *) - (* the PIFs connects to the target host *) - let hosts = - List.map (fun self -> Db.PIF.get_host ~__context ~self) pifs in - List.mem host hosts - end else begin - let other_config = Db.Network.get_other_config ~__context ~self:net in - if List.mem_assoc Xapi_globs.assume_network_is_shared other_config && (List.assoc Xapi_globs.assume_network_is_shared other_config = "true") then begin - debug "other_config:%s is set on Network %s" Xapi_globs.assume_network_is_shared (Ref.string_of net); - true - end else begin - (* find all the VIFs on this network and whose VM's are running. *) - (* XXX: in many environments this will perform O (Vms) calls to *) - (* VM.getRecord. *) - let vifs = Db.Network.get_VIFs ~__context ~self:net in - let vms = List.map (fun self -> Db.VIF.get_VM ~__context ~self) vifs in - let vms = List.map (fun self -> Db.VM.get_record ~__context ~self) vms in - let vms = List.filter (fun vm -> vm.API.vM_power_state = `Running) vms in - let hosts = List.map (fun vm -> vm.API.vM_resident_on) vms in - (* either not pinned to any host OR pinned to this host already *) - hosts = [] || (List.mem host hosts) - end - end - in - - let avail_nets = List.filter (is_network_available_on host) reqd_nets in - let not_available = List.set_difference reqd_nets avail_nets in - - List.iter - (fun net -> warn "Host %s cannot see Network %s" - (Helpers.checknull - (fun () -> Db.Host.get_name_label ~__context ~self:host)) - (Helpers.checknull - (fun () -> Db.Network.get_name_label ~__context ~self:net))) - not_available; - if not_available <> [] then - raise (Api_errors.Server_error (Api_errors.vm_requires_net, [ - Ref.string_of self; - Ref.string_of (List.hd not_available) - ])); - - (* Also, for each of the available networks, we need to ensure that we can bring it - * up on the specified host; i.e. it doesn't need an enslaved PIF. *) - List.iter - (fun network-> - try - Xapi_network_attach_helpers.assert_can_attach_network_on_host - ~__context - ~self:network - ~host - (* throw exception more appropriate to this context: *) - with exn -> - debug - "Caught exception while checking if network %s could be attached on host %s:%s" - (Ref.string_of network) - (Ref.string_of host) - (ExnHelper.string_of_exn exn); - raise (Api_errors.Server_error ( - Api_errors.host_cannot_attach_network, [ - Ref.string_of host; Ref.string_of network ])) - ) - avail_nets + assert_can_see_named_networks ~__context ~vm:self ~host reqd_nets (* IOMMU (VT-d) is required iff the VM has any vGPUs which require PCI * passthrough. *) From 272db61b9f1e83c4ba549756a914fb303ec52ff9 Mon Sep 17 00:00:00 2001 From: Rob Dobson Date: Tue, 20 Sep 2016 17:17:59 +0100 Subject: [PATCH 59/69] CA-222060: Only validate VCPUs_max against cores_per_socket, not VCPUs_at_startup Backports 72332070a8d15acde6429f53b6d0c807450fc9dd Backports 5b76f105fe050e4e2b46d10d0f0fa5722cf6ef5a Signed off by: Rob Dobson --- ocaml/xapi/xapi_xenops.ml | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 4bb6a58e9bd..4c7dbafdfe4 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -169,12 +169,11 @@ module Platform = struct begin try let cores_per_socket = int_of_string(List.assoc "cores-per-socket" platformdata) in - (* cores per socket has to be in multiples of VCPUs_max and VCPUs_at_startup *) - if (((Int64.to_int(vcpu_max) mod cores_per_socket) <> 0) - || ((Int64.to_int(vcpu_at_startup) mod cores_per_socket) <> 0)) then + (* VCPUs_max has to be a multiple of cores per socket *) + if ((Int64.to_int(vcpu_max) mod cores_per_socket) <> 0) then raise (Api_errors.Server_error(Api_errors.invalid_value, ["platform:cores-per-socket"; - "VCPUs_max/VCPUs_at_startup must be a multiple of this field"])) + "VCPUs_max must be a multiple of this field"])) with Failure msg -> raise (Api_errors.Server_error(Api_errors.invalid_value, ["platform:cores-per-socket"; Printf.sprintf "value = %s is not a valid int" (List.assoc "cores-per-socket" platformdata)])) From 8a39fd822ffa014de64877c6aba1eab8470874f8 Mon Sep 17 00:00:00 2001 From: Rob Dobson Date: Tue, 20 Sep 2016 17:22:55 +0100 Subject: [PATCH 60/69] CA-222060: Remove test for removed validation code Backports 915b2cd593a398a972c7a0dcccd6d6b825898104 Signed-off-by: Rob Dobson --- ocaml/test/test_platformdata.ml | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/ocaml/test/test_platformdata.ml b/ocaml/test/test_platformdata.ml index be5fea2f220..8622207b024 100644 --- a/ocaml/test/test_platformdata.ml +++ b/ocaml/test/test_platformdata.ml @@ -131,19 +131,12 @@ module SanityCheck = Generic.Make(struct "cores-per-socket", "3"; ])); (* Check VCPUs configuration - hvm failure scenario*) - (([ - "cores-per-socket", "3"; - ], false, 6L, 5L, true), - Either.Left (Api_errors.Server_error(Api_errors.invalid_value, - ["platform:cores-per-socket"; - "VCPUs_max/VCPUs_at_startup must be a multiple of this field"]))); - (* Check VCPUs configuration - hvm failure scenario*) (([ "cores-per-socket", "4"; ], false, 6L, 6L, true), Either.Left (Api_errors.Server_error(Api_errors.invalid_value, ["platform:cores-per-socket"; - "VCPUs_max/VCPUs_at_startup must be a multiple of this field"]))); + "VCPUs_max must be a multiple of this field"]))); (* Check VCPUs configuration - hvm failure scenario*) (([ "cores-per-socket", "abc"; From d0d5ef85a39d49e1b68893369426d86f2840a11f Mon Sep 17 00:00:00 2001 From: Zheng Li Date: Mon, 16 May 2016 16:52:03 +0100 Subject: [PATCH 61/69] CA-199734: Small refactoring ... aggregates two similar branching logics, no semantics change. Signed-off-by: Zheng Li --- ocaml/xapi/xapi_vm_migrate.ml | 35 +++++++++++++++++------------------ 1 file changed, 17 insertions(+), 18 deletions(-) diff --git a/ocaml/xapi/xapi_vm_migrate.ml b/ocaml/xapi/xapi_vm_migrate.ml index 40d7f630f1c..a7b81ca4ca4 100644 --- a/ocaml/xapi/xapi_vm_migrate.ml +++ b/ocaml/xapi/xapi_vm_migrate.ml @@ -488,31 +488,30 @@ let vdi_copy_fun __context dbg vdi_map remote is_intra_pool remote_vdis so_far t vconf.location,dest_vdi_ref,None,None else begin let newdp = Printf.sprintf (if vconf.do_mirror then "mirror_%s" else "copy_%s") vconf.dp in - (* DP set up is only essential for MIRROR.start/stop due to their open ended pattern. - It's not necessary for copy which will take care of that itself。*) - if vconf.do_mirror then begin - (* Though we have no intention of "write", here we use the same mode as the - associated VBD on a mirrored VDIs (i.e. always RW). This avoids problem - when we need to start/stop the VM along the migration. *) - let read_write = true in - ignore(SMAPI.VDI.attach ~dbg ~dp:newdp ~sr:vconf.sr ~vdi:vconf.location ~read_write); - SMAPI.VDI.activate ~dbg ~dp:newdp ~sr:vconf.sr ~vdi:vconf.location; - end; - - let mapfn = - let start = (Int64.to_float !so_far) /. (Int64.to_float total_size) in - let len = (Int64.to_float vconf.size) /. (Int64.to_float total_size) in - fun x -> start +. x *. len - in - let task = if not vconf.do_mirror then + let task = + if not vconf.do_mirror then SMAPI.DATA.copy ~dbg ~sr:vconf.sr ~vdi:vconf.location ~dp:newdp ~url:remote.sm_url ~dest:dest_sr_uuid else begin + (* Though we have no intention of "write", here we use the same mode as the + associated VBD on a mirrored VDIs (i.e. always RW). This avoids problem + when we need to start/stop the VM along the migration. *) + let read_write = true in + (* DP set up is only essential for MIRROR.start/stop due to their open ended pattern. + It's not necessary for copy which will take care of that itself. *) + ignore(SMAPI.VDI.attach ~dbg ~dp:newdp ~sr:vconf.sr ~vdi:vconf.location ~read_write); + SMAPI.VDI.activate ~dbg ~dp:newdp ~sr:vconf.sr ~vdi:vconf.location; ignore(Storage_access.register_mirror __context vconf.location); SMAPI.DATA.MIRROR.start ~dbg ~sr:vconf.sr ~vdi:vconf.location ~dp:newdp ~url:remote.sm_url ~dest:dest_sr_uuid end in - + + let mapfn = + let start = (Int64.to_float !so_far) /. (Int64.to_float total_size) in + let len = (Int64.to_float vconf.size) /. (Int64.to_float total_size) in + fun x -> start +. x *. len + in + let open Storage_access in let task_result = task |> register_task __context From eeccbc376e41e783911c7604bd73ad984504d417 Mon Sep 17 00:00:00 2001 From: Zheng Li Date: Fri, 20 May 2016 00:21:06 +0100 Subject: [PATCH 62/69] CA-199734: best-effort DP destroy and other cleanups for mirror/copy task failure ... previously we didn't do this which caused issue like CA-199734. A bit of code refactoring is done as part of this. Big chunk of code is re-orgnized into small parts. Also use with_ style functions to facilitate the separation and composition of error handling etc. Signed-off-by: Zheng Li --- ocaml/xapi/xapi_vm_migrate.ml | 215 +++++++++++++++++----------------- 1 file changed, 107 insertions(+), 108 deletions(-) diff --git a/ocaml/xapi/xapi_vm_migrate.ml b/ocaml/xapi/xapi_vm_migrate.ml index a7b81ca4ca4..07f1bbcc233 100644 --- a/ocaml/xapi/xapi_vm_migrate.ml +++ b/ocaml/xapi/xapi_vm_migrate.ml @@ -482,118 +482,117 @@ let vdi_copy_fun __context dbg vdi_map remote is_intra_pool remote_vdis so_far t (not is_intra_pool) || (dest_sr_uuid <> vconf.sr) in - let remote_vdi,remote_vdi_reference,newdp,mirror_id = - if not mirror then - let dest_vdi_ref = XenAPI.VDI.get_by_uuid remote.rpc remote.session vdi_uuid in - vconf.location,dest_vdi_ref,None,None - else begin - let newdp = Printf.sprintf (if vconf.do_mirror then "mirror_%s" else "copy_%s") vconf.dp in - - let task = - if not vconf.do_mirror then - SMAPI.DATA.copy ~dbg ~sr:vconf.sr ~vdi:vconf.location ~dp:newdp ~url:remote.sm_url ~dest:dest_sr_uuid - else begin - (* Though we have no intention of "write", here we use the same mode as the - associated VBD on a mirrored VDIs (i.e. always RW). This avoids problem - when we need to start/stop the VM along the migration. *) - let read_write = true in - (* DP set up is only essential for MIRROR.start/stop due to their open ended pattern. - It's not necessary for copy which will take care of that itself. *) - ignore(SMAPI.VDI.attach ~dbg ~dp:newdp ~sr:vconf.sr ~vdi:vconf.location ~read_write); - SMAPI.VDI.activate ~dbg ~dp:newdp ~sr:vconf.sr ~vdi:vconf.location; - ignore(Storage_access.register_mirror __context vconf.location); - SMAPI.DATA.MIRROR.start ~dbg ~sr:vconf.sr ~vdi:vconf.location ~dp:newdp ~url:remote.sm_url ~dest:dest_sr_uuid - end - in - - let mapfn = - let start = (Int64.to_float !so_far) /. (Int64.to_float total_size) in - let len = (Int64.to_float vconf.size) /. (Int64.to_float total_size) in - fun x -> start +. x *. len - in - - let open Storage_access in - let task_result = - task |> register_task __context - |> add_to_progress_map mapfn - |> wait_for_task dbg - |> remove_from_progress_map - |> unregister_task __context - |> success_task dbg in - - let vdi, mirror_id = - if not vconf.do_mirror - then begin - let vdi = task_result |> vdi_of_task dbg in - remote_vdis := vdi.vdi :: !remote_vdis; - vdi.vdi,None - end else begin - let mirror_id = task_result |> mirror_of_task dbg in - let m = SMAPI.DATA.MIRROR.stat ~dbg ~id:mirror_id in - m.Mirror.dest_vdi, Some mirror_id - end - in - - so_far := Int64.add !so_far vconf.size; - - debug "Local VDI %s mirrored to %s" vconf.location vdi; - debug "Executing remote scan to ensure VDI is known to xapi"; - XenAPI.SR.scan remote.rpc remote.session dest_sr_ref; - let query = Printf.sprintf "(field \"location\"=\"%s\") and (field \"SR\"=\"%s\")" vdi (Ref.string_of dest_sr_ref) in - let vdis = XenAPI.VDI.get_all_records_where remote.rpc remote.session query in - - if List.length vdis <> 1 then error "Could not locate remote VDI: query='%s', length of results: %d" query (List.length vdis); - - let remote_vdi_reference = fst (List.hd vdis) in - - debug "Found remote vdi reference: %s" (Ref.string_of remote_vdi_reference); - vdi, remote_vdi_reference, (Some newdp), mirror_id - end - in - let mirror_record = ({ mr_dp = newdp; - mr_mirrored = mirror; - mr_local_sr = vconf.sr; - mr_local_vdi = vconf.location; - mr_remote_sr = dest_sr_uuid; - mr_remote_vdi = remote_vdi; - mr_local_xenops_locator = vconf.xenops_locator; - mr_remote_xenops_locator = Xapi_xenops.xenops_vdi_locator_of_strings dest_sr_uuid remote_vdi; - mr_local_vdi_reference = vconf.vdi; - mr_remote_vdi_reference = remote_vdi_reference; }) in - try - let result = continuation mirror_record in - - (match mirror_id with - | Some mid -> ignore(Storage_access.unregister_mirror mid); - | None -> ()); - - if mirror && not (Xapi_fist.storage_motion_keep_vdi () || copy) - then - Helpers.call_api_functions ~__context (fun rpc session_id -> - XenAPI.VDI.destroy rpc session_id vconf.vdi); - - result - with e -> - (* Stop mirroring and check to see if it was us that caused the mirror failure *) - let mirror_failed = - match mirror_id with - | Some mid -> - (try SMAPI.DATA.MIRROR.stop ~dbg ~id:mid with _ -> ()); - let m = SMAPI.DATA.MIRROR.stat ~dbg ~id:mid in - m.Mirror.failed - | None -> - false + let with_new_dp cont = + let dp = Printf.sprintf (if vconf.do_mirror then "mirror_%s" else "copy_%s") vconf.dp in + try cont dp + with e -> + (try SMAPI.DP.destroy ~dbg ~dp ~allow_leak:false with _ -> info "Failed to cleanup datapath: %s" dp); + raise e in + + let with_remote_vdi remote_vdi cont = + debug "Executing remote scan to ensure VDI is known to xapi"; + XenAPI.SR.scan remote.rpc remote.session dest_sr_ref; + let query = Printf.sprintf "(field \"location\"=\"%s\") and (field \"SR\"=\"%s\")" remote_vdi (Ref.string_of dest_sr_ref) in + let vdis = XenAPI.VDI.get_all_records_where remote.rpc remote.session query in + let remote_vdi_ref = match vdis with + | [] -> raise (Api_errors.Server_error(Api_errors.vdi_location_missing, [Ref.string_of dest_sr_ref; remote_vdi])) + | h :: [] -> debug "Found remote vdi reference: %s" (Ref.string_of (fst h)); fst h + | _ -> raise (Api_errors.Server_error(Api_errors.location_not_unique, [Ref.string_of dest_sr_ref; remote_vdi])) in + try cont remote_vdi_ref + with e -> + (try XenAPI.VDI.destroy remote.rpc remote.session remote_vdi_ref with _ -> error "Failed to destroy remote VDI"); + raise e in + + let get_mirror_record ?new_dp remote_vdi remote_vdi_reference = + { mr_dp = new_dp; + mr_mirrored = mirror; + mr_local_sr = vconf.sr; + mr_local_vdi = vconf.location; + mr_remote_sr = dest_sr_uuid; + mr_remote_vdi = remote_vdi; + mr_local_xenops_locator = vconf.xenops_locator; + mr_remote_xenops_locator = Xapi_xenops.xenops_vdi_locator_of_strings dest_sr_uuid remote_vdi; + mr_local_vdi_reference = vconf.vdi; + mr_remote_vdi_reference = remote_vdi_reference } in + + let mirror_to_remote new_dp = + let task = + if not vconf.do_mirror then + SMAPI.DATA.copy ~dbg ~sr:vconf.sr ~vdi:vconf.location ~dp:new_dp ~url:remote.sm_url ~dest:dest_sr_uuid + else begin + (* Though we have no intention of "write", here we use the same mode as the + associated VBD on a mirrored VDIs (i.e. always RW). This avoids problem + when we need to start/stop the VM along the migration. *) + let read_write = true in + (* DP set up is only essential for MIRROR.start/stop due to their open ended pattern. + It's not necessary for copy which will take care of that itself. *) + ignore(SMAPI.VDI.attach ~dbg ~dp:new_dp ~sr:vconf.sr ~vdi:vconf.location ~read_write); + SMAPI.VDI.activate ~dbg ~dp:new_dp ~sr:vconf.sr ~vdi:vconf.location; + ignore(Storage_access.register_mirror __context vconf.location); + SMAPI.DATA.MIRROR.start ~dbg ~sr:vconf.sr ~vdi:vconf.location ~dp:new_dp ~url:remote.sm_url ~dest:dest_sr_uuid + end in + + let mapfn = + let start = (Int64.to_float !so_far) /. (Int64.to_float total_size) in + let len = (Int64.to_float vconf.size) /. (Int64.to_float total_size) in + fun x -> start +. x *. len in - (* Now that mirroring has finished, clean up any datapath we made *) - (match newdp with | Some dp -> (try SMAPI.DP.destroy ~dbg ~dp ~allow_leak:false with _ -> error "Failed to cleanup datapath: %s" dp) | None -> ()); + let open Storage_access in + + let task_result = + task |> register_task __context + |> add_to_progress_map mapfn + |> wait_for_task dbg + |> remove_from_progress_map + |> unregister_task __context + |> success_task dbg in + + let mirror_id, remote_vdi = + if not vconf.do_mirror then + let vdi = task_result |> vdi_of_task dbg in + remote_vdis := vdi.vdi :: !remote_vdis; + None, vdi.vdi + else + let mirrorid = task_result |> mirror_of_task dbg in + let m = SMAPI.DATA.MIRROR.stat ~dbg ~id:mirrorid in + Some mirrorid, m.Mirror.dest_vdi in - (* And destroy the new VDI *) - (try XenAPI.VDI.destroy remote.rpc remote.session remote_vdi_reference with _ -> error "Failed to destroy remote VDI"); + so_far := Int64.add !so_far vconf.size; + debug "Local VDI %s %s to %s" vconf.location (if vconf.do_mirror then "mirrored" else "copied") remote_vdi; + mirror_id, remote_vdi in - if mirror_failed then raise (Api_errors.Server_error(Api_errors.mirror_failed,[Ref.string_of vconf.vdi])); - - raise e + let post_mirror mirror_id mirror_record = + try + let result = continuation mirror_record in + (match mirror_id with + | Some mid -> ignore(Storage_access.unregister_mirror mid); + | None -> ()); + if mirror && not (Xapi_fist.storage_motion_keep_vdi () || copy) then + Helpers.call_api_functions ~__context (fun rpc session_id -> + XenAPI.VDI.destroy rpc session_id vconf.vdi); + result + with e -> + let mirror_failed = + match mirror_id with + | Some mid -> + ignore(Storage_access.unregister_mirror mid); + (try SMAPI.DATA.MIRROR.stop ~dbg ~id:mid with _ -> ()); + let m = SMAPI.DATA.MIRROR.stat ~dbg ~id:mid in + m.Mirror.failed + | None -> false in + if mirror_failed then raise (Api_errors.Server_error(Api_errors.mirror_failed,[Ref.string_of vconf.vdi])) + else raise e in + + if mirror then + with_new_dp (fun new_dp -> + let mirror_id, remote_vdi = mirror_to_remote new_dp in + with_remote_vdi remote_vdi (fun remote_vdi_ref -> + let mirror_record = get_mirror_record ~new_dp remote_vdi remote_vdi_ref in + post_mirror mirror_id mirror_record)) + else + let mirror_record = get_mirror_record vconf.location (XenAPI.VDI.get_by_uuid remote.rpc remote.session vdi_uuid) in + continuation mirror_record let wait_for_fist __context fistpoint name = if fistpoint () then begin From 628f5341ae02f18698f1556ee0888ba9c4643168 Mon Sep 17 00:00:00 2001 From: Zheng Li Date: Tue, 24 May 2016 13:35:29 +0100 Subject: [PATCH 63/69] CA-199734: code improvement on mapfn The code change was suggested by Christian Lindig for better naming and style. Signed-off-by: Zheng Li --- ocaml/xapi/xapi_vm_migrate.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/ocaml/xapi/xapi_vm_migrate.ml b/ocaml/xapi/xapi_vm_migrate.ml index 07f1bbcc233..7a32ad6cf5c 100644 --- a/ocaml/xapi/xapi_vm_migrate.ml +++ b/ocaml/xapi/xapi_vm_migrate.ml @@ -532,11 +532,11 @@ let vdi_copy_fun __context dbg vdi_map remote is_intra_pool remote_vdis so_far t SMAPI.DATA.MIRROR.start ~dbg ~sr:vconf.sr ~vdi:vconf.location ~dp:new_dp ~url:remote.sm_url ~dest:dest_sr_uuid end in - let mapfn = - let start = (Int64.to_float !so_far) /. (Int64.to_float total_size) in - let len = (Int64.to_float vconf.size) /. (Int64.to_float total_size) in - fun x -> start +. x *. len - in + let mapfn x = + let total = Int64.to_float total_size in + let done_ = Int64.to_float !so_far /. total in + let remaining = Int64.to_float vconf.size /. total in + done_ +. x *. remaining in let open Storage_access in From 68f5b46eb776a4bda78fe4f1126bd15fcb305133 Mon Sep 17 00:00:00 2001 From: Liang Dai Date: Mon, 26 Sep 2016 16:31:45 +0800 Subject: [PATCH 64/69] CA-222760: Add default list of accepted ciphers into xapi We are adding a default list of ciphers to xapi, so that it can be omitted in the config file Signed-off-by: Liang Dai --- ocaml/xapi/sparse_dd_wrapper.ml | 4 ++-- ocaml/xapi/xapi.ml | 4 ++-- ocaml/xapi/xapi_globs.ml | 8 ++++---- ocaml/xapi/xapi_sync.ml | 4 ++-- scripts/xapi.conf | 4 ++-- 5 files changed, 12 insertions(+), 12 deletions(-) diff --git a/ocaml/xapi/sparse_dd_wrapper.ml b/ocaml/xapi/sparse_dd_wrapper.ml index 6b69181db07..c171fae371b 100644 --- a/ocaml/xapi/sparse_dd_wrapper.ml +++ b/ocaml/xapi/sparse_dd_wrapper.ml @@ -72,9 +72,9 @@ let dd_internal progress_cb base prezeroed infile outfile size = "-dest"; outfile; "-size"; Int64.to_string size; "-good-ciphersuites"; (match !Xapi_globs.ciphersuites_good_outbound with - | Some s -> s - | None -> raise (Api_errors.Server_error + | "" -> raise (Api_errors.Server_error (Api_errors.internal_error,["Vdi_copy found no good ciphersuites in Xapi_globs."])) + | s -> s ); "-legacy-ciphersuites"; !Xapi_globs.ciphersuites_legacy_outbound ] @ (if Stunnel.is_legacy_protocol_and_ciphersuites_allowed () then [ "-ssl-legacy" ] else [] diff --git a/ocaml/xapi/xapi.ml b/ocaml/xapi/xapi.ml index d9e7569b201..b3dcdc4d2ba 100644 --- a/ocaml/xapi/xapi.ml +++ b/ocaml/xapi/xapi.ml @@ -692,8 +692,8 @@ let set_stunnel_timeout () = * master, and to do that we need to start an outgoing stunnel. *) let set_stunnel_legacy_inv ~__context () = Stunnel.set_good_ciphersuites (match !Xapi_globs.ciphersuites_good_outbound with - | None -> raise (Api_errors.Server_error (Api_errors.internal_error,["Configuration file does not specify ciphersuites-good-outbound."])) - | Some s -> s + | "" -> raise (Api_errors.Server_error (Api_errors.internal_error,["Configuration file does not specify ciphersuites-good-outbound."])) + | s -> s ); Stunnel.set_legacy_ciphersuites !Xapi_globs.ciphersuites_legacy_outbound; let s = Xapi_inventory.lookup Xapi_inventory._stunnel_legacy ~default:"true" in diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index 9563c233058..d0b409ebf72 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/ocaml/xapi/xapi_globs.ml @@ -906,8 +906,8 @@ let xenopsd_queues = ref ([ let default_xenopsd = ref "org.xen.xapi.xenops.xenlight" -let ciphersuites_good_outbound = ref None -let ciphersuites_legacy_outbound = ref "" +let ciphersuites_good_outbound = ref "!EXPORT:RSA+AES128-SHA256" +let ciphersuites_legacy_outbound = ref "RSA+AES256-SHA:RSA+AES128-SHA:RSA+RC4-SHA:RSA+DES-CBC3-SHA" let gpumon_stop_timeout = ref 10.0 @@ -996,8 +996,8 @@ let other_options = [ "cluster-stack-default", Arg.Set_string cluster_stack_default, (fun () -> !cluster_stack_default), "Default cluster stack (HA)"; - "ciphersuites-good-outbound", Arg.String (fun s -> ciphersuites_good_outbound := if String_plain.trim s <> "" then Some s else None), - (fun () -> match !ciphersuites_good_outbound with None -> "" | Some s -> s), + "ciphersuites-good-outbound", Arg.String (fun s -> ciphersuites_good_outbound := if String_plain.trim s <> "" then s else ""), + (fun () -> !ciphersuites_good_outbound), "Preferred set of ciphersuites for outgoing TLS connections. (This list must match, or at least contain one of, the GOOD_CIPHERS in the 'xapissl' script for starting the listening stunnel.)"; "ciphersuites-legacy-outbound", Arg.Set_string ciphersuites_legacy_outbound, diff --git a/ocaml/xapi/xapi_sync.ml b/ocaml/xapi/xapi_sync.ml index ba0bbb31ca4..e881def34a6 100644 --- a/ocaml/xapi/xapi_sync.ml +++ b/ocaml/xapi/xapi_sync.ml @@ -36,8 +36,8 @@ let sync_host ~__context host = Unix.putenv "XSH_SESSION" (Ref.string_of session); Unix.putenv "XSH_SSL_LEGACY" (string_of_bool (Db.Host.get_ssl_legacy ~__context ~self:host)); (match !Xapi_globs.ciphersuites_good_outbound with - | Some c -> Unix.putenv "XSH_GOOD_CIPHERSUITES" c - | None -> raise (Api_errors.Server_error (Api_errors.internal_error,["Xapi_sync found no good ciphersuites in Xapi_globs."])) + | "" -> raise (Api_errors.Server_error (Api_errors.internal_error,["Xapi_sync found no good ciphersuites in Xapi_globs."])) + | c -> Unix.putenv "XSH_GOOD_CIPHERSUITES" c ); Unix.putenv "XSH_LEGACY_CIPHERSUITES" !Xapi_globs.ciphersuites_legacy_outbound; diff --git a/scripts/xapi.conf b/scripts/xapi.conf index 547fd810bb0..1804cef902c 100644 --- a/scripts/xapi.conf +++ b/scripts/xapi.conf @@ -75,12 +75,12 @@ igd-passthru-vendor-whitelist = 8086 # This string is used for the "ciphers" field in stunnel configuration. # This "good" list must match, or at least contain one of, # the GOOD_CIPHERS in @LIBEXECDIR@/xapissl -ciphersuites-good-outbound = !EXPORT:RSA+AES128-SHA256 +# ciphersuites-good-outbound = !EXPORT:RSA+AES128-SHA256 # Additional ciphersuites for backward compatibility in outgoing # TLS connections, used in addition to "ciphersuites-good-outbound" # if the host has ssl_legacy=true. -ciphersuites-legacy-outbound = RSA+AES256-SHA:RSA+AES128-SHA:RSA+RC4-SHA:RSA+DES-CBC3-SHA +# ciphersuites-legacy-outbound = RSA+AES256-SHA:RSA+AES128-SHA:RSA+RC4-SHA:RSA+DES-CBC3-SHA # Paths to utilities: ############################################ From c735665d7ce262f7ac233e98b89cd8a114576dc0 Mon Sep 17 00:00:00 2001 From: Sharad Yadav Date: Mon, 19 Sep 2016 05:51:17 +0100 Subject: [PATCH 65/69] CA-220506: Update rbac roles for network.attach_for_vm and network.detach_for_vm API calls. Allow VM_POWER_ADMIN and above roles to perform `network.attach_for_vm` and `network.detach_for_vm` calls. Signed-off-by: Sharad Yadav --- ocaml/idl/datamodel.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 03df910bb81..79ed8293551 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -4802,7 +4802,7 @@ let network_attach_for_vm = call ] ~in_product_since:rel_tampa ~hide_from_docs:true - ~allowed_roles:_R_POOL_OP + ~allowed_roles:_R_VM_POWER_ADMIN () let network_detach_for_vm = call @@ -4814,7 +4814,7 @@ let network_detach_for_vm = call ] ~in_product_since:rel_tampa ~hide_from_docs:true - ~allowed_roles:_R_POOL_OP + ~allowed_roles:_R_VM_POWER_ADMIN () (** A virtual network *) From dbb34597c3b3e9a96fafa04ff1da260c664f83f3 Mon Sep 17 00:00:00 2001 From: Sharad Yadav Date: Fri, 28 Oct 2016 11:46:18 +0100 Subject: [PATCH 66/69] Revert "CA-220506: Update rbac roles for network.attach_for_vm and network.detach_for_vm API calls." Allowing `VM Power Admin` role to perform API call 'network.attach_for_vm' doesn't fix the VM migration to be allowed to `VM Power Admin`. VM migration internally uses `SR.scan` which is currently allowed to `Pool operator`. This reverts commit c735665d7ce262f7ac233e98b89cd8a114576dc0. --- ocaml/idl/datamodel.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 79ed8293551..03df910bb81 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -4802,7 +4802,7 @@ let network_attach_for_vm = call ] ~in_product_since:rel_tampa ~hide_from_docs:true - ~allowed_roles:_R_VM_POWER_ADMIN + ~allowed_roles:_R_POOL_OP () let network_detach_for_vm = call @@ -4814,7 +4814,7 @@ let network_detach_for_vm = call ] ~in_product_since:rel_tampa ~hide_from_docs:true - ~allowed_roles:_R_VM_POWER_ADMIN + ~allowed_roles:_R_POOL_OP () (** A virtual network *) From 0b545f8953ac1b10dd39eb0c9c5c88760d90f100 Mon Sep 17 00:00:00 2001 From: Zheng Li Date: Tue, 22 Nov 2016 18:45:54 +0000 Subject: [PATCH 67/69] CA-232290: Task.cancel verify permission before forwarding By design, an internal superuser session will be created and used for message forwarding to slaves, so permission checking afterwards (i.e. where the message is already forwarded) will always return success. So we should make the permission checking right on the front. Signed-off-by: Zheng Li --- ocaml/xapi/message_forwarding.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 7643843a840..66913880d34 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -442,6 +442,7 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct include Local.Task let cancel ~__context ~task = + TaskHelper.assert_can_destroy ~__context task; let local_fn = cancel ~task in let forwarded_to = Db.Task.get_forwarded_to ~__context ~self:task in if Db.is_valid_ref __context forwarded_to From 89d02942a740b038aa912c802d18c37b50f4e9e4 Mon Sep 17 00:00:00 2001 From: Frederico Mazzone Date: Mon, 5 Dec 2016 15:53:50 +0000 Subject: [PATCH 68/69] CA-229340: Ensure ref is valid before injecting update Signed-off-by: Jon Ludlam --- ocaml/xapi/xapi_event.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ocaml/xapi/xapi_event.ml b/ocaml/xapi/xapi_event.ml index 4342f8001a5..df9a151ec75 100644 --- a/ocaml/xapi/xapi_event.ml +++ b/ocaml/xapi/xapi_event.ml @@ -558,6 +558,8 @@ let inject ~__context ~_class ~_ref = (fun () -> let db_ref = Db_backend.make () in let g = Manifest.generation (Database.manifest (Db_ref.get_database db_ref)) in + let ok = match Db_cache_impl.get_table_from_ref db_ref _ref with Some tbl -> tbl = _class | None -> false in + if not ok then raise (Api_errors.Server_error (Api_errors.handle_invalid, [_class; _ref])); Db_cache_impl.touch_row db_ref _class _ref; (* consumes this generation *) g ) in From eabcfdf6fe3ad7e74cae53c6db0c437a1bdca7a4 Mon Sep 17 00:00:00 2001 From: Liang Dai Date: Mon, 19 Dec 2016 02:35:35 +0000 Subject: [PATCH 69/69] CA-235358: Fix AD users in child domains cannot log in to XenCenter 7 When user input username as "ChildDomain\Username", the original code ignores "ChildDomain". Signed-off-by: Liang Dai (cherry picked from commit 09cba1dc146ad28e5a71f4469cd01f0a1f6e24ff) Signed-off-by: Frederico Mazzone --- ocaml/auth/extauth_plugin_ADpbis.ml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/ocaml/auth/extauth_plugin_ADpbis.ml b/ocaml/auth/extauth_plugin_ADpbis.ml index cf3bb308594..47679ae1803 100644 --- a/ocaml/auth/extauth_plugin_ADpbis.ml +++ b/ocaml/auth/extauth_plugin_ADpbis.ml @@ -390,8 +390,11 @@ let get_subject_identifier _subject_name = let authenticate_username_password username password = (* first, we try to authenticated user against our external user database *) (* pbis_common will raise an Auth_failure if external authentication fails *) - let user = List.hd (List.rev (String.split_f (fun c -> c = '\\') username)) in - let domain = get_joined_domain_name () in + let (domain, user) = match (String.split_f (fun c -> c = '\\') username) with + | [domain; user] -> (domain, user) + | [user] -> (get_joined_domain_name(), user) + | _ -> raise (Auth_signature.Auth_service_error (Auth_signature.E_GENERIC,"Invalid username " ^ username)) + in let (_: (string * string) list) = pbis_common "/opt/pbis/bin/lsa" ["authenticate-user";"--user";user;"--domain";domain;"--password";password] in (* no exception raised, then authentication succeeded, *) (* now we return the authenticated user's id *)