CP-308854 Add host.get_ntp_servers_status

Signed-off-by: Changlei Li <changlei.li@cloud.com>

Author: changlei-li

ocaml/idl/datamodel_host.ml

@@ -2585,6 +2585,17 @@ let enable_ntp =
     ~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
@@ -2734,6 +2745,7 @@ let t =
       ; set_ntp_custom_servers
       ; disable_ntp
       ; enable_ntp
+      ; get_ntp_servers_status
       ]
     ~contents:
       ([

ocaml/xapi/message_forwarding.ml

@@ -4150,6 +4150,13 @@ functor
         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

@@ -805,6 +805,8 @@ 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"
@@ -1848,6 +1850,11 @@ let other_options =
     , (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)

ocaml/xapi/xapi_host.ml

@@ -3461,3 +3461,9 @@ let sync_ntp_config ~__context ~host =
     Db.Host.set_ntp_custom_servers ~__context ~self:host ~value:servers ;
   let ntp_enabled = Xapi_host_ntp.is_ntp_service_active () in
   Db.Host.set_ntp_enabled ~__context ~self:host ~value:ntp_enabled
+
+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

@@ -607,3 +607,6 @@ val enable_ntp : __context:Context.t -> self:API.ref_host -> unit
 val disable_ntp : __context:Context.t -> self:API.ref_host -> unit
 
 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

ocaml/xapi/xapi_host_ntp.ml

@@ -117,3 +117,41 @@ let is_ntp_dhcp_enabled () =
     let stat = Unix.stat !Xapi_globs.ntp_dhcp_script in
     stat.Unix.st_perm land 0o100 <> 0
   with _ -> false
+
+(* chronyc -c sources output the ntp servers status in csv format. Example:
+    ^,-,10.62.16.11,5,6,377,54,0.000496471,0.000496471,0.071449950
+    ^,?,17.253.14.123,0,8,0,4294967295,0.000000000,0.000000000,0.000000000
+    ^,?,104.40.149.189,0,8,0,4294967295,0.000000000,0.000000000,0.000000000
+    ^,*,10.71.56.11,5,6,377,57,-0.000006851,-0.000118707,0.082518920
+   Source mode: '^' = server, '=' = peer, '#' = local clock.
+   Source state: '*' = current synced, '+' = combined, '-' = not combined,
+        '?' = unreachable, 'x' = time may be in error, '~' = time too variable
+*)
+let get_servers_status () =
+  let convert = function
+    | "*" ->
+        "synced"
+    | "+" ->
+        "combined"
+    | "-" ->
+        "uncombined"
+    | "x" ->
+        "error"
+    | "~" ->
+        "variable"
+    | "?" ->
+        "unreachable"
+    | _ ->
+        "unknown"
+  in
+  let r = Helpers.call_script !Xapi_globs.ntp_client_path ["-c"; "sources"] in
+  let lines = String.split_on_char '\n' r in
+  List.filter_map
+    (fun line ->
+      line |> String.trim |> String.split_on_char ',' |> function
+      | "^" :: status :: server :: _ ->
+          Some (server, convert status)
+      | _ ->
+          None
+    )
+    lines

ocaml/xapi/xapi_host_ntp.mli

@@ -31,3 +31,5 @@ val is_ntp_service_active : unit -> bool
 val get_servers_from_conf : unit -> string list
 
 val is_ntp_dhcp_enabled : unit -> bool
+
+val get_servers_status : unit -> (string * string) list