From ed90086a38a0d1d352546da9ec227fbbfc391106 Mon Sep 17 00:00:00 2001 From: Steven Woods Date: Tue, 17 Sep 2024 17:06:23 +0100 Subject: [PATCH] CP-51527: Add --force option to pool-uninstall-ca-certificate This allows the CA certificate to be removed from the DB even if the certificate file does not exist. Signed-off-by: Steven Woods --- ocaml/idl/datamodel_host.ml | 34 ++++++++++++++++++++--- ocaml/idl/datamodel_pool.ml | 36 +++++++++++++++++++++++-- ocaml/xapi-cli-server/cli_frontend.ml | 7 +++-- ocaml/xapi-cli-server/cli_operations.ml | 3 ++- ocaml/xapi/certificates.ml | 30 ++++++++++++--------- ocaml/xapi/certificates.mli | 5 ++-- ocaml/xapi/message_forwarding.ml | 13 +++++---- ocaml/xapi/xapi_host.ml | 6 ++--- ocaml/xapi/xapi_host.mli | 2 +- ocaml/xapi/xapi_pool.ml | 8 +++--- ocaml/xapi/xapi_pool.mli | 3 ++- 11 files changed, 111 insertions(+), 36 deletions(-) diff --git a/ocaml/idl/datamodel_host.ml b/ocaml/idl/datamodel_host.ml index 266d695fa34..b0fb9a6aace 100644 --- a/ocaml/idl/datamodel_host.ml +++ b/ocaml/idl/datamodel_host.ml @@ -1479,12 +1479,40 @@ let install_ca_certificate = let uninstall_ca_certificate = call ~pool_internal:true ~hide_from_docs:true ~name:"uninstall_ca_certificate" ~doc:"Remove a TLS CA certificate from this host." - ~params: + ~versioned_params: [ - (Ref _host, "host", "The host"); (String, "name", "The certificate name") + { + param_type= Ref _host + ; param_name= "host" + ; param_doc= "The host" + ; param_release= numbered_release "1.290.0" + ; param_default= None + } + ; { + param_type= String + ; param_name= "name" + ; param_doc= "The certificate name" + ; param_release= numbered_release "1.290.0" + ; param_default= None + } + ; { + param_type= Bool + ; param_name= "force" + ; param_doc= "Remove the DB entry even if the file is non-existent" + ; param_release= numbered_release "24.35.0" + ; param_default= Some (VBool false) + } ] ~allowed_roles:_R_LOCAL_ROOT_ONLY - ~lifecycle:[(Published, "1.290.0", "Uninstall TLS CA certificate")] + ~lifecycle: + [ + (Published, "1.290.0", "Uninstall TLS CA certificate") + ; ( Changed + , "24.35.0" + , "Added --force option to allow DB entries to be removed for \ + non-existent files" + ) + ] () let certificate_list = diff --git a/ocaml/idl/datamodel_pool.ml b/ocaml/idl/datamodel_pool.ml index f94a531903c..ab0d1669788 100644 --- a/ocaml/idl/datamodel_pool.ml +++ b/ocaml/idl/datamodel_pool.ml @@ -851,9 +851,41 @@ let certificate_uninstall = let uninstall_ca_certificate = call ~name:"uninstall_ca_certificate" ~doc:"Remove a pool-wide TLS CA certificate." - ~params:[(String, "name", "The certificate name")] + ~params: + [ + (String, "name", "The certificate name") + ; ( Bool + , "force" + , "If true, remove the DB entry even if the file is non-existent" + ) + ] + ~versioned_params: + [ + { + param_type= String + ; param_name= "name" + ; param_doc= "The certificate name" + ; param_release= numbered_release "1.290.0" + ; param_default= None + } + ; { + param_type= Bool + ; param_name= "force" + ; param_doc= "Remove the DB entry even if the file is non-existent" + ; param_release= numbered_release "24.35.0" + ; param_default= Some (VBool false) + } + ] ~allowed_roles:(_R_POOL_OP ++ _R_CLIENT_CERT) - ~lifecycle:[(Published, "1.290.0", "Uninstall TLS CA certificate")] + ~lifecycle: + [ + (Published, "1.290.0", "Uninstall TLS CA certificate") + ; ( Changed + , "24.35.0" + , "Added --force option to allow DB entries to be removed for \ + non-existent files" + ) + ] () let certificate_list = diff --git a/ocaml/xapi-cli-server/cli_frontend.ml b/ocaml/xapi-cli-server/cli_frontend.ml index 881d016267a..3de231f3cad 100644 --- a/ocaml/xapi-cli-server/cli_frontend.ml +++ b/ocaml/xapi-cli-server/cli_frontend.ml @@ -396,8 +396,11 @@ let rec cmdtable_data : (string * cmd_spec) list = ; ( "pool-uninstall-ca-certificate" , { reqd= ["name"] - ; optn= [] - ; help= "Uninstall a pool-wide TLS CA certificate." + ; optn= ["force"] + ; help= + "Uninstall a pool-wide TLS CA certificate. The optional parameter \ + '--force' will remove the DB entry even if the certificate file is \ + non-existent" ; implementation= No_fd Cli_operations.pool_uninstall_ca_certificate ; flags= [] } diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index aa3bf08c05a..1e8ba0f3b37 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -1770,7 +1770,8 @@ let pool_install_ca_certificate fd _printer rpc session_id params = let pool_uninstall_ca_certificate _printer rpc session_id params = let name = List.assoc "name" params in - Client.Pool.uninstall_ca_certificate ~rpc ~session_id ~name + let force = get_bool_param params "force" in + Client.Pool.uninstall_ca_certificate ~rpc ~session_id ~name ~force let pool_certificate_list printer rpc session_id _params = printer (Cli_printer.PList (Client.Pool.certificate_list ~rpc ~session_id)) diff --git a/ocaml/xapi/certificates.ml b/ocaml/xapi/certificates.ml index 2ae9e72aebe..9a6298c129d 100644 --- a/ocaml/xapi/certificates.ml +++ b/ocaml/xapi/certificates.ml @@ -304,17 +304,21 @@ let host_install kind ~name ~cert = (ExnHelper.string_of_exn e) ; raise_library_corrupt () -let host_uninstall kind ~name = +let host_uninstall kind ~name ~force = validate_name kind name ; let filename = library_filename kind name in - if not (Sys.file_exists filename) then - raise_does_not_exist kind name ; - debug "Uninstalling %s %s" (to_string kind) name ; - try Sys.remove filename ; update_ca_bundle () - with e -> - warn "Exception uninstalling %s %s: %s" (to_string kind) name - (ExnHelper.string_of_exn e) ; - raise_corrupt kind name + if Sys.file_exists filename then ( + debug "Uninstalling %s %s" (to_string kind) name ; + try Sys.remove filename ; update_ca_bundle () + with e -> + warn "Exception uninstalling %s %s: %s" (to_string kind) name + (ExnHelper.string_of_exn e) ; + raise_corrupt kind name + ) else if force then + info "Certificate file %s is non-existent but ignoring this due to force." + name + else + raise_does_not_exist kind name let get_cert kind name = validate_name kind name ; @@ -367,6 +371,7 @@ let sync_certs kind ~__context master_certs host = ) (fun rpc session_id host name -> Client.Host.uninstall_ca_certificate ~rpc ~session_id ~host ~name + ~force:false ) ~__context master_certs host | CRL -> @@ -403,15 +408,16 @@ let pool_install kind ~__context ~name ~cert = host_install kind ~name ~cert ; try pool_sync ~__context with exn -> - ( try host_uninstall kind ~name + ( try host_uninstall kind ~name ~force:false with e -> warn "Exception unwinding install of %s %s: %s" (to_string kind) name (ExnHelper.string_of_exn e) ) ; raise exn -let pool_uninstall kind ~__context ~name = - host_uninstall kind ~name ; pool_sync ~__context +let pool_uninstall kind ~__context ~name ~force = + host_uninstall kind ~name ~force ; + pool_sync ~__context (* Extracts the server certificate from the server certificate pem file. It strips the private key as well as the rest of the certificate chain. *) diff --git a/ocaml/xapi/certificates.mli b/ocaml/xapi/certificates.mli index 486ada825e2..064c7e47e31 100644 --- a/ocaml/xapi/certificates.mli +++ b/ocaml/xapi/certificates.mli @@ -53,12 +53,13 @@ val install_server_certificate : val host_install : t_trusted -> name:string -> cert:string -> unit -val host_uninstall : t_trusted -> name:string -> unit +val host_uninstall : t_trusted -> name:string -> force:bool -> unit val pool_install : t_trusted -> __context:Context.t -> name:string -> cert:string -> unit -val pool_uninstall : t_trusted -> __context:Context.t -> name:string -> unit +val pool_uninstall : + t_trusted -> __context:Context.t -> name:string -> force:bool -> unit (* Database manipulation *) diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index c85dc2cb025..17ff3de0261 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -3745,19 +3745,22 @@ functor ~cert ) - let uninstall_ca_certificate ~__context ~host ~name = - info "Host.uninstall_ca_certificate: host = '%s'; name = '%s'" + let uninstall_ca_certificate ~__context ~host ~name ~force = + info + "Host.uninstall_ca_certificate: host = '%s'; name = '%s'; force = \ + '%b'" (host_uuid ~__context host) - name ; - let local_fn = Local.Host.uninstall_ca_certificate ~host ~name in + name force ; + let local_fn = Local.Host.uninstall_ca_certificate ~host ~name ~force in do_op_on ~local_fn ~__context ~host (fun session_id rpc -> Client.Host.uninstall_ca_certificate ~rpc ~session_id ~host ~name + ~force ) (* legacy names *) let certificate_install = install_ca_certificate - let certificate_uninstall = uninstall_ca_certificate + let certificate_uninstall = uninstall_ca_certificate ~force:false let certificate_list ~__context ~host = info "Host.certificate_list: host = '%s'" (host_uuid ~__context host) ; diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index 32139f79896..7958a15a367 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -1548,9 +1548,9 @@ let install_ca_certificate ~__context ~host:_ ~name ~cert = (* don't modify db - Pool.install_ca_certificate will handle that *) Certificates.(host_install CA_Certificate ~name ~cert) -let uninstall_ca_certificate ~__context ~host:_ ~name = +let uninstall_ca_certificate ~__context ~host:_ ~name ~force = (* don't modify db - Pool.uninstall_ca_certificate will handle that *) - Certificates.(host_uninstall CA_Certificate ~name) + Certificates.(host_uninstall CA_Certificate ~name ~force) let certificate_list ~__context ~host:_ = Certificates.(local_list CA_Certificate) @@ -1559,7 +1559,7 @@ let crl_install ~__context ~host:_ ~name ~crl = Certificates.(host_install CRL ~name ~cert:crl) let crl_uninstall ~__context ~host:_ ~name = - Certificates.(host_uninstall CRL ~name) + Certificates.(host_uninstall CRL ~name ~force:false) let crl_list ~__context ~host:_ = Certificates.(local_list CRL) diff --git a/ocaml/xapi/xapi_host.mli b/ocaml/xapi/xapi_host.mli index 8813f037b19..c303ee69597 100644 --- a/ocaml/xapi/xapi_host.mli +++ b/ocaml/xapi/xapi_host.mli @@ -290,7 +290,7 @@ val install_ca_certificate : __context:Context.t -> host:API.ref_host -> name:string -> cert:string -> unit val uninstall_ca_certificate : - __context:Context.t -> host:API.ref_host -> name:string -> unit + __context:Context.t -> host:API.ref_host -> name:string -> force:bool -> unit val certificate_list : __context:'a -> host:'b -> string list diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index e3aca23e47b..044507bc9c2 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -1432,12 +1432,12 @@ let certificate_install ~__context ~name ~cert = let install_ca_certificate = certificate_install -let certificate_uninstall ~__context ~name = +let uninstall_ca_certificate ~__context ~name ~force = let open Certificates in - pool_uninstall CA_Certificate ~__context ~name ; + pool_uninstall CA_Certificate ~__context ~name ~force ; Db_util.remove_ca_cert_by_name ~__context name -let uninstall_ca_certificate = certificate_uninstall +let certificate_uninstall = uninstall_ca_certificate ~force:false let certificate_list ~__context = let open Certificates in @@ -1446,7 +1446,7 @@ let certificate_list ~__context = let crl_install = Certificates.(pool_install CRL) -let crl_uninstall = Certificates.(pool_uninstall CRL) +let crl_uninstall = Certificates.(pool_uninstall CRL ~force:false) let crl_list ~__context = Certificates.(local_list CRL) diff --git a/ocaml/xapi/xapi_pool.mli b/ocaml/xapi/xapi_pool.mli index 0bd71a22996..835a356f782 100644 --- a/ocaml/xapi/xapi_pool.mli +++ b/ocaml/xapi/xapi_pool.mli @@ -248,7 +248,8 @@ val install_ca_certificate : val certificate_uninstall : __context:Context.t -> name:string -> unit -val uninstall_ca_certificate : __context:Context.t -> name:string -> unit +val uninstall_ca_certificate : + __context:Context.t -> name:string -> force:bool -> unit val certificate_list : __context:Context.t -> string list