CP-54471 Configure Dom0 NTP via XAPI (#6689)

New filed: `host.ntp_mode`, `host.ntp_custom_servers`
New API: `host.set_ntp_mode`, `host.set_ntp_custom_servers`,
`host.get_ntp_mode`, `host.get_ntp_custom_servers`,
`host.get_ntp_servers_status`.

**ntp_mode_dhcp**: In this mode, ntp uses the dhcp assigned ntp servers
as sources. In Dom0, dhclient triggers `chrony.sh` to update the ntp
servers when network event happens. It writes ntp servers to
`/run/chrony-dhcp/$interface.sources` and the dir `/run/chrony-dhcp` is
included in `chrony.conf`. The dhclient also stores dhcp lease in
`/var/lib/xcp/dhclient-$interface.leases`, see
https://github.com/xapi-project/xen-api/blob/v25.31.0/ocaml/networkd/lib/network_utils.ml#L925.
When switch ntp mode to dhcp, XAPI checks the lease file and finds ntp
server then fills chrony-dhcp file. The exec permission of `chrony.sh`
is added. When swith ntp mode from dhcp to others, XAPI removes the
chrony-dhcp files and the exec permission of `chrony.sh`. The operation
is same with xsconsole
https://github.com/xapi-project/xsconsole/blob/v11.1.1/XSConsoleData.py#L593.
In this feature, xsconsole will change to use XenAPI to manage ntp later
to avoid conflict.

**ntp_mode_custom**: In this mode, ntp uses `host.ntp_custom_servers` as
sources. This is implemented by changing `chrony.conf` and restart
chronyd. `host.ntp_custom_servers` is set by the user.

**ntp_mode_default**: In this mode, ntp uses default-ntp-servers in XAPI
config file.

Author: changlei-li

ocaml/idl/datamodel_errors.ml

@@ -2062,6 +2062,9 @@ let _ =
   error Api_errors.sysprep ["vm"; "message"]
     ~doc:"VM.sysprep error with details in the message" () ;
 
+  error Api_errors.invalid_ntp_config ["reason"]
+    ~doc:"The NTP configuration is invalid." () ;
+
   message
     (fst Api_messages.ha_pool_overcommitted)
     ~doc:

ocaml/idl/datamodel_host.ml

@@ -2544,6 +2544,58 @@ let set_max_cstate =
       ]
     ~allowed_roles:_R_POOL_OP ()
 
+let host_ntp_mode =
+  Enum
+    ( "host_ntp_mode"
+    , [
+        ("ntp_mode_dhcp", "Using NTP servers assigned by DHCP to sync time")
+      ; ( "ntp_mode_custom"
+        , "Using custom NTP servers configured by user to sync time"
+        )
+      ; ("ntp_mode_default", "Using default NTP servers to sync time")
+      ]
+    )
+
+let set_ntp_mode =
+  call ~name:"set_ntp_mode" ~lifecycle:[] ~doc:"Set the NTP mode for the host"
+    ~params:
+      [
+        (Ref _host, "self", "The host")
+      ; (host_ntp_mode, "value", "The NTP mode to set")
+      ]
+    ~allowed_roles:_R_POOL_OP ()
+
+let set_ntp_custom_servers =
+  call ~name:"set_ntp_custom_servers" ~lifecycle:[]
+    ~doc:"Set the custom NTP servers for the host"
+    ~params:
+      [
+        (Ref _host, "self", "The host")
+      ; (Set String, "value", "The set of custom NTP servers to configure")
+      ]
+    ~allowed_roles:_R_POOL_OP ()
+
+let disable_ntp =
+  call ~name:"disable_ntp" ~lifecycle:[] ~doc:"Disable NTP on the host"
+    ~params:[(Ref _host, "self", "The host")]
+    ~allowed_roles:_R_POOL_OP ()
+
+let enable_ntp =
+  call ~name:"enable_ntp" ~lifecycle:[] ~doc:"Enable NTP on the host"
+    ~params:[(Ref _host, "self", "The host")]
+    ~allowed_roles:_R_POOL_OP ()
+
+let get_ntp_servers_status =
+  call ~name:"get_ntp_servers_status" ~lifecycle:[]
+    ~doc:"Get the NTP servers status on the host"
+    ~params:[(Ref _host, "self", "The host")]
+    ~result:
+      ( Map (String, String)
+      , "The map of NTP server to its status, status may be \
+         synced/combined/uncombined/error/variable/unreachable/unknown"
+      )
+    ~allowed_roles:_R_READ_ONLY ()
+
 (** Hosts *)
 let t =
   create_obj ~in_db:true
@@ -2689,6 +2741,11 @@ let t =
       ; set_console_idle_timeout
       ; set_ssh_auto_mode
       ; set_max_cstate
+      ; set_ntp_mode
+      ; set_ntp_custom_servers
+      ; disable_ntp
+      ; enable_ntp
+      ; get_ntp_servers_status
       ]
     ~contents:
       ([
@@ -3156,6 +3213,16 @@ let t =
         ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:Bool
             ~default_value:(Some (VBool false)) "secure_boot"
             "Whether the host has booted in secure boot mode"
+        ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:host_ntp_mode
+            ~default_value:(Some (VEnum "ntp_mode_dhcp")) "ntp_mode"
+            "Indicates NTP servers are assigned by DHCP, or configured by \
+             user, or the default servers"
+        ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:(Set String)
+            ~default_value:(Some (VSet [])) "ntp_custom_servers"
+            "The set of NTP servers configured for the host"
+        ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:Bool
+            ~default_value:(Some (VBool false)) "ntp_enabled"
+            "Reflects whether NTP is enabled on the host"
         ]
       )
     ()

ocaml/idl/schematest.ml

@@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex
 (* BEWARE: if this changes, check that schema has been bumped accordingly in
    ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *)
 
-let last_known_schema_hash = "6fa9e85157804e2753dee31972b52b61"
+let last_known_schema_hash = "34c69ac52c1e6c1d46bc35f610562a58"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/tests/common/test_common.ml

@@ -221,7 +221,8 @@ let make_host2 ~__context ?(ref = Ref.make ()) ?(uuid = make_uuid ())
     ~pending_guidances_recommended:[] ~pending_guidances_full:[]
     ~last_update_hash:"" ~ssh_enabled:true ~ssh_enabled_timeout:0L
     ~ssh_expiry:Date.epoch ~console_idle_timeout:0L ~ssh_auto_mode:false
-    ~max_cstate:"" ~secure_boot:false ;
+    ~max_cstate:"" ~secure_boot:false ~ntp_mode:`ntp_mode_dhcp
+    ~ntp_custom_servers:[] ~ntp_enabled:false ;
   ref
 
 let make_pif ~__context ~network ~host ?(device = "eth0")

ocaml/xapi-cli-server/cli_frontend.ml

@@ -1098,6 +1098,24 @@ let rec cmdtable_data : (string * cmd_spec) list =
       ; flags= [Neverforward]
       }
     )
+  ; ( "host-enable-ntp"
+    , {
+        reqd= []
+      ; optn= []
+      ; help= "Enable ntp service on the host."
+      ; implementation= No_fd Cli_operations.host_enable_ntp
+      ; flags= [Host_selectors]
+      }
+    )
+  ; ( "host-disable-ntp"
+    , {
+        reqd= []
+      ; optn= []
+      ; help= "Disable ntp service on the host."
+      ; implementation= No_fd Cli_operations.host_disable_ntp
+      ; flags= [Host_selectors]
+      }
+    )
   ; ( "patch-upload"
     , {
         reqd= ["file-name"]

ocaml/xapi-cli-server/cli_operations.ml

@@ -7817,6 +7817,26 @@ let host_disable_ssh _printer rpc session_id params =
        params []
     )
 
+let host_enable_ntp _printer rpc session_id params =
+  ignore
+    (do_host_op rpc session_id
+       (fun _ host ->
+         let host = host.getref () in
+         Client.Host.enable_ntp ~rpc ~session_id ~self:host
+       )
+       params []
+    )
+
+let host_disable_ntp _printer rpc session_id params =
+  ignore
+    (do_host_op rpc session_id
+       (fun _ host ->
+         let host = host.getref () in
+         Client.Host.disable_ntp ~rpc ~session_id ~self:host
+       )
+       params []
+    )
+
 module SDN_controller = struct
   let introduce printer rpc session_id params =
     let port =

ocaml/xapi-cli-server/records.ml

@@ -3402,6 +3402,30 @@ let host_record rpc session_id host =
       ; make_field ~name:"secure-boot"
           ~get:(fun () -> string_of_bool (x ()).API.host_secure_boot)
           ()
+      ; make_field ~name:"ntp-mode"
+          ~get:(fun () ->
+            Record_util.host_ntp_mode_to_string (x ()).API.host_ntp_mode
+          )
+          ~set:(fun value ->
+            Client.Host.set_ntp_mode ~rpc ~session_id ~self:host
+              ~value:(Record_util.host_ntp_mode_of_string value)
+          )
+          ()
+      ; make_field ~name:"ntp-custom-servers"
+          ~get:(fun () -> concat_with_comma (x ()).API.host_ntp_custom_servers)
+          ~get_set:(fun () -> (x ()).API.host_ntp_custom_servers)
+          ~set:(fun value ->
+            Client.Host.set_ntp_custom_servers ~rpc ~session_id ~self:host
+              ~value:
+                (String.split_on_char ',' value
+                |> List.map String.trim
+                |> List.filter (( <> ) "")
+                )
+          )
+          ()
+      ; make_field ~name:"ntp_enabled"
+          ~get:(fun () -> string_of_bool (x ()).API.host_ntp_enabled)
+          ()
       ]
   }
 

ocaml/xapi-consts/api_errors.ml

@@ -1438,3 +1438,5 @@ let tls_verification_not_enabled_in_pool =
   add_error "TLS_VERIFICATION_NOT_ENABLED_IN_POOL"
 
 let sysprep = add_error "SYSPREP"
+
+let invalid_ntp_config = add_error "INVALID_NTP_CONFIG"

ocaml/xapi/dbsync_slave.ml

@@ -412,6 +412,9 @@ let update_env __context sync_keys =
   switched_sync Xapi_globs.sync_max_cstate (fun () ->
       Xapi_host.sync_max_cstate ~__context ~host:localhost
   ) ;
+  switched_sync Xapi_globs.sync_ntp_config (fun () ->
+      Xapi_host.sync_ntp_config ~__context ~host:localhost
+  ) ;
 
   switched_sync Xapi_globs.sync_secure_boot (fun () ->
       let result =

ocaml/xapi/message_forwarding.ml

@@ -4122,6 +4122,41 @@ functor
         let local_fn = Local.Host.set_max_cstate ~self ~value in
         let remote_fn = Client.Host.set_max_cstate ~self ~value in
         do_op_on ~local_fn ~__context ~host:self ~remote_fn
+
+      let set_ntp_mode ~__context ~self ~value =
+        info "Host.set_ntp_mode: host='%s' value='%s'"
+          (host_uuid ~__context self)
+          (Record_util.host_ntp_mode_to_string value) ;
+        let local_fn = Local.Host.set_ntp_mode ~self ~value in
+        let remote_fn = Client.Host.set_ntp_mode ~self ~value in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
+
+      let set_ntp_custom_servers ~__context ~self ~value =
+        info "Host.set_ntp_custom_servers: host='%s' value='%s'"
+          (host_uuid ~__context self)
+          ("[" ^ String.concat ", " value ^ "]") ;
+        let local_fn = Local.Host.set_ntp_custom_servers ~self ~value in
+        let remote_fn = Client.Host.set_ntp_custom_servers ~self ~value in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
+
+      let enable_ntp ~__context ~self =
+        info "Host.enable_ntp: host='%s'" (host_uuid ~__context self) ;
+        let local_fn = Local.Host.enable_ntp ~self in
+        let remote_fn = Client.Host.enable_ntp ~self in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
+
+      let disable_ntp ~__context ~self =
+        info "Host.disable_ntp: host='%s'" (host_uuid ~__context self) ;
+        let local_fn = Local.Host.disable_ntp ~self in
+        let remote_fn = Client.Host.disable_ntp ~self in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
+
+      let get_ntp_servers_status ~__context ~self =
+        info "Host.get_ntp_servers_status: host = '%s'"
+          (host_uuid ~__context self) ;
+        let local_fn = Local.Host.get_ntp_servers_status ~self in
+        let remote_fn = Client.Host.get_ntp_servers_status ~self in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
     end
 
     module Host_crashdump = struct