Add internal host level APIs

Signed-off-by: Ming Lu <ming.lu@cloud.com>

Author: minglumlu

ocaml/idl/datamodel_host.ml

@@ -1938,6 +1938,72 @@ let refresh_server_certificate =
     ~params:[(Ref _host, "host", "The host")]
     ~allowed_roles:_R_POOL_ADMIN ()
 
+let list_trusted_certificates =
+  call ~flags:[`Session] ~pool_internal:true ~hide_from_docs:true
+    ~name:"list_trusted_certificates"
+    ~doc:
+      "List the file names of all installed TLS trusted certificates on the \
+       host."
+    ~params:
+      [
+        (Ref _host, "host", "The host.")
+      ; ( Bool
+        , "ca"
+        , "The trusted certificates are root CA certificates used to verify \
+           chains (true), or leaf certificates used for certificate pinning \
+           (false)."
+        )
+      ]
+    ~result:
+      ( Set String
+      , "All root CA certificates used to verify chains when ca = true, or all \
+         leaf certificates used for certificate pinning when ca = false."
+      )
+    ~allowed_roles:_R_LOCAL_ROOT_ONLY ~lifecycle:[] ()
+
+let install_trusted_certificate =
+  call ~flags:[`Session] ~pool_internal:true ~hide_from_docs:true
+    ~name:"install_trusted_certificate"
+    ~doc:"Install a TLS trusted certificate on this host."
+    ~params:
+      [
+        (Ref _host, "host", "The host.")
+      ; ( Bool
+        , "ca"
+        , "The trusted certificate is a root CA certificate used to verify a \
+           chain (true), or a leaf certificate used for certificate pinning \
+           (false)."
+        )
+      ; (String, "name", "The file name of the certificate.")
+      ; (String, "cert", "The certificate in PEM format.")
+      ; ( Set Datamodel_certificate.certificate_purpose
+        , "purpose"
+        , "The purpose of the certificate."
+        )
+      ]
+    ~allowed_roles:_R_LOCAL_ROOT_ONLY ~lifecycle:[] ()
+
+let uninstall_trusted_certificate =
+  call ~flags:[`Session] ~pool_internal:true ~hide_from_docs:true
+    ~name:"uninstall_trusted_certificate"
+    ~doc:"Remove a TLS trusted certificate from this host."
+    ~params:
+      [
+        (Ref _host, "host", "The host.")
+      ; ( Bool
+        , "ca"
+        , "The trusted certificate is a root CA certificate used to verify a \
+           chain (true), or a leaf certificate used for certificate pinning \
+           (false)"
+        )
+      ; (String, "name", "The file name of the certificate.")
+      ; ( Bool
+        , "force"
+        , "If true, return success even if the file doesn't exist."
+        )
+      ]
+    ~allowed_roles:_R_LOCAL_ROOT_ONLY ~lifecycle:[] ()
+
 let display =
   Enum
     ( "host_display"
@@ -2897,6 +2963,9 @@ let t =
       ; list_timezones
       ; get_ntp_synchronized
       ; set_servertime
+      ; list_trusted_certificates
+      ; install_trusted_certificate
+      ; uninstall_trusted_certificate
       ]
     ~contents:
       ([

ocaml/xapi/certificates.ml

@@ -569,16 +569,15 @@ let sync_certs kind ~__context host =
       let ca = if kind = Root_CA then true else false in
       sync_certs_crls kind
         (fun rpc session_id host ->
-          []
-          (* TODO: Client.Host.list_trusted_certificates ~rpc ~session_id ~host ~ca *)
+          Client.Host.list_trusted_certificates ~rpc ~session_id ~host ~ca
         )
         (fun rpc session_id host name purpose cert ->
-          ()
-          (* TODO: Client.Host.install_trusted_certificate ~rpc ~session_id ~host ~ca ~name ~cert ~purpose *)
+          Client.Host.install_trusted_certificate ~rpc ~session_id ~host ~ca
+            ~name ~cert ~purpose
         )
         (fun rpc session_id host name ->
-          ()
-          (* TODO: Client.Host.uninstall_trusted_certificate ~rpc ~session_id ~host ~ca ~name ~force:false *)
+          Client.Host.uninstall_trusted_certificate ~rpc ~session_id ~host ~ca
+            ~name ~force:false
         )
         ~__context main_certs host
 

ocaml/xapi/message_forwarding.ml

@@ -4223,6 +4223,46 @@ functor
           let local_fn = Local.Host.set_servertime ~self ~value in
           let remote_fn = Client.Host.set_servertime ~self ~value in
           do_op_on ~local_fn ~__context ~host:self ~remote_fn
+
+      let list_trusted_certificates ~__context ~host ~ca =
+        info "Host.list_trusted_certificates: host = '%s'; ca = '%b'"
+          (host_uuid ~__context host)
+          ca ;
+        let local_fn = Local.Host.list_trusted_certificates ~host ~ca in
+        let remote_fn = Client.Host.list_trusted_certificates ~host ~ca in
+        do_op_on ~local_fn ~__context ~host ~remote_fn
+
+      let install_trusted_certificate ~__context ~host ~ca ~name ~cert ~purpose
+          =
+        info
+          "Host.install_trusted_certificate: host = '%s'; ca = '%b'; name = \
+           '%s'; purpose = [%s]"
+          (host_uuid ~__context host)
+          ca name
+          (List.map Record_util.certificate_purpose_to_string purpose
+          |> String.concat "; "
+          ) ;
+        let local_fn =
+          Local.Host.install_trusted_certificate ~host ~ca ~name ~cert ~purpose
+        in
+        let remote_fn =
+          Client.Host.install_trusted_certificate ~host ~ca ~name ~cert ~purpose
+        in
+        do_op_on ~local_fn ~__context ~host ~remote_fn
+
+      let uninstall_trusted_certificate ~__context ~host ~ca ~name ~force =
+        info
+          "Host.uninstall_trusted_certificate: host = '%s'; ca = '%b'; name = \
+           '%s'; force = '%b'"
+          (host_uuid ~__context host)
+          ca name force ;
+        let local_fn =
+          Local.Host.uninstall_trusted_certificate ~host ~ca ~name ~force
+        in
+        let remote_fn =
+          Client.Host.uninstall_trusted_certificate ~host ~ca ~name ~force
+        in
+        do_op_on ~local_fn ~__context ~host ~remote_fn
     end
 
     module Host_crashdump = struct

ocaml/xapi/xapi_host.ml

@@ -3618,3 +3618,20 @@ let set_servertime ~__context ~self ~value =
         raise (Invalid_argument "Missing timezone offset in value")
   with e ->
     Helpers.internal_error "%s: %s" __FUNCTION__ (ExnHelper.string_of_exn e)
+
+let list_trusted_certificates ~__context ~host:_ ~ca =
+  Certificates.local_list (if ca then Root_CA else Leaf_Pinned)
+
+let install_trusted_certificate ~__context ~host:_ ~ca ~name ~cert ~purpose =
+  Certificates.host_install ~purpose
+    (if ca then Root_CA else Leaf_Pinned)
+    ~name ~cert
+
+let uninstall_trusted_certificate ~__context ~host:_ ~ca ~name ~force =
+  List.iter
+    (fun purpose ->
+      Certificates.host_uninstall ~purpose
+        (if ca then Root_CA else Leaf_Pinned)
+        ~name ~force
+    )
+    ([] :: List.map (fun x -> [x]) API.certificate_purpose__all)

ocaml/xapi/xapi_host.mli

@@ -642,3 +642,23 @@ val get_ntp_synchronized : __context:Context.t -> self:API.ref_host -> bool
 
 val set_servertime :
   __context:Context.t -> self:API.ref_host -> value:Clock.Date.t -> unit
+
+val list_trusted_certificates :
+  __context:Context.t -> host:API.ref_host -> ca:bool -> string list
+
+val install_trusted_certificate :
+     __context:Context.t
+  -> host:API.ref_host
+  -> ca:bool
+  -> name:string
+  -> cert:string
+  -> purpose:API.certificate_purpose list
+  -> unit
+
+val uninstall_trusted_certificate :
+     __context:Context.t
+  -> host:API.ref_host
+  -> ca:bool
+  -> name:string
+  -> force:bool
+  -> unit