Merge pull request #4901 from mg12/private/marcusg/CP-41675

Author: psafont

ocaml/xapi/helpers.ml

@@ -1959,10 +1959,24 @@ end = struct
     Xapi_psr_util.load_psr_pool_secrets ()
 end
 
+let ( let@ ) f x = f x
+
+let with_temp_out_ch ch f = finally (fun () -> f ch) (fun () -> close_out ch)
+
+let with_temp_file ?mode prefix suffix f =
+  let path, channel = Filename.open_temp_file ?mode prefix suffix in
+  finally (fun () -> f (path, channel)) (fun () -> Unix.unlink path)
+
+let with_temp_out_ch_of_temp_file ?mode prefix suffix f =
+  let@ path, channel = with_temp_file ?mode prefix suffix in
+  f (path, channel |> with_temp_out_ch)
+
 module FileSys : sig
   (* bash-like interface for manipulating files *)
   type path = string
 
+  val realpathm : path -> path
+
   val rmrf : ?rm_top:bool -> path -> unit
 
   val mv : src:path -> dest:path -> unit
@@ -1973,16 +1987,24 @@ module FileSys : sig
 end = struct
   type path = string
 
+  let realpathm path = try Unix.readlink path with _ -> path
+
   let rmrf ?(rm_top = true) path =
     let ( // ) = Filename.concat in
     let rec rm rm_top path =
-      let st = Unix.lstat path in
-      match st.Unix.st_kind with
-      | Unix.S_DIR ->
-          Sys.readdir path |> Array.iter (fun file -> rm true (path // file)) ;
-          if rm_top then Unix.rmdir path
-      | _ ->
-          Unix.unlink path
+      match Unix.lstat path with
+      | exception Unix.Unix_error (Unix.ENOENT, _, _) ->
+          () (*noop*)
+      | exception e ->
+          raise e
+      | st -> (
+        match st.Unix.st_kind with
+        | Unix.S_DIR ->
+            Sys.readdir path |> Array.iter (fun file -> rm true (path // file)) ;
+            if rm_top then Unix.rmdir path
+        | _ ->
+            Unix.unlink path
+      )
     in
     try rm rm_top path
     with e ->

ocaml/xapi/xapi_db_upgrade.ml

@@ -868,6 +868,19 @@ let remove_legacy_ssl_support =
       )
   }
 
+let empty_pool_uefi_certificates =
+  {
+    description=
+      "empty contents of pool.uefi_certificates, as they are now provided in \
+       RPMs"
+  ; version= (fun _ -> true)
+  ; fn=
+      (fun ~__context ->
+        let pool = Helpers.get_pool ~__context in
+        Db.Pool.set_uefi_certificates ~__context ~self:pool ~value:""
+      )
+  }
+
 let rules =
   [
     upgrade_domain_type
@@ -896,6 +909,7 @@ let rules =
   ; upgrade_cluster_timeouts
   ; upgrade_secrets
   ; remove_legacy_ssl_support
+  ; empty_pool_uefi_certificates
   ]
 
 (* Maybe upgrade most recent db *)

ocaml/xapi/xapi_globs.ml

@@ -844,7 +844,11 @@ let nbd_client_manager_script =
 
 let varstore_rm = ref "/usr/bin/varstore-rm"
 
-let varstore_dir = ref "/usr/share/varstored"
+let varstore_dir = ref "/var/lib/varstored"
+
+let default_auth_dir = ref "/usr/share/varstored"
+
+let override_uefi_certs = ref false
 
 let disable_logging_for = ref []
 
@@ -1395,6 +1399,12 @@ let other_options =
     , (fun () -> string_of_bool !ignore_vtpm_unimplemented)
     , "Do not raise errors on use-cases where VTPM codepaths are not finished."
     )
+  ; ( "override-uefi-certs"
+    , Arg.Set override_uefi_certs
+    , (fun () -> string_of_bool !override_uefi_certs)
+    , "Enable (true) or Disable (false) overriding location for varstored UEFI \
+       certificates"
+    )
   ]
 
 (* The options can be set with the variable xapiflags in /etc/sysconfig/xapi.

ocaml/xapi/xapi_host.ml

@@ -2672,26 +2672,47 @@ let with_temp_file_contents ~contents f =
     )
     (fun () -> Sys.remove filename)
 
-let write_uefi_certificates_to_disk ~__context ~host:_ =
-  if
-    Sys.file_exists !Xapi_globs.varstore_dir
-    && Sys.is_directory !Xapi_globs.varstore_dir
-  then
-    match
-      Base64.decode
-        (Db.Pool.get_uefi_certificates ~__context
-           ~self:(Helpers.get_pool ~__context)
-        )
-    with
+let ( let@ ) f x = f x
+
+let ( // ) = Filename.concat
+
+let really_read_uefi_certificates_from_disk ~__context ~host:_ from_path =
+  let certs_files = Sys.readdir from_path |> Array.map (( // ) from_path) in
+  let@ temp_file, with_temp_out_ch =
+    Helpers.with_temp_out_ch_of_temp_file ~mode:[Open_binary]
+      "pool-uefi-certificates" "tar"
+  in
+  if Array.length certs_files > 0 then (
+    let@ temp_out_ch = with_temp_out_ch in
+    Tar_unix.Archive.create
+      (certs_files |> Array.to_list)
+      (temp_out_ch |> Unix.descr_of_out_channel) ;
+    debug "UEFI tar file %s populated from directory %s" temp_file from_path
+  ) else
+    debug "UEFI tar file %s empty from directory %s" temp_file from_path ;
+  temp_file |> Unixext.string_of_file |> Base64.encode_string
+
+let really_write_uefi_certificates_to_disk ~__context ~host:_ ~value =
+  match value with
+  | "" ->
+      (* from an existing directory *)
+      Sys.readdir !Xapi_globs.default_auth_dir
+      |> Array.iter (fun file ->
+             let src = !Xapi_globs.default_auth_dir // file in
+             let dst = !Xapi_globs.varstore_dir // file in
+             let@ src_fd = Unixext.with_file src [Unix.O_RDONLY] 0o400 in
+             let@ dst_fd =
+               Unixext.with_file dst
+                 [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC]
+                 0o644
+             in
+             debug "override_uefi_certs: copy_file %s->%s" src dst ;
+             ignore (Unixext.copy_file src_fd dst_fd)
+         )
+  | base64_value -> (
+    (* from an existing base64 tar file *)
+    match Base64.decode base64_value with
     | Ok contents ->
-        (* Remove existing certs before extracting xapi ones
-         * to avoid a extract override issue. *)
-        List.iter
-          (fun name ->
-            let path = Filename.concat !Xapi_globs.varstore_dir name in
-            Unixext.unlink_safe path
-          )
-          ["KEK.auth"; "db.auth"] ;
         (* No uefi certificates, nothing to do. *)
         if contents <> "" then (
           with_temp_file_contents ~contents
@@ -2702,14 +2723,75 @@ let write_uefi_certificates_to_disk ~__context ~host:_ =
     | Error _ ->
         debug
           "UEFI tar file was not extracted: it was not base64-encoded correctly"
+  )
+
+let write_uefi_certificates_to_disk ~__context ~host =
+  let with_valid_symlink ~from_path ~to_path fn =
+    debug "override_uefi_certs: with_valid_symlink %s->%s" from_path to_path ;
+    if Helpers.FileSys.realpathm from_path <> to_path then (
+      Helpers.FileSys.rmrf ~rm_top:true from_path ;
+      Unix.symlink to_path from_path
+    ) ;
+    fn from_path
+  in
+  let with_empty_dir path fn =
+    debug "override_uefi_certs: with_empty_dir %s" path ;
+    Helpers.FileSys.rmrf ~rm_top:false path ;
+    Unixext.mkdir_rec path 0o755 ;
+    fn path
+  in
+  let check_valid_uefi_certs_in path =
+    let uefi_certs_in_disk = path |> Helpers.FileSys.realpathm |> Sys.readdir in
+    (* check expected uefi certificates are present *)
+    ["KEK.auth"; "db.auth"]
+    |> List.iter (fun cert ->
+           let log_of found =
+             (if found then info else error)
+               "check_valid_uefi_certs: %s %s in %s"
+               (if found then "found" else "missing")
+               cert path
+           in
+           uefi_certs_in_disk |> Array.mem cert |> log_of
+       )
+  in
+  match !Xapi_globs.override_uefi_certs with
+  | false ->
+      let@ path =
+        with_valid_symlink ~from_path:!Xapi_globs.varstore_dir
+          ~to_path:!Xapi_globs.default_auth_dir
+      in
+      check_valid_uefi_certs_in path ;
+      if Pool_role.is_master () then
+        let disk_uefi_certs_tar =
+          really_read_uefi_certificates_from_disk ~__context ~host
+            !Xapi_globs.varstore_dir
+        in
+        (* synchronize read-only field with contents in disk *)
+        Db.Pool.set_uefi_certificates ~__context
+          ~self:(Helpers.get_pool ~__context)
+          ~value:disk_uefi_certs_tar
+  | true ->
+      let@ path = with_empty_dir !Xapi_globs.varstore_dir in
+      (* get from pool for consistent results across hosts *)
+      let pool_uefi_certs =
+        Db.Pool.get_uefi_certificates ~__context
+          ~self:(Helpers.get_pool ~__context)
+      in
+      really_write_uefi_certificates_to_disk ~__context ~host
+        ~value:pool_uefi_certs ;
+      check_valid_uefi_certs_in path
 
 let set_uefi_certificates ~__context ~host ~value =
-  Db.Host.set_uefi_certificates ~__context ~self:host ~value ;
-  Helpers.call_api_functions ~__context (fun rpc session_id ->
-      Client.Client.Pool.set_uefi_certificates ~rpc ~session_id
-        ~self:(Helpers.get_pool ~__context)
-        ~value
-  )
+  match !Xapi_globs.override_uefi_certs with
+  | false ->
+      raise Api_errors.(Server_error (Api_errors.operation_not_allowed, [""]))
+  | true ->
+      Db.Host.set_uefi_certificates ~__context ~self:host ~value ;
+      Helpers.call_api_functions ~__context (fun rpc session_id ->
+          Client.Client.Pool.set_uefi_certificates ~rpc ~session_id
+            ~self:(Helpers.get_pool ~__context)
+            ~value
+      )
 
 let set_iscsi_iqn ~__context ~host ~value =
   if value = "" then

ocaml/xapi/xapi_pool.ml

@@ -3588,14 +3588,22 @@ let disable_repository_proxy ~__context ~self =
     )
 
 let set_uefi_certificates ~__context ~self ~value =
-  Db.Pool.set_uefi_certificates ~__context ~self ~value ;
-  Helpers.call_api_functions ~__context (fun rpc session_id ->
-      List.iter
-        (fun host ->
-          Client.Host.write_uefi_certificates_to_disk ~rpc ~session_id ~host
-        )
-        (Db.Host.get_all ~__context)
-  )
+  match !Xapi_globs.override_uefi_certs with
+  | false ->
+      let msg =
+        "Setting UEFI certificates is not possible when override_uefi_certs is \
+         false"
+      in
+      raise Api_errors.(Server_error (operation_not_allowed, [msg]))
+  | true ->
+      Db.Pool.set_uefi_certificates ~__context ~self ~value ;
+      Helpers.call_api_functions ~__context (fun rpc session_id ->
+          List.iter
+            (fun host ->
+              Client.Host.write_uefi_certificates_to_disk ~rpc ~session_id ~host
+            )
+            (Db.Host.get_all ~__context)
+      )
 
 let set_https_only ~__context ~self:_ ~value =
   Helpers.call_api_functions ~__context (fun rpc session_id ->

scripts/xapi.conf

@@ -77,6 +77,10 @@ igd-passthru-vendor-whitelist = 8086
 # Allowlist of domain name pattern in binary-url and source-url in repository
 # repository-domain-name-allowlist =
 
+# Override the default location of RPM-provided certificates in default_auth_dir (/usr/share/varstored)
+# to force use of customised UEFI certificates in varstore_dir (/var/lib/varstored)
+# override-uefi-certs = true
+
 # Paths to utilities: ############################################
 
 search-path = @LIBEXECDIR@:@OPTDIR@/bin