CP-49147: Reduce size of the pool record (uefi_certificates)

This field is very big and part of every pool.get_all_records() call
(done by SM), which is currently >64KiB in size.

TODO: the Changed field needs to match the (future!) tag that this will receive.

Signed-off-by: Edwin Török <[email protected]>

Author: edwintorok

ocaml/idl/datamodel_common.ml

@@ -10,7 +10,7 @@ open Datamodel_roles
               to leave a gap for potential hotfixes needing to increment the schema version.*)
 let schema_major_vsn = 5
 
-let schema_minor_vsn = 785
+let schema_minor_vsn = 786
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/idl/datamodel_pool.ml

@@ -1377,6 +1377,18 @@ let disable_repository_proxy =
     ~allowed_roles:(_R_POOL_OP ++ _R_CLIENT_CERT)
     ()
 
+let get_uefi_certificates =
+  call ~name:"get_uefi_certificates"
+    ~result:(String, "The UEFI certificates")
+    ~lifecycle:
+      [
+        (Published, "22.16.0", "")
+      ; (Changed, "24.38.0", "internal type changed to blob")
+      ]
+    ~doc:"Get the UEFI certificates for a pool"
+    ~params:[(Ref _pool, "self", "The pool")]
+    ~allowed_roles:_R_POOL_ADMIN ()
+
 let set_uefi_certificates =
   call ~name:"set_uefi_certificates"
     ~lifecycle:
@@ -1620,6 +1632,7 @@ let t =
       ; disable_client_certificate_auth
       ; configure_repository_proxy
       ; disable_repository_proxy
+      ; get_uefi_certificates
       ; set_uefi_certificates
       ; set_custom_uefi_certificates
       ; set_https_only
@@ -2006,9 +2019,13 @@ let t =
                 , "22.16.0"
                 , "Became StaticRO to be editable through new method"
                 )
+              ; ( Changed
+                , "24.38.0"
+                , "Field converted to internal-only and replaced with a digest"
+                )
               ]
             ~default_value:(Some (VString "")) "uefi_certificates"
-            "The UEFI certificates allowing Secure Boot"
+            ~internal_only:true "The UEFI certificates allowing Secure Boot"
         ; field ~qualifier:StaticRO ~ty:String ~lifecycle:[]
             ~default_value:(Some (VString "")) "custom_uefi_certificates"
             "Custom UEFI certificates allowing Secure Boot"

ocaml/idl/json_backend/gen_json.ml

@@ -613,8 +613,8 @@ module Version = struct
     try Scanf.sscanf name "%d.%d.%d%s" of_chunks
     with _ ->
       failwith
-        (Printf.sprintf "Version schema changed, please change this code %s"
-           __LOC__
+        (Printf.sprintf "Version schema changed, please change this code %s: %s"
+           name __LOC__
         )
 
   let to_name_date (lst, str) =

ocaml/idl/schematest.ml

@@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex
 (* BEWARE: if this changes, check that schema has been bumped accordingly in
    ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *)
 
-let last_known_schema_hash = "18df8c33434e3df1982e11ec55d1f3f8"
+let last_known_schema_hash = "b868d0553a0f37cede3bc454104d66e1"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/xapi-cli-server/records.ml

@@ -1354,7 +1354,9 @@ let pool_record rpc session_id pool =
           )
           ()
       ; make_field ~name:"uefi-certificates" ~hidden:true
-          ~get:(fun () -> (x ()).API.pool_uefi_certificates)
+          ~get:(fun () ->
+            Client.Pool.get_uefi_certificates ~rpc ~session_id ~self:pool
+          )
           ~set:(fun value ->
             Client.Pool.set_uefi_certificates ~rpc ~session_id ~self:pool ~value
           )

ocaml/xapi/helpers.ml

@@ -2141,7 +2141,8 @@ let get_active_uefi_certificates ~__context ~self =
   in
   match (!Xapi_globs.allow_custom_uefi_certs, custom_uefi_certs) with
   | false, _ | true, "" ->
-      Db.Pool.get_uefi_certificates ~__context ~self
+      let master = Db.Pool.get_master ~__context ~self in
+      Db.Host.get_uefi_certificates ~__context ~self:master
   | true, _ ->
       custom_uefi_certs
 

ocaml/xapi/xapi_host.ml

@@ -2778,7 +2778,7 @@ let write_uefi_certificates_to_disk ~__context ~host =
   if Pool_role.is_master () then
     Db.Pool.set_uefi_certificates ~__context
       ~self:(Helpers.get_pool ~__context)
-      ~value:disk_uefi_certs_tar ;
+      ~value:(Digest.string disk_uefi_certs_tar |> Digest.to_hex) ;
   let pool_uefi_certs =
     Db.Pool.get_custom_uefi_certificates ~__context
       ~self:(Helpers.get_pool ~__context)

ocaml/xapi/xapi_pool.ml

@@ -3722,6 +3722,11 @@ let disable_repository_proxy ~__context ~self =
         Db.Secret.destroy ~__context ~self:old_secret_ref
     )
 
+let get_uefi_certificates ~__context ~self =
+  (* cyclic dependency with Helpers, do it inline *)
+  let master = Db.Pool.get_master ~__context ~self in
+  Db.Host.get_uefi_certificates ~__context ~self:master
+
 let set_uefi_certificates ~__context ~self:_ ~value:_ =
   let msg =
     "Setting UEFI certificates is deprecated, please use \

ocaml/xapi/xapi_pool.mli

@@ -386,6 +386,8 @@ val configure_repository_proxy :
 
 val disable_repository_proxy : __context:Context.t -> self:API.ref_pool -> unit
 
+val get_uefi_certificates : __context:Context.t -> self:API.ref_pool -> string
+
 val set_uefi_certificates :
   __context:Context.t -> self:API.ref_pool -> value:string -> unit