diff --git a/ocaml/idl/datamodel_errors.ml b/ocaml/idl/datamodel_errors.ml index 52543b509a..fbe8fc6284 100644 --- a/ocaml/idl/datamodel_errors.ml +++ b/ocaml/idl/datamodel_errors.ml @@ -2065,6 +2065,12 @@ let _ = error Api_errors.invalid_ntp_config ["reason"] ~doc:"The NTP configuration is invalid." () ; + error Api_errors.not_allowed_when_ntp_is_enabled ["host"] + ~doc:"The operation is not allowed on the host when the NTP is enabled." () ; + + error Api_errors.not_allowed_tz_in_localtime [] + ~doc:"The timezone is not allowed in localtime." () ; + message (fst Api_messages.ha_pool_overcommitted) ~doc: diff --git a/ocaml/idl/datamodel_host.ml b/ocaml/idl/datamodel_host.ml index 3d3c4d8e26..6d825f571c 100644 --- a/ocaml/idl/datamodel_host.ml +++ b/ocaml/idl/datamodel_host.ml @@ -2627,6 +2627,34 @@ 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 () + +let set_server_localtime = + call ~name:"set_server_localtime" ~lifecycle:[] + ~doc: + "Set the host's system clock in its local timezone when NTP is disabled." + ~params: + [ + (Ref _host, "self", "The host") + ; ( DateTime + , "value" + , "A datetime without timezone information. If UTC is specified, the \ + timezone will be ignored." + ) + ] + ~allowed_roles:_R_POOL_OP () + (** Hosts *) let t = create_obj ~in_db:true @@ -2779,6 +2807,8 @@ let t = ; disable_ntp ; enable_ntp ; get_ntp_servers_status + ; get_ntp_synchronized + ; set_server_localtime ] ~contents: ([ diff --git a/ocaml/libs/clock/date.mli b/ocaml/libs/clock/date.mli index 1ba0f19c9d..84385d26e1 100644 --- a/ocaml/libs/clock/date.mli +++ b/ocaml/libs/clock/date.mli @@ -21,7 +21,9 @@ datetime string. This timezone is determined when creating a value and cannot be changed. For timestamps created from datetime strings, the timezone is maintained. For all other values UTC is used. *) -type t +type tz = int option + +type t = {t: Ptime.t; tz: tz} (** Conversions *) diff --git a/ocaml/xapi-consts/api_errors.ml b/ocaml/xapi-consts/api_errors.ml index 14c5806135..e32c605f48 100644 --- a/ocaml/xapi-consts/api_errors.ml +++ b/ocaml/xapi-consts/api_errors.ml @@ -1440,3 +1440,8 @@ let tls_verification_not_enabled_in_pool = let sysprep = add_error "SYSPREP" let invalid_ntp_config = add_error "INVALID_NTP_CONFIG" + +let not_allowed_when_ntp_is_enabled = + add_error "NOT_ALLOWED_WHEN_NTP_IS_ENABLED" + +let not_allowed_tz_in_localtime = add_error "NOT_ALLOWED_TZ_IN_LOCALTIME" diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index d3cf4d9ae8..d0854af7a6 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -4170,6 +4170,26 @@ 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 + + let set_server_localtime ~__context ~self ~value = + info "Host.set_server_localtime: host = '%s'; value = '%s'" + (host_uuid ~__context self) + (Clock.Date.to_rfc3339 value) ; + if Db.Host.get_ntp_enabled ~__context ~self then + raise + (Api_errors.Server_error + (Api_errors.not_allowed_when_ntp_is_enabled, [Ref.string_of self]) + ) + else + let local_fn = Local.Host.set_server_localtime ~self ~value in + let remote_fn = Client.Host.set_server_localtime ~self ~value in + do_op_on ~local_fn ~__context ~host:self ~remote_fn end module Host_crashdump = struct diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml index 9250877bea..57526fd2e9 100644 --- a/ocaml/xapi/xapi_globs.ml +++ b/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) diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index c540eec265..a7371d03d6 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -3555,3 +3555,28 @@ 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 + +let set_server_localtime ~__context ~self:_ ~value = + let param = + match value with + | Date.{t; tz= Some 0} | Date.{t; tz= None} -> + (* Ideally it should be of a new type like NaiveDateTime. For + simplicity, reuse DateTime here. But it can't tell if the UTC is + specified explicitly or not. Just ignore it in that case. *) + let (y, mon, d), ((h, min, s), _) = Ptime.to_date_time t in + Printf.sprintf "%04i-%02i-%02i %02i:%02i:%02i" y mon d h min s + | _ -> + raise + (Api_errors.Server_error (Api_errors.not_allowed_tz_in_localtime, [])) + in + try + Helpers.call_script !Xapi_globs.timedatectl ["set-time"; param] |> ignore ; + () + with e -> Helpers.internal_error "%s" (ExnHelper.string_of_exn e) diff --git a/ocaml/xapi/xapi_host.mli b/ocaml/xapi/xapi_host.mli index bdf889d1ab..e6d0993a4e 100644 --- a/ocaml/xapi/xapi_host.mli +++ b/ocaml/xapi/xapi_host.mli @@ -627,3 +627,8 @@ 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 + +val set_server_localtime : + __context:Context.t -> self:API.ref_host -> value:Clock.Date.t -> unit diff --git a/ocaml/xapi/xapi_host_ntp.ml b/ocaml/xapi/xapi_host_ntp.ml index dd4bd86203..942490d127 100644 --- a/ocaml/xapi/xapi_host_ntp.ml +++ b/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) diff --git a/ocaml/xapi/xapi_host_ntp.mli b/ocaml/xapi/xapi_host_ntp.mli index d69194c866..8d8fdfe5b4 100644 --- a/ocaml/xapi/xapi_host_ntp.mli +++ b/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