Make xcp-rrdp-cpu more robust (#6418)

Draft, because I still need to test it.

Author: psafont

ocaml/xapi-idl/rrd/rrd_interface.ml

@@ -29,6 +29,8 @@ let default_sockets_dir = "/var/lib/xcp"
 
 let daemon_name = "xcp-rrdd"
 
+let max_supported_vms = 1024
+
 let default_path = ref (Filename.concat default_sockets_dir daemon_name)
 
 let forwarded_path =

ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml

@@ -225,11 +225,11 @@ let dss_mem_host xc =
 (** estimate the space needed to serialize all the dss_mem_vms in a host. the
     json-like serialization for the 3 dss in dss_mem_vms takes 622 bytes. these
     bytes plus some overhead make 1024 bytes an upper bound. *)
-let max_supported_vms = 1024
 
 let bytes_per_mem_vm = 1024
 
-let mem_vm_writer_pages = ((max_supported_vms * bytes_per_mem_vm) + 4095) / 4096
+let mem_vm_writer_pages =
+  ((Rrd_interface.max_supported_vms * bytes_per_mem_vm) + 4095) / 4096
 
 let res_error fmt = Printf.ksprintf Result.error fmt
 

ocaml/xcp-rrdd/bin/rrdp-cpu/rrdp_cpu.ml

@@ -188,12 +188,15 @@ let dss_hostload xc domains =
   let load =
     List.fold_left
       (fun acc (dom, _, domid) ->
-        sum 0 dom.Xenctrl.max_vcpu_id (fun id ->
-            let vcpuinfo = Xenctrl.domain_get_vcpuinfo xc domid id in
-            if vcpuinfo.Xenctrl.online && not vcpuinfo.Xenctrl.blocked then
-              1
-            else
-              0
+        ( try
+            sum 0 dom.Xenctrl.max_vcpu_id (fun id ->
+                let vcpuinfo = Xenctrl.domain_get_vcpuinfo xc domid id in
+                if vcpuinfo.Xenctrl.online && not vcpuinfo.Xenctrl.blocked then
+                  1
+                else
+                  0
+            )
+          with _ -> 0
         )
         + acc
       )
@@ -230,14 +233,20 @@ let generate_cpu_ds_list xc () =
   let _, domains, _ = Xenctrl_lib.domain_snapshot xc in
   dss_pcpus xc @ dss_vcpus xc domains @ dss_loadavg () @ dss_hostload xc domains
 
+(* 32 vCPUS ~8659 bytes, so 64 vCPUs should fit in 5 *)
+let cpu_pages_per_vm = 5
+
 let _ =
   Xenctrl.with_intf (fun xc ->
       let _, domains, _ = Xenctrl_lib.domain_snapshot xc in
       Process.initialise () ;
       (* Share one page per PCPU and dom each *)
       let physinfo = Xenctrl.physinfo xc in
-      let shared_page_count = physinfo.Xenctrl.nr_cpus + List.length domains in
-      (* TODO: Can run out of pages if a lot of domains are added at runtime *)
+      let shared_page_count =
+        physinfo.Xenctrl.nr_cpus
+        + Int.max Rrd_interface.max_supported_vms (List.length domains)
+          * cpu_pages_per_vm
+      in
       Process.main_loop ~neg_shift:0.5
         ~target:(Reporter.Local shared_page_count) ~protocol:Rrd_interface.V2
         ~dss_f:(generate_cpu_ds_list xc)