CA-422071: guard against losing Host field settings on pool join (#6799)

This only looks at newly added fields (those with an empty `lifecycle`),
and requires them to be present in `Host.create_params`. This ensures
that we get a compile error, and are forced to propagate it during pool
join.

Otherwise newly added fields seem to keep reintroducing this bug with
every newly added feature (e.g. the pending NTP feature branch has this
bug on most of its fields).

So far I only found this bug on the update guidance fields. There are
more bugs on other pre-existing fields in older releases, but those are
skipped by the unit test (there are too many, `logging`, `iscsi_iqn`,
etc.).
We do want to eventually fix those, but it'll require a lot more
testing, so will be done separately (also some of them are actually
overwritten in dbsync_slave).

There are a lot more properties we could check in the unit test (e.g.
that all newly added parameters have defaults for backwards
compatibility, that the doc and type matches the field, etc.).
Although eventually I'd probably want to entirely auto-generate
`create_params`, but we'll need to see how to do that to also take into
account what dbsync_slave already does.

Author: robhoes

ocaml/idl/datamodel_host.ml

@@ -1226,6 +1226,24 @@ let host_numa_affinity_policy =
       ]
     )
 
+let latest_synced_updates_applied_state =
+  Enum
+    ( "latest_synced_updates_applied_state"
+    , [
+        ( "yes"
+        , "The host is up to date with the latest updates synced from remote \
+           CDN"
+        )
+      ; ( "no"
+        , "The host is outdated with the latest updates synced from remote CDN"
+        )
+      ; ( "unknown"
+        , "If the host is up to date with the latest updates synced from \
+           remote CDN is unknown"
+        )
+      ]
+    )
+
 let create_params =
   [
     {
@@ -1430,6 +1448,36 @@ let create_params =
     ; param_release= numbered_release "25.39.0-next"
     ; param_default= Some (VEnum "default_policy")
     }
+  ; {
+      param_type= latest_synced_updates_applied_state
+    ; param_name= "latest_synced_updates_applied"
+    ; param_doc=
+        "Default as 'unknown', 'yes' if the host is up to date with updates \
+         synced from remote CDN, otherwise 'no'"
+    ; param_release= numbered_release "25.39.0-next"
+    ; param_default= Some (VSet [])
+    }
+  ; {
+      param_type= Set update_guidances
+    ; param_name= "pending_guidances_full"
+    ; param_doc=
+        "The set of pending full guidances after applying updates, which a \
+         user should follow to make some updates, e.g. specific hardware \
+         drivers or CPU features, fully effective, but the 'average user' \
+         doesn't need to"
+    ; param_release= numbered_release "25.39.0-next"
+    ; param_default= Some (VSet [])
+    }
+  ; {
+      param_type= Set update_guidances
+    ; param_name= "pending_guidances_recommended"
+    ; param_doc=
+        "The set of pending recommended guidances after applying updates, \
+         which most users should follow to make the updates effective, but if \
+         not followed, will not cause a failure"
+    ; param_release= numbered_release "25.39.0-next"
+    ; param_default= Some (VSet [])
+    }
   ]
 
 let create =
@@ -2542,24 +2590,6 @@ let update_firewalld_service_status =
        status."
     ~allowed_roles:_R_POOL_OP ()
 
-let latest_synced_updates_applied_state =
-  Enum
-    ( "latest_synced_updates_applied_state"
-    , [
-        ( "yes"
-        , "The host is up to date with the latest updates synced from remote \
-           CDN"
-        )
-      ; ( "no"
-        , "The host is outdated with the latest updates synced from remote CDN"
-        )
-      ; ( "unknown"
-        , "If the host is up to date with the latest updates synced from \
-           remote CDN is unknown"
-        )
-      ]
-    )
-
 let get_tracked_user_agents =
   call ~name:"get_tracked_user_agents" ~lifecycle:[]
     ~doc:

ocaml/idl/dune

@@ -64,9 +64,9 @@
 )
 
 (tests
-  (names schematest test_datetimes)
+  (names schematest test_datetimes test_host)
   (modes exe)
-  (modules schematest test_datetimes)
+  (modules schematest test_datetimes test_host)
   (libraries
     astring
     rpclib.core

ocaml/idl/test_host.ml

@@ -0,0 +1,31 @@
+module DT = Datamodel_types
+module FieldSet = Astring.String.Set
+
+let recent_field (f : DT.field) = f.lifecycle.transitions = []
+
+let rec field_full_names = function
+  | DT.Field f ->
+      if recent_field f then
+        f.full_name |> String.concat "_" |> Seq.return
+      else
+        Seq.empty
+  | DT.Namespace (_, xs) ->
+      xs |> List.to_seq |> Seq.concat_map field_full_names
+
+let () =
+  let create_params =
+    Datamodel_host.create_params
+    |> List.map (fun p -> p.DT.param_name)
+    |> FieldSet.of_list
+  and fields =
+    Datamodel_host.t.contents
+    |> List.to_seq
+    |> Seq.concat_map field_full_names
+    |> FieldSet.of_seq
+  in
+  let missing_in_create_params = FieldSet.diff fields create_params in
+  if not (FieldSet.is_empty missing_in_create_params) then (
+    Format.eprintf "Missing fields in create_params: %a@." FieldSet.dump
+      missing_in_create_params ;
+    exit 1
+  )

ocaml/idl/test_host.mli

@@ -185,6 +185,8 @@ let make_host ~__context ?(uuid = make_uuid ()) ?(name_label = "host")
       ~console_idle_timeout ~ssh_auto_mode ~secure_boot
       ~software_version:(Xapi_globs.software_version ())
       ~https_only ~numa_affinity_policy:`default_policy
+      ~latest_synced_updates_applied:`unknown ~pending_guidances_full:[]
+      ~pending_guidances_recommended:[]
   in
   Db.Host.set_cpu_info ~__context ~self:host ~value:default_cpu_info ;
   host

ocaml/tests/common/test_common.ml

@@ -28,6 +28,8 @@ let add_host __context name =
        ~console_idle_timeout:0L ~ssh_auto_mode:false ~secure_boot:false
        ~software_version:(Xapi_globs.software_version ())
        ~https_only:false ~numa_affinity_policy:`default_policy
+       ~latest_synced_updates_applied:`unknown ~pending_guidances_full:[]
+       ~pending_guidances_recommended:[]
     )
 
 (* Creates an unlicensed pool with the maximum number of hosts *)

ocaml/tests/test_host.ml

@@ -67,6 +67,8 @@ let create_localhost ~__context info =
         ~ssh_auto_mode:!Xapi_globs.ssh_auto_mode_default
         ~secure_boot:false ~software_version:[]
         ~https_only:!Xapi_globs.https_only ~numa_affinity_policy:`default_policy
+        ~latest_synced_updates_applied:`unknown ~pending_guidances_full:[]
+        ~pending_guidances_recommended:[]
     in
     ()
 

ocaml/xapi/dbsync_slave.ml

@@ -1029,7 +1029,9 @@ let create ~__context ~uuid ~name_label ~name_description:_ ~hostname ~address
     ~license_params ~edition ~license_server ~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 ~https_only ~numa_affinity_policy =
+    ~secure_boot ~software_version ~https_only ~numa_affinity_policy
+    ~latest_synced_updates_applied ~pending_guidances_full
+    ~pending_guidances_recommended =
   (* fail-safe. We already test this on the joining host, but it's racy, so multiple concurrent
      pool-join might succeed. Note: we do it in this order to avoid a problem checking restrictions during
      the initial setup of the database *)
@@ -1090,8 +1092,8 @@ let create ~__context ~uuid ~name_label ~name_description:_ ~hostname ~address
     ~control_domain:Ref.null ~updates_requiring_reboot:[] ~iscsi_iqn:""
     ~multipathing:false ~uefi_certificates:"" ~editions:[] ~pending_guidances:[]
     ~tls_verification_enabled ~last_software_update ~last_update_hash
-    ~recommended_guidances:[] ~latest_synced_updates_applied:`unknown
-    ~pending_guidances_recommended:[] ~pending_guidances_full:[] ~ssh_enabled
+    ~recommended_guidances:[] ~latest_synced_updates_applied
+    ~pending_guidances_recommended ~pending_guidances_full ~ssh_enabled
     ~ssh_enabled_timeout ~ssh_expiry ~console_idle_timeout ~ssh_auto_mode
     ~secure_boot ;
   (* If the host we're creating is us, make sure its set to live *)

ocaml/xapi/xapi_host.ml

@@ -140,6 +140,9 @@ val create :
   -> software_version:(string * string) list
   -> https_only:bool
   -> numa_affinity_policy:API.host_numa_affinity_policy
+  -> latest_synced_updates_applied:API.latest_synced_updates_applied_state
+  -> pending_guidances_full:API.update_guidances_set
+  -> pending_guidances_recommended:API.update_guidances_set
   -> [`host] Ref.t
 
 val destroy : __context:Context.t -> self:API.ref_host -> unit

ocaml/xapi/xapi_host.mli

@@ -1063,6 +1063,11 @@ let rec create_or_get_host_on_master __context rpc session_id (host_ref, host) :
           ~software_version:host.API.host_software_version
           ~https_only:host.API.host_https_only
           ~numa_affinity_policy:host.API.host_numa_affinity_policy
+          ~latest_synced_updates_applied:
+            host.API.host_latest_synced_updates_applied
+          ~pending_guidances_full:host.API.host_pending_guidances_full
+          ~pending_guidances_recommended:
+            host.API.host_pending_guidances_recommended
       in
       (* Copy other-config into newly created host record: *)
       no_exn