diff --git a/ocaml/tests/test_helpers.ml b/ocaml/tests/test_helpers.ml index b856bb363e..aecd8d4b15 100644 --- a/ocaml/tests/test_helpers.ml +++ b/ocaml/tests/test_helpers.ml @@ -466,6 +466,138 @@ module RunInParallel = Generic.MakeStateless (struct ] end) +module Version = struct + let test_compare_int_list () = + let test_cases = + [ + ("Equal Lists", [1; 2; 3], [1; 2; 3], 0) + ; ("Empty Lists", [], [], 0) + ; ("'a' is smaller (first element)", [1; 10; 100], [2; 0; 0], -1) + ; ("'a' is smaller (later element)", [1; 2; 3], [1; 2; 4], -1) + ; ("'a' is greater (first element)", [5; 1; 1], [2; 10; 10], 1) + ; ("'a' is greater (later element)", [1; 3; 3], [1; 2; 4], 1) + ; ("Lists with negative numbers", [0; -5; 10], [0; -2; -10], -1) + ; ("Single element lists (equal)", [42], [42], 0) + ; ("Single element lists (unequal)", [42], [43], -1) + ; ("Different number of element in lists", [25; 27], [25; 27; 1], -1) + ] + in + let test_compare (description, list1, list2, expected) = + let actual = Helpers.compare_int_lists list1 list2 in + let description = Printf.sprintf "compate_int_lists: %s" description in + Alcotest.(check int) description expected actual + in + List.iter test_compare test_cases + + let test_version_numbers_of_string () = + let test_cases = + [ + ( "Standard major.minor.patch version, e.g. xapi build version stored \ + in the database" + , "25.30.0" + , [25; 30; 0] + ) + ; ( "Dev build version, e.g. xapi build version stored in the database" + , "25.30.0.6.gb239bd75a" + , [25; 30; 0; 6] + ) + ; ( "Version with a patch identifier e.g. xen versions stored in the \ + database" + , "25.15.0-13" + , [25; 15; 0; 13] + ) + ; ("Default version", "0.0.0", [0; 0; 0]) + ] + in + let test_version_numbers (description, version_string, expected) = + let actual = Helpers.version_numbers_of_string version_string in + let description = + Printf.sprintf "version_numbers_of_string: %s" description + in + Alcotest.(check @@ list int) description expected actual + in + List.iter test_version_numbers test_cases + + let test_compare_versions () = + let sw_vers_a = + Xapi_globs.[(_platform_version, "2.4.0"); (_xen_version, "4.14.0-13")] + in + let sw_vers_b = Xapi_globs.[(_xen_version, "4.13.0-13")] in + let test_cases = + Xapi_globs. + [ + ( "Software versions 'b' are missing platform version" + , _platform_version + , sw_vers_a + , sw_vers_b + , 1 + ) + ; ( "Software versions 'a' are missing platform version" + , _platform_version + , sw_vers_b + , sw_vers_a + , -1 + ) + ; ( "xen version exists in both (`a` is greater)" + , _xen_version + , sw_vers_a + , sw_vers_b + , 1 + ) + ; ( "xapi build version is missing from both (equal)" + , _xapi_build_version + , sw_vers_a + , sw_vers_b + , 0 + ) + ] + in + let test_compare (description, key, value_a, value_b, expected) = + let actual = Helpers.compare_versions ~version_key:key value_a value_b in + let description = Printf.sprintf "compare_versions: %s" description in + Alcotest.(check int) description expected actual + in + List.iter test_compare test_cases + + let test_compare_all_versions () = + let current = + Xapi_globs.[(_platform_version, "8.1.0"); (_xen_version, "4.13.0-15")] + in + let newer = + Xapi_globs.[(_platform_version, "8.2.0"); (_xen_version, "4.13.0-15")] + in + let mixed = + Xapi_globs.[(_platform_version, "8.2.0"); (_xen_version, "4.12.0-15")] + in + let test_cases = + [ + ("Newer is greater or equal than Current", newer, current, true) + ; ("Current is greater or equal than Current", current, current, true) + ; ("Current is not greater or equal than Newer", current, newer, false) + ; ("Mixed is not greater or equal then Current", mixed, current, false) + ; ("Current is not greater or equal than Mixed", current, mixed, false) + ] + in + let test_compare (description, vers_a, vers_b, expected) = + let actual = + Helpers.compare_all_versions ~is_greater_or_equal:vers_a ~than:vers_b + in + let description = Printf.sprintf "compare_all_versions: %s" description in + Alcotest.(check bool) description expected actual + in + List.iter test_compare test_cases + + let test = + [ + ("Compare int list", `Quick, test_compare_int_list) + ; ("Version numbers from string", `Quick, test_version_numbers_of_string) + ; ("Compare versions", `Quick, test_compare_versions) + ; ("Compare all versions", `Quick, test_compare_all_versions) + ] + + let tests = [("Version compare tests", test)] +end + let tests = make_suite "helpers_" [ @@ -476,3 +608,4 @@ let tests = ; ("assert_is_valid_cidr", CIDRCheckers.tests) ; ("run_in_parallel", RunInParallel.tests) ] + @ Version.tests diff --git a/ocaml/xapi/db_gc.ml b/ocaml/xapi/db_gc.ml index c8c6830936..50e2a23a6a 100644 --- a/ocaml/xapi/db_gc.ml +++ b/ocaml/xapi/db_gc.ml @@ -165,16 +165,18 @@ let detect_rolling_upgrade ~__context = in (* Resynchronise *) if actually_in_progress <> pool_says_in_progress then ( - let platform_versions = + let host_versions = List.map (fun host -> - Helpers.version_string_of ~__context (Helpers.LocalObject host) + Helpers.get_software_versions ~__context + (Helpers.LocalObject host) + |> Helpers.versions_string_of ) (Db.Host.get_all ~__context) in debug "xapi platform version = %s; host platform versions = [ %s ]" (Xapi_version.platform_version ()) - (String.concat "; " platform_versions) ; + (String.concat "; " host_versions) ; warn "Pool thinks rolling upgrade%s in progress but Host version \ numbers indicate otherwise; correcting" diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index 121c1c179c..9807c4540d 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -867,12 +867,18 @@ let assert_we_are_master ~__context = ) (* Host version compare helpers *) -let compare_int_lists : int list -> int list -> int = +let rec compare_int_lists : int list -> int list -> int = fun a b -> - let first_non_zero is = - List.fold_left (fun a b -> if a <> 0 then a else b) 0 is - in - first_non_zero (List.map2 compare a b) + match (a, b) with + | [], [] -> + 0 + | [], _ -> + -1 + | _, [] -> + 1 + | x :: xs, y :: ys -> + let r = compare x y in + if r <> 0 then r else compare_int_lists xs ys let group_by f list = let evaluated_list = List.map (fun x -> (x, f x)) list in @@ -913,41 +919,69 @@ let sort_by_schwarzian ?(descending = false) f list = |> List.sort (fun (_, x') (_, y') -> comp x' y') |> List.map (fun (x, _) -> x) -let platform_version_inverness = [2; 4; 0] +let version_keys_list = + Xapi_globs.[_platform_version; _xapi_build_version; _xen_version] -let version_string_of : __context:Context.t -> [`host] api_object -> string = - fun ~__context host -> - try - let software_version = - match host with - | LocalObject host_ref -> - Db.Host.get_software_version ~__context ~self:host_ref - | RemoteObject (rpc, session_id, host_ref) -> - Client.Client.Host.get_software_version ~rpc ~session_id - ~self:host_ref - in - List.assoc Xapi_globs._platform_version software_version - with Not_found -> Xapi_globs.default_platform_version +let get_software_versions ~__context host = + ( match host with + | LocalObject self -> + Db.Host.get_software_version ~__context ~self + | RemoteObject (rpc, session_id, self) -> + Client.Client.Host.get_software_version ~rpc ~session_id ~self + ) + |> List.filter (fun (k, _) -> List.mem k version_keys_list) + +let versions_string_of : (string * string) list -> string = + fun ver_list -> + ver_list + |> List.map (fun (k, v) -> Printf.sprintf "%s: %s" k v) + |> String.concat "," + +let version_numbers_of_string version_string = + ( match String.split_on_char '-' version_string with + | [standard_version; patch] -> + String.split_on_char '.' standard_version @ [patch] + | [standard_version] -> + String.split_on_char '.' standard_version + | _ -> + ["0"; "0"; "0"] + ) + |> List.filter_map int_of_string_opt -let version_of : __context:Context.t -> [`host] api_object -> int list = - fun ~__context host -> - let vs = version_string_of ~__context host in - List.map int_of_string (String.split_on_char '.' vs) +let version_of : version_key:string -> (string * string) list -> int list = + fun ~version_key versions_list -> + List.assoc_opt version_key versions_list + |> Option.value ~default:"0.0.0" + |> version_numbers_of_string (* Compares host versions, analogous to Stdlib.compare. *) -let compare_host_platform_versions : - __context:Context.t -> [`host] api_object -> [`host] api_object -> int = - fun ~__context host_a host_b -> - let version_of = version_of ~__context in - compare_int_lists (version_of host_a) (version_of host_b) - -let max_version_in_pool : __context:Context.t -> int list = +let compare_versions : + version_key:string + -> (string * string) list + -> (string * string) list + -> int = + fun ~version_key sw_ver_a sw_ver_b -> + let version_a = version_of ~version_key sw_ver_a in + let version_b = version_of ~version_key sw_ver_b in + compare_int_lists version_a version_b + +let compare_all_versions ~is_greater_or_equal:a ~than:b = + List.for_all + (fun version_key -> compare_versions ~version_key a b >= 0) + version_keys_list + +let max_version_in_pool : __context:Context.t -> (string * string) list = fun ~__context -> let max_version a b = - if a = [] then b else if compare_int_lists a b > 0 then a else b + if a = [] then + b + else if compare_all_versions ~is_greater_or_equal:a ~than:b then + a + else + b and versions = List.map - (fun host_ref -> version_of ~__context (LocalObject host_ref)) + (fun host_ref -> get_software_versions ~__context (LocalObject host_ref)) (Db.Host.get_all ~__context) in List.fold_left max_version [] versions @@ -955,21 +989,30 @@ let max_version_in_pool : __context:Context.t -> int list = let host_has_highest_version_in_pool : __context:Context.t -> host:[`host] api_object -> bool = fun ~__context ~host -> - let host_version = version_of ~__context host + let host_versions = get_software_versions ~__context host and max_version = max_version_in_pool ~__context in - compare_int_lists host_version max_version >= 0 + compare_all_versions ~is_greater_or_equal:host_versions ~than:max_version let host_versions_not_decreasing ~__context ~host_from ~host_to = - compare_host_platform_versions ~__context host_from host_to <= 0 + let sw_vers_from = get_software_versions ~__context host_from in + let sw_vers_to = get_software_versions ~__context host_to in + compare_all_versions ~is_greater_or_equal:sw_vers_to ~than:sw_vers_from -let is_platform_version_same_on_master ~__context ~host = +let are_host_versions_same_on_master_inner ~__context ~host ~master = if is_pool_master ~__context ~host then true else - let master = get_master ~__context in - compare_host_platform_versions ~__context (LocalObject master) - (LocalObject host) - = 0 + let sw_ver_master = get_software_versions ~__context (LocalObject master) in + let sw_ver_host = get_software_versions ~__context (LocalObject host) in + List.for_all + (fun version_key -> + compare_versions ~version_key sw_ver_master sw_ver_host = 0 + ) + version_keys_list + +let are_host_versions_same_on_master ~__context ~host = + let master = get_master ~__context in + are_host_versions_same_on_master_inner ~__context ~host ~master let maybe_raise_vtpm_unimplemented func message = if not !ignore_vtpm_unimplemented then ( @@ -977,8 +1020,8 @@ let maybe_raise_vtpm_unimplemented func message = raise Api_errors.(Server_error (not_implemented, [message])) ) -let assert_platform_version_is_same_on_master ~__context ~host ~self = - if not (is_platform_version_same_on_master ~__context ~host) then +let assert_host_versions_are_same_on_master ~__context ~host ~self = + if not (are_host_versions_same_on_master ~__context ~host) then raise (Api_errors.Server_error ( Api_errors.vm_host_incompatible_version @@ -1004,15 +1047,14 @@ let assert_host_has_highest_version_in_pool : let pool_has_different_host_platform_versions ~__context = let all_hosts = Db.Host.get_all ~__context in - let platform_versions = - List.map - (fun host -> version_string_of ~__context (LocalObject host)) - all_hosts - in - let is_different_to_me platform_version = - platform_version <> Xapi_version.platform_version () - in - List.exists is_different_to_me platform_versions + let master = get_master ~__context in + not + (List.for_all + (fun host -> + are_host_versions_same_on_master_inner ~__context ~host ~master + ) + all_hosts + ) (* Checks that a host has a PBD for a particular SR (meaning that the SR is visible to the host) *) diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index 3688478dce..ce2f9aeb0f 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/ocaml/xapi/xapi_globs.ml @@ -151,6 +151,10 @@ let _dbv = "dbv" let _db_schema = "db_schema" +let _xapi_build_version = "xapi_build" + +let _xen_version = "xen" + (* When comparing two host versions, always treat a host that has platform_version defined as newer * than any host that does not have platform_version defined. * Substituting this default when a host does not have platform_version defined will be acceptable, diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index 1bf3e4d9b6..6c714f24f1 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -285,13 +285,18 @@ let compute_evacuation_plan_no_wlb ~__context ~host ?(ignore_ha = false) () = the source host. So as long as host versions aren't decreasing, we're allowed to migrate VMs between hosts. *) debug "evacuating host version: %s" - (Helpers.version_string_of ~__context (Helpers.LocalObject host)) ; + (Helpers.get_software_versions ~__context (Helpers.LocalObject host) + |> Helpers.versions_string_of + ) ; let target_hosts = List.filter (fun target -> debug "host %s version: %s" (Db.Host.get_hostname ~__context ~self:target) - (Helpers.version_string_of ~__context (Helpers.LocalObject target)) ; + Helpers.( + get_software_versions ~__context (LocalObject target) + |> versions_string_of + ) ; Helpers.host_versions_not_decreasing ~__context ~host_from:(Helpers.LocalObject host) ~host_to:(Helpers.LocalObject target) diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 68d07bfac1..069e840731 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -65,7 +65,7 @@ let update_allowed_operations ~__context ~self = let assert_can_boot_here ~__context ~self ~host = let snapshot = Db.VM.get_record ~__context ~self in if Helpers.rolling_upgrade_in_progress ~__context then - Helpers.assert_platform_version_is_same_on_master ~__context ~host ~self ; + Helpers.assert_host_versions_are_same_on_master ~__context ~host ~self ; assert_can_boot_here ~__context ~self ~host ~snapshot ~do_cpuid_check:true () let retrieve_wlb_recommendations ~__context ~vm = diff --git a/ocaml/xapi/xapi_vm_lifecycle.ml b/ocaml/xapi/xapi_vm_lifecycle.ml index 4daa9c3b56..b9cc6b884b 100644 --- a/ocaml/xapi/xapi_vm_lifecycle.ml +++ b/ocaml/xapi/xapi_vm_lifecycle.ml @@ -309,26 +309,6 @@ let report_concurrent_operations_error ~current_ops ~ref_str = ) let check_vgpu ~__context ~op ~ref_str ~vgpus ~power_state = - let is_migratable vgpu = - try - (* Prevent VMs with VGPU from being migrated from pre-Jura to Jura and later hosts during RPU *) - let host_from = - Db.VGPU.get_VM ~__context ~self:vgpu |> fun vm -> - Db.VM.get_resident_on ~__context ~self:vm |> fun host -> - Helpers.LocalObject host - in - (* true if platform version of host_from more than inverness' 2.4.0 *) - Helpers.( - compare_int_lists - (version_of ~__context host_from) - platform_version_inverness - ) - > 0 - with e -> - debug "is_migratable: %s" (ExnHelper.string_of_exn e) ; - (* best effort: yes if not possible to decide *) - true - in let is_suspendable vgpu = Db.VGPU.get_type ~__context ~self:vgpu |> fun self -> Db.VGPU_type.get_implementation ~__context ~self |> function @@ -343,9 +323,7 @@ let check_vgpu ~__context ~op ~ref_str ~vgpus ~power_state = match op with | `migrate_send when power_state = `Halted -> None - | (`pool_migrate | `migrate_send) - when List.for_all is_migratable vgpus && List.for_all is_suspendable vgpus - -> + | (`pool_migrate | `migrate_send) when List.for_all is_suspendable vgpus -> None | `checkpoint when power_state = `Suspended -> None