diff --git a/ocaml/xapi-guard/src/main.ml b/ocaml/xapi-guard/src/main.ml index 5332ad1782b..6a74d49e34b 100644 --- a/ocaml/xapi-guard/src/main.ml +++ b/ocaml/xapi-guard/src/main.ml @@ -119,11 +119,30 @@ let depriv_destroy dbg gid path = D.debug "[%s] stopped server for gid %d and removed socket" dbg gid ; Lwt.return_unit +let vtpm_set_contents dbg vtpm_uuid contents = + let open Xen_api_lwt_unix in + let open Lwt.Syntax in + let uuid = Uuidm.to_string vtpm_uuid in + D.debug "[%s] saving vTPM contents for %s" dbg uuid ; + ret + @@ let* self = Varstored_interface.with_xapi @@ VTPM.get_by_uuid ~uuid in + Varstored_interface.with_xapi @@ VTPM.set_contents ~self ~contents + +let vtpm_get_contents _dbg vtpm_uuid = + let open Xen_api_lwt_unix in + let open Lwt.Syntax in + let uuid = Uuidm.to_string vtpm_uuid in + ret + @@ let* self = Varstored_interface.with_xapi @@ VTPM.get_by_uuid ~uuid in + Varstored_interface.with_xapi @@ VTPM.get_contents ~self + let rpc_fn = let module Server = Varstore_privileged_interface.RPC_API (Rpc_lwt.GenServer ()) in (* bind APIs *) Server.create depriv_create ; Server.destroy depriv_destroy ; + Server.vtpm_set_contents vtpm_set_contents ; + Server.vtpm_get_contents vtpm_get_contents ; Rpc_lwt.server Server.implementation let process body = diff --git a/ocaml/xapi-idl/lib/uuidm_rpc_type.ml b/ocaml/xapi-idl/lib/uuidm_rpc_type.ml new file mode 100644 index 00000000000..24a93fa13b6 --- /dev/null +++ b/ocaml/xapi-idl/lib/uuidm_rpc_type.ml @@ -0,0 +1,42 @@ +module Uuidm = struct + include Uuidm + + (** Validate UUIDs by converting them to Uuidm.t in the API *) + let typ_of = + Rpc.Types.Abstract + { + aname= "uuid" + ; test_data= [Uuidm.v4_gen (Random.get_state ()) ()] + ; rpc_of= (fun t -> Rpc.String (Uuidm.to_string t)) + ; of_rpc= + (function + | Rpc.String s -> ( + match Uuidm.of_string s with + | Some uuid -> + Ok uuid + | None -> + Error + (`Msg + (Printf.sprintf "typ_of_vm_uuid: not a valid UUID: %s" s) + ) + ) + | r -> + Error + (`Msg + (Printf.sprintf + "typ_of_vm_uuid: expected rpc string but got %s" + (Rpc.to_string r) + ) + ) + ) + } + + let t_of_sexp sexp = + match sexp |> Sexplib.Std.string_of_sexp |> Uuidm.of_string with + | None -> + Sexplib.Conv.of_sexp_error "not a UUID" sexp + | Some u -> + u + + let sexp_of_t t = t |> Uuidm.to_string |> Sexplib.Std.sexp_of_string +end diff --git a/ocaml/xapi-idl/lib/uuidm_rpc_type.mli b/ocaml/xapi-idl/lib/uuidm_rpc_type.mli new file mode 100644 index 00000000000..303533a696a --- /dev/null +++ b/ocaml/xapi-idl/lib/uuidm_rpc_type.mli @@ -0,0 +1,11 @@ +module Uuidm : sig + type t = Uuidm.t + + include module type of Uuidm with type t := t + + val typ_of : t Rpc.Types.typ + + val t_of_sexp : Sexplib.Sexp.t -> t + + val sexp_of_t : t -> Sexplib.Sexp.t +end diff --git a/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml b/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml index 87c40cad43a..31b39d1f9f7 100644 --- a/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml +++ b/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml @@ -21,6 +21,7 @@ open Rpc open Idl +module Uuidm = Uuidm_rpc_type.Uuidm let service_name = "xapi_depriv" @@ -34,42 +35,10 @@ module E = Error.Make (struct let internal_error_of e = Some (InternalError (Printexc.to_string e)) end) -module Uuidm = struct - include Uuidm - - (** Validate UUIDs by converting them to Uuidm.t in the API *) - let typ_of = - Rpc.Types.Abstract - { - aname= "uuid" - ; test_data= [Uuidm.v4_gen (Random.get_state ()) ()] - ; rpc_of= (fun t -> Rpc.String (Uuidm.to_string t)) - ; of_rpc= - (function - | Rpc.String s -> ( - match Uuidm.of_string s with - | Some uuid -> - Ok uuid - | None -> - Error - (`Msg - (Printf.sprintf "typ_of_vm_uuid: not a valid UUID: %s" s) - ) - ) - | r -> - Error - (`Msg - (Printf.sprintf - "typ_of_vm_uuid: expected rpc string but got %s" - (Rpc.to_string r) - ) - ) - ) - } -end - type vm_uuid = Uuidm.t [@@deriving rpcty] +type vtpm_uuid = Uuidm.t [@@deriving rpcty] + module RPC_API (R : RPC) = struct open R @@ -120,4 +89,17 @@ module RPC_API (R : RPC) = struct declare "destroy" ["Stop listening on sockets for the specified group"] (debug_info_p @-> gid_p @-> path_p @-> returning unit_p err) + + let vtpm_uuid_p = + Param.mk ~name:"vtpm_uuid" ~description:["VTPM UUID"] vtpm_uuid + + let string_p = Param.mk Types.string + + let vtpm_set_contents = + declare "vtpm_set_contents" ["Set vTPM contents blob"] + (debug_info_p @-> vtpm_uuid_p @-> string_p @-> returning unit_p err) + + let vtpm_get_contents = + declare "vtpm_get_contents" ["Get vTPM contents blob"] + (debug_info_p @-> vtpm_uuid_p @-> returning string_p err) end diff --git a/ocaml/xapi-idl/xen/xenops_types.ml b/ocaml/xapi-idl/xen/xenops_types.ml index bf7130546a0..765181f2023 100644 --- a/ocaml/xapi-idl/xen/xenops_types.ml +++ b/ocaml/xapi-idl/xen/xenops_types.ml @@ -1,5 +1,6 @@ open Sexplib.Std open Xcp_pci +open Uuidm_rpc_type module TopLevel = struct type power_state = Running | Halted | Suspended | Paused @@ -77,7 +78,7 @@ module Vm = struct let default_firmware = Bios [@@deriving rpcty] - type tpm = Vtpm [@@deriving rpcty, sexp] + type tpm = Vtpm of Uuidm.t [@@deriving rpcty, sexp] type hvm_info = { hap: bool [@default true] diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index af2ac47fa86..3f6121c191f 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -346,7 +346,7 @@ let is_boot_file_whitelisted filename = (* avoid ..-style attacks and other weird things *) && safe_str filename -let builder_of_vm ~__context (_, vm) timeoffset pci_passthrough vgpu = +let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu = let open Vm in let video_mode = if vgpu then @@ -386,20 +386,28 @@ let builder_of_vm ~__context (_, vm) timeoffset pci_passthrough vgpu = warn "QEMU stub domains are no longer implemented" ; let tpm_of_vm () = - if bool vm.API.vM_platform false "vtpm" then ( - if vm.API.vM_VTPMs = [] then ( - let ref () = Ref.make () in - let uuid () = Uuid.(to_string (make_uuid ())) in - let profile = [] in - let other_config = [] in - let contents = ref () in - Db.Secret.create ~__context ~ref:contents ~uuid:(uuid ()) ~value:"" - ~other_config ; - Db.VTPM.create ~__context ~ref:(ref ()) ~uuid:(uuid ()) ~vM:vmref - ~profile ~contents - ) ; - Some Xenops_interface.Vm.Vtpm - ) else + if bool vm.API.vM_platform false "vtpm" then + let uuid = + match vm.API.vM_VTPMs with + | [] -> + let ref () = Ref.make () in + let uuid () = Uuid.(to_string (make ())) in + let profile = [] in + let other_config = [] in + let contents = ref () in + Db.Secret.create ~__context ~ref:contents ~uuid:(uuid ()) + ~value:"" ~other_config ; + let vtpm_uuid = uuid () in + Db.VTPM.create ~__context ~ref:(ref ()) ~uuid:vtpm_uuid ~vM:vmref + ~profile ~contents ; + vtpm_uuid + | [self] -> + Db.VTPM.get_uuid ~__context ~self + | _ :: _ :: _ -> + failwith "Multiple vTPMs are not supported" + in + Some (Xenops_interface.Vm.Vtpm (Uuidm.of_string uuid |> Option.get)) + else None in diff --git a/ocaml/xenopsd/cli/xn.ml b/ocaml/xenopsd/cli/xn.ml index 35412891e61..1304cc496cb 100644 --- a/ocaml/xenopsd/cli/xn.ml +++ b/ocaml/xenopsd/cli/xn.ml @@ -605,8 +605,9 @@ let add' _copts x () = ; firmware= Xenops_types.Vm.default_firmware ; tpm= ( match find_opt _vtpm with - | Some id when bool id -> - Some Vtpm + | Some id -> + Some + (Vtpm (string id |> Uuidm.of_string |> Option.get)) | _ -> None ) diff --git a/ocaml/xenopsd/lib/resources.ml b/ocaml/xenopsd/lib/resources.ml index aee7bc4db7f..aa3200d3ec9 100644 --- a/ocaml/xenopsd/lib/resources.ml +++ b/ocaml/xenopsd/lib/resources.ml @@ -20,6 +20,8 @@ let qemu_system_i386 = ref "qemu-system-i386" let upstream_compat_qemu_dm_wrapper = ref "qemu-wrapper" +let swtpm_wrapper = ref "swtpm-wrapper" + let chgrp = ref "chgrp" let modprobe = ref "/usr/sbin/modprobe" @@ -77,6 +79,9 @@ let pvinpvh_guests = ) ] +let vtpm_guests = + [(X_OK, "swtpm-wrapper", swtpm_wrapper, "path to swtpm-wrapper")] + (* libvirt xc *) let network_configuration = [(R_OK, "network-conf", network_conf, "path to the network backend switch")] diff --git a/ocaml/xenopsd/lib/suspend_image.ml b/ocaml/xenopsd/lib/suspend_image.ml index 72c705728a3..33fe352fa0b 100644 --- a/ocaml/xenopsd/lib/suspend_image.ml +++ b/ocaml/xenopsd/lib/suspend_image.ml @@ -62,6 +62,7 @@ type header_type = | Qemu_xen | Demu | Varstored + | Swtpm | End_of_image exception Invalid_header_type @@ -83,6 +84,8 @@ let header_type_of_int64 = function Ok Demu | 0x0f11L -> Ok Varstored + | 0x0f12L -> + Ok Swtpm | 0xffffL -> Ok End_of_image | _ -> @@ -105,6 +108,8 @@ let int64_of_header_type = function 0x0f10L | Varstored -> 0x0f11L + | Swtpm -> + 0x0f12L | End_of_image -> 0xffffL @@ -129,6 +134,8 @@ let string_of_header h = s "vGPU save record (record length=%Ld)" len | Varstored, len -> s "varstored save record (record length=%Ld)" len + | Swtpm, len -> + s "swtpm save record (record length=%Ld)" len | End_of_image, _ -> s "Suspend image footer" diff --git a/ocaml/xenopsd/lib/suspend_image.mli b/ocaml/xenopsd/lib/suspend_image.mli index e9447494176..794cdd75fb9 100644 --- a/ocaml/xenopsd/lib/suspend_image.mli +++ b/ocaml/xenopsd/lib/suspend_image.mli @@ -40,6 +40,7 @@ type header_type = | Qemu_xen | Demu | Varstored + | Swtpm | End_of_image type format = Structured | Legacy diff --git a/ocaml/xenopsd/lib/xenops_sandbox.ml b/ocaml/xenopsd/lib/xenops_sandbox.ml index df9eb97cc3e..4e77af1c52b 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.ml +++ b/ocaml/xenopsd/lib/xenops_sandbox.ml @@ -120,6 +120,8 @@ end module type SANDBOX = sig val create : domid:int -> vm_uuid:string -> Chroot.Path.t -> string + val chroot : domid:int -> vm_uuid:string -> Chroot.t + val start : string -> vm_uuid:string diff --git a/ocaml/xenopsd/lib/xenops_sandbox.mli b/ocaml/xenopsd/lib/xenops_sandbox.mli index c6c071c85f3..3c8cfb6539d 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.mli +++ b/ocaml/xenopsd/lib/xenops_sandbox.mli @@ -48,6 +48,11 @@ module type SANDBOX = sig [domid] inside the chroot for [domid] and returns the absolute path to it outside the chroot *) + val chroot : domid:int -> vm_uuid:string -> Chroot.t + (** [chroot ~domid ~vm_uuid] returns the chroot for [domid] and [vm_uuid]. + The chroot may not necessarily exist yet. + *) + val start : string -> vm_uuid:string diff --git a/ocaml/xenopsd/scripts/make-custom-xenopsd.conf b/ocaml/xenopsd/scripts/make-custom-xenopsd.conf index 828f845897b..7158b5e1ca5 100755 --- a/ocaml/xenopsd/scripts/make-custom-xenopsd.conf +++ b/ocaml/xenopsd/scripts/make-custom-xenopsd.conf @@ -46,6 +46,7 @@ qemu-dm-wrapper=${LIBEXECDIR}/qemu-dm-wrapper setup-vif-rules=${LIBEXECDIR}/setup-vif-rules sockets-group=$group qemu-wrapper=${QEMU_WRAPPER_DIR}/qemu-wrapper +swtpm-wrapper=${QEMU_WRAPPER_DIR}/qemu-wrapper disable-logging-for=http # Workaround xenopsd bug #45 diff --git a/ocaml/xenopsd/suspend_image_viewer/suspend_image_viewer.ml b/ocaml/xenopsd/suspend_image_viewer/suspend_image_viewer.ml index 3d74f551140..70e0e420eb1 100644 --- a/ocaml/xenopsd/suspend_image_viewer/suspend_image_viewer.ml +++ b/ocaml/xenopsd/suspend_image_viewer/suspend_image_viewer.ml @@ -68,6 +68,9 @@ let parse_layout fd = | Varstored, len -> Io.read fd (Io.int_of_int64_exn len) |> ignore ; aux (h :: acc) + | Swtpm, len -> + Io.read fd (Io.int_of_int64_exn len) |> ignore ; + aux (h :: acc) | End_of_image, _ -> return (h :: acc) | Libxl, _ -> diff --git a/ocaml/xenopsd/test/test.ml b/ocaml/xenopsd/test/test.ml index 447585b7a15..3d2e35f31c7 100644 --- a/ocaml/xenopsd/test/test.ml +++ b/ocaml/xenopsd/test/test.ml @@ -231,7 +231,7 @@ let create_vm vmid = ; qemu_disk_cmdline= false ; qemu_stubdom= false ; firmware= Bios - ; tpm= Some Vtpm + ; tpm= None } in { diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index 83ae5fbb171..e1054379f64 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -1264,13 +1264,74 @@ module Varstored = SystemdDaemonMgmt (struct let pid_path domid = sprintf "/local/domain/%d/varstored-pid" domid end) -module Swtpm = SystemdDaemonMgmt (struct - let name = "swtpm-wrapper" +(* TODO: struct and include and uri to uri mapper, etc. + also xapi needs default backend set +*) +module Swtpm = struct + module D = SystemdDaemonMgmt (struct + let name = "swtpm-wrapper" - let use_pidfile = false + let use_pidfile = false - let pid_path domid = sprintf "/local/domain/%d/varstored-pid" domid -end) + let pid_path domid = sprintf "/local/domain/%d/varstored-pid" domid + end) + + let xs_path ~domid = Device_common.get_private_path domid ^ "/vtpm" + + let state_path = + (* for easier compat with dir:// mode, but can be anything. + If we implement VDI state storage this could be a block device + *) + Xenops_sandbox.Chroot.Path.of_string ~relative:"tpm2-00.permall" + + let restore ~xs:_ ~domid ~vm_uuid state = + if String.length state > 0 then ( + let path = Xenops_sandbox.Swtpm_guard.create ~domid ~vm_uuid state_path in + debug "Restored vTPM for domid %d: %d bytes, digest %s" domid + (String.length state) + (state |> Digest.string |> Digest.to_hex) ; + Unixext.write_string_to_file path state + ) else + debug "vTPM state for domid %d is empty: not restoring" domid + + let start_daemon dbg ~xs ~path ~args ~domid ~vm_uuid ~vtpm_uuid ~index () = + let state = + Varstore_privileged_client.Client.vtpm_get_contents dbg vtpm_uuid + |> Base64.decode_exn + in + let chroot = Xenops_sandbox.Swtpm_guard.chroot ~domid ~vm_uuid in + let abs_path = + Xenops_sandbox.Chroot.absolute_path_outside chroot state_path + in + if Sys.file_exists abs_path then + debug "Not restoring vTPM: %s already exists" abs_path + else + restore ~xs ~domid ~vm_uuid state ; + let vtpm_path = xs_path ~domid in + xs.Xs.write + (Filename.concat vtpm_path @@ string_of_int index) + (Uuidm.to_string vtpm_uuid) ; + D.start_daemon ~path ~args ~domid () + + let suspend ~xs ~domid ~vm_uuid = + D.stop ~xs domid ; + Xenops_sandbox.Swtpm_guard.read ~domid ~vm_uuid state_path + + let stop dbg ~xs ~domid ~vm_uuid ~vtpm_uuid = + debug "About to stop vTPM (%s) for domain %d (%s)" + (Uuidm.to_string vtpm_uuid) + domid vm_uuid ; + let contents = suspend ~xs ~domid ~vm_uuid in + let length = String.length contents in + if length > 0 then ( + debug "Storing vTPM state of %d bytes" length ; + Varstore_privileged_client.Client.vtpm_set_contents dbg vtpm_uuid + (Base64.encode_string contents) + ) else + debug "vTPM state is empty: not storing" ; + (* needed to save contents before wiping the chroot *) + Xenops_sandbox.Swtpm_guard.stop dbg ~domid ~vm_uuid +end module PV_Vnc = struct module D = DaemonMgmt (struct @@ -2736,7 +2797,7 @@ module Dm_Common = struct signal task ~xs ~qemu_domid ~domid "continue" ~wait_for:"running" (* Called by every domain destroy, even non-HVM *) - let stop ~xs ~qemu_domid domid = + let stop ~xs ~qemu_domid ~vtpm domid = let qemu_pid_path = Qemu.pid_path domid in let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuid.to_string in let dbg = Printf.sprintf "stop domid %d" domid in @@ -2772,7 +2833,11 @@ module Dm_Common = struct ) in let stop_swptm () = - Swtpm.stop ~xs domid ; + Option.iter + (fun (Xenops_interface.Vm.Vtpm vtpm_uuid) -> + Swtpm.stop dbg ~xs ~domid ~vm_uuid ~vtpm_uuid + ) + vtpm ; Xenops_sandbox.Swtpm_guard.stop dbg ~domid ~vm_uuid in let stop_vgpu () = Vgpu.stop ~xs domid in @@ -2944,7 +3009,12 @@ module Backend = struct (** [init_daemon task path args domid xenstore ready_path timeout cancel] returns a forkhelper pid after starting the qemu daemon in dom0 *) - val stop : xs:Xenstore.Xs.xsh -> qemu_domid:int -> int -> unit + val stop : + xs:Xenstore.Xs.xsh + -> qemu_domid:int + -> vtpm:Xenops_interface.Vm.tpm option + -> int + -> unit (** [stop xenstore qemu_domid domid] stops a domain *) val qemu_args : @@ -2958,7 +3028,11 @@ module Backend = struct arguments to pass to the qemu wrapper script *) val after_suspend_image : - xs:Xenstore.Xs.xsh -> qemu_domid:int -> int -> unit + xs:Xenstore.Xs.xsh + -> qemu_domid:int + -> vtpm:Xenops_interface.Vm.tpm option + -> int + -> unit (** [after_suspend_image xs qemu_domid domid] hook to execute actions after the suspend image has been created *) @@ -3011,7 +3085,7 @@ module Backend = struct let suspend (task : Xenops_task.task_handle) ~xs ~qemu_domid domid = Dm_Common.signal task ~xs ~qemu_domid ~domid "save" ~wait_for:"paused" - let stop ~xs:_ ~qemu_domid:_ _ = () + let stop ~xs:_ ~qemu_domid:_ ~vtpm:_ _ = () let init_daemon ~task:_ ~path:_ ~args:_ ~domid:_ ~xs:_ ~ready_path:_ ~timeout:_ ~cancel:_ ?fds:_ _ = @@ -3019,7 +3093,7 @@ module Backend = struct let qemu_args ~xs:_ ~dm:_ _ _ _ = {Dm_Common.argv= []; fd_map= []} - let after_suspend_image ~xs:_ ~qemu_domid:_ _ = () + let after_suspend_image ~xs:_ ~qemu_domid:_ ~vtpm:_ _ = () let pci_assign_guest ~xs:_ ~index:_ ~host:_ = None end @@ -3758,8 +3832,8 @@ module Backend = struct QMP_Event.add domid ; pid - let stop ~xs ~qemu_domid domid = - Dm_Common.stop ~xs ~qemu_domid domid ; + let stop ~xs ~qemu_domid ~vtpm domid = + Dm_Common.stop ~xs ~qemu_domid ~vtpm domid ; QMP_Event.remove domid ; let rm path = let msg = Printf.sprintf "removing %s" path in @@ -4014,9 +4088,9 @@ module Backend = struct } - let after_suspend_image ~xs ~qemu_domid domid = + let after_suspend_image ~xs ~qemu_domid ~vtpm domid = (* device model not needed anymore after suspend image has been created *) - stop ~xs ~qemu_domid domid + stop ~xs ~qemu_domid ~vtpm domid let pci_assign_guest ~xs ~index ~host = DefaultConfig.PCI.assign_guest ~xs ~index ~host @@ -4118,17 +4192,17 @@ module Dm = struct let module Q = (val Backend.of_profile dm) in Q.Dm.suspend task ~xs ~qemu_domid domid - let stop ~xs ~qemu_domid ~dm domid = + let stop ~xs ~qemu_domid ~vtpm ~dm domid = let module Q = (val Backend.of_profile dm) in - Q.Dm.stop ~xs ~qemu_domid domid + Q.Dm.stop ~xs ~vtpm ~qemu_domid domid let qemu_args ~xs ~dm info restore domid = let module Q = (val Backend.of_profile dm) in Q.Dm.qemu_args ~xs ~dm info restore domid - let after_suspend_image ~xs ~dm ~qemu_domid domid = + let after_suspend_image ~xs ~dm ~qemu_domid ~vtpm domid = let module Q = (val Backend.of_profile dm) in - Q.Dm.after_suspend_image ~xs ~qemu_domid domid + Q.Dm.after_suspend_image ~xs ~qemu_domid ~vtpm domid let pci_assign_guest ~xs ~dm ~index ~host = let module Q = (val Backend.of_profile dm) in @@ -4137,9 +4211,9 @@ module Dm = struct (* the following functions depend on the functions above that use the qemu backend Q *) - let start_swtpm ~xs task domid = + let start_swtpm ~xs task domid ~vtpm_uuid ~index = debug "Preparing to start swtpm-wrapper to provide a vTPM (domid=%d)" domid ; - let exec_path = "/usr/lib64/xen/bin/swtpm-wrapper" in + let exec_path = !Resources.swtpm_wrapper in let name = "swtpm" in let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuid.to_string in @@ -4150,10 +4224,19 @@ module Dm = struct let tpm_root = Xenops_sandbox.Chroot.(absolute_path_outside chroot Path.root) in - let args = Fe_argv.Add.many [string_of_int domid; tpm_root] in + (* the uri here is relative to the chroot path, if chrooting is disabled then + swtpm-wrapper should modify the uri accordingly. + xenopsd needs to be in charge of choosing the scheme according to the backend + *) + let state_uri = + Filename.concat "file://" + @@ Xenops_sandbox.Chroot.chroot_path_inside Swtpm.state_path + in + let args = Fe_argv.Add.many [string_of_int domid; tpm_root; state_uri] in let args = Fe_argv.run args |> snd |> Fe_argv.argv in let timeout_seconds = !Xenopsd.swtpm_ready_timeout in - let execute = Swtpm.start_daemon in + let dbg = Xenops_task.get_dbg task in + let execute = Swtpm.start_daemon dbg ~xs ~vtpm_uuid ~vm_uuid ~index in let service = {Service.name; domid; exec_path; chroot; args; execute; timeout_seconds} in @@ -4320,8 +4403,10 @@ module Dm = struct (* start swtpm-wrapper if appropriate and modify QEMU arguments as needed *) let tpmargs = match info.tpm with - | Some Vtpm -> - let tpm_socket_path = start_swtpm ~xs task domid in + | Some (Vtpm vtpm_uuid) -> + let tpm_socket_path = + start_swtpm ~xs task domid ~vtpm_uuid ~index:0 + in [ "-chardev" ; Printf.sprintf "socket,id=chrtpm,path=%s" tpm_socket_path @@ -4331,6 +4416,7 @@ module Dm = struct ; "tpm-crb,tpmdev=tpm0" ] | None -> + D.debug "VM domid %d has no vTPM" domid ; [] in @@ -4449,6 +4535,21 @@ module Dm = struct debug "Writing EFI variables to %s (domid=%d)" path domid ; Unixext.write_string_to_file path efivars ; debug "Wrote EFI variables to %s (domid=%d)" path domid + + let suspend_vtpms (_task : Xenops_task.task_handle) ~xs domid ~vm_uuid ~vtpm = + debug "Called Dm.suspend_vtpms (domid=%d)" domid ; + Option.map + (fun (Xenops_interface.Vm.Vtpm _vtpm_uuid) -> + Swtpm.suspend ~xs ~domid ~vm_uuid + ) + vtpm + |> Option.to_list + + let restore_vtpm (_task : Xenops_task.task_handle) ~xs ~contents domid = + debug "Called Dm.restore_vtpms (domid=%d)" domid ; + let vm_uuid = Uuid.to_string (Xenops_helpers.uuid_of_domid ~xs domid) in + (* TODO: multiple vTPM support? *) + Swtpm.restore ~xs ~domid ~vm_uuid contents end (* Dm *) diff --git a/ocaml/xenopsd/xc/device.mli b/ocaml/xenopsd/xc/device.mli index d9fc4605645..051b46f29e8 100644 --- a/ocaml/xenopsd/xc/device.mli +++ b/ocaml/xenopsd/xc/device.mli @@ -456,6 +456,7 @@ module Dm : sig val stop : xs:Xenstore.Xs.xsh -> qemu_domid:int + -> vtpm:Xenops_interface.Vm.tpm option -> dm:Profile.t -> Xenctrl.domid -> unit @@ -484,8 +485,28 @@ module Dm : sig -> Xenctrl.domid -> unit + val suspend_vtpms : + Xenops_task.task_handle + -> xs:Xenstore.Xs.xsh + -> Xenctrl.domid + -> vm_uuid:string + -> vtpm:Xenops_interface.Vm.tpm option + -> string list + + val restore_vtpm : + Xenops_task.task_handle + -> xs:Xenstore.Xs.xsh + -> contents:string + -> Xenctrl.domid + -> unit + val after_suspend_image : - xs:Xenstore.Xs.xsh -> dm:Profile.t -> qemu_domid:int -> int -> unit + xs:Xenstore.Xs.xsh + -> dm:Profile.t + -> qemu_domid:int + -> vtpm:Xenops_interface.Vm.tpm option + -> int + -> unit val pci_assign_guest : xs:Xenstore.Xs.xsh diff --git a/ocaml/xenopsd/xc/domain.ml b/ocaml/xenopsd/xc/domain.ml index 2e7bc1e326f..e0493984365 100644 --- a/ocaml/xenopsd/xc/domain.ml +++ b/ocaml/xenopsd/xc/domain.ml @@ -632,7 +632,8 @@ let sysrq ~xs domid key = let path = xs.Xs.getdomainpath domid ^ "/control/sysrq" in xs.Xs.write path (String.make 1 key) -let destroy (task : Xenops_task.task_handle) ~xc ~xs ~qemu_domid ~dm domid = +let destroy (task : Xenops_task.task_handle) ~xc ~xs ~qemu_domid ~vtpm ~dm domid + = let dom_path = xs.Xs.getdomainpath domid in let xenops_dom_path = xenops_path_of_domain domid in let libxl_dom_path = sprintf "/libxl/%d" domid in @@ -690,7 +691,7 @@ let destroy (task : Xenops_task.task_handle) ~xc ~xs ~qemu_domid ~dm domid = (Uuid.to_string uuid) domid ; log_exn_continue "Xenctrl.domain_destroy" (Xenctrl.domain_destroy xc) domid ; log_exn_continue "Error stoping device-model, already dead ?" - (fun () -> Device.Dm.stop ~xs ~qemu_domid ~dm domid) + (fun () -> Device.Dm.stop ~xs ~qemu_domid ~vtpm ~dm domid) () ; log_exn_continue "Error stoping vncterm, already dead ?" (fun () -> Device.PV_Vnc.stop ~xs domid) @@ -1399,6 +1400,12 @@ let restore_common (task : Xenops_task.task_handle) ~xc ~xs debug "Read varstored record contents (domid=%d)" domid ; Device.Dm.restore_varstored task ~xs ~efivars domid ; process_header fd res + | Swtpm, len -> + debug "Read swtpm record header (domid=%d length=%Ld)" domid len ; + let contents = Io.read fd (Io.int_of_int64_exn len) in + debug "Read swtpm record contents (domid=%d)" domid ; + Device.Dm.restore_vtpm task ~xs ~contents domid ; + process_header fd res | End_of_image, _ -> debug "Read suspend image footer" ; res @@ -1585,7 +1592,7 @@ let restore (task : Xenops_task.task_handle) ~xc ~xs ~dm ~store_domid store_mfn store_port local_stuff vm_stuff let suspend_emu_manager ~(task : Xenops_task.task_handle) ~xc:_ ~xs ~domain_type - ~is_uefi ~dm ~manager_path ~domid ~uuid ~main_fd ~vgpu_fd ~flags + ~is_uefi ~vtpm ~dm ~manager_path ~domid ~uuid ~main_fd ~vgpu_fd ~flags ~progress_callback ~qemu_domid ~do_suspend_callback = let open Suspend_image in let open Suspend_image.M in @@ -1669,6 +1676,9 @@ let suspend_emu_manager ~(task : Xenops_task.task_handle) ~xc:_ ~xs ~domain_type let (_ : string) = Device.Dm.suspend_varstored task ~xs domid ~vm_uuid in + let (_ : string list) = + Device.Dm.suspend_vtpms task ~xs domid ~vm_uuid ~vtpm + in () ) ; send_done cnx ; @@ -1745,12 +1755,30 @@ let write_varstored_record task ~xs domid main_fd = Io.write main_fd varstored_record ; return () +let forall f l = + let open Suspend_image.M in + fold (fun x () -> f x) l () + +let write_vtpms_record task ~xs ~vtpm domid main_fd = + let open Suspend_image in + let open Suspend_image.M in + Device.Dm.suspend_vtpms task ~xs domid + ~vm_uuid:(Uuid.to_string (Xenops_helpers.uuid_of_domid ~xs domid)) + ~vtpm + |> forall @@ fun swtpm_record -> + let swtpm_rec_len = String.length swtpm_record in + debug "Writing swtpm record (domid=%d length=%d)" domid swtpm_rec_len ; + write_header main_fd (Swtpm, Int64.of_int swtpm_rec_len) >>= fun () -> + debug "Writing swtpm record contents (domid=%d)" domid ; + Io.write main_fd swtpm_record ; + return () + (* suspend register the callback function that will be call by linux_save and is in charge to suspend the domain when called. the whole domain context is saved to fd *) let suspend (task : Xenops_task.task_handle) ~xc ~xs ~domain_type ~is_uefi ~dm ~manager_path vm_str domid main_fd vgpu_fd flags - ?(progress_callback = fun _ -> ()) ~qemu_domid do_suspend_callback = + ?(progress_callback = fun _ -> ()) ~qemu_domid ~vtpm do_suspend_callback = let module DD = Debug.Make (struct let name = "mig64" end) in let open DD in let hvm = domain_type = `hvm in @@ -1775,12 +1803,13 @@ let suspend (task : Xenops_task.task_handle) ~xc ~xs ~domain_type ~is_uefi ~dm write_header main_fd (Xenops, Int64.of_int xenops_rec_len) >>= fun () -> debug "Writing Xenops record contents" ; Io.write main_fd xenops_record ; - suspend_emu_manager ~task ~xc ~xs ~domain_type ~is_uefi ~dm ~manager_path - ~domid ~uuid ~main_fd ~vgpu_fd ~flags ~progress_callback ~qemu_domid - ~do_suspend_callback + suspend_emu_manager ~task ~xc ~xs ~domain_type ~is_uefi ~vtpm ~dm + ~manager_path ~domid ~uuid ~main_fd ~vgpu_fd ~flags ~progress_callback + ~qemu_domid ~do_suspend_callback >>= fun () -> ( if is_uefi then - write_varstored_record task ~xs domid main_fd + write_varstored_record task ~xs domid main_fd >>= fun () -> + write_vtpms_record task ~xs ~vtpm domid main_fd else return () ) @@ -1814,7 +1843,7 @@ let suspend (task : Xenops_task.task_handle) ~xc ~xs ~domain_type ~is_uefi ~dm | Ok () -> debug "VM = %s; domid = %d; suspend complete" (Uuid.to_string uuid) domid ) ; - if hvm then Device.Dm.after_suspend_image ~xs ~dm ~qemu_domid domid + if hvm then Device.Dm.after_suspend_image ~xs ~dm ~qemu_domid ~vtpm domid let send_s3resume ~xc domid = let uuid = get_uuid ~xc domid in diff --git a/ocaml/xenopsd/xc/domain.mli b/ocaml/xenopsd/xc/domain.mli index d2fa1b4de1e..f566ba3e557 100644 --- a/ocaml/xenopsd/xc/domain.mli +++ b/ocaml/xenopsd/xc/domain.mli @@ -201,6 +201,7 @@ val destroy : -> xc:Xenctrl.handle -> xs:Xenstore.Xs.xsh -> qemu_domid:int + -> vtpm:Xenops_interface.Vm.tpm option -> dm:Device.Profile.t -> domid -> unit @@ -269,6 +270,7 @@ val suspend : -> suspend_flag list -> ?progress_callback:(float -> unit) -> qemu_domid:int + -> vtpm:Xenops_interface.Vm.tpm option -> (unit -> unit) -> unit (** suspend a domain into the file descriptor *) diff --git a/ocaml/xenopsd/xc/xc_resources.ml b/ocaml/xenopsd/xc/xc_resources.ml index a5e9761bfd6..5f9dba7f79f 100644 --- a/ocaml/xenopsd/xc/xc_resources.ml +++ b/ocaml/xenopsd/xc/xc_resources.ml @@ -95,3 +95,4 @@ let nonessentials = @ Resources.hvm_guests @ Resources.pv_guests @ Resources.pvinpvh_guests + @ Resources.vtpm_guests diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index 7f32bd9c247..ea98a813f3a 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -1138,6 +1138,8 @@ let dm_of ~vm = with _ -> Device.Profile.fallback ) +let vtpm_of ~vm = match vm.Vm.ty with Vm.HVM h -> h.tpm | _ -> None + module VM = struct open Vm @@ -1676,7 +1678,10 @@ module VM = struct let domid = di.Xenctrl.domid in let qemu_domid = this_domid ~xs in log_exn_continue "Error stoping device-model, already dead ?" - (fun () -> Device.Dm.stop ~xs ~qemu_domid ~dm:(dm_of ~vm) domid) + (fun () -> + Device.Dm.stop ~xs ~qemu_domid ~vtpm:(vtpm_of ~vm) ~dm:(dm_of ~vm) + domid + ) () ; log_exn_continue "Error stoping vncterm, already dead ?" (fun () -> Device.PV_Vnc.stop ~xs domid) @@ -1722,7 +1727,8 @@ module VM = struct vm.Vm.id di.Xenctrl.domid ; if DB.exists vm.Vm.id then DB.remove vm.Vm.id ) ; - Domain.destroy task ~xc ~xs ~qemu_domid ~dm:(dm_of ~vm) domid ; + Domain.destroy task ~xc ~xs ~qemu_domid ~vtpm:(vtpm_of ~vm) + ~dm:(dm_of ~vm) domid ; (* Detach any remaining disks *) List.iter (fun dp -> @@ -1863,8 +1869,7 @@ module VM = struct ?(serial = "pty") ?(monitor = "null") ?(nics = []) ?(disks = []) ?(vgpus = []) ?(pci_emulations = []) ?(usb = Device.Dm.Disabled) ?(parallel = None) ?(acpi = true) ?(video = Cirrus) ?keymap ?vnc_ip - ?(pci_passthrough = false) ?(video_mib = 4) - ?(tpm = None) () = + ?(pci_passthrough = false) ?(video_mib = 4) ?(tpm = None) () = let video = match (video, vgpus) with | Cirrus, [] -> @@ -2489,8 +2494,8 @@ module VM = struct in let manager_path = choose_emu_manager vm.Vm.platformdata in Domain.suspend task ~xc ~xs ~domain_type ~dm:(dm_of ~vm) - ~progress_callback ~qemu_domid ~manager_path ~is_uefi vm_str domid - fd vgpu_fd flags' (fun () -> + ~vtpm:(vtpm_of ~vm) ~progress_callback ~qemu_domid ~manager_path + ~is_uefi vm_str domid fd vgpu_fd flags' (fun () -> (* SCTX-2558: wait more for ballooning if needed *) wait_ballooning task vm ; pre_suspend_callback task ; @@ -2666,8 +2671,8 @@ module VM = struct "VM %s: libxenguest has destroyed domid %d; cleaning \ up xenstore for consistency" vm.Vm.id di.Xenctrl.domid ; - Domain.destroy task ~xc ~xs ~qemu_domid ~dm:(dm_of ~vm) - di.Xenctrl.domid + Domain.destroy task ~xc ~xs ~qemu_domid + ~vtpm:(vtpm_of ~vm) ~dm:(dm_of ~vm) di.Xenctrl.domid with _ -> debug "Domain.destroy failed. Re-raising original error." ) ;