Add host.get_ntp_synchronized and host.set_server_localtime

ocaml/idl/datamodel_host.ml

@@ -2627,6 +2627,19 @@ let get_ntp_servers_status =
       )
     ~allowed_roles:_R_READ_ONLY ()
 
+let get_ntp_synchronized =
+  call ~name:"get_ntp_synchronized" ~lifecycle:[]
+    ~doc:
+      "Returns true if the system clock on the host is synchronized with the \
+       NTP servers."
+    ~params:[(Ref _host, "self", "The host")]
+    ~result:
+      ( Bool
+      , "true if the system clock on the host is synchronized with the NTP \
+         servers."
+      )
+    ~allowed_roles:_R_READ_ONLY ()
+
 (** Hosts *)
 let t =
   create_obj ~in_db:true
@@ -2779,6 +2792,7 @@ let t =
       ; disable_ntp
       ; enable_ntp
       ; get_ntp_servers_status
+      ; get_ntp_synchronized
       ]
     ~contents:
       ([

ocaml/xapi/message_forwarding.ml

@@ -4170,6 +4170,12 @@ functor
         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
+
+      let get_ntp_synchronized ~__context ~self =
+        info "Host.get_ntp_synchronized: host = '%s'" (host_uuid ~__context self) ;
+        let local_fn = Local.Host.get_ntp_synchronized ~self in
+        let remote_fn = Client.Host.get_ntp_synchronized ~self in
+        do_op_on ~local_fn ~__context ~host:self ~remote_fn
     end
 
     module Host_crashdump = struct

ocaml/xapi/xapi_globs.ml

@@ -812,6 +812,8 @@ let ntp_dhcp_dir = ref "/run/chrony-dhcp"
 
 let ntp_client_path = ref "/usr/bin/chronyc"
 
+let timedatectl = ref "/usr/bin/timedatectl"
+
 let udhcpd_skel = ref (Filename.concat "/etc/xensource" "udhcpd.skel")
 
 let udhcpd_leases_db = ref "/var/lib/xcp/dhcp-leases.db"
@@ -1904,6 +1906,11 @@ let other_options =
     , (fun () -> !ntp_client_path)
     , "Path to the ntp client binary"
     )
+  ; ( "timedatectl"
+    , Arg.Set_string timedatectl
+    , (fun () -> !timedatectl)
+    , "Path to the timedatectl executable"
+    )
   ; gen_list_option "legacy-default-ntp-servers"
       "space-separated list of legacy default NTP servers"
       (fun s -> s)

ocaml/xapi/xapi_host.ml

@@ -3555,3 +3555,10 @@ let get_ntp_servers_status ~__context ~self:_ =
     Xapi_host_ntp.get_servers_status ()
   else
     []
+
+let get_ntp_synchronized ~__context ~self:_ =
+  match Xapi_host_ntp.is_synchronized () with
+  | Ok r ->
+      r
+  | Error msg ->
+      Helpers.internal_error "%s" msg

ocaml/xapi/xapi_host.mli

@@ -627,3 +627,5 @@ val sync_ntp_config : __context:Context.t -> host:API.ref_host -> unit
 
 val get_ntp_servers_status :
   __context:Context.t -> self:API.ref_host -> (string * string) list
+
+val get_ntp_synchronized : __context:Context.t -> self:API.ref_host -> bool

ocaml/xapi/xapi_host_ntp.ml

@@ -175,3 +175,12 @@ let promote_legacy_default_servers () =
     set_servers_in_conf defaults ;
     restart_ntp_service ()
   )
+
+let is_synchronized () =
+  let patterns = ["System clock synchronized: yes"; "NTP synchronized: yes"] in
+  try
+    Helpers.call_script !Xapi_globs.timedatectl ["status"]
+    |> String.split_on_char '\n'
+    |> List.exists ((Fun.flip List.mem) patterns)
+    |> Result.ok
+  with e -> Error (ExnHelper.string_of_exn e)

ocaml/xapi/xapi_host_ntp.mli

@@ -35,3 +35,5 @@ val get_servers_from_conf : unit -> string list
 val is_ntp_dhcp_enabled : unit -> bool
 
 val get_servers_status : unit -> (string * string) list
+
+val is_synchronized : unit -> (bool, string) Result.t