CP-24361: improve abstraction for dmpath parameter from string to Profile.t

Passing dm:Profile.t parameter to device.ml instead of dmpath:string permits
more type-safe choices to be made when starting the qemu daemon.

This patch prepares the code for the next commit which will select the right
qemu backend based on the profile received.

Signed-off-by: Marcus Granado <marcus.granado@citrix.com>

Author: mg12ctx

xc/device.ml

@@ -2167,7 +2167,7 @@ module Dm = struct
         )
     | _ -> failwith "Unsupported vGPU configuration"
 
-  let __start (task: Xenops_task.task_handle) ~xs ~dmpath ?(timeout = !Xenopsd.qemu_dm_ready_timeout) l info domid =
+  let __start (task: Xenops_task.task_handle) ~xs ~dm ?(timeout = !Xenopsd.qemu_dm_ready_timeout) l info domid =
     debug "Device.Dm.start domid=%d args: [%s]" domid (String.concat " " l);
 
     (* start vgpu emulation if appropriate *)
@@ -2185,7 +2185,7 @@ module Dm = struct
     let ready_path =
       Printf.sprintf "/local/domain/%d/device-model/%d/state" qemu_domid domid in
     let cancel = Cancel_utils.Qemu (qemu_domid, domid) in
-    let qemu_pid = init_daemon ~task ~path:dmpath ~args ~name:"qemu-dm" ~domid
+    let qemu_pid = init_daemon ~task ~path:(Profile.wrapper_of dm) ~args ~name:"qemu-dm" ~domid
         ~xs ~ready_path ~ready_val:"running" ~timeout ~cancel () in
     match !Xenopsd.action_after_qemu_crash with
     | None ->
@@ -2221,17 +2221,17 @@ module Dm = struct
               xs.Xs.write (Qemu.pid_path_signal domid) crash_reason
         ))
 
-  let start (task: Xenops_task.task_handle) ~xs ~dmpath ?timeout info domid =
+  let start (task: Xenops_task.task_handle) ~xs ~dm ?timeout info domid =
     let l = cmdline_of_info info false domid in
-    __start task ~xs ~dmpath ?timeout l info domid
+    __start task ~xs ~dm ?timeout l info domid
 
-  let restore (task: Xenops_task.task_handle) ~xs ~dmpath ?timeout info domid =
+  let restore (task: Xenops_task.task_handle) ~xs ~dm ?timeout info domid =
     let l = cmdline_of_info info true domid in
-    __start task ~xs ~dmpath ?timeout l info domid
+    __start task ~xs ~dm ?timeout l info domid
 
-  let start_vnconly (task: Xenops_task.task_handle) ~xs ~dmpath ?timeout info domid =
+  let start_vnconly (task: Xenops_task.task_handle) ~xs ~dm ?timeout info domid =
     let l = vnconly_cmdline ~info domid in
-    __start task ~xs ~dmpath ?timeout l info domid
+    __start task ~xs ~dm ?timeout l info domid
 
 end (* Dm *)
 

xc/device.mli

@@ -255,9 +255,9 @@ sig
 
 	val cmdline_of_info: info -> bool -> int -> string list
 
-	val start : Xenops_task.task_handle -> xs:Xenstore.Xs.xsh -> dmpath:string -> ?timeout:float -> info -> Xenctrl.domid -> unit
-	val start_vnconly : Xenops_task.task_handle -> xs:Xenstore.Xs.xsh -> dmpath:string -> ?timeout:float -> info -> Xenctrl.domid -> unit
-	val restore : Xenops_task.task_handle -> xs:Xenstore.Xs.xsh -> dmpath:string -> ?timeout:float -> info -> Xenctrl.domid -> unit
+	val start : Xenops_task.task_handle -> xs:Xenstore.Xs.xsh -> dm:Profile.t -> ?timeout:float -> info -> Xenctrl.domid -> unit
+	val start_vnconly : Xenops_task.task_handle -> xs:Xenstore.Xs.xsh -> dm:Profile.t -> ?timeout:float -> info -> Xenctrl.domid -> unit
+	val restore : Xenops_task.task_handle -> xs:Xenstore.Xs.xsh -> dm:Profile.t -> ?timeout:float -> info -> Xenctrl.domid -> unit
 	val suspend : Xenops_task.task_handle -> xs:Xenstore.Xs.xsh -> qemu_domid:int -> Xenctrl.domid -> unit
 	val resume : Xenops_task.task_handle -> xs:Xenstore.Xs.xsh -> qemu_domid:int -> Xenctrl.domid -> unit
 	val stop : xs:Xenstore.Xs.xsh -> qemu_domid:int -> Xenctrl.domid -> unit

xc/xenops_server_xen.ml

@@ -57,11 +57,11 @@ let choose_alternative kind default platformdata =
 	end else default
 
 (* We allow qemu-dm to be overriden via a platform flag *)
-let choose_qemu_dm x = Device.(Profile.wrapper_of (
+let choose_qemu_dm x = Device.(
 	if List.mem_assoc _device_model x
 	then Profile.of_string (List.assoc _device_model x)
 	else Profile.fallback
-))
+)
 
 (* We allow xenguest to be overriden via a platform flag *)
 let choose_xenguest x = choose_alternative _xenguest !Xc_resources.xenguest x
@@ -1334,7 +1334,7 @@ module VM = struct
 		let vmextra = DB.read_exn vm.Vm.id in
 		let qemu_dm = choose_qemu_dm vm.Vm.platformdata in
 		let xenguest = choose_xenguest vm.Vm.platformdata in
-		debug "chosen qemu_dm = %s" qemu_dm;
+		debug "chosen qemu_dm = %s" (Device.Profile.wrapper_of qemu_dm);
 		debug "chosen xenguest = %s" xenguest;
 		try
 			Opt.iter (fun info ->
@@ -1344,15 +1344,15 @@ module VM = struct
 						Opt.iter
 							(fun stubdom_domid ->
 								Stubdom.build task ~xc ~xs ~store_domid ~console_domid info xenguest di.Xenctrl.domid stubdom_domid;
-								Device.Dm.start_vnconly task ~xs ~dmpath:qemu_dm info stubdom_domid
+								Device.Dm.start_vnconly task ~xs ~dm:qemu_dm info stubdom_domid
 							) (get_stubdom ~xs di.Xenctrl.domid);
 					| Vm.HVM { Vm.qemu_stubdom = false } ->
 						(if saved_state then Device.Dm.restore else Device.Dm.start)
-							task ~xs ~dmpath:qemu_dm info di.Xenctrl.domid
+							task ~xs ~dm:qemu_dm info di.Xenctrl.domid
 					| Vm.PV _ ->
 						Device.Vfb.add ~xc ~xs di.Xenctrl.domid;
 						Device.Vkbd.add ~xc ~xs di.Xenctrl.domid;
-						Device.Dm.start_vnconly task ~xs ~dmpath:qemu_dm info di.Xenctrl.domid
+						Device.Dm.start_vnconly task ~xs ~dm:qemu_dm info di.Xenctrl.domid
 			) (create_device_model_config vm vmextra vbds vifs vgpus);
 			match vm.Vm.ty with
 				| Vm.PV { vncterm = true; vncterm_ip = ip } -> Device.PV_Vnc.start ~xs ?ip di.Xenctrl.domid