CA-417951: Migration and detecting RPU checks (#6698)

While attempting to improve these checks in
#6655, this caused the
system to detect false positives for detecting RPU.

This splits the logic between RPU and migration version checks.

Author: GabrielBuica

ocaml/idl/datamodel_host.ml

@@ -1391,6 +1391,13 @@ let create_params =
     ; param_release= numbered_release "25.32.0"
     ; param_default= Some (VBool false)
     }
+  ; {
+      param_type= Map (String, String)
+    ; param_name= "software_version"
+    ; param_doc= "Information about the software versions on the host"
+    ; param_release= numbered_release "25.32.0-next"
+    ; param_default= Some (VMap [])
+    }
   ]
 
 let create =

ocaml/tests/common/test_common.ml

@@ -181,6 +181,7 @@ let make_host ~__context ?(uuid = make_uuid ()) ?(name_label = "host")
       ~local_cache_sr ~chipset_info ~ssl_legacy ~last_software_update
       ~last_update_hash ~ssh_enabled ~ssh_enabled_timeout ~ssh_expiry
       ~console_idle_timeout ~ssh_auto_mode ~secure_boot
+      ~software_version:(Xapi_globs.software_version ())
   in
   Db.Host.set_cpu_info ~__context ~self:host ~value:default_cpu_info ;
   host

ocaml/tests/test_helpers.ml

@@ -510,7 +510,7 @@ module Version = struct
       ]
     in
     let test_version_numbers (description, version_string, expected) =
-      let actual = Helpers.version_numbers_of_string version_string in
+      let actual = Helpers.Checks.version_numbers_of_string version_string in
       let description =
         Printf.sprintf "version_numbers_of_string: %s" description
       in
@@ -553,13 +553,15 @@ module Version = struct
         ]
     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 actual =
+        Helpers.Checks.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 test_compare_all_versions_migration () =
     let current =
       Xapi_globs.[(_platform_version, "8.1.0"); (_xen_version, "4.13.0-15")]
     in
@@ -580,7 +582,8 @@ module Version = struct
     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
+        Helpers.Checks.Migration.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
@@ -592,7 +595,10 @@ module Version = struct
       ("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)
+    ; ( "Compare all versions for migration"
+      , `Quick
+      , test_compare_all_versions_migration
+      )
     ]
 
   let tests = [("Version compare tests", test)]

ocaml/tests/test_host.ml

@@ -26,6 +26,7 @@ let add_host __context name =
        ~last_software_update:Clock.Date.epoch ~last_update_hash:""
        ~ssh_enabled:true ~ssh_enabled_timeout:0L ~ssh_expiry:Clock.Date.epoch
        ~console_idle_timeout:0L ~ssh_auto_mode:false ~secure_boot:false
+       ~software_version:(Xapi_globs.software_version ())
     )
 
 (* Creates an unlicensed pool with the maximum number of hosts *)

ocaml/xapi/create_misc.ml

@@ -434,10 +434,6 @@ let create_root_user ~__context =
   if all = [] then
     Db.User.create ~__context ~ref ~fullname ~short_name ~uuid ~other_config:[]
 
-let get_xapi_verstring () =
-  Printf.sprintf "%d.%d" Xapi_version.xapi_version_major
-    Xapi_version.xapi_version_minor
-
 (** Create assoc list of Supplemental-Pack information.
  *  The package information is taking from the [XS-REPOSITORY] XML file in the package
  *  directory.
@@ -531,8 +527,7 @@ let make_software_version ~__context host_info =
   Xapi_globs.software_version ()
   @ v6_version
   @ [
-      (Xapi_globs._xapi_version, get_xapi_verstring ())
-    ; ("xapi_build", Xapi_version.version)
+      ("xapi_build", Xapi_version.version)
     ; ("xen", Option.value ~default:"(unknown)" host_info.xen_verstring)
     ; ("linux", host_info.linux_verstring)
     ; ("xencenter_min", Xapi_globs.xencenter_min_verstring)

ocaml/xapi/db_gc.ml

@@ -149,7 +149,7 @@ let detect_rolling_upgrade ~__context =
     (* NB: it is critical this code runs once in the master of a pool of one before the dbsync, since this
        		   is the only time at which the master's Version will be out of sync with its database record *)
     let actually_in_progress =
-      Helpers.pool_has_different_host_platform_versions ~__context
+      Helpers.Checks.RPU.pool_has_different_host_platform_versions ~__context
     in
     (* Check the current state of the Pool as indicated by the Pool.other_config:rolling_upgrade_in_progress *)
     let pools = Db.Pool.get_all ~__context in
@@ -168,9 +168,9 @@ let detect_rolling_upgrade ~__context =
           let host_versions =
             List.map
               (fun host ->
-                Helpers.get_software_versions ~__context
+                Helpers.Checks.RPU.get_software_versions ~__context
                   (Helpers.LocalObject host)
-                |> Helpers.versions_string_of
+                |> Helpers.Checks.versions_string_of
               )
               (Db.Host.get_all ~__context)
           in

ocaml/xapi/dbsync_slave.ml

@@ -65,7 +65,7 @@ let create_localhost ~__context info =
         ~ssh_expiry:Date.epoch
         ~console_idle_timeout:Constants.default_console_idle_timeout
         ~ssh_auto_mode:!Xapi_globs.ssh_auto_mode_default
-        ~secure_boot:false
+        ~secure_boot:false ~software_version:[]
     in
     ()