Add pool.sync_trusted_certificates_from API

doc/content/design/external-auth-ldaps.md

@@ -268,10 +268,10 @@ alt precheck failed
 client-->>user: precheck failed
 end
 
-Note over client,coor: sync all ldaps certs
-client->>coor: pool.download_trusted_certificate
-coor-->>client:
-client->>join: pool.install_trusted_certificate
+Note over client,coor: sync trusted CA certs from coordinator to joining host
+client->>join: pool.sync_trusted_certificates_from
+join->>coor: pool.exchange_trusted_certificates_on_join
+coor-->>join:
 join-->>client:
 
 user->>client: join domain username/password
@@ -289,15 +289,11 @@ client-->>user: pool.join succeed
 
 **Detailed Steps:**
 
-1. Client find proper `ldaps certs` from pool coordinator as `certs_pool`
-   - a. find all certs `ldaps in purpose`
-   - b. if no LDAPS certs, find all `general` certs
-2. Client find all certs in joining host as `certs_joining_host`
-3. Client identify the certs needs to be synced to joining host as `certs_to_sync = certs_pool - certs_joining_host` (certs in `certs_pool`, but not in `certs_joining_host`), the certs fingerprint should be used to identify the certs
-4. Client download all `certs_to_sync`, `pool.download_trusted_certificate` from coordinator
-5. Client upload all certs to joining pool, `pool.install_trusted_certificate` to joining pool, with the same purpose
-6. Client trigger `pool.join` again with domain username and password
-7. After pool.join:
+1. Client calls `pool.sync_trusted_certificates_from` to joiner host. The call will
+   - a. download all trusted certificates from the pool, and
+   - b. install the trusted certificates into the joiner host.
+2. Client trigger `pool.join` again with domain username and password
+3. After pool.join:
    - If pool.join failed, Client call `pool.uninstall_trusted_certificate` on joining host to revert the certs
    - If pool.join succeed, do nothing as pool.join would sync the certs anyway
 

ocaml/idl/datamodel_pool.ml

@@ -1697,6 +1697,36 @@ let uninstall_trusted_certificate =
     ~allowed_roles:(_R_POOL_OP ++ _R_CLIENT_CERT)
     ~lifecycle:[] ()
 
+let sync_trusted_certificates_from =
+  call ~name:"sync_trusted_certificates_from"
+    ~doc:
+      "Download trusted TLS certificates from a remote pool and install them \
+       in this pool. Certificates already present locally (matched by \
+       fingerprint and purpose) are skipped."
+    ~params:
+      [
+        (Ref _pool, "self", "The pool")
+      ; ( String
+        , "remote_pool"
+        , "The hostname or IP address of the coordinator of the remote pool \
+           from which the certificates are downloaded"
+        )
+      ; ( Ref _session
+        , "remote_session"
+        , "A session obtained from the remote pool, used to authenticate the \
+           download"
+        )
+      ; ( String
+        , "remote_certificate"
+        , "The PEM-encoded TLS certificate of the remote pool's coordinator, \
+           used to verify the TLS connection to the remote pool."
+        )
+      ; (Bool, "ca", "true for 'ca' or false for 'pinned'")
+      ]
+    ~result:(Set (Ref _certificate), "The references of certificates synced.")
+    ~allowed_roles:(_R_POOL_OP ++ _R_CLIENT_CERT)
+    ~lifecycle:[] ()
+
 let trusted_certs = Map (String, Set String)
 
 let exchange_trusted_certificates_on_join =
@@ -1849,6 +1879,7 @@ let t =
       ; set_ssh_auto_mode
       ; install_trusted_certificate
       ; uninstall_trusted_certificate
+      ; sync_trusted_certificates_from
       ; exchange_trusted_certificates_on_join
       ; exchange_crls_on_join
       ]

ocaml/xapi/message_forwarding.ml

@@ -1274,6 +1274,21 @@ functor
           (certificate_uuid ~__context certificate) ;
         Local.Pool.uninstall_trusted_certificate ~__context ~self ~certificate
 
+      let sync_trusted_certificates_from ~__context ~self ~remote_pool
+          ~remote_session ~remote_certificate ~ca =
+        Xapi_pool_helpers.with_pool_operation ~__context
+          ~op:`copy_primary_host_certs
+          ~doc:"Pool.sync_trusted_certificates_from"
+          ~self:(Helpers.get_pool ~__context)
+        @@ fun () ->
+        info
+          "Pool.sync_trusted_certificates_from: pool=%S remote_pool=%S \
+           remote_certificate=%S ca=%b"
+          (pool_uuid ~__context self)
+          remote_pool remote_certificate ca ;
+        Local.Pool.sync_trusted_certificates_from ~__context ~self ~remote_pool
+          ~remote_session ~remote_certificate ~ca
+
       let exchange_trusted_certificates_on_join ~__context ~self ~ca ~import
           ~export =
         Xapi_pool_helpers.with_pool_operation ~__context

ocaml/xapi/xapi_pool.ml

@@ -1688,7 +1688,7 @@ let certificate_sync ~__context =
   Certificates.sync_all_hosts ~__context (Db.Host.get_all ~__context) ;
   ()
 
-let install_trusted_certificate ~__context ~self:_ ~ca ~cert ~purpose =
+let install_trusted_certificate' ~__context ~self:_ ~ca ~cert ~purpose =
   let open Certificates in
   let certificate =
     let open Api_errors in
@@ -1712,12 +1712,18 @@ let install_trusted_certificate ~__context ~self:_ ~ca ~cert ~purpose =
     | false, true ->
         raise Api_errors.(Server_error (certificate_lacks_purpose, []))
   in
-  let (_ : API.ref_Certificate), uuid =
+  let (ref : API.ref_Certificate), uuid =
     Db_util.add_cert ~__context ~type':cert_type ~purpose certificate
   in
   let name = Certificates.name_of_uuid uuid in
   Certificates.host_install kind ~name ~cert ;
   Cert_distrib.copy_certs_to_all ~__context ;
+  ref
+
+let install_trusted_certificate ~__context ~self ~ca ~cert ~purpose =
+  let (_ : API.ref_Certificate) =
+    install_trusted_certificate' ~__context ~self ~ca ~cert ~purpose
+  in
   ()
 
 let uninstall_trusted_certificate ~__context ~self:_ ~certificate =
@@ -1742,15 +1748,29 @@ let uninstall_trusted_certificate ~__context ~self:_ ~certificate =
   Cert_distrib.copy_certs_to_all ~__context ;
   ()
 
-let install_trusted_certificate_ignore_dup ~__context ~self ~ca ~cert ~purpose =
-  try install_trusted_certificate ~__context ~self ~ca ~cert ~purpose
+let install_trusted_certificate_ignore_dup' ~__context ~self ~ca ~cert ~purpose
+    =
+  try
+    Ok (Some (install_trusted_certificate' ~__context ~self ~ca ~cert ~purpose))
   with
   | Api_errors.(Server_error (code, [fp]))
-  when code = Api_errors.trusted_certificate_already_exists
-  ->
-    warn "%s: a trusted certificate (fingerprint=%s) exists already."
-      __FUNCTION__ fp ;
-    ()
+    when code = Api_errors.trusted_certificate_already_exists ->
+      warn "%s: a trusted certificate (fingerprint=%s) exists already."
+        __FUNCTION__ fp ;
+      Ok None
+  | e ->
+      error "%s: failed to install certificate: %s" __FUNCTION__
+        (Printexc.to_string e) ;
+      Error e
+
+let install_trusted_certificate_ignore_dup ~__context ~self ~ca ~cert ~purpose =
+  match
+    install_trusted_certificate_ignore_dup' ~__context ~self ~ca ~cert ~purpose
+  with
+  | Ok _ ->
+      ()
+  | Error e ->
+      raise e
 
 let purpose_of_string_list = List.map Record_util.certificate_purpose_of_string
 
@@ -1788,6 +1808,48 @@ let exchange_trusted_certificates ~__context ~rpc ~session_id ~remote ~local =
     )
     [`ca; `pinned]
 
+let sync_trusted_certificates_from ~__context ~self ~remote_pool ~remote_session
+    ~remote_certificate ~ca =
+  let rpc =
+    Helpers.make_external_host_verified_rpc ~__context remote_pool
+      remote_certificate
+  in
+  let session_id = remote_session in
+  let cert_type =
+    if ca then
+      "ca"
+    else
+      "pinned"
+  in
+  let expr =
+    Printf.sprintf {|field "type"="%s" and field "name"=""|} cert_type
+  in
+  let export =
+    Client.Certificate.get_all_records_where ~rpc ~session_id ~expr
+    |> List.map fst
+  in
+  Client.Pool.exchange_trusted_certificates_on_join ~rpc ~session_id
+    ~self:(get_pool ~rpc ~session_id)
+    ~ca ~import:[] ~export
+  |> Listext.List.try_map_collect (fun (cert, purpose) ->
+      let purpose = purpose_of_string_list purpose in
+      install_trusted_certificate_ignore_dup' ~__context
+        ~self:(Helpers.get_pool ~__context)
+        ~ca ~cert ~purpose
+  )
+  |> function
+  | Ok refs ->
+      List.filter_map Fun.id refs
+  | Error (refs, e) ->
+      List.filter_map Fun.id refs
+      |> List.iter (fun ref ->
+          try uninstall_trusted_certificate ~__context ~self ~certificate:ref
+          with e ->
+            error "Can't revert the installed certificate %s: %s"
+              (Ref.string_of ref) (Printexc.to_string e)
+      ) ;
+      raise e
+
 let exchange_crls_on_join ~__context ~self:_ ~import ~export =
   List.iter (fun (name, crl) -> crl_install ~__context ~name ~cert:crl) import ;
   Cert_distrib.collect_crls ~__context ~names:export

ocaml/xapi/xapi_pool.mli

@@ -478,3 +478,12 @@ val exchange_crls_on_join :
   -> import:API.string_to_string_map
   -> export:string list
   -> API.string_to_string_map
+
+val sync_trusted_certificates_from :
+     __context:Context.t
+  -> self:API.ref_pool
+  -> remote_pool:string
+  -> remote_session:API.ref_session
+  -> remote_certificate:string
+  -> ca:bool
+  -> API.ref_Certificate list