CP-54471 Configure Dom0 NTP via XAPI

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/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

ocaml/xapi/xapi_globs.ml

@@ -795,6 +795,16 @@ let stunnel_conf = ref "/etc/stunnel/xapi.conf"
 
 let udhcpd_conf = ref (Filename.concat "/etc/xensource" "udhcpd.conf")
 
+let ntp_service = ref "chronyd"
+
+let ntp_conf = ref (Filename.concat "/etc" "chrony.conf")
+
+let ntp_dhcp_script = ref (Filename.concat "/etc/dhcp/dhclient.d" "chrony.sh")
+
+let ntp_dhcp_dir = ref "/run/chrony-dhcp"
+
+let ntp_client_path = ref "/usr/bin/chronyc"
+
 let udhcpd_skel = ref (Filename.concat "/etc/xensource" "udhcpd.skel")
 
 let udhcpd_leases_db = ref "/var/lib/xcp/dhcp-leases.db"
@@ -1387,6 +1397,8 @@ let nvidia_gpumon_detach = ref false
 
 let failed_login_alert_freq = ref 3600
 
+let default_ntp_servers = ref []
+
 let other_options =
   [
     gen_list_option "sm-plugins"
@@ -1816,6 +1828,36 @@ let other_options =
     , (fun () -> string_of_int !max_span_depth)
     , "The maximum depth to which spans are recorded in a trace in Tracing"
     )
+  ; ( "ntp-service"
+    , Arg.Set_string ntp_service
+    , (fun () -> !ntp_service)
+    , "Name of the NTP service to manage"
+    )
+  ; ( "ntp-config-path"
+    , Arg.Set_string ntp_conf
+    , (fun () -> !ntp_conf)
+    , "Path to the ntp configuration file"
+    )
+  ; ( "ntp-dhcp-script-path"
+    , Arg.Set_string ntp_dhcp_script
+    , (fun () -> !ntp_dhcp_script)
+    , "Path to the ntp dhcp script file"
+    )
+  ; ( "ntp-dhcp-dir"
+    , Arg.Set_string ntp_dhcp_dir
+    , (fun () -> !ntp_dhcp_dir)
+    , "Path to the ntp dhcp directory"
+    )
+  ; ( "ntp-client-path"
+    , Arg.Set_string ntp_client_path
+    , (fun () -> !ntp_client_path)
+    , "Path to the ntp client binary"
+    )
+  ; gen_list_option "default-ntp-servers"
+      "space-separated list of default NTP servers"
+      (fun s -> s)
+      (fun s -> s)
+      default_ntp_servers
   ]
 
 (* The options can be set with the variable xapiflags in /etc/sysconfig/xapi.

ocaml/xapi/xapi_host.ml

@@ -1094,7 +1094,8 @@ let create ~__context ~uuid ~name_label ~name_description:_ ~hostname ~address
     ~recommended_guidances:[] ~latest_synced_updates_applied:`unknown
     ~pending_guidances_recommended:[] ~pending_guidances_full:[] ~ssh_enabled
     ~ssh_enabled_timeout ~ssh_expiry ~console_idle_timeout ~ssh_auto_mode
-    ~max_cstate:"" ~secure_boot ;
+    ~max_cstate:"" ~secure_boot ~ntp_mode:`ntp_mode_dhcp ~ntp_custom_servers:[]
+    ~ntp_enabled:false ;
   (* If the host we're creating is us, make sure its set to live *)
   Db.Host_metrics.set_last_updated ~__context ~self:metrics ~value:(Date.now ()) ;
   Db.Host_metrics.set_live ~__context ~self:metrics ~value:host_is_us ;
@@ -3374,3 +3375,64 @@ let sync_max_cstate ~__context ~host =
     let value = Xapi_host_max_cstate.to_string (max_cstate, max_sub_cstate) in
     Db.Host.set_max_cstate ~__context ~self:host ~value
   with e -> error "Failed to sync max_cstate: %s" (Printexc.to_string e)
+
+let set_ntp_mode ~__context ~self ~value =
+  let current_mode = Db.Host.get_ntp_mode ~__context ~self in
+  let ntp_enabled = Db.Host.get_ntp_enabled ~__context ~self in
+  if current_mode <> value then (
+    let open Xapi_host_ntp in
+    let ensure_custom_servers_exist servers =
+      if servers = [] then
+        Helpers.internal_error "ntp_custom_servers is empty, please set first"
+    in
+    let default_servers = !Xapi_globs.default_ntp_servers in
+    ( match (current_mode, value) with
+    | `ntp_mode_dhcp, `ntp_mode_custom ->
+        let custom_servers = Db.Host.get_ntp_custom_servers ~__context ~self in
+        ensure_custom_servers_exist custom_servers ;
+        remove_dhcp_ntp_servers () ;
+        set_servers_in_conf custom_servers
+    | `ntp_mode_default, `ntp_mode_custom ->
+        let custom_servers = Db.Host.get_ntp_custom_servers ~__context ~self in
+        ensure_custom_servers_exist custom_servers ;
+        set_servers_in_conf custom_servers
+    | _, `ntp_mode_dhcp ->
+        clear_servers_in_conf () ; add_dhcp_ntp_servers ()
+    | `ntp_mode_dhcp, `ntp_mode_default ->
+        remove_dhcp_ntp_servers () ;
+        set_servers_in_conf default_servers
+    | `ntp_mode_custom, `ntp_mode_default ->
+        set_servers_in_conf default_servers
+    | _, _ ->
+        ()
+    ) ;
+    if ntp_enabled then Xapi_host_ntp.restart_ntp_service () ;
+    Db.Host.set_ntp_mode ~__context ~self ~value
+  )
+
+let set_ntp_custom_servers ~__context ~self ~value =
+  let current_mode = Db.Host.get_ntp_mode ~__context ~self in
+  match (current_mode, value) with
+  | `ntp_mode_custom, [] ->
+      Helpers.internal_error
+        "ntp_mode is custom, can't clear ntp_custom_servers"
+  | `ntp_mode_custom, servers ->
+      Xapi_host_ntp.set_servers_in_conf servers ;
+      Xapi_host_ntp.restart_ntp_service () ;
+      Db.Host.set_ntp_custom_servers ~__context ~self ~value
+  | _ ->
+      Db.Host.set_ntp_custom_servers ~__context ~self ~value
+
+let enable_ntp ~__context ~self =
+  Xapi_host_ntp.enable_ntp_service () ;
+  Db.Host.set_ntp_enabled ~__context ~self ~value:true
+
+let disable_ntp ~__context ~self =
+  Xapi_host_ntp.disable_ntp_service () ;
+  Db.Host.set_ntp_enabled ~__context ~self ~value:false
+
+let get_ntp_servers_status ~__context ~self:_ =
+  if Xapi_host_ntp.is_ntp_service_active () then
+    Xapi_host_ntp.get_servers_status ()
+  else
+    []

ocaml/xapi/xapi_host.mli

@@ -595,3 +595,16 @@ val set_max_cstate :
   __context:Context.t -> self:API.ref_host -> value:string -> unit
 
 val sync_max_cstate : __context:Context.t -> host:API.ref_host -> unit
+
+val set_ntp_mode :
+  __context:Context.t -> self:API.ref_host -> value:API.host_ntp_mode -> unit
+
+val set_ntp_custom_servers :
+  __context:Context.t -> self:API.ref_host -> value:string list -> unit
+
+val enable_ntp : __context:Context.t -> self:API.ref_host -> unit
+
+val disable_ntp : __context:Context.t -> self:API.ref_host -> unit
+
+val get_ntp_servers_status :
+  __context:Context.t -> self:API.ref_host -> (string * string) list