xenopsd/xc: upstream more NUMA changes

ocaml/xenopsd/xc/domain.ml

@@ -886,7 +886,7 @@ let numa_placement domid ~vcpus ~memory affinity =
             Array.map2 NUMAResource.min_memory (Array.of_list nodes) a
       in
       numa_resources := Some nodea ;
-      let _ =
+      let memory_plan =
         match Softaffinity.plan ~vm host nodea with
         | None ->
             D.debug "NUMA-aware placement failed for domid %d" domid ;
@@ -898,10 +898,34 @@ let numa_placement domid ~vcpus ~memory affinity =
             done ;
             mem_plan
       in
-      (* Neither xenguest nor emu-manager allow allocating pages to a single
-         NUMA node, don't return any NUMA in any case. Claiming the memory
-         would be done here, but it conflicts with DMC. *)
-      None
+      (* Xen only allows a single node when using memory claims, or none at all. *)
+      let* numa_node, node =
+        match memory_plan with
+        | [Node node] ->
+            Some (Xenctrlext.NumaNode.from node, node)
+        | [] | _ :: _ :: _ ->
+            D.debug
+              "%s: domain %d can't fit a single NUMA node, falling back to \
+               default behaviour"
+              __FUNCTION__ domid ;
+            None
+      in
+      let nr_pages = Int64.div memory 4096L |> Int64.to_int in
+      try
+        Xenctrlext.domain_claim_pages xcext domid ~numa_node nr_pages ;
+        Some (node, memory)
+      with
+      | Xenctrlext.Not_available ->
+          (* Xen does not provide the interface to claim pages from a single NUMA
+             node, ignore the error and continue. *)
+          None
+      | Xenctrlext.Unix_error (errno, _) ->
+          D.info
+            "%s: unable to claim enough memory, domain %d won't be hosted in a \
+             single NUMA node. (error %s)"
+            __FUNCTION__ domid
+            Unix.(error_message errno) ;
+          None
   )
 
 let build_pre ~xc ~xs ~vcpus ~memory ~hard_affinity domid =

ocaml/xenopsd/xc/xenctrlext.ml

@@ -125,5 +125,9 @@ module NumaNode = struct
   let from = Fun.id
 end
 
+exception Not_available
+
 let domain_claim_pages handle domid ?(numa_node = NumaNode.none) nr_pages =
+  if numa_node <> NumaNode.none then
+    raise Not_available ;
   stub_domain_claim_pages handle domid numa_node nr_pages

ocaml/xenopsd/xc/xenctrlext.mli

@@ -102,5 +102,9 @@ module NumaNode : sig
   val from : int -> t
 end
 
+exception Not_available
+
 val domain_claim_pages : handle -> domid -> ?numa_node:NumaNode.t -> int -> unit
-(** Raises {Unix_error} if there's not enough memory to claim in the system *)
+(** Raises {Unix_error} if there's not enough memory to claim in the system.
+    Raises {Not_available} if a single numa node is requested and xen does not
+    provide page claiming for single numa nodes. *)