From 1b1fd4525b4033609f2a1207bbbe2f5fd68a76f3 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 20 Dec 2021 16:39:37 +0000 Subject: [PATCH 01/53] CP-38617: Add module with stubs for xenforeignmemory For now the {open,close}_handle and a with_mapping are added to the module, this allows users to map and unmap memory from domains to dom0 memory with correct permissions. The map and unmap functions are not exposed to ensure the use of the same handle for both. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/c_stubs/dune | 2 +- ocaml/xenopsd/c_stubs/xenctrlext_stubs.c | 147 +++++++++++++++++++++++ ocaml/xenopsd/xc/dune | 1 + ocaml/xenopsd/xc/xenctrlext.ml | 38 ++++++ ocaml/xenopsd/xc/xenctrlext.mli | 27 +++++ xapi-xenopsd-xc.opam | 1 + 6 files changed, 215 insertions(+), 1 deletion(-) diff --git a/ocaml/xenopsd/c_stubs/dune b/ocaml/xenopsd/c_stubs/dune index 2be098fb2c1..31e6c4a29c0 100644 --- a/ocaml/xenopsd/c_stubs/dune +++ b/ocaml/xenopsd/c_stubs/dune @@ -16,7 +16,7 @@ (foreign_stubs (language c) (names tuntap_stubs xenctrlext_stubs) - (flags (-L/lib64 -lxentoollog)) ) + (c_library_flags (-L/lib64 -lxentoollog -lxenforeignmemory)) ) diff --git a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c index 1f7167dc10c..7c3fcd01ab5 100644 --- a/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c +++ b/ocaml/xenopsd/c_stubs/xenctrlext_stubs.c @@ -19,6 +19,10 @@ #include #include #include +#include +#include + +#include #include #include @@ -28,6 +32,7 @@ #include #include #include +#include #define _H(__h) ((xc_interface *)(__h)) #define _D(__d) ((uint32_t)Int_val(__d)) @@ -35,6 +40,16 @@ /* From xenctrl_stubs */ #define ERROR_STRLEN 1024 +#define Xtl_val(x)(*((struct xentoollog_logger **) Data_custom_val(x))) +#define Xfm_val(x)(*((struct xenforeignmemory_handle **) Data_abstract_val(x))) +#define Addr_val(x)(*((void **) Data_abstract_val(x))) + +// Defined in OCaml 4.12: https://github.com/ocaml/ocaml/pull/9734 +#if OCAML_VERSION < 41200 +#define Some_val(v) Field(v, 0) +#define Is_some(v) Is_block(v) +#endif + static void raise_unix_errno_msg(int err_code, const char *err_msg) { CAMLparam0(); @@ -394,6 +409,138 @@ CAMLprim value stub_xenctrlext_cputopoinfo(value xch) CAMLreturn(result); } +CAMLprim value stub_xenforeignmemory_open(value logger, value open_flags) +{ + CAMLparam2(logger, open_flags); + struct xentoollog_logger *log_handle = NULL; + struct xenforeignmemory_handle *fmem; + CAMLlocal1(result); + + if(Is_some(logger)) { + log_handle = Xtl_val(Some_val(logger)); + } + + // allocate memory to store the result, if the call to get the xfm + // handle fails the ocaml GC will collect this abstract tag + result = caml_alloc(1, Abstract_tag); + + fmem = xenforeignmemory_open(log_handle, Int_val(open_flags)); + + if(fmem == NULL) { + caml_failwith("Error when opening foreign memory handle"); + } + + Xfm_val(result) = fmem; + + CAMLreturn(result); +} + +CAMLprim value stub_xenforeignmemory_close(value fmem) +{ + CAMLparam1(fmem); + int retval; + + if(Xfm_val(fmem) == NULL) { + caml_invalid_argument( + "Error: cannot close NULL foreign memory handle"); + } + + retval = xenforeignmemory_close(Xfm_val(fmem)); + + if(retval < 0) { + caml_failwith("Error when closing foreign memory handle"); + } + + // Protect against double close + Xfm_val(fmem) = NULL; + + CAMLreturn(Val_unit); +} + +CAMLprim value stub_xenforeignmemory_map(value fmem, value dom, + value prot_flags, value pages) +{ + CAMLparam4(fmem, dom, prot_flags, pages); + CAMLlocal2(cell, result); + size_t i, pages_length; + xen_pfn_t *arr; + int prot, the_errno; + void *retval; + + if (Field(prot_flags, 0) == Val_false && + Field(prot_flags, 1) == Val_false && + Field(prot_flags, 2) == Val_false) { + prot = PROT_NONE; + } else { + prot = 0; + if(Field(prot_flags, 0) == Val_true) { + prot |= PROT_READ; + } + if(Field(prot_flags, 1) == Val_true) { + prot |= PROT_WRITE; + } + if(Field(prot_flags, 2) == Val_true) { + prot |= PROT_EXEC; + } + } + + // traverse list to know the length of the array + cell = pages; + for(pages_length = 0; cell != Val_emptylist; pages_length++) { + cell = Field(cell, 1); + } + + // allocate and populate the array + arr = malloc(sizeof(xen_pfn_t) * pages_length); + if(arr == NULL) { + caml_failwith("Error: could not allocate page array before mapping memory"); + } + + cell = pages; + for(i = 0; i < pages_length; i++) { + arr[i] = Int64_val(Field(cell, 0)); + cell = Field(cell, 1); + } + + retval = xenforeignmemory_map + (Xfm_val(fmem), _D(dom), prot, pages_length, arr, NULL); + the_errno = errno; + + free(arr); + + if(retval == NULL) { + raise_unix_errno_msg(the_errno, + "Error when trying to map foreign memory"); + } + + result = caml_ba_alloc_dims( + CAML_BA_CHAR | CAML_BA_C_LAYOUT | CAML_BA_EXTERNAL, 1, + retval, (long) 4096 * pages_length); + + CAMLreturn(result); +} + +CAMLprim value stub_xenforeignmemory_unmap(value fmem, value mapping) +{ + CAMLparam2(fmem, mapping); + size_t pages; + int retval, the_errno; + + // convert mapping to pages and addr + pages = Caml_ba_array_val(mapping)->dim[0] / 4096; + + retval = xenforeignmemory_unmap(Xfm_val(fmem), + Caml_ba_data_val(mapping), pages); + the_errno = errno; + + if(retval < 0) { + raise_unix_errno_msg(the_errno, + "Error when trying to unmap foreign memory"); + } + + CAMLreturn(Val_unit); +} + /* * Local variables: * indent-tabs-mode: t diff --git a/ocaml/xenopsd/xc/dune b/ocaml/xenopsd/xc/dune index a990ba3fa49..573a5e340e0 100644 --- a/ocaml/xenopsd/xc/dune +++ b/ocaml/xenopsd/xc/dune @@ -46,6 +46,7 @@ xapi-xenopsd.c_stubs xapi-xenopsd-xc.c_stubs xenctrl + xentoollog xenstore xenstore_transport.unix ) diff --git a/ocaml/xenopsd/xc/xenctrlext.ml b/ocaml/xenopsd/xc/xenctrlext.ml index 71f466bf6fe..a351926d15e 100644 --- a/ocaml/xenopsd/xc/xenctrlext.ml +++ b/ocaml/xenopsd/xc/xenctrlext.ml @@ -82,3 +82,41 @@ type cputopo = {core: int; socket: int; node: int} external numainfo : handle -> numainfo = "stub_xenctrlext_numainfo" external cputopoinfo : handle -> cputopo array = "stub_xenctrlext_cputopoinfo" + +module Xenforeignmemory = struct + type handle + + (** pages are mapped linearly *) + type mapping = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + + type prot = {read: bool; write: bool; exec: bool} + + external acquire : Xentoollog.handle option -> handle + = "stub_xenforeignmemory_open" + + external release : handle -> unit = "stub_xenforeignmemory_close" + + external map : handle -> domid -> prot -> Int64.t list -> mapping + = "stub_xenforeignmemory_map" + + external unmap : handle -> mapping -> unit = "stub_xenforeignmemory_unmap" + + let with_mapping handle domid prot pages ?on_unmap_failure f = + let mapping = map handle domid prot pages in + Fun.protect + ~finally:(fun () -> + try unmap handle mapping + with Unix_error (errno, _) -> ( + match on_unmap_failure with + | None -> + () + | Some log -> + log + (Printf.sprintf "Error while unmapping memory: %s\n" + (Unix.error_message errno) + ) + ) + ) + (fun () -> f mapping) +end diff --git a/ocaml/xenopsd/xc/xenctrlext.mli b/ocaml/xenopsd/xc/xenctrlext.mli index 4ac96e48ed4..fe112c1002c 100644 --- a/ocaml/xenopsd/xc/xenctrlext.mli +++ b/ocaml/xenopsd/xc/xenctrlext.mli @@ -78,3 +78,30 @@ external vcpu_setaffinity_soft : handle -> domid -> int -> bool array -> unit external numainfo : handle -> numainfo = "stub_xenctrlext_numainfo" external cputopoinfo : handle -> cputopo array = "stub_xenctrlext_cputopoinfo" + +module Xenforeignmemory : sig + type handle + + type mapping = + (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t + + type prot = {read: bool; write: bool; exec: bool} + + val acquire : Xentoollog.handle option -> handle + + val release : handle -> unit + + val with_mapping : + handle + -> domid + -> prot + -> Int64.t list + -> ?on_unmap_failure:(string -> unit) + -> (mapping -> unit) + -> unit + (** [with_mapping handle domid prot pages ~on_unmap_failure f] maps the + [pages] in the domain [domid] to the current domain with the flags + [prot] and allows to use this memory as a bigarray inside the scope of + [f]. [on_memory_failure] may be defined to capture an unmap failure + after [f] goes out of scope. This is useful for logging, for example. *) +end diff --git a/xapi-xenopsd-xc.opam b/xapi-xenopsd-xc.opam index 628503e0cfb..c8363302d4e 100644 --- a/xapi-xenopsd-xc.opam +++ b/xapi-xenopsd-xc.opam @@ -46,6 +46,7 @@ depends: [ "xenctrl" "xenstore" "xenstore_transport" + "xentoollog" ] synopsis: "A xenops plugin which knows how to use xenstore, xenctrl and xenguest to manage" From 3d1a2e70016a0d4d9c8ee138e63d0c85bac6ce6e Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 24 Jan 2022 15:35:57 +0000 Subject: [PATCH 02/53] Add a test executable that works against the bindings This binary is not installed when building the package Signed-off-by: Pau Ruiz Safont --- ocaml/xenforeign/dune | 4 ++++ ocaml/xenforeign/main.ml | 27 +++++++++++++++++++++++++++ quality-gate.sh | 2 +- 3 files changed, 32 insertions(+), 1 deletion(-) create mode 100644 ocaml/xenforeign/dune create mode 100644 ocaml/xenforeign/main.ml diff --git a/ocaml/xenforeign/dune b/ocaml/xenforeign/dune new file mode 100644 index 00000000000..770a3264e21 --- /dev/null +++ b/ocaml/xenforeign/dune @@ -0,0 +1,4 @@ +(executable + (name main) + (libraries xenopsd_xc hex) + ) diff --git a/ocaml/xenforeign/main.ml b/ocaml/xenforeign/main.ml new file mode 100644 index 00000000000..023cfa237dd --- /dev/null +++ b/ocaml/xenforeign/main.ml @@ -0,0 +1,27 @@ +module Xfm = Xenctrlext.Xenforeignmemory + +let usage_msg = "foreign-mapper " + +let domid = ref None + +let anon_fun param = + match !domid with None -> domid := Some (int_of_string param) | _ -> () + +let defer f = Fun.protect ~finally:f + +let () = + Arg.parse [] anon_fun usage_msg ; + let the_domid = Option.get !domid in + + let handle = Xfm.acquire None in + defer (fun () -> Xfm.release handle) @@ fun () -> + let prot = {Xfm.read= true; write= true; exec= false} in + let tpm_addr = 0x110000L in + Xfm.with_mapping handle the_domid prot [tpm_addr] + ~on_unmap_failure:(Fun.const ()) + @@ fun mapping -> + let readable_region = Bigarray.Array1.(create Char C_layout 1024) in + for i = 0 to 1023 do + readable_region.{i} <- mapping.{i} + done ; + Hex.(hexdump (of_bigstring readable_region)) diff --git a/quality-gate.sh b/quality-gate.sh index f05ea40b8d6..b66e7864001 100755 --- a/quality-gate.sh +++ b/quality-gate.sh @@ -25,7 +25,7 @@ verify-cert () { } mli-files () { - N=517 + N=518 # do not count ml files from the tests in ocaml/{tests/perftest/quicktest} MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) MLS=$(git ls-files -- '**/*.ml' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) From 4a77beffd7e3547cccbfa7e3cf26697d522941e5 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 7 Mar 2022 10:21:27 +0000 Subject: [PATCH 03/53] CP-38626: move vtpm module to its own file Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel.ml | 19 +------------------ ocaml/idl/datamodel_vtpm.ml | 32 ++++++++++++++++++++++++++++++++ ocaml/idl/dune | 3 ++- quality-gate.sh | 2 +- 4 files changed, 36 insertions(+), 20 deletions(-) create mode 100644 ocaml/idl/datamodel_vtpm.ml diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index cf6264c9ee8..6f8c8ca01b9 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -5012,23 +5012,6 @@ module Role = struct () end -module VTPM = struct - let t = - create_obj ~in_db:true ~in_product_since:rel_rio ~in_oss_since:oss_since_303 - ~internal_deprecated_since:None ~persist:PersistEverything - ~gen_constructor_destructor:true ~name:_vtpm ~descr:"A virtual TPM device" - ~gen_events:false ~doccomments:[] - ~messages_default_allowed_roles:_R_VM_ADMIN ~messages:[] - ~contents: - [ - uid _vtpm - ; field ~qualifier:StaticRO ~ty:(Ref _vm) "VM" "the virtual machine" - ; field ~qualifier:StaticRO ~ty:(Ref _vm) "backend" - "the domain where the backend is located" - ] - () -end - module Console = struct (** Console protocols *) let protocol = @@ -7783,7 +7766,7 @@ let all_system = ; PBD.t ; Crashdump.t ; (* misc *) - VTPM.t + Datamodel_vtpm.t ; Console.t ; (* filesystem; *) User.t diff --git a/ocaml/idl/datamodel_vtpm.ml b/ocaml/idl/datamodel_vtpm.ml new file mode 100644 index 00000000000..6eb8680513f --- /dev/null +++ b/ocaml/idl/datamodel_vtpm.ml @@ -0,0 +1,32 @@ +(* + Copyright (C) Citrix Systems Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published + by the Free Software Foundation; version 2.1 only. with the special + exception on linking described in file LICENSE. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + *) + +open Datamodel_types +open Datamodel_common +open Datamodel_roles + +let t = + create_obj ~in_db:true ~in_oss_since:oss_since_303 ~persist:PersistEverything + ~lifecycle:[(Published, rel_rio, "Added VTPM stub")] + ~gen_constructor_destructor:true ~name:_vtpm ~descr:"A virtual TPM device" + ~gen_events:false ~doccomments:[] + ~messages_default_allowed_roles:_R_VM_ADMIN ~messages:[] + ~contents: + [ + uid _vtpm + ; field ~qualifier:StaticRO ~ty:(Ref _vm) "VM" "the virtual machine" + ; field ~qualifier:StaticRO ~ty:(Ref _vm) "backend" + "the domain where the backend is located" + ] + () diff --git a/ocaml/idl/dune b/ocaml/idl/dune index e42139e1a0b..aedb6688538 100644 --- a/ocaml/idl/dune +++ b/ocaml/idl/dune @@ -5,7 +5,8 @@ datamodel_errors datamodel_roles datamodel_vm datamodel_host datamodel_pool datamodel_cluster datamodel_cluster_host dm_api escaping datamodel_values datamodel_schema datamodel_certificate - datamodel_diagnostics datamodel_repository datamodel_lifecycle) + datamodel_diagnostics datamodel_repository datamodel_lifecycle + datamodel_vtpm) (flags (:standard -warn-error +a-3-4-6-9-27-28-29)) (libraries ppx_sexp_conv.runtime-lib diff --git a/quality-gate.sh b/quality-gate.sh index b66e7864001..1064409547e 100755 --- a/quality-gate.sh +++ b/quality-gate.sh @@ -25,7 +25,7 @@ verify-cert () { } mli-files () { - N=518 + N=519 # do not count ml files from the tests in ocaml/{tests/perftest/quicktest} MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) MLS=$(git ls-files -- '**/*.ml' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) From c350afcc8930afce079d62a468f0cb16c3ebcbb6 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 8 Mar 2022 12:01:53 +0000 Subject: [PATCH 04/53] CP-38626: Allow manipulation of VTPM contents This is restricted to local access only, through the UNIX socket. This allows the software TPM daemon to retrieve and push the contents of the TPM from and to the xapi database. Any remote accesses to the contents are forbidden, Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_common.ml | 2 +- ocaml/idl/datamodel_vm.ml | 5 +++ ocaml/idl/datamodel_vtpm.ml | 40 +++++++++++++++++++++--- ocaml/idl/schematest.ml | 2 +- ocaml/tests/common/test_common.ml | 4 +-- ocaml/xapi-cli-server/cli_operations.ml | 2 +- ocaml/xapi/api_server.ml | 8 ++--- ocaml/xapi/create_misc.ml | 2 +- ocaml/xapi/xapi_vm.ml | 4 +-- ocaml/xapi/xapi_vm.mli | 1 + ocaml/xapi/xapi_vm_clone.ml | 3 +- ocaml/xapi/xapi_vtpm.ml | 41 +++++++++++++++++++++++++ ocaml/xapi/xapi_vtpm.mli | 22 +++++++++++++ 13 files changed, 116 insertions(+), 20 deletions(-) create mode 100644 ocaml/xapi/xapi_vtpm.ml create mode 100644 ocaml/xapi/xapi_vtpm.mli diff --git a/ocaml/idl/datamodel_common.ml b/ocaml/idl/datamodel_common.ml index a60de53ae7a..a4059a367a1 100644 --- a/ocaml/idl/datamodel_common.ml +++ b/ocaml/idl/datamodel_common.ml @@ -9,7 +9,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 = 711 +let schema_minor_vsn = 712 (* Historical schema versions just in case this is useful later *) let rio_schema_major_vsn = 5 diff --git a/ocaml/idl/datamodel_vm.ml b/ocaml/idl/datamodel_vm.ml index 4311cd07b03..eeae6ecbd08 100644 --- a/ocaml/idl/datamodel_vm.ml +++ b/ocaml/idl/datamodel_vm.ml @@ -2113,6 +2113,11 @@ let t = ~ty:(Set update_guidances) "pending_guidances" ~default_value:(Some (VSet [])) "The set of pending guidances after applying updates" + ; field ~qualifier:StaticRO ~in_product_since:rel_next + ~ty:(Map (String, String)) + ~default_value:(Some (VMap [])) "default_vtpm_profile" + "The security properties that will be used by default when \ + creating a TPMs attached to the VM / template" ] ) () diff --git a/ocaml/idl/datamodel_vtpm.ml b/ocaml/idl/datamodel_vtpm.ml index 6eb8680513f..d7f4fb13013 100644 --- a/ocaml/idl/datamodel_vtpm.ml +++ b/ocaml/idl/datamodel_vtpm.ml @@ -16,17 +16,47 @@ open Datamodel_types open Datamodel_common open Datamodel_roles +let get_contents = + call ~name:"get_contents" ~in_product_since:"rel_next" + ~doc:"Obtain the contents of the TPM" ~secret:true + ~params:[(Ref _vtpm, "self", "The VTPM reference")] + ~result:(String, "The contents") ~hide_from_docs:true + ~allowed_roles:_R_LOCAL_ROOT_ONLY () + +let set_contents = + call ~name:"set_contents" ~in_product_since:"rel_next" + ~doc:"Introduce new contents for the TPM" ~secret:true + ~params: + [ + (Ref _vtpm, "self", "The VTPM reference") + ; (String, "contents", "The new contents") + ] + ~hide_from_docs:true ~allowed_roles:_R_LOCAL_ROOT_ONLY () + let t = create_obj ~in_db:true ~in_oss_since:oss_since_303 ~persist:PersistEverything - ~lifecycle:[(Published, rel_rio, "Added VTPM stub")] + ~lifecycle: + [ + (Published, rel_rio, "Added VTPM stub") + ; (Extended, rel_next, "Added ability to manipulate contents") + ; (Extended, rel_next, "Added VTPM profiles") + ; (Changed, rel_next, "Removed backend field") + ] ~gen_constructor_destructor:true ~name:_vtpm ~descr:"A virtual TPM device" ~gen_events:false ~doccomments:[] - ~messages_default_allowed_roles:_R_VM_ADMIN ~messages:[] + ~messages_default_allowed_roles:_R_POOL_ADMIN ~contents: [ uid _vtpm - ; field ~qualifier:StaticRO ~ty:(Ref _vm) "VM" "the virtual machine" - ; field ~qualifier:StaticRO ~ty:(Ref _vm) "backend" - "the domain where the backend is located" + ; field ~qualifier:StaticRO ~ty:(Ref _vm) "VM" + "The virtual machine the TPM is attached to" + ; field ~qualifier:DynamicRO + ~ty:(Map (String, String)) + ~lifecycle:[(Published, rel_next, "Added VTPM profiles")] + "profile" "The security properties that define how the TPM is handled" + ; field ~qualifier:DynamicRO ~ty:(Ref _secret) ~internal_only:true + ~lifecycle:[(Published, rel_next, "Added VTPM contents")] + "contents" "The contents of the TPM" ] + ~messages:[get_contents; set_contents] () diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index eda4e72942c..1d236cf15c6 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -1,7 +1,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly *) -let last_known_schema_hash = "8ae84546b95daaeef2bd0639c734e9e8" +let last_known_schema_hash = "86da35f0d2370c16c866b116f241a6f0" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/tests/common/test_common.ml b/ocaml/tests/common/test_common.ml index ccd201ed005..2f2e46825a4 100644 --- a/ocaml/tests/common/test_common.ml +++ b/ocaml/tests/common/test_common.ml @@ -144,7 +144,7 @@ let make_vm ~__context ?(name_label = "name_label") ?(hardware_platform_version = 0L) ?(has_vendor_device = false) ?(has_vendor_device = false) ?(reference_label = "") ?(domain_type = `hvm) ?(nVRAM = []) ?(last_booted_record = "") ?(last_boot_CPU_flags = []) - ?(power_state = `Halted) () = + ?(power_state = `Halted) ?(default_vtpm_profile = []) () = Xapi_vm.create ~__context ~name_label ~name_description ~user_version ~is_a_template ~affinity ~memory_target ~memory_static_max ~memory_dynamic_max ~memory_dynamic_min ~memory_static_min ~vCPUs_params @@ -157,7 +157,7 @@ let make_vm ~__context ?(name_label = "name_label") ~start_delay ~shutdown_delay ~order ~suspend_SR ~suspend_VDI ~snapshot_schedule ~is_vmss_snapshot ~version ~generation_id ~hardware_platform_version ~has_vendor_device ~reference_label ~domain_type - ~last_booted_record ~last_boot_CPU_flags ~power_state + ~last_booted_record ~last_boot_CPU_flags ~default_vtpm_profile ~power_state let make_host ~__context ?(uuid = make_uuid ()) ?(name_label = "host") ?(name_description = "description") ?(hostname = "localhost") diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index 80532190aad..46c4303d4db 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -2660,7 +2660,7 @@ let vm_create printer rpc session_id params = ~suspend_VDI:Ref.null ~version:0L ~generation_id:"" ~hardware_platform_version:0L ~has_vendor_device:false ~reference_label:"" ~domain_type:`unspecified ~nVRAM:[] ~last_booted_record:"" - ~last_boot_CPU_flags:[] ~power_state:`Halted + ~last_boot_CPU_flags:[] ~default_vtpm_profile:[] ~power_state:`Halted in let uuid = Client.VM.get_uuid rpc session_id vm in printer (Cli_printer.PList [uuid]) diff --git a/ocaml/xapi/api_server.ml b/ocaml/xapi/api_server.ml index 1350d90cb03..de73dc01ef9 100644 --- a/ocaml/xapi/api_server.ml +++ b/ocaml/xapi/api_server.ml @@ -80,15 +80,11 @@ module Actions = struct module Data_source = struct end + module VTPM = Xapi_vtpm + let not_implemented x = raise (Api_errors.Server_error (Api_errors.not_implemented, [x])) - module VTPM = struct - let create ~__context ~vM ~backend = not_implemented "VTPM.create" - - let destroy ~__context ~self = not_implemented "VTPM.destroy" - end - module Console = struct let create ~__context ~other_config = not_implemented "Console.create" diff --git a/ocaml/xapi/create_misc.ml b/ocaml/xapi/create_misc.ml index 577336e1d3e..c6eca706ed3 100644 --- a/ocaml/xapi/create_misc.ml +++ b/ocaml/xapi/create_misc.ml @@ -329,7 +329,7 @@ and create_domain_zero_record ~__context ~domain_zero_ref (host_info : host_info ~version:0L ~generation_id:"" ~hardware_platform_version:0L ~has_vendor_device:false ~requires_reboot:false ~reference_label:"" ~domain_type:Xapi_globs.domain_zero_domain_type ~nVRAM:[] - ~pending_guidances:[] ; + ~pending_guidances:[] ~default_vtpm_profile:[] ; ensure_domain_zero_metrics_record ~__context ~domain_zero_ref host_info ; Db.Host.set_control_domain ~__context ~self:localhost ~value:domain_zero_ref ; Xapi_vm_helpers.update_memory_overhead ~__context ~vm:domain_zero_ref diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 011d4e75008..3005f5efea5 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -632,7 +632,7 @@ let create ~__context ~name_label ~name_description ~power_state ~user_version ~is_snapshot_from_vmpp ~snapshot_schedule ~is_vmss_snapshot ~appliance ~start_delay ~shutdown_delay ~order ~suspend_SR ~version ~generation_id ~hardware_platform_version ~has_vendor_device ~reference_label ~domain_type - ~nVRAM : API.ref_VM = + ~nVRAM ~default_vtpm_profile : API.ref_VM = if has_vendor_device then Pool_features.assert_enabled ~__context ~f:Features.PCI_device_for_auto_update ; @@ -713,7 +713,7 @@ let create ~__context ~name_label ~name_description ~power_state ~user_version ~snapshot_schedule:Ref.null ~is_vmss_snapshot:false ~appliance ~start_delay ~shutdown_delay ~order ~suspend_SR ~version ~generation_id ~hardware_platform_version ~has_vendor_device ~requires_reboot:false - ~reference_label ~domain_type ~pending_guidances:[] ; + ~reference_label ~domain_type ~pending_guidances:[] ~default_vtpm_profile ; Xapi_vm_lifecycle.update_allowed_operations ~__context ~self:vm_ref ; update_memory_overhead ~__context ~vm:vm_ref ; update_vm_virtual_hardware_platform_version ~__context ~vm:vm_ref ; diff --git a/ocaml/xapi/xapi_vm.mli b/ocaml/xapi/xapi_vm.mli index aae51f764df..be1c0b52d09 100644 --- a/ocaml/xapi/xapi_vm.mli +++ b/ocaml/xapi/xapi_vm.mli @@ -203,6 +203,7 @@ val create : -> reference_label:string -> domain_type:API.domain_type -> nVRAM:(string * string) list + -> default_vtpm_profile:(string * string) list -> API.ref_VM val destroy : __context:Context.t -> self:[`VM] Ref.t -> unit diff --git a/ocaml/xapi/xapi_vm_clone.ml b/ocaml/xapi/xapi_vm_clone.ml index d45f9e19494..44ce5d1f060 100644 --- a/ocaml/xapi/xapi_vm_clone.ml +++ b/ocaml/xapi/xapi_vm_clone.ml @@ -392,7 +392,8 @@ let copy_vm_record ?snapshot_info_record ~__context ~vm ~disk_op ~new_name ~has_vendor_device:all.Db_actions.vM_has_vendor_device ~requires_reboot:false ~reference_label:all.Db_actions.vM_reference_label ~domain_type:all.Db_actions.vM_domain_type ~nVRAM:all.Db_actions.vM_NVRAM - ~pending_guidances:[] ; + ~pending_guidances:[] + ~default_vtpm_profile:all.Db_actions.vM_default_vtpm_profile ; (* update the VM's parent field in case of snapshot. Note this must be done after "ref" has been created, so that its "children" field can be updated by the database layer *) ( match disk_op with diff --git a/ocaml/xapi/xapi_vtpm.ml b/ocaml/xapi/xapi_vtpm.ml new file mode 100644 index 00000000000..b9030bc6daa --- /dev/null +++ b/ocaml/xapi/xapi_vtpm.ml @@ -0,0 +1,41 @@ +(* + Copyright (C) Citrix Systems Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published + by the Free Software Foundation; version 2.1 only. with the special + exception on linking described in file LICENSE. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + *) + +let introduce ~__context ~uuid ~vM ~profile ~contents = + let ref = Ref.make () in + Db.VTPM.create ~__context ~ref ~uuid ~vM ~profile ~contents ; + ref + +let create ~__context ~vM = + let uuid = Uuid.(to_string (make_uuid ())) in + let profile = Db.VM.get_default_vtpm_profile ~__context ~self:vM in + let contents = Xapi_secret.create ~__context ~value:"" ~other_config:[] in + let ref = introduce ~__context ~uuid ~vM ~profile ~contents in + ref + +let destroy ~__context ~self = + let secret = Db.VTPM.get_contents ~__context ~self in + Db.Secret.destroy ~__context ~self:secret ; + Db.VTPM.destroy ~__context ~self + +let get_contents ~__context ~self = + let secret = Db.VTPM.get_contents ~__context ~self in + Base64.decode_exn (Db.Secret.get_value ~__context ~self:secret) + +let set_contents ~__context ~self ~contents = + let previous_secret = Db.VTPM.get_contents ~__context ~self in + let encoded = Base64.encode_exn contents in + let secret = Xapi_secret.create ~__context ~value:encoded ~other_config:[] in + Db.VTPM.set_contents ~__context ~self ~value:secret ; + Db.Secret.destroy ~__context ~self:previous_secret diff --git a/ocaml/xapi/xapi_vtpm.mli b/ocaml/xapi/xapi_vtpm.mli new file mode 100644 index 00000000000..31c6c3c5a9d --- /dev/null +++ b/ocaml/xapi/xapi_vtpm.mli @@ -0,0 +1,22 @@ +(* + Copyright (C) Citrix Systems Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published + by the Free Software Foundation; version 2.1 only. with the special + exception on linking described in file LICENSE. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + *) + +val create : __context:Context.t -> vM:[`VM] API.Ref.t -> [`VTPM] Ref.t + +val destroy : __context:Context.t -> self:[`VTPM] Ref.t -> unit + +val get_contents : __context:Context.t -> self:[`VTPM] Ref.t -> string + +val set_contents : + __context:Context.t -> self:[`VTPM] Ref.t -> contents:string -> unit From 525259f6cf06512362fd06dbb36e2f08ad88c4a7 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 9 Mar 2022 09:57:33 +0000 Subject: [PATCH 05/53] CP-38626: expose vtpm objects through xe cli Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel.ml | 1 + ocaml/xapi-cli-server/cli_operations.ml | 4 +++ ocaml/xapi-cli-server/records.ml | 42 +++++++++++++++++++++++++ 3 files changed, 47 insertions(+) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index 6f8c8ca01b9..b669dbe2653 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -8025,6 +8025,7 @@ let expose_get_all_messages_for = ; _cluster_host ; _certificate ; _repository + ; _vtpm ] let no_task_id_for = [_task; (* _alert; *) _event] diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index 46c4303d4db..d4f34a72134 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -1297,6 +1297,10 @@ let gen_cmds rpc session_id = ] rpc session_id ) + ; Client.VTPM.( + mk () get_all_records_where get_by_uuid vtpm_record "vtpm" [] + ["uuid"; "vm"; "profile"] rpc session_id + ) ] let message_create printer rpc session_id params = diff --git a/ocaml/xapi-cli-server/records.ml b/ocaml/xapi-cli-server/records.ml index b68920127bd..83a82500273 100644 --- a/ocaml/xapi-cli-server/records.ml +++ b/ocaml/xapi-cli-server/records.ml @@ -2431,6 +2431,14 @@ let vm_record rpc session_id vm = (x ()).API.vM_pending_guidances ) () + ; make_field ~name:"vtpm" + ~get:(fun () -> get_uuids_from_refs (x ()).API.vM_VTPMs) + () + ; make_field ~name:"default_vtpm_profile" + ~get:(fun () -> + Record_util.s2sm_to_string "; " (x ()).API.vM_default_vtpm_profile + ) + () ] } @@ -4976,3 +4984,37 @@ let repository_record rpc session_id repository = () ] } + +let vtpm_record rpc session_id vtpm = + let _ref = ref vtpm in + let empty_record = + ToGet (fun () -> Client.VTPM.get_record rpc session_id !_ref) + in + let record = ref empty_record in + let x () = lzy_get record in + { + setref= + (fun r -> + _ref := r ; + record := empty_record + ) + ; setrefrec= + (fun (a, b) -> + _ref := a ; + record := Got b + ) + ; record= x + ; getref= (fun () -> !_ref) + ; fields= + [ + make_field ~name:"uuid" ~get:(fun () -> (x ()).API.vTPM_uuid) () + ; make_field ~name:"vm" + ~get:(fun () -> get_uuid_from_ref (x ()).API.vTPM_VM) + () + ; make_field ~name:"profile" + ~get:(fun () -> + Record_util.s2sm_to_string "; " (x ()).API.vTPM_profile + ) + () + ] + } From 6f448be99c5a838c0e59bbd14085d0e452ae81f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 8 Apr 2022 11:33:30 +0100 Subject: [PATCH 06/53] Maintenance: update quality gate after merge MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- quality-gate.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/quality-gate.sh b/quality-gate.sh index 0201bd0c2c9..b66e7864001 100755 --- a/quality-gate.sh +++ b/quality-gate.sh @@ -25,7 +25,7 @@ verify-cert () { } mli-files () { - N=520 + N=518 # do not count ml files from the tests in ocaml/{tests/perftest/quicktest} MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) MLS=$(git ls-files -- '**/*.ml' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) From 79576d57e8a00eda8a89ddf3d91ea606d031cd60 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 17 Mar 2022 10:35:56 +0000 Subject: [PATCH 07/53] CP-38554: functorize varstored sandbox code This will be used for creating sandboxes for swtpm While we're at it, create an interface file for sandboxes to hide implementation details, add useful methods for Path and tweak methods Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/lib/xenops_sandbox.ml | 139 ++++++++++++++++++--------- ocaml/xenopsd/lib/xenops_sandbox.mli | 66 +++++++++++++ quality-gate.sh | 2 +- 3 files changed, 161 insertions(+), 46 deletions(-) create mode 100644 ocaml/xenopsd/lib/xenops_sandbox.mli diff --git a/ocaml/xenopsd/lib/xenops_sandbox.ml b/ocaml/xenopsd/lib/xenops_sandbox.ml index 92e8d6a8f6f..f0c6ab2ecbf 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.ml +++ b/ocaml/xenopsd/lib/xenops_sandbox.ml @@ -21,32 +21,39 @@ module Chroot : sig module Path : sig type t + val root : t + val of_string : relative:string -> t + + val concat : t -> string -> t end val absolute_path_outside : t -> Path.t -> string - (** [absolute_path_outside chroot path] returns the absolute path outside the - chroot *) val chroot_path_inside : Path.t -> string - (** [chroot_path_inside path] returns the path when inside the chroot *) - val of_domid : daemon:string -> domid:int -> vm_uuid:string -> t - (** [of_domid daemon domid] describes a chroot for specified daemon and domain *) + val create_dir : within:t -> int -> Path.t -> unit - val create : daemon:string -> domid:int -> vm_uuid:string -> Path.t list -> t - (** [create daemon domid paths] Creates the specified chroot with appropriate - permissions, and ensures that all [paths] are owned by the chrooted daemon - and rw- *) + val of_domid : + base:string -> daemon:string -> domid:int -> vm_uuid:string -> t + + val create : + base:string + -> daemon:string + -> domid:int + -> vm_uuid:string + -> Path.t list + -> t val destroy : t -> unit - (** [destroy chroot] Deletes the chroot *) end = struct type t = {root: string; uid: int; gid: int} module Path = struct type t = string + let root = "/" + let of_string ~relative = if not (Filename.is_implicit relative) then invalid_arg @@ -54,30 +61,41 @@ end = struct relative __LOC__ ) ; relative + + let concat = Filename.concat end let absolute_path_outside chroot path = Filename.concat chroot.root path - let chroot_path_inside path = Filename.concat "/" path + let chroot_path_inside path = Path.(concat root path) + + let create_dir ~within perm path = + let fullpath = absolute_path_outside within path in + Xenops_utils.Unixext.with_file fullpath [Unix.O_CREAT; Unix.O_EXCL] perm + (fun fd -> Unix.fchown fd within.uid within.gid + ) let qemu_base_uid () = (Unix.getpwnam "qemu_base").Unix.pw_uid let qemu_base_gid () = (Unix.getpwnam "qemu_base").Unix.pw_gid - let of_domid ~daemon ~domid ~vm_uuid = + let of_domid ~base ~daemon ~domid ~vm_uuid = let root = - if domid = 0 then - Printf.sprintf "/var/run/xen/%s-root-%d-%s" daemon domid vm_uuid - else - Printf.sprintf "/var/run/xen/%s-root-%d" daemon domid + let dir = + if domid = 0 then + Printf.sprintf "%s-root-%d-%s" daemon domid vm_uuid + else + Printf.sprintf "%s-root-%d" daemon domid + in + Filename.concat base dir in (* per VM uid/gid as for QEMU *) let uid = qemu_base_uid () + domid in let gid = qemu_base_gid () + domid in {root; uid; gid} - let create ~daemon ~domid ~vm_uuid paths = - let chroot = of_domid ~daemon ~domid ~vm_uuid in + let create ~base ~daemon ~domid ~vm_uuid paths = + let chroot = of_domid ~base ~daemon ~domid ~vm_uuid in try Xenops_utils.Unixext.mkdir_rec chroot.root 0o755 ; (* we want parent dir to be 0o755 and this dir 0o750 *) @@ -85,13 +103,8 @@ end = struct (* the chrooted daemon will have r-x permissions *) Unix.chown chroot.root 0 chroot.gid ; D.debug "Created chroot %s" chroot.root ; - let prepare path = - let fullpath = absolute_path_outside chroot path in - Xenops_utils.Unixext.with_file fullpath [Unix.O_CREAT; Unix.O_EXCL] - 0o600 (fun fd -> Unix.fchown fd chroot.uid chroot.gid - ) - in - List.iter prepare paths ; chroot + List.iter (create_dir ~within:chroot 0o600) paths ; + chroot with e -> Backtrace.is_important e ; D.warn "Failed to create chroot at %s for UID %d: %s" chroot.root @@ -104,47 +117,70 @@ end = struct ) end -module Varstore_guard = struct - let daemon = "varstored" +module type SANDBOX = sig + val prepare : domid:int -> vm_uuid:string -> Chroot.Path.t -> string + + val start : + string + -> vm_uuid:string + -> domid:int + -> paths:Chroot.Path.t list + -> Chroot.t * string + + val read : domid:int -> Chroot.Path.t -> vm_uuid:string -> string + + val stop : string -> domid:int -> vm_uuid:string -> unit +end + +module type GUARD = sig + val daemon_name : string - let varstored_chroot ~domid ~vm_uuid = Chroot.of_domid ~daemon ~domid ~vm_uuid + val base_directory : string + + val create : string -> vm_uuid:Uuidm.t -> domid:int -> path:string -> unit + + val destroy : string -> domid:int -> path:string -> unit +end + +module Guard (G : GUARD) : SANDBOX = struct + let daemon = G.daemon_name let socket_path = Chroot.Path.of_string ~relative:"xapi-depriv-socket" - (** [start dbg ~vm_uuid ~domid ~paths] prepares a chroot for [domid], and asks - varstore-guard to create a socket restricted to [vm_uuid]. Also creates - empty files specified in [paths] owned by [domid] user.*) + let chroot ~domid ~vm_uuid = + Chroot.of_domid ~base:G.base_directory ~daemon ~domid ~vm_uuid + let start dbg ~vm_uuid ~domid ~paths = - let chroot = Chroot.create ~daemon ~domid ~vm_uuid paths in + let chroot = + Chroot.create ~base:G.base_directory ~daemon ~domid ~vm_uuid paths + in let absolute_socket_path = Chroot.absolute_path_outside chroot socket_path in - let vm_uuidm = + let vm_uuid = match Uuidm.of_string vm_uuid with | Some uuid -> uuid | None -> failwith (Printf.sprintf "Invalid VM uuid %s" vm_uuid) in - Varstore_privileged_client.Client.create dbg vm_uuidm chroot.gid - absolute_socket_path ; + G.create dbg ~vm_uuid ~domid:chroot.gid ~path:absolute_socket_path ; (chroot, Chroot.chroot_path_inside socket_path) - (** [prepare ~domid path] creates an empty [path] file owned by [domid] inside - the chroot for [domid] and returns the absolute path to it outside the - chroot *) - let prepare ~domid ~vm_uuid path = - let chroot = Chroot.create ~daemon ~domid ~vm_uuid [path] in + let create ~domid ~vm_uuid path = + let chroot = + Chroot.create ~base:G.base_directory ~daemon ~domid ~vm_uuid [path] + in Chroot.absolute_path_outside chroot path let read ~domid path ~vm_uuid = - let chroot = varstored_chroot ~domid ~vm_uuid in + let chroot = chroot ~domid ~vm_uuid in path |> Chroot.absolute_path_outside chroot |> Xenops_utils.Unixext.string_of_file let stop dbg ~domid ~vm_uuid = - let chroot = varstored_chroot ~domid ~vm_uuid in + let chroot = chroot ~domid ~vm_uuid in if Sys.file_exists chroot.root then ( D.debug "About to stop varstored for %d (%s) %s" domid vm_uuid __LOC__ ; let gid = chroot.Chroot.gid in @@ -152,11 +188,24 @@ module Varstore_guard = struct Chroot.absolute_path_outside chroot socket_path in Xenops_utils.best_effort "Stop listening on deprivileged socket" - (fun () -> - Varstore_privileged_client.Client.destroy dbg gid absolute_socket_path + (fun () -> G.destroy dbg ~domid:gid ~path:absolute_socket_path ) ; Chroot.destroy chroot ) else - D.warn "Can't stop varstored for %d (%s): %s does not exist" domid vm_uuid + D.warn "Can't stop %s for %d (%s): %s does not exist" daemon domid vm_uuid chroot.root end + +module Varstored : GUARD = struct + let daemon_name = "varstored" + + let base_directory = "/var/run/xen" + + let create dbg ~vm_uuid ~domid ~path = + Varstore_privileged_client.Client.create dbg vm_uuid domid path + + let destroy dbg ~domid ~path = + Varstore_privileged_client.Client.destroy dbg domid path +end + +module Varstore_guard = Guard (Varstored) diff --git a/ocaml/xenopsd/lib/xenops_sandbox.mli b/ocaml/xenopsd/lib/xenops_sandbox.mli new file mode 100644 index 00000000000..f5136df49f3 --- /dev/null +++ b/ocaml/xenopsd/lib/xenops_sandbox.mli @@ -0,0 +1,66 @@ +module Chroot : sig + type t = private {root: string; uid: int; gid: int} + + module Path : sig + type t + + val root : t + + val of_string : relative:string -> t + + val concat : t -> string -> t + end + + val absolute_path_outside : t -> Path.t -> string + (** [absolute_path_outside chroot path] returns the absolute path outside the + chroot *) + + val chroot_path_inside : Path.t -> string + (** [chroot_path_inside path] returns the path when inside the chroot *) + + val create_dir : within:t -> int -> Path.t -> unit + (** [create_dir ~within perm path] Creates the directory with path [path] inside + the chroot [within] with its owner and group ids and permissions [perm]*) + + val of_domid : + base:string -> daemon:string -> domid:int -> vm_uuid:string -> t + (** [of_domid ~base ~daemon ~domid ~vm_uuid] describes a chroot for specified + daemon and domain *) + + val create : + base:string + -> daemon:string + -> domid:int + -> vm_uuid:string + -> Path.t list + -> t + (** [create ~base ~daemon ~domid paths] Creates the specified chroot with + appropriate permissions on directory [base], and ensures that all [paths] + are owned by the chrooted daemon and rw- *) + + val destroy : t -> unit + (** [destroy chroot] Deletes the chroot *) +end + +module type SANDBOX = sig + val prepare : domid:int -> vm_uuid:string -> Chroot.Path.t -> string + (** [prepare ~domid ~vm_uuid path] creates an empty [path] file owned by + [domid] inside the chroot for [domid] and returns the absolute path to it + outside the chroot *) + + val start : + string + -> vm_uuid:string + -> domid:int + -> paths:Chroot.Path.t list + -> Chroot.t * string + (** [start dbg ~vm_uuid ~domid ~paths] prepares a chroot for [domid], and asks + the guard to create a socket restricted to [vm_uuid]. Also creates + empty files specified in [path] owned by [domid] user. *) + + val read : domid:int -> Chroot.Path.t -> vm_uuid:string -> string + + val stop : string -> domid:int -> vm_uuid:string -> unit +end + +module Varstore_guard : SANDBOX diff --git a/quality-gate.sh b/quality-gate.sh index b66e7864001..f05ea40b8d6 100755 --- a/quality-gate.sh +++ b/quality-gate.sh @@ -25,7 +25,7 @@ verify-cert () { } mli-files () { - N=518 + N=517 # do not count ml files from the tests in ocaml/{tests/perftest/quicktest} MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) MLS=$(git ls-files -- '**/*.ml' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) From 27833696a030da5cbce32381b78807a171e62f70 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 4 Apr 2022 14:51:43 +0100 Subject: [PATCH 08/53] CP-39441: Enable xenopsd to directly wait on pid creation Xenopsd manages several services that sustain the lifecycle of each domain. To launch a service, xenopsd usually starts up a daemon and it waits for this daemon to write its pid on xenstore to signal the service is ready to attend requests. While this method is convenient in order to be able to cancel the wait using xenstore watches, it's unfortunate as it makes the daemons depend on xenstore even if it isn't needed to supply the service. This change implements an alternative way to set up a cancellable wait on the service readiness using inotify and epoll by setting up filesystem watches instead of xenstore ones. The polling loop wakes up every second to have a direct method to deal with timeouts as well as unrelated events that happened in the filesystem. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/device.ml | 9 +- ocaml/xenopsd/xc/dune | 1 + ocaml/xenopsd/xc/service.ml | 166 +++++++++++++++++++++++++++++++++++ ocaml/xenopsd/xc/service.mli | 15 ++++ 4 files changed, 184 insertions(+), 7 deletions(-) create mode 100644 ocaml/xenopsd/xc/service.ml create mode 100644 ocaml/xenopsd/xc/service.mli diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index 62e876c8493..53f96b77532 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -28,7 +28,7 @@ exception Device_not_found exception Cdrom -module D = Debug.Make (struct let name = "xenops" end) +module D = Debug.Make (struct let name = "device" end) open D @@ -66,11 +66,7 @@ module Profile = struct let wrapper_of = function | Qemu_none | Qemu_trad -> "/bin/false" - | Qemu_upstream_compat -> - !Resources.upstream_compat_qemu_dm_wrapper - | Qemu_upstream -> - !Resources.upstream_compat_qemu_dm_wrapper - | Qemu_upstream_uefi -> + | Qemu_upstream_compat | Qemu_upstream | Qemu_upstream_uefi -> !Resources.upstream_compat_qemu_dm_wrapper let of_string = function @@ -4212,7 +4208,6 @@ module Dm = struct in let backend = nvram.Nvram_uefi_variables.backend in let open Fe_argv in - let ( >>= ) = bind in let argf fmt = ksprintf (fun s -> ["--arg"; s]) fmt in let on cond value = if cond then value else return () in let chroot, socket_path = diff --git a/ocaml/xenopsd/xc/dune b/ocaml/xenopsd/xc/dune index 77ea798f23d..6169564f2cd 100644 --- a/ocaml/xenopsd/xc/dune +++ b/ocaml/xenopsd/xc/dune @@ -13,6 +13,7 @@ fd-send-recv fmt forkexec + inotify mtime mtime.clock.os polly diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml new file mode 100644 index 00000000000..228f45996b0 --- /dev/null +++ b/ocaml/xenopsd/xc/service.ml @@ -0,0 +1,166 @@ +module D = Debug.Make (struct let name = "service" end) + +open! D +module Unixext = Xapi_stdext_unix.Unixext +module Xenops_task = Xenops_task.Xenops_task +module Chroot = Xenops_sandbox.Chroot +module Path = Chroot.Path + +let defer f g = Xapi_stdext_pervasives.Pervasiveext.finally g f + +exception Service_failed of (string * string) + +type t = { + name: string + ; domid: Xenctrl.domid + ; exec_path: string + ; chroot: Chroot.t + ; timeout_seconds: float + ; args: string list + ; execute: + path:string -> args:string list -> domid:Xenctrl.domid -> unit -> string +} + +let alive service = + let is_active = Fe_systemctl.is_active ~service in + ( if not is_active then + let status = Fe_systemctl.show ~service in + error + "%s: unexpected termination \ + (Result=%s,ExecMainPID=%d,ExecMainStatus=%d,ActiveState=%s)" + service status.result status.exec_main_pid status.exec_main_status + status.active_state + ) ; + is_active + +type watch_trigger = Created | Cancelled | Waiting + +let fold_events ~init f events = + events + |> List.to_seq + |> Seq.flat_map (fun (_, events, _, fnameopt) -> + List.to_seq events |> Seq.map (fun event -> (event, fnameopt)) + ) + |> Seq.fold_left f init + +exception ECancelled of Xenops_task.task_handle + +let raise_e = function + | ECancelled t -> + Xenops_task.raise_cancelled t + | e -> + raise e + +let with_inotify f = + let fd = Inotify.create () in + defer (fun () -> Unix.close fd) (fun () -> f fd) + +let with_watch notifd dir f = + let open Inotify in + let flags = [S_Create; S_Delete; S_Delete_self; S_Onlydir] in + let watch = Inotify.add_watch notifd dir flags in + defer (fun () -> Inotify.rm_watch notifd watch) (fun () -> f watch) + +let with_monitor watch_fd f = + let fd = Polly.create () in + Polly.add fd watch_fd Polly.Events.inp ; + defer (fun () -> Polly.del fd watch_fd ; Polly.close fd) (fun () -> f fd) + +let start_and_wait_for_readyness ~task ~service = + let sandbox_path p = + Chroot.absolute_path_outside service.chroot (Path.of_string ~relative:p) + in + + let pid_name = Printf.sprintf "%s-%d.pid" service.name service.domid in + let cancel_name = + Printf.sprintf "%s-%s.cancel" service.name (Xenops_task.get_dbg task) + in + + let cancel_path = sandbox_path cancel_name in + + let cancel () = + (* create an empty file to trigger the watch and delete it + immediately *) + Unixext.touch_file cancel_path ; + Unixext.unlink_safe cancel_path + in + (* create watches for pidfile and task cancellation *) + with_inotify @@ fun notifd -> + with_watch notifd service.chroot.root @@ fun _ -> + with_monitor notifd @@ fun pollfd -> + let wait ~for_s ~service_name = + let start_time = Mtime_clock.elapsed () in + let poll_period_ms = 1000 in + let collect_watches acc (event, file) = + match (acc, event, file) with + (* treat deleted directory or pidfile as cancelling *) + | Cancelled, _, _ | _, (Inotify.Ignored | Inotify.Delete_self), _ -> + Cancelled + | _, Inotify.Delete, Some name when name = pid_name -> + Cancelled + | _, Inotify.Create, Some name when name = cancel_name -> + Cancelled + | _, Inotify.Create, Some name when name = pid_name -> + Created + | _, _, _ -> + acc + in + + let cancellable_watch () = + let event = ref Waiting in + let rec poll_loop () = + try + ignore + @@ Polly.wait pollfd 1 poll_period_ms (fun _ fd events -> + if Polly.Events.(test events inp) then + event := + fold_events ~init:!event collect_watches (Inotify.read fd) + ) ; + + let current_time = Mtime_clock.elapsed () in + let elapsed_time = + Mtime.Span.(to_s (abs_diff start_time current_time)) + in + + match !event with + | Waiting when elapsed_time < for_s -> + poll_loop () + | Created -> + Ok () + | Cancelled -> + Error (ECancelled task) + | Waiting -> + let err_msg = + if alive service_name then + "Timeout reached while starting service" + else + "Service exited unexpectedly" + in + Error (Service_failed (service_name, err_msg)) + with e -> + let err_msg = + Printf.sprintf + "Exception while waiting for service %s to be ready: %s" + service_name (Printexc.to_string e) + in + Error (Service_failed (service_name, err_msg)) + in + + Xenops_task.with_cancel task cancel poll_loop + in + cancellable_watch () + in + + (* start systemd service *) + let syslog_key = + service.execute ~path:service.exec_path ~args:service.args + ~domid:service.domid () + in + + Xenops_task.check_cancelling task ; + + (* wait for pidfile to appear *) + Result.iter_error raise_e + (wait ~for_s:service.timeout_seconds ~service_name:syslog_key) ; + + debug "Service %s initialized" syslog_key diff --git a/ocaml/xenopsd/xc/service.mli b/ocaml/xenopsd/xc/service.mli new file mode 100644 index 00000000000..0f23cbb24da --- /dev/null +++ b/ocaml/xenopsd/xc/service.mli @@ -0,0 +1,15 @@ +exception Service_failed of (string * string) + +type t = { + name: string + ; domid: Xenctrl.domid + ; exec_path: string + ; chroot: Xenops_sandbox.Chroot.t + ; timeout_seconds: float + ; args: string list + ; execute: + path:string -> args:string list -> domid:Xenctrl.domid -> unit -> string +} + +val start_and_wait_for_readyness : + task:Xenops_task.Xenops_task.task_handle -> service:t -> unit From 9b52389776330ac324472d7560dde8e879012aed Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 4 Apr 2022 15:19:07 +0100 Subject: [PATCH 09/53] CP-38554: Start up and stop SWTPM and guard for every domain For every domain now xenopsd creates a chroot (which starts up a guard daemon instance), launches an SWTPM instance, then waits on its pidfile to be created. On domain destruction is shuts down both instances: first SWTPM, then the guard. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/lib/xenops_sandbox.ml | 15 +++++++ ocaml/xenopsd/lib/xenops_sandbox.mli | 2 + ocaml/xenopsd/lib/xenopsd.ml | 2 + ocaml/xenopsd/xc/device.ml | 61 ++++++++++++++++++++++++++-- 4 files changed, 76 insertions(+), 4 deletions(-) diff --git a/ocaml/xenopsd/lib/xenops_sandbox.ml b/ocaml/xenopsd/lib/xenops_sandbox.ml index f0c6ab2ecbf..1cfa03f9235 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.ml +++ b/ocaml/xenopsd/lib/xenops_sandbox.ml @@ -208,4 +208,19 @@ module Varstored : GUARD = struct Varstore_privileged_client.Client.destroy dbg domid path end +module Swtpm : GUARD = struct + let daemon_name = "swtpm" + + (* swtpm cannot run on /var/run because it's mounted using nodev and access + is needed to /dev/urandom *) + let base_directory = "/var/lib/xcp/run" + + let create dbg ~vm_uuid ~domid ~path = + Varstore_privileged_client.Client.create dbg vm_uuid domid path + + let destroy dbg ~domid ~path = + Varstore_privileged_client.Client.destroy dbg domid path +end + module Varstore_guard = Guard (Varstored) +module Swtpm_guard = Guard (Swtpm) diff --git a/ocaml/xenopsd/lib/xenops_sandbox.mli b/ocaml/xenopsd/lib/xenops_sandbox.mli index f5136df49f3..a6eccb523e5 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.mli +++ b/ocaml/xenopsd/lib/xenops_sandbox.mli @@ -64,3 +64,5 @@ module type SANDBOX = sig end module Varstore_guard : SANDBOX + +module Swtpm_guard : SANDBOX diff --git a/ocaml/xenopsd/lib/xenopsd.ml b/ocaml/xenopsd/lib/xenopsd.ml index 82673d4ef19..704d5b03b05 100644 --- a/ocaml/xenopsd/lib/xenopsd.ml +++ b/ocaml/xenopsd/lib/xenopsd.ml @@ -41,6 +41,8 @@ let vgpu_ready_timeout = ref 30. let varstored_ready_timeout = ref 30. +let swtpm_ready_timeout = ref 30. + let use_upstream_qemu = ref false let pci_quarantine = ref true diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index 53f96b77532..3613ae7bada 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -1271,6 +1271,14 @@ module Varstored = SystemdDaemonMgmt (struct let pid_path domid = sprintf "/local/domain/%d/varstored-pid" domid end) +module Swtpm = SystemdDaemonMgmt (struct + let name = "swtpm-wrapper" + + let use_pidfile = false + + let pid_path domid = sprintf "/local/domain/%d/varstored-pid" domid +end) + module PV_Vnc = struct module D = DaemonMgmt (struct let name = "vncterm" @@ -2800,6 +2808,8 @@ module Dm_Common = struct (* Called by every domain destroy, even non-HVM *) let stop ~xs ~qemu_domid domid = let qemu_pid_path = Qemu.pid_path domid in + let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuidm.to_string in + let dbg = Printf.sprintf "stop domid %d" domid in let stop_qemu () = match Qemu.pid ~xs domid with | None -> @@ -2831,15 +2841,17 @@ module Dm_Common = struct ) ) in + let stop_swptm () = + Swtpm.stop ~xs domid ; + Xenops_sandbox.Swtpm_guard.stop dbg ~domid ~vm_uuid + in let stop_vgpu () = Vgpu.stop ~xs domid in let stop_varstored () = - let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuidm.to_string in debug "About to stop varstored for domain %d (%s)" domid vm_uuid ; Varstored.stop ~xs domid ; - let dbg = Printf.sprintf "stop domid %d" domid in Xenops_sandbox.Varstore_guard.stop dbg ~domid ~vm_uuid in - stop_vgpu () ; stop_varstored () ; stop_qemu () + stop_vgpu () ; stop_varstored () ; stop_swptm () ; stop_qemu () type disk_type_args = int * string * Media.t -> string list @@ -4196,6 +4208,32 @@ module Dm = struct (* the following functions depend on the functions above that use the qemu backend Q *) + let start_swtpm ~xs task domid = + debug "Preparing to start swtpm-wrapper to provide a vTPM (domid=%d)" domid ; + let exec_path = "/usr/lib64/xen/bin/swtpm-wrapper" in + let name = "swtpm" in + let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuidm.to_string in + + let chroot, _socket_path = + Xenops_sandbox.Swtpm_guard.start (Xenops_task.get_dbg task) ~vm_uuid + ~domid ~paths:[] + in + 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 + 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 service = + {Service.name; domid; exec_path; chroot; args; execute; timeout_seconds} + in + Service.start_and_wait_for_readyness ~task ~service ; + (* return the socket path so qemu can have a reference to it*) + Xenops_sandbox.Chroot.( + absolute_path_outside chroot (Path.of_string ~relative:"swtpm-sock") + ) + let start_varstored ~xs ~nvram ?(restore = false) (task : Xenops_task.task_handle) domid = let open Xenops_types in @@ -4349,9 +4387,24 @@ module Dm = struct | Bios -> () ) ; + + (* start swtpm-wrapper *) + let tpm_socket_path = start_swtpm ~xs task domid in + + let tpmargs = + [ + "-chardev" + ; Printf.sprintf "socket,id=chrtpm,path=%s" tpm_socket_path + ; "-tpmdev" + ; "emulator,id=tpm0,chardev=chrtpm" + ; "-device" + ; "tpm-crb,tpmdev=tpm0" + ] + in + (* Execute qemu-dm-wrapper, forwarding stdout to the syslog, with the key "qemu-dm-" *) - let argv = prepend_wrapper_args domid args.argv in + let argv = prepend_wrapper_args domid (List.concat [tpmargs; args.argv]) in let qemu_domid = 0 in let ready_path = Printf.sprintf "/local/domain/%d/device-model/%d/state" qemu_domid domid From 27f2799d1149d05c2d394334c2fd373edc9a5497 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 6 Apr 2022 10:31:05 +0100 Subject: [PATCH 10/53] xenops_sandbox: use create instead of prepare This fits the documentation of chroots better Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/lib/xenops_sandbox.ml | 2 +- ocaml/xenopsd/lib/xenops_sandbox.mli | 4 ++-- ocaml/xenopsd/xc/device.ml | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/ocaml/xenopsd/lib/xenops_sandbox.ml b/ocaml/xenopsd/lib/xenops_sandbox.ml index 1cfa03f9235..2032a7bebc8 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.ml +++ b/ocaml/xenopsd/lib/xenops_sandbox.ml @@ -118,7 +118,7 @@ end = struct end module type SANDBOX = sig - val prepare : domid:int -> vm_uuid:string -> Chroot.Path.t -> string + val create : domid:int -> vm_uuid:string -> Chroot.Path.t -> string val start : string diff --git a/ocaml/xenopsd/lib/xenops_sandbox.mli b/ocaml/xenopsd/lib/xenops_sandbox.mli index a6eccb523e5..c6c071c85f3 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.mli +++ b/ocaml/xenopsd/lib/xenops_sandbox.mli @@ -43,8 +43,8 @@ module Chroot : sig end module type SANDBOX = sig - val prepare : domid:int -> vm_uuid:string -> Chroot.Path.t -> string - (** [prepare ~domid ~vm_uuid path] creates an empty [path] file owned by + val create : domid:int -> vm_uuid:string -> Chroot.Path.t -> string + (** [create ~domid ~vm_uuid path] creates an empty [path] file owned by [domid] inside the chroot for [domid] and returns the absolute path to it outside the chroot *) diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index 3613ae7bada..7668989d123 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -4510,7 +4510,7 @@ module Dm = struct let restore_varstored (task : Xenops_task.task_handle) ~xs ~efivars domid = debug "Called Dm.restore_varstored (domid=%d)" domid ; let path = - Xenops_sandbox.Varstore_guard.prepare ~domid + Xenops_sandbox.Varstore_guard.create ~domid ~vm_uuid:(Uuidm.to_string (Xenops_helpers.uuid_of_domid ~xs domid)) efivars_resume_path in From 1ed27f88f44eee67c705bd5487c16f6c57b7eeca Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 22 Apr 2022 17:19:01 +0100 Subject: [PATCH 11/53] CP-39414: start swtpm depending on the VM's platform metadata Now swtpm is only started for domains that have vtpm=true added to their platform's metada. This can be done using xe e.g. xe vm-param-add uuid=VM-XXX param-name=platform vtpm=true Shutting down domains without the swtpm and the xapi-guard services running works as normal and without any errors Signed-off-by: Pau Ruiz Safont --- ocaml/xapi-idl/xen/xenops_types.ml | 3 +++ ocaml/xapi/xapi_xenops.ml | 19 ++++++++++++++----- ocaml/xenopsd/cli/xn.ml | 10 +++++++++- ocaml/xenopsd/cli/xn_cfg_types.ml | 2 ++ ocaml/xenopsd/test/test.ml | 1 + ocaml/xenopsd/xc/device.ml | 26 +++++++++++++++----------- ocaml/xenopsd/xc/device.mli | 1 + ocaml/xenopsd/xc/xenops_server_xen.ml | 14 ++++++-------- 8 files changed, 51 insertions(+), 25 deletions(-) diff --git a/ocaml/xapi-idl/xen/xenops_types.ml b/ocaml/xapi-idl/xen/xenops_types.ml index d9ab03ad932..bf7130546a0 100644 --- a/ocaml/xapi-idl/xen/xenops_types.ml +++ b/ocaml/xapi-idl/xen/xenops_types.ml @@ -77,6 +77,8 @@ module Vm = struct let default_firmware = Bios [@@deriving rpcty] + type tpm = Vtpm [@@deriving rpcty, sexp] + type hvm_info = { hap: bool [@default true] ; shadow_multiplier: float [@default 1.0] @@ -93,6 +95,7 @@ module Vm = struct ; qemu_disk_cmdline: bool [@default false] ; qemu_stubdom: bool [@default false] ; firmware: firmware_type [@default default_firmware] + ; tpm: tpm option [@default None] } [@@deriving rpcty, sexp] diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index bed7f6907c9..6188ac4d549 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -213,7 +213,8 @@ let assume_default_if_null_empty map default feature = let int = find int_of_string -let bool = find (function "1" -> true | "0" -> false | x -> bool_of_string x) +let bool platformdata default key = + Vm_platform.is_true ~key ~platformdata ~default let nvram_uefi_of_vm vm = let open Xenops_types.Nvram_uefi_variables in @@ -383,6 +384,14 @@ let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu = let make_hvmloader_boot_record {Helpers.timeoffset= t} = if bool vm.API.vM_platform false "qemu_stubdom" then warn "QEMU stub domains are no longer implemented" ; + + let tpm_of_vm () = + if bool vm.API.vM_platform false "vtpm" then + Some Xenops_interface.Vm.Vtpm + else + None + in + { hap= true ; shadow_multiplier= vm.API.vM_HVM_shadow_multiplier @@ -431,9 +440,9 @@ let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu = hvm_default_boot_order hvm_boot_params_order ) ; qemu_disk_cmdline= bool vm.API.vM_platform false "qemu_disk_cmdline" - ; qemu_stubdom= false - ; (* Obsolete: implementation removed *) - firmware= firmware_of_vm vm + ; qemu_stubdom= false (* Obsolete: implementation removed *) + ; firmware= firmware_of_vm vm + ; tpm= tpm_of_vm () } in let make_direct_boot_record @@ -1598,7 +1607,7 @@ module Xenopsd_metadata = struct (** Manage the lifetime of VM metadata pushed to xenopsd *) (* If the VM has Xapi_globs.persist_xenopsd_md -> filename in its other_config, - we persist the xenopsd metadata to a well-known location in the filesystem *) + we persist the xenopsd metadata to a well-known location in the filesystem *) let maybe_persist_md ~__context ~self md = let oc = Db.VM.get_other_config ~__context ~self in if List.mem_assoc Xapi_globs.persist_xenopsd_md oc then diff --git a/ocaml/xenopsd/cli/xn.ml b/ocaml/xenopsd/cli/xn.ml index daf09b6f79e..5737d022717 100644 --- a/ocaml/xenopsd/cli/xn.ml +++ b/ocaml/xenopsd/cli/xn.ml @@ -511,7 +511,8 @@ let add' _copts x () = let open Xn_cfg_types in let mem x = List.mem_assoc x config in let find x = List.assoc x config in - let any xs = List.fold_left ( || ) false (List.map mem xs) in + let find_opt x = List.assoc_opt x config in + let any xs = List.exists mem xs in let pv = false || mem _builder @@ -602,6 +603,13 @@ let add' _copts x () = ; qemu_disk_cmdline= false ; qemu_stubdom= false ; firmware= Xenops_types.Vm.default_firmware + ; tpm= + ( match find_opt _vtpm with + | Some id when bool id -> + Some Vtpm + | _ -> + None + ) } in let uuid = diff --git a/ocaml/xenopsd/cli/xn_cfg_types.ml b/ocaml/xenopsd/cli/xn_cfg_types.ml index 5b2ccb8343f..5bcf8fc48b9 100644 --- a/ocaml/xenopsd/cli/xn_cfg_types.ml +++ b/ocaml/xenopsd/cli/xn_cfg_types.ml @@ -85,3 +85,5 @@ let _vm_pci_msitranslate = "pci_msitranslate" let _vm_pci_power_mgmt = "pci_power_mgmt" let _vm_has_vendor_device = "has_vendor_device" + +let _vtpm = "vtpm" diff --git a/ocaml/xenopsd/test/test.ml b/ocaml/xenopsd/test/test.ml index f800bf94888..447585b7a15 100644 --- a/ocaml/xenopsd/test/test.ml +++ b/ocaml/xenopsd/test/test.ml @@ -231,6 +231,7 @@ let create_vm vmid = ; qemu_disk_cmdline= false ; qemu_stubdom= false ; firmware= Bios + ; tpm= Some Vtpm } in { diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index 7668989d123..56b4870aa1b 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -2461,6 +2461,7 @@ module Dm_Common = struct ; pci_emulations: string list ; pci_passthrough: bool ; video_mib: int + ; tpm: Xenops_types.Vm.tpm option ; xen_platform: (int * int) option ; extras: (string * string option) list } @@ -4388,18 +4389,21 @@ module Dm = struct () ) ; - (* start swtpm-wrapper *) - let tpm_socket_path = start_swtpm ~xs task domid in - + (* start swtpm-wrapper if appropriate and modify QEMU arguments as needed *) let tpmargs = - [ - "-chardev" - ; Printf.sprintf "socket,id=chrtpm,path=%s" tpm_socket_path - ; "-tpmdev" - ; "emulator,id=tpm0,chardev=chrtpm" - ; "-device" - ; "tpm-crb,tpmdev=tpm0" - ] + match info.tpm with + | Some Vtpm -> + let tpm_socket_path = start_swtpm ~xs task domid in + [ + "-chardev" + ; Printf.sprintf "socket,id=chrtpm,path=%s" tpm_socket_path + ; "-tpmdev" + ; "emulator,id=tpm0,chardev=chrtpm" + ; "-device" + ; "tpm-crb,tpmdev=tpm0" + ] + | None -> + [] in (* Execute qemu-dm-wrapper, forwarding stdout to the syslog, with the key diff --git a/ocaml/xenopsd/xc/device.mli b/ocaml/xenopsd/xc/device.mli index 1ee473259bb..aba65a1e68d 100644 --- a/ocaml/xenopsd/xc/device.mli +++ b/ocaml/xenopsd/xc/device.mli @@ -384,6 +384,7 @@ module Dm : sig ; pci_emulations: string list ; pci_passthrough: bool ; video_mib: int + ; tpm: Xenops_types.Vm.tpm option ; xen_platform: (int * int) option ; extras: (string * string option) list } diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index 46697730303..3cd21485f5e 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -1863,7 +1863,8 @@ 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) ?(hvm = true) ?(video_mib = 4) () = + ?(pci_passthrough = false) ?(hvm = true) ?(video_mib = 4) + ?(tpm = None) () = let video = match (video, vgpus) with | Cirrus, [] -> @@ -1911,6 +1912,7 @@ module VM = struct ; disp= VNC (video, vnc_ip, true, 0, keymap) ; pci_passthrough ; video_mib + ; tpm ; xen_platform ; extras= [] } @@ -1974,12 +1976,7 @@ module VM = struct | false, _ -> Device.Dm.Disabled in - let parallel = - if List.mem_assoc "parallel" vm.Vm.platformdata then - Some (List.assoc "parallel" vm.Vm.platformdata) - else - None - in + let parallel = List.assoc_opt "parallel" vm.Vm.platformdata in Some (make ~video_mib:hvm_info.video_mib ~firmware:hvm_info.firmware ~video:hvm_info.video ~acpi:hvm_info.acpi @@ -1987,7 +1984,8 @@ module VM = struct ?vnc_ip:hvm_info.vnc_ip ~usb ~parallel ~pci_emulations:hvm_info.pci_emulations ~pci_passthrough:hvm_info.pci_passthrough - ~boot_order:hvm_info.boot_order ~nics ~disks ~vgpus () + ~boot_order:hvm_info.boot_order ~nics ~disks ~vgpus + ~tpm:hvm_info.tpm () ) ) From d08304892cb501b218ec026f01888ecdc0b32221 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 25 Apr 2022 14:50:40 +0100 Subject: [PATCH 12/53] CP-39414: log actual daemon name when deleting sandbox This was missed when parametrizing the code, varstored was hardcoded Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/lib/xenops_sandbox.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/xenopsd/lib/xenops_sandbox.ml b/ocaml/xenopsd/lib/xenops_sandbox.ml index 2032a7bebc8..df9eb97cc3e 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.ml +++ b/ocaml/xenopsd/lib/xenops_sandbox.ml @@ -182,7 +182,7 @@ module Guard (G : GUARD) : SANDBOX = struct let stop dbg ~domid ~vm_uuid = let chroot = chroot ~domid ~vm_uuid in if Sys.file_exists chroot.root then ( - D.debug "About to stop varstored for %d (%s) %s" domid vm_uuid __LOC__ ; + D.debug "About to stop %s for %d (%s) %s" daemon domid vm_uuid __LOC__ ; let gid = chroot.Chroot.gid in let absolute_socket_path = Chroot.absolute_path_outside chroot socket_path From 8dbc71eebef139f7b8064b545a5cc2154fa124e9 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 26 Apr 2022 16:49:12 +0100 Subject: [PATCH 13/53] CP-39574: Create and destroy VTPM objects attached to VMs Now VTPM objects are created and attached to a VM when it is started for the first and they are destroyed when the VM they are attached to are destroyed. These objects are empty and do not reflect the state of the actual vTPM attached to the domains. Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/xapi_vm.ml | 3 +++ ocaml/xapi/xapi_xenops.ml | 19 +++++++++++++++---- 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 1137c11afa3..792caf00ba6 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -731,6 +731,9 @@ let destroy ~__context ~self = (Db.VM.get_children ~__context ~self) ; let uuid = Db.VM.get_uuid ~__context ~self in log_and_ignore_exn (fun () -> Rrdd.remove_rrd uuid) ; + List.iter + (fun self -> Db.VTPM.destroy ~__context ~self) + (Db.VM.get_VTPMs ~__context ~self) ; destroy ~__context ~self (* Note: we don't need to call lock_vm around clone or copy. The lock_vm just takes the local diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 6188ac4d549..b333c8cf6fc 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -386,10 +386,21 @@ let builder_of_vm ~__context (vmref, 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 - Some Xenops_interface.Vm.Vtpm - else - None + 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 + None in { From 7ee7e333ceb2a7dbd3eec1ab5a2fdff2f9c96008 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 8 Jun 2022 17:10:00 +0100 Subject: [PATCH 14/53] maintenance: post-merge fixes Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/xapi_xenops.ml | 4 ++-- ocaml/xenopsd/xc/xenops_server_xen.ml | 3 +-- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index af2ac47fa86..9ed7b9a37cb 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 @@ -389,7 +389,7 @@ let builder_of_vm ~__context (_, vm) timeoffset pci_passthrough vgpu = 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 uuid () = Uuid.(to_string (make ())) in let profile = [] in let other_config = [] in let contents = ref () in diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index 7f32bd9c247..62780f29614 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -1863,8 +1863,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, [] -> From 4ff283a43c9865cc8d015219331e68a8ab761bf4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 9 Jun 2022 11:20:59 +0100 Subject: [PATCH 15/53] xapi-idl: move Uuidm type to separate module MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Needs to be moved to a separate module to avoid cycles in the build system, about to use this type from another module. Signed-off-by: Edwin Török --- ocaml/xapi-idl/lib/uuidm_rpc_type.ml | 33 +++++++++++++++++ .../varstore_privileged_interface.ml | 35 +------------------ ocaml/xapi-idl/xen/xenops_types.ml | 1 + 3 files changed, 35 insertions(+), 34 deletions(-) create mode 100644 ocaml/xapi-idl/lib/uuidm_rpc_type.ml 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..2fc2ff33046 --- /dev/null +++ b/ocaml/xapi-idl/lib/uuidm_rpc_type.ml @@ -0,0 +1,33 @@ +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 diff --git a/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml b/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml index 87c40cad43a..368083be96e 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,40 +35,6 @@ 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] module RPC_API (R : RPC) = struct diff --git a/ocaml/xapi-idl/xen/xenops_types.ml b/ocaml/xapi-idl/xen/xenops_types.ml index bf7130546a0..b1793fb3032 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 From 3833d10f37e2013b8382983b41c90bed2024dabf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 9 Jun 2022 11:23:44 +0100 Subject: [PATCH 16/53] xapi-idl: add sexp converter to Uuidm type MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- ocaml/xapi-idl/lib/uuidm_rpc_type.ml | 9 +++++++++ ocaml/xapi-idl/lib/uuidm_rpc_type.mli | 11 +++++++++++ 2 files changed, 20 insertions(+) create mode 100644 ocaml/xapi-idl/lib/uuidm_rpc_type.mli diff --git a/ocaml/xapi-idl/lib/uuidm_rpc_type.ml b/ocaml/xapi-idl/lib/uuidm_rpc_type.ml index 2fc2ff33046..24a93fa13b6 100644 --- a/ocaml/xapi-idl/lib/uuidm_rpc_type.ml +++ b/ocaml/xapi-idl/lib/uuidm_rpc_type.ml @@ -30,4 +30,13 @@ module Uuidm = struct ) ) } + + 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 From a8dec3a630f7350751ef1500c558f2fcf49ba431 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 9 Jun 2022 11:31:45 +0100 Subject: [PATCH 17/53] vTPM: plumb through Uuid MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Xenopsd needs to know not just whether a VM has a vTPM or not, but also its UUID (in case a XAPI DB storage backend is used). For now only 1 vTPM/VM is supported, as before. Signed-off-by: Edwin Török --- ocaml/xapi-idl/xen/xenops_types.ml | 2 +- ocaml/xapi/xapi_xenops.ml | 36 ++++++++++++++++++------------ ocaml/xenopsd/cli/xn.ml | 5 +++-- ocaml/xenopsd/test/test.ml | 2 +- ocaml/xenopsd/xc/device.ml | 9 +++++--- 5 files changed, 33 insertions(+), 21 deletions(-) diff --git a/ocaml/xapi-idl/xen/xenops_types.ml b/ocaml/xapi-idl/xen/xenops_types.ml index b1793fb3032..765181f2023 100644 --- a/ocaml/xapi-idl/xen/xenops_types.ml +++ b/ocaml/xapi-idl/xen/xenops_types.ml @@ -78,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 9ed7b9a37cb..3f6121c191f 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -386,20 +386,28 @@ let builder_of_vm ~__context (vmref, 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 ())) 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/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..ecbca9a66e2 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -4137,7 +4137,7 @@ 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 name = "swtpm" in @@ -4320,8 +4320,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 +4333,7 @@ module Dm = struct ; "tpm-crb,tpmdev=tpm0" ] | None -> + D.debug "VM domid %d has no vTPM" domid ; [] in From 4e5597e9934ce96a745f56ce918c0f28739c2797 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 9 Jun 2022 11:32:55 +0100 Subject: [PATCH 18/53] varstore-guard: add filtering for vTPM.{set,get}_contents API MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- ocaml/xapi-guard/src/main.ml | 19 +++++++++++++++++++ .../varstore_privileged_interface.ml | 15 +++++++++++++++ 2 files changed, 34 insertions(+) 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/varstore/privileged/varstore_privileged_interface.ml b/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml index 368083be96e..31b39d1f9f7 100644 --- a/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml +++ b/ocaml/xapi-idl/varstore/privileged/varstore_privileged_interface.ml @@ -37,6 +37,8 @@ end) type vm_uuid = Uuidm.t [@@deriving rpcty] +type vtpm_uuid = Uuidm.t [@@deriving rpcty] + module RPC_API (R : RPC) = struct open R @@ -87,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 From 875da3679535be81610a4287b4ff016df52bf809 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 9 Jun 2022 13:47:19 +0100 Subject: [PATCH 19/53] vTPM: add minimal support for saving/restoring state through the XAPI DB MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit On VM start read the vTPM state from the XAPI DB and write it out to a file that is passed as argument to `swtpm-wrapper`. On VM stop read the vTPM state from the filesystem and save it back into the XAPI DB. Note: any updated to vTPM state inbetween start/stop are lost if the host running the VM crashes for now. To be addressed by other storage backends. Signed-off-by: Edwin Török --- ocaml/xenopsd/lib/xenops_sandbox.ml | 2 + ocaml/xenopsd/lib/xenops_sandbox.mli | 5 ++ ocaml/xenopsd/xc/device.ml | 96 +++++++++++++++++++++++++--- 3 files changed, 95 insertions(+), 8 deletions(-) diff --git a/ocaml/xenopsd/lib/xenops_sandbox.ml b/ocaml/xenopsd/lib/xenops_sandbox.ml index df9eb97cc3e..d34abebe918 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..182c0c96400 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/xc/device.ml b/ocaml/xenopsd/xc/device.ml index ecbca9a66e2..9f33e615e71 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -1264,13 +1264,80 @@ 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 vtpms_of_domid ~xs ~domid = + try + let vtpm_path = xs_path domid in + xs.Xs.directory vtpm_path + |> List.map @@ fun index -> + xs.Xs.read @@ Filename.concat vtpm_path index + |> Uuidm.of_string + |> Option.get + with _ -> [] + + 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 begin + 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 + end 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 begin + debug "Storing vTPM state of %d bytes" length; + Varstore_privileged_client.Client.vtpm_set_contents dbg vtpm_uuid (Base64.encode_string contents); + end else begin + debug "vTPM state is empty: not storing" + end; + (* 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 @@ -2772,7 +2839,11 @@ module Dm_Common = struct ) in let stop_swptm () = - Swtpm.stop ~xs domid ; + let () = + Swtpm.vtpms_of_domid ~xs ~domid + |> List.iter @@ fun vtpm_uuid -> + Swtpm.stop dbg ~xs ~domid ~vm_uuid ~vtpm_uuid + in Xenops_sandbox.Swtpm_guard.stop dbg ~domid ~vm_uuid in let stop_vgpu () = Vgpu.stop ~xs domid in @@ -4150,10 +4221,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 From 43baa4aa9958df948b37d343f1ad71687d9173c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 9 Jun 2022 13:49:17 +0100 Subject: [PATCH 20/53] vTPM: add minimal migration support MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Write a new swtpm record (similar to varstore record) into the migration stream that contains the latest vTPM state (from the filesystem). When vTPM start is called on the other end there will be 2 sources of vTPM state: the migration state and the xapi DB. The data from the migration state is restored first and takes precedence: there is a check to guard against EEXIST when starting the vTPM: if it already exists then we must've been just migrated and we leave the state alone. This assumes that state would be stored in the filesystem (through either the file:// or dir:// backends of swtpm, currently the only 2 existing ones). If other backends are implemented in the future then we would need to retrieve the latest vTPM state via another mechanism. TBC: would qemu attempt to restore the device state as well? But we need to start swtpm with *some* state during migration... Signed-off-by: Edwin Török --- ocaml/xenopsd/lib/suspend_image.ml | 7 ++ ocaml/xenopsd/lib/suspend_image.mli | 1 + ocaml/xenopsd/lib/xenops_sandbox.ml | 2 +- ocaml/xenopsd/lib/xenops_sandbox.mli | 2 +- .../suspend_image_viewer.ml | 3 + ocaml/xenopsd/xc/device.ml | 98 +++++++++++-------- ocaml/xenopsd/xc/device.mli | 23 ++++- ocaml/xenopsd/xc/domain.ml | 47 +++++++-- ocaml/xenopsd/xc/domain.mli | 2 + ocaml/xenopsd/xc/xenops_server_xen.ml | 18 ++-- 10 files changed, 145 insertions(+), 58 deletions(-) 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 d34abebe918..4e77af1c52b 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.ml +++ b/ocaml/xenopsd/lib/xenops_sandbox.ml @@ -120,7 +120,7 @@ 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 chroot : domid:int -> vm_uuid:string -> Chroot.t val start : string diff --git a/ocaml/xenopsd/lib/xenops_sandbox.mli b/ocaml/xenopsd/lib/xenops_sandbox.mli index 182c0c96400..3c8cfb6539d 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.mli +++ b/ocaml/xenopsd/lib/xenops_sandbox.mli @@ -48,7 +48,7 @@ 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 + 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. *) 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/xc/device.ml b/ocaml/xenopsd/xc/device.ml index 9f33e615e71..9c57681f6e6 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -1278,28 +1278,20 @@ module Swtpm = struct let xs_path ~domid = Device_common.get_private_path domid ^ "/vtpm" - let vtpms_of_domid ~xs ~domid = - try - let vtpm_path = xs_path domid in - xs.Xs.directory vtpm_path - |> List.map @@ fun index -> - xs.Xs.read @@ Filename.concat vtpm_path index - |> Uuidm.of_string - |> Option.get - with _ -> [] - 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 begin + 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); + 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 - end else + ) 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 () = @@ -1308,12 +1300,14 @@ module Swtpm = struct |> 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 + 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 + let vtpm_path = xs_path ~domid in xs.Xs.write (Filename.concat vtpm_path @@ string_of_int index) (Uuidm.to_string vtpm_uuid) ; @@ -1329,12 +1323,12 @@ module Swtpm = struct domid vm_uuid ; let contents = suspend ~xs ~domid ~vm_uuid in let length = String.length contents in - if length > 0 then begin - debug "Storing vTPM state of %d bytes" length; - Varstore_privileged_client.Client.vtpm_set_contents dbg vtpm_uuid (Base64.encode_string contents); - end else begin - debug "vTPM state is empty: not storing" - end; + 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 @@ -2803,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 @@ -2839,11 +2833,11 @@ module Dm_Common = struct ) in let stop_swptm () = - let () = - Swtpm.vtpms_of_domid ~xs ~domid - |> List.iter @@ fun vtpm_uuid -> - Swtpm.stop dbg ~xs ~domid ~vm_uuid ~vtpm_uuid - in + 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 @@ -3015,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 : @@ -3029,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 *) @@ -3082,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:_ _ = @@ -3090,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 @@ -3829,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 @@ -4085,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 @@ -4189,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 @@ -4532,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/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index 62780f29614..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 -> @@ -2488,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 ; @@ -2665,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." ) ; From cca5ac70ff98bad7e94fe5f22d2ca108c0c6f83f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Thu, 9 Jun 2022 13:59:27 +0100 Subject: [PATCH 21/53] vTPM: do not hardcode swtpm-wrapper path MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- ocaml/xenopsd/lib/resources.ml | 5 +++++ ocaml/xenopsd/scripts/make-custom-xenopsd.conf | 1 + ocaml/xenopsd/xc/device.ml | 2 +- ocaml/xenopsd/xc/xc_resources.ml | 1 + 4 files changed, 8 insertions(+), 1 deletion(-) 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/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/xc/device.ml b/ocaml/xenopsd/xc/device.ml index 9c57681f6e6..e1054379f64 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -4213,7 +4213,7 @@ module Dm = struct 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 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 From d72b6804694094f895f91cde5c75483bd05643f4 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 21 Jun 2022 17:13:34 +0100 Subject: [PATCH 22/53] CP-40032: Block VTPM creation and destruction on certain cases For now, only allow a single VTPM to be associated to a VM, and only allow VTPM creation and destruction on halted VMs to avoid desync of the DB and the actual running state of the devices. Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_errors.ml | 6 ++++-- ocaml/xapi-consts/api_errors.ml | 4 ++++ ocaml/xapi/xapi_vtpm.ml | 14 ++++++++++++++ 3 files changed, 22 insertions(+), 2 deletions(-) diff --git a/ocaml/idl/datamodel_errors.ml b/ocaml/idl/datamodel_errors.ml index 24384d77d14..b052ac93f03 100644 --- a/ocaml/idl/datamodel_errors.ml +++ b/ocaml/idl/datamodel_errors.ml @@ -1940,9 +1940,11 @@ let _ = error Api_errors.invalid_repository_proxy_url ["url"] ~doc:"The repository proxy URL is invalid." () ; error Api_errors.invalid_repository_proxy_credential [] - ~doc:"The repository proxy username/password is invalid." () + ~doc:"The repository proxy username/password is invalid." () ; + + error Api_errors.vtpm_max_amount_reached ["amount"] + ~doc:"The VM cannot be associated with more VTPMs." () ; -let _ = message (fst Api_messages.ha_pool_overcommitted) ~doc: diff --git a/ocaml/xapi-consts/api_errors.ml b/ocaml/xapi-consts/api_errors.ml index 72ea6e6414d..909ed278b6c 100644 --- a/ocaml/xapi-consts/api_errors.ml +++ b/ocaml/xapi-consts/api_errors.ml @@ -1277,3 +1277,7 @@ let invalid_repository_proxy_url = "INVALID_REPOSITORY_PROXY_URL" let invalid_repository_proxy_credential = "INVALID_REPOSITORY_PROXY_CREDENTIAL" let dynamic_memory_control_unavailable = "DYNAMIC_MEMORY_CONTROL_UNAVAILABLE" + +(* VTPMs *) + +let vtpm_max_amount_reached = "VTPM_MAX_AMOUNT_REACHED" diff --git a/ocaml/xapi/xapi_vtpm.ml b/ocaml/xapi/xapi_vtpm.ml index 5722b3d3931..d97e40ef74c 100644 --- a/ocaml/xapi/xapi_vtpm.ml +++ b/ocaml/xapi/xapi_vtpm.ml @@ -12,12 +12,23 @@ GNU Lesser General Public License for more details. *) +let assert_no_vtpm_associated ~__context vm = + match Db.VM.get_VTPMs ~__context ~self:vm with + | [] -> + () + | vtpms -> + let amount = List.length vtpms |> Int.to_string in + raise Api_errors.(Server_error (vtpm_max_amount_reached, [amount])) + let introduce ~__context ~uuid ~vM ~profile ~contents = let ref = Ref.make () in Db.VTPM.create ~__context ~ref ~uuid ~vM ~profile ~contents ; ref let create ~__context ~vM = + assert_no_vtpm_associated ~__context vM ; + Xapi_vm_lifecycle.assert_initial_power_state_is ~__context ~self:vM + ~expected:`Halted ; let uuid = Uuid.(to_string (make ())) in let profile = Db.VM.get_default_vtpm_profile ~__context ~self:vM in let contents = Xapi_secret.create ~__context ~value:"" ~other_config:[] in @@ -25,6 +36,9 @@ let create ~__context ~vM = ref let destroy ~__context ~self = + let vm = Db.VTPM.get_VM ~__context ~self in + Xapi_vm_lifecycle.assert_initial_power_state_is ~__context ~self:vm + ~expected:`Halted ; let secret = Db.VTPM.get_contents ~__context ~self in Db.Secret.destroy ~__context ~self:secret ; Db.VTPM.destroy ~__context ~self From b9c99efc07452b961c94d800e708429e0f4a2689 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 21 Jun 2022 11:28:45 +0100 Subject: [PATCH 23/53] CP-40032: add vtpm-create and destroy to cli Signed-off-by: Pau Ruiz Safont --- ocaml/xapi-cli-server/cli_frontend.ml | 18 ++++++++++++++++++ ocaml/xapi-cli-server/cli_operations.ml | 14 ++++++++++++++ 2 files changed, 32 insertions(+) diff --git a/ocaml/xapi-cli-server/cli_frontend.ml b/ocaml/xapi-cli-server/cli_frontend.ml index 80e03a445be..87211422ca5 100644 --- a/ocaml/xapi-cli-server/cli_frontend.ml +++ b/ocaml/xapi-cli-server/cli_frontend.ml @@ -3569,6 +3569,24 @@ let rec cmdtable_data : (string * cmd_spec) list = ; flags= [] } ) + ; ( "vtpm-create" + , { + reqd= ["vm-uuid"] + ; optn= [] + ; help= "Create a VTPM associated with a VM." + ; implementation= No_fd Cli_operations.VTPM.create + ; flags= [] + } + ) + ; ( "vtpm-destroy" + , { + reqd= ["uuid"] + ; optn= [] + ; help= "Destroy a VTPM" + ; implementation= No_fd Cli_operations.VTPM.destroy + ; flags= [] + } + ) ] let cmdtable : (string, cmd_spec) Hashtbl.t = Hashtbl.create 50 diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index 4e764f09cdc..99073c16b40 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -7828,3 +7828,17 @@ module Repository = struct Client.Repository.set_gpgkey_path ~rpc ~session_id ~self:ref ~value:gpgkey_path end + +module VTPM = struct + let create printer rpc session_id params = + let vm_uuid = List.assoc "vm-uuid" params in + let vM = Client.VM.get_by_uuid ~rpc ~session_id ~uuid:vm_uuid in + let ref = Client.VTPM.create ~rpc ~session_id ~vM in + let uuid = Client.VTPM.get_uuid ~rpc ~session_id ~self:ref in + printer (Cli_printer.PList [uuid]) + + let destroy _ rpc session_id params = + let uuid = List.assoc "uuid" params in + let ref = Client.VTPM.get_by_uuid ~rpc ~session_id ~uuid in + Client.VTPM.destroy ~rpc ~session_id ~self:ref +end From 66dc6a098e25e87265a90158370c18f2d2a2773e Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 23 Jun 2022 15:16:14 +0100 Subject: [PATCH 24/53] CA-368102: Send the VTPM uuid to xenops whenever its available Previously the VTPM uuid was only sent when platform data contained vtpm=true. Now this parameter only has influence when there is no vtpm already associated with the VM. Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/xapi_xenops.ml | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 3f6121c191f..39f1213c567 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -386,10 +386,14 @@ let builder_of_vm ~__context (vmref, 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 - let uuid = - match vm.API.vM_VTPMs with - | [] -> + let ( let* ) = Option.bind in + let* uuid = + match vm.API.vM_VTPMs with + | [] -> + (* The vtpm parameter in platform data only has influence when the + VM does not have a VTPM associated, otherwise the associated + VTPM gets always attached. *) + if bool vm.API.vM_platform false "vtpm" then ( let ref () = Ref.make () in let uuid () = Uuid.(to_string (make ())) in let profile = [] in @@ -400,15 +404,15 @@ let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu = 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 + Some vtpm_uuid + ) else + None + | [self] -> + Some (Db.VTPM.get_uuid ~__context ~self) + | _ :: _ :: _ -> + failwith "Multiple vTPMs are not supported" + in + Some (Xenops_interface.Vm.Vtpm (Uuidm.of_string uuid |> Option.get)) in { From 5ff4c2f00de99b2442eeb6467ea85398e806907b Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 20 Jun 2022 09:48:47 +0100 Subject: [PATCH 25/53] xenops_sandbox: only get references by creating the sandbox This way it's harder to for code elsewhere to get a reference to inactive / non-existent sandboxes. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/lib/xenops_sandbox.ml | 2 -- ocaml/xenopsd/lib/xenops_sandbox.mli | 5 ----- ocaml/xenopsd/xc/device.ml | 5 ++--- 3 files changed, 2 insertions(+), 10 deletions(-) diff --git a/ocaml/xenopsd/lib/xenops_sandbox.ml b/ocaml/xenopsd/lib/xenops_sandbox.ml index 4e77af1c52b..df9eb97cc3e 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.ml +++ b/ocaml/xenopsd/lib/xenops_sandbox.ml @@ -120,8 +120,6 @@ 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 3c8cfb6539d..c6c071c85f3 100644 --- a/ocaml/xenopsd/lib/xenops_sandbox.mli +++ b/ocaml/xenopsd/lib/xenops_sandbox.mli @@ -48,11 +48,6 @@ 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/xc/device.ml b/ocaml/xenopsd/xc/device.ml index e1054379f64..d5a0e1b6de0 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -1294,12 +1294,11 @@ module Swtpm = struct ) 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 start_daemon dbg ~xs ~chroot ~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 @@ -4236,7 +4235,7 @@ module Dm = struct let args = Fe_argv.run args |> snd |> Fe_argv.argv in let timeout_seconds = !Xenopsd.swtpm_ready_timeout in let dbg = Xenops_task.get_dbg task in - let execute = Swtpm.start_daemon dbg ~xs ~vtpm_uuid ~vm_uuid ~index in + let execute = Swtpm.start_daemon dbg ~xs ~chroot ~vtpm_uuid ~vm_uuid ~index in let service = {Service.name; domid; exec_path; chroot; args; execute; timeout_seconds} in From 9c2dc9a00d888eab4a3e35302d79b10cad071b90 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 19 May 2022 14:22:16 +0100 Subject: [PATCH 26/53] CP-39894: move xenopsd's daemon modules from device to service This needed some bindings to move to xenops_utils or the PV_Vnc module in service. The change helps set up a baseline for the more complex changes around moving the arg building and reducing the surface of the service submodules. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/lib/xenops_utils.ml | 23 ++ ocaml/xenopsd/xc/device.ml | 500 +++----------------------- ocaml/xenopsd/xc/device.mli | 64 +--- ocaml/xenopsd/xc/domain.ml | 2 +- ocaml/xenopsd/xc/service.ml | 406 +++++++++++++++++++++ ocaml/xenopsd/xc/service.mli | 124 +++++++ ocaml/xenopsd/xc/xenops_server_xen.ml | 21 +- 7 files changed, 623 insertions(+), 517 deletions(-) diff --git a/ocaml/xenopsd/lib/xenops_utils.ml b/ocaml/xenopsd/lib/xenops_utils.ml index 554a802d85a..8a2fe0ba032 100644 --- a/ocaml/xenopsd/lib/xenops_utils.ml +++ b/ocaml/xenopsd/lib/xenops_utils.ml @@ -43,6 +43,23 @@ module Unix = struct } end +(** Represent an IPC endpoint *) +module Socket = struct + type t = Unix of string | Port of int + + module Unix = struct + let path x = "unix:" ^ x + + let rm x = + let dbg = debug "error cleaning unix socket %s: %s" x in + try Unix.unlink x with + | Unix.Unix_error (Unix.ENOENT, _, _) -> + () + | Unix.Unix_error (e, _, _) -> + dbg (Unix.error_message e) + end +end + let all = List.fold_left ( && ) true let any = List.fold_left ( || ) false @@ -632,6 +649,12 @@ let chunks size lst = |> List.map (fun xs -> List.rev xs) |> List.rev +let really_kill pid = + try Unixext.kill_and_wait pid + with Unixext.Process_still_alive -> + debug "%d: failed to respond to SIGTERM, sending SIGKILL" pid ; + Unixext.kill_and_wait ~signal:Sys.sigkill pid + let best_effort txt f = try f () with e -> info "%s: ignoring exception %s" txt (Printexc.to_string e) diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index d5a0e1b6de0..492f4e21b2e 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -88,23 +88,6 @@ module Profile = struct Qemu_upstream_compat end -(** Represent an IPC endpoint *) -module Socket = struct - type t = Unix of string | Port of int - - module Unix = struct - let path x = "unix:" ^ x - - let rm x = - let dbg = debug "error cleaning unix socket %s: %s" x in - try Unix.unlink x with - | Unix.Unix_error (Unix.ENOENT, _, _) -> - () - | Unix.Unix_error (e, _, _) -> - dbg (Unix.error_message e) - end -end - (* keys read by vif udev script (keep in sync with api:scripts/vif) *) let vif_udev_keys = "promiscuous" @@ -113,10 +96,6 @@ let vif_udev_keys = (****************************************************************************************) module Generic = struct - let vnc_port_path domid = sprintf "/local/domain/%d/console/vnc-port" domid - - let tc_port_path domid = sprintf "/local/domain/%d/console/tc-port" domid - (* Oxenstored's transaction conflict algorithm will cause parallel but separate device creation transactions to abort and retry, leading to livelock while starting lots of VMs. Work around this by serialising these @@ -362,11 +341,7 @@ module Generic = struct "Device.Generic.hard_shutdown about to blow away backend and error paths" ; rm_device_state ~xs x - let really_kill pid = - try Unixext.kill_and_wait pid - with Unixext.Process_still_alive -> - debug "%d: failed to respond to SIGTERM, sending SIGKILL" pid ; - Unixext.kill_and_wait ~signal:Sys.sigkill pid + let really_kill = Xenops_utils.really_kill let best_effort = Xenops_utils.best_effort end @@ -1070,389 +1045,6 @@ module Vcpu_Common = struct with Xs_protocol.Enoent _ -> false end -module type DAEMONPIDPATH = sig - val name : string - - val use_pidfile : bool - - val pid_path : int -> string -end - -module DaemonMgmt (D : DAEMONPIDPATH) = struct - module SignalMask = struct - module H = Hashtbl - - type t = (int, bool) H.t - - let create () = H.create 16 - - let set tbl key = H.replace tbl key true - - let unset tbl key = H.remove tbl key - - let has tbl key = H.mem tbl key - end - - let signal_mask = SignalMask.create () - - let name = D.name - - let pid_path = D.pid_path - - let pid_path_signal domid = pid_path domid ^ "-signal" - - let pidfile_path domid = - if D.use_pidfile then - Some (sprintf "%s/%s-%d.pid" Device_common.var_run_xen_path D.name domid) - else - None - - let pid ~xs domid = - try - match pidfile_path domid with - | Some path when Sys.file_exists path -> - let pid = - path |> Unixext.string_of_file |> String.trim |> int_of_string - in - Unixext.with_file path [Unix.O_RDONLY] 0 (fun fd -> - try - Unix.lockf fd Unix.F_TRLOCK 0 ; - (* we succeeded taking the lock: original process is dead. - * some other process might've reused its pid *) - None - with Unix.Unix_error (Unix.EAGAIN, _, _) -> - (* cannot obtain lock: process is alive *) - Some pid - ) - | _ -> - (* backward compatibility during update installation: only has - xenstore pid *) - let pid = xs.Xs.read (pid_path domid) in - Some (int_of_string pid) - with _ -> None - - let is_running ~xs domid = - match pid ~xs domid with - | None -> - false - | Some p -> ( - try Unix.kill p 0 ; (* This checks the existence of pid p *) - true - with _ -> false - ) - - let stop ~xs domid = - match pid ~xs domid with - | None -> - () - | Some pid -> ( - debug "%s: stopping %s with SIGTERM (domid = %d pid = %d)" D.name D.name - domid pid ; - let open Generic in - best_effort (sprintf "killing %s" D.name) (fun () -> really_kill pid) ; - let key = pid_path domid in - best_effort (sprintf "removing XS key %s" key) (fun () -> xs.Xs.rm key) ; - match pidfile_path domid with - | None -> - () - | Some path -> - best_effort (sprintf "removing %s" path) (fun () -> Unix.unlink path) - ) - - let syslog_key ~domid = Printf.sprintf "%s-%d" D.name domid - - let start ~fds ~syslog_key path args = - let syslog_stdout = Forkhelpers.Syslog_WithKey syslog_key in - let redirect_stderr_to_stdout = true in - let pid = - Forkhelpers.safe_close_and_exec None None None fds ~syslog_stdout - ~redirect_stderr_to_stdout path args - in - debug - "%s: should be running in the background (stdout -> syslog); (fd,pid) = \ - %s" - D.name - (Forkhelpers.string_of_pidty pid) ; - pid - - (* Forks a daemon and then returns the pid. *) - let start_daemon ~path ~args ~domid ?(fds = []) () = - let syslog_key = syslog_key ~domid in - debug "Starting daemon: %s with args [%s]" path (String.concat "; " args) ; - let pid = start ~fds ~syslog_key path args in - debug "Daemon started: %s" syslog_key ; - pid -end - -module SystemdDaemonMgmt (D : DAEMONPIDPATH) = struct - (* backward compat: for daemons running during an update *) - module Compat = DaemonMgmt (D) - - let pidfile_path = Compat.pidfile_path - - let pid_path = Compat.pid_path - - let of_domid domid = - let key = Compat.syslog_key ~domid in - if Fe_systemctl.exists ~service:key then - Some key - else - None - - let alive service _ = - if Fe_systemctl.is_active ~service then - true - else - let status = Fe_systemctl.show ~service in - let open Fe_systemctl in - error - "%s: unexpected termination \ - (Result=%s,ExecMainPID=%d,ExecMainStatus=%d,ActiveState=%s)" - service status.result status.exec_main_pid status.exec_main_status - status.active_state ; - false - - let stop ~xs domid = - match of_domid domid with - | None -> - Compat.stop ~xs domid - | Some service -> - (* xenstore cleanup is done by systemd unit file *) - let (_ : Fe_systemctl.status) = Fe_systemctl.stop ~service in - () - - let start_daemon ~path ~args ~domid () = - debug "Starting daemon: %s with args [%s]" path (String.concat "; " args) ; - let service = Compat.syslog_key ~domid in - let pidpath = D.pid_path domid in - let properties = - ("ExecStopPost", "-/usr/bin/xenstore-rm " ^ pidpath) - :: - ( match Compat.pidfile_path domid with - | None -> - [] - | Some path -> - [("ExecStopPost", "-/bin/rm -f " ^ path)] - ) - in - Fe_systemctl.start_transient ~properties ~service path args ; - debug "Daemon started: %s" service ; - service -end - -module Qemu = DaemonMgmt (struct - let name = "qemu-dm" - - let use_pidfile = true - - let pid_path domid = sprintf "/local/domain/%d/qemu-pid" domid -end) - -module Vgpu = DaemonMgmt (struct - let name = "vgpu" - - let use_pidfile = false - - let pid_path domid = sprintf "/local/domain/%d/vgpu-pid" domid -end) - -module Varstored = SystemdDaemonMgmt (struct - let name = "varstored" - - let use_pidfile = true - - let pid_path domid = sprintf "/local/domain/%d/varstored-pid" domid -end) - -(* 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 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 ~chroot ~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 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 - let name = "vncterm" - - let use_pidfile = false - - let pid_path domid = sprintf "/local/domain/%d/vncterm-pid" domid - end) - - let vnc_console_path domid = sprintf "/local/domain/%d/console" domid - - let pid ~xs domid = D.pid ~xs domid - - (* Look up the commandline args for the vncterm pid; *) - (* Check that they include the vncterm binary path and the xenstore console - path for the supplied domid. *) - let is_cmdline_valid domid pid = - try - let cmdline = - Printf.sprintf "/proc/%d/cmdline" pid - |> Unixext.string_of_file - |> Astring.String.cuts ~sep:"\000" - in - List.mem !Xc_resources.vncterm cmdline - && List.mem (vnc_console_path domid) cmdline - with _ -> false - - let is_vncterm_running ~xs domid = - match pid ~xs domid with - | None -> - false - | Some p -> - D.is_running ~xs domid && is_cmdline_valid domid p - - let get_vnc_port ~xs domid = - if not (is_vncterm_running ~xs domid) then - None - else - try - Some - (Socket.Port (int_of_string (xs.Xs.read (Generic.vnc_port_path domid))) - ) - with _ -> None - - let get_tc_port ~xs domid = - if not (is_vncterm_running ~xs domid) then - None - else - try Some (int_of_string (xs.Xs.read (Generic.tc_port_path domid))) - with _ -> None - - let load_args = function - | None -> - [] - | Some filename -> - if Sys.file_exists filename then - ["-l"; filename] - else - [] - - exception Failed_to_start - - let vncterm_statefile pid = - sprintf "/var/xen/vncterm/%d/vncterm.statefile" pid - - let get_statefile ~xs domid = - match pid ~xs domid with - | None -> - None - | Some pid -> - let filename = vncterm_statefile pid in - if Sys.file_exists filename then - Some filename - else - None - - let save ~xs domid = - match pid ~xs domid with - | Some pid -> - Unix.kill pid Sys.sigusr1 ; - let filename = vncterm_statefile pid in - let delay = 10. in - let start_time = Unix.time () in - (* wait at most ten seconds *) - while - (not (Sys.file_exists filename)) || Unix.time () -. start_time > delay - do - debug "Device.PV_Vnc.save: waiting for %s to appear" filename ; - Thread.delay 1. - done ; - if Unix.time () -. start_time > delay then - debug "Device.PV_Vnc.save: timeout while waiting for %s to appear" - filename - else - debug "Device.PV_Vnc.save: %s has appeared" filename - | None -> - () - - let start ?statefile ~xs ?ip domid = - debug "In PV_Vnc.start" ; - let ip = Option.value ~default:"127.0.0.1" ip in - let l = - [ - "-x" - ; sprintf "/local/domain/%d/console" domid - ; "-T" - ; (* listen for raw connections *) - "-v" - ; ip ^ ":1" - ] - @ load_args statefile - in - (* Now add the close fds wrapper *) - let pid = D.start_daemon ~path:!Xc_resources.vncterm ~args:l ~domid () in - let path = D.pid_path domid in - xs.Xs.write path (string_of_int (Forkhelpers.getpid pid)) ; - Forkhelpers.dontwaitpid pid - - let stop ~xs domid = D.stop ~xs domid -end - module PCI = struct type t = { address: Xenops_interface.Pci.address @@ -1612,7 +1204,7 @@ module PCI = struct |> int_of_string in if hvm && qmp_add then - if Qemu.is_running ~xs domid then + if Service.Qemu.is_running ~xs domid then let id = Printf.sprintf "pci-pt-%02x_%02x.%01x" host.bus host.dev host.fn in @@ -2202,7 +1794,7 @@ module Vusb = struct {"execute":"qom-list","arguments":{"path":"/machine/peripheral"}} result: {"return": [{"name": "usb1", "type": "child"}, {"name":"type", "type": "string"}} The usb1 is added. *) - if Qemu.is_running ~xs domid then + if Service.Qemu.is_running ~xs domid then let path = "/machine/peripheral" in match qmp_send_cmd domid Qmp.(Qom_list path) with | Qmp.(Qom usbs) -> @@ -2273,13 +1865,13 @@ module Vusb = struct speed id ; get_bus_from_version () in - if Qemu.is_running ~xs domid then ( + if Service.Qemu.is_running ~xs domid then ( let bus, prepare_bus = get_bus () in prepare_bus () ; (* Need to reset USB device before passthrough to vm according to CP-24616. Also need to do deprivileged work in usb_reset script if QEMU is deprivileged. *) - ( match Qemu.pid ~xs domid with + ( match Service.Qemu.pid ~xs domid with | Some pid -> usb_reset_attach ~hostbus ~hostport ~domid ~pid ~privileged | _ -> @@ -2308,7 +1900,7 @@ module Vusb = struct debug "vusb_unplug: unplug VUSB device %s" id ; finally (fun () -> - if Qemu.is_running ~xs domid then + if Service.Qemu.is_running ~xs domid then try qmp_send_cmd domid Qmp.(Device_del id) |> ignore with QMP_connection_error _ -> raise (Xenopsd_error Device_not_connected) @@ -2340,7 +1932,7 @@ end = struct (** query qemu for the serial console and write it to xenstore. Only write path for a real console, not a file or socket path. CA-318579 *) let update_xenstore ~xs domid = - ( if not @@ Qemu.is_running ~xs domid then + ( if not @@ Service.Qemu.is_running ~xs domid then let msg = sprintf "Qemu not running for domain %d (%s)" domid __LOC__ in raise (Xenopsd_error (Internal_error msg)) ) ; @@ -2467,13 +2059,13 @@ module Dm_Common = struct Xenops_sandbox.Chroot.Path.of_string ~relative:"efi-vars-save.dat" let get_vnc_port ~xs domid ~f = - match Qemu.is_running ~xs domid with true -> f () | false -> None + match Service.Qemu.is_running ~xs domid with true -> f () | false -> None let get_tc_port ~xs domid = - if not (Qemu.is_running ~xs domid) then + if not (Service.Qemu.is_running ~xs domid) then None else - try Some (int_of_string (xs.Xs.read (Generic.tc_port_path domid))) + try Some (int_of_string (xs.Xs.read (Service.PV_Vnc.tc_port_path domid))) with _ -> None let signal (task : Xenops_task.task_handle) ~xs ~qemu_domid ~domid ?wait_for @@ -2602,7 +2194,7 @@ module Dm_Common = struct ) |> List.concat ; (info.monitor |> function None -> [] | Some x -> ["-monitor"; x]) - ; (Qemu.pidfile_path domid |> function + ; (Service.Qemu.pidfile_path domid |> function | None -> [] | Some x -> @@ -2797,11 +2389,11 @@ module Dm_Common = struct (* Called by every domain destroy, even non-HVM *) let stop ~xs ~qemu_domid ~vtpm domid = - let qemu_pid_path = Qemu.pid_path domid in + let qemu_pid_path = Service.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 let stop_qemu () = - match Qemu.pid ~xs domid with + match Service.Qemu.pid ~xs domid with | None -> () (* nothing to do *) | Some qemu_pid -> ( @@ -2809,7 +2401,7 @@ module Dm_Common = struct let open Generic in best_effort "signalling that qemu is ending as expected, mask further signals" - (fun () -> Qemu.SignalMask.set Qemu.signal_mask domid + (fun () -> Service.Qemu.(SignalMask.set signal_mask domid) ) ; best_effort "killing qemu-dm" (fun () -> really_kill qemu_pid) ; best_effort "removing qemu-pid from xenstore" (fun () -> @@ -2817,12 +2409,12 @@ module Dm_Common = struct ) ; best_effort "unmasking signals, qemu-pid is already gone from xenstore" - (fun () -> Qemu.SignalMask.unset Qemu.signal_mask domid + (fun () -> Service.Qemu.(SignalMask.unset signal_mask domid) ) ; best_effort "removing device model path from xenstore" (fun () -> xs.Xs.rm (device_model_path ~qemu_domid domid) ) ; - match Qemu.pidfile_path domid with + match Service.Qemu.pidfile_path domid with | None -> () | Some path -> @@ -2834,15 +2426,15 @@ module Dm_Common = struct let stop_swptm () = Option.iter (fun (Xenops_interface.Vm.Vtpm vtpm_uuid) -> - Swtpm.stop dbg ~xs ~domid ~vm_uuid ~vtpm_uuid + Service.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 + let stop_vgpu () = Service.Vgpu.stop ~xs domid in let stop_varstored () = debug "About to stop varstored for domain %d (%s)" domid vm_uuid ; - Varstored.stop ~xs domid ; + Service.Varstored.stop ~xs domid ; Xenops_sandbox.Varstore_guard.stop dbg ~domid ~vm_uuid in stop_vgpu () ; stop_varstored () ; stop_swptm () ; stop_qemu () @@ -3074,7 +2666,9 @@ module Backend = struct try Some (Socket.Port - (int_of_string (xs.Xs.read (Generic.vnc_port_path domid))) + (int_of_string + (xs.Xs.read (Service.PV_Vnc.vnc_port_path domid)) + ) ) with _ -> None ) @@ -3088,7 +2682,7 @@ module Backend = struct let init_daemon ~task:_ ~path:_ ~args:_ ~domid:_ ~xs:_ ~ready_path:_ ~timeout:_ ~cancel:_ ?fds:_ _ = - raise (Ioemu_failed (Qemu.name, "PV guests have no IO emulator")) + raise (Ioemu_failed (Service.Qemu.name, "PV guests have no IO emulator")) let qemu_args ~xs:_ ~dm:_ _ _ _ = {Dm_Common.argv= []; fd_map= []} @@ -3826,8 +3420,8 @@ module Backend = struct let init_daemon ~task ~path ~args ~domid ~xs:_ ~ready_path:_ ~timeout ~cancel:_ ?(fds = []) _ = - let pid = Qemu.start_daemon ~path ~args ~domid ~fds () in - wait_event_socket ~task ~name:Qemu.name ~domid ~timeout ; + let pid = Service.Qemu.start_daemon ~path ~args ~domid ~fds () in + wait_event_socket ~task ~name:Service.Qemu.name ~domid ~timeout ; QMP_Event.add domid ; pid @@ -4229,13 +3823,15 @@ module Dm = struct *) let state_uri = Filename.concat "file://" - @@ Xenops_sandbox.Chroot.chroot_path_inside Swtpm.state_path + @@ Xenops_sandbox.Chroot.chroot_path_inside Service.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 dbg = Xenops_task.get_dbg task in - let execute = Swtpm.start_daemon dbg ~xs ~chroot ~vtpm_uuid ~vm_uuid ~index in + let execute = + Service.Swtpm.start_daemon dbg ~xs ~chroot ~vtpm_uuid ~vm_uuid ~index + in let service = {Service.name; domid; exec_path; chroot; args; execute; timeout_seconds} in @@ -4281,7 +3877,7 @@ module Dm = struct ; Printf.sprintf "socket:%s" socket_path ] >>= fun () -> - (Varstored.pidfile_path domid |> function + (Service.Varstored.pidfile_path domid |> function | None -> return () | Some x -> @@ -4301,10 +3897,11 @@ module Dm = struct (Xenops_sandbox.Chroot.chroot_path_inside efivars_save_path) in let args = Fe_argv.run args |> snd |> Fe_argv.argv in - let service = Varstored.start_daemon ~path ~args ~domid () in - let ready_path = Varstored.pid_path domid in - wait_path ~pidalive:(Varstored.alive service) ~task ~name ~domid ~xs - ~ready_path + let service = Service.Varstored.start_daemon ~path ~args ~domid () in + let ready_path = Service.Varstored.pid_path domid in + wait_path + ~pidalive:(Service.Varstored.alive service) + ~task ~name ~domid ~xs ~ready_path ~timeout:!Xenopsd.varstored_ready_timeout ~cancel:(Cancel_utils.Varstored domid) () @@ -4315,13 +3912,14 @@ module Dm = struct (* Start DEMU and wait until it has reached the desired state *) let state_path = Printf.sprintf "/local/domain/%d/vgpu/state" domid in let cancel = Cancel_utils.Vgpu domid in - if not (Vgpu.is_running ~xs domid) then ( + if not (Service.Vgpu.is_running ~xs domid) then ( let pcis = List.map (fun x -> x.physical_pci_address) vgpus in PCI.bind pcis PCI.Nvidia ; let module Q = (val Backend.of_profile profile) in let args = vgpu_args_of_nvidia domid vcpus vgpus restore in let vgpu_pid = - Vgpu.start_daemon ~path:!Xc_resources.vgpu ~args ~domid ~fds:[] () + Service.Vgpu.start_daemon ~path:!Xc_resources.vgpu ~args ~domid + ~fds:[] () in wait_path ~pidalive:(pid_alive vgpu_pid) ~task ~name:"vgpu" ~domid ~xs ~ready_path:state_path @@ -4492,8 +4090,8 @@ module Dm = struct Printf.sprintf "unknown" ) in - if not (Qemu.SignalMask.has Qemu.signal_mask domid) then - match Qemu.pid ~xs domid with + if not Service.Qemu.(SignalMask.has signal_mask domid) then + match Service.Qemu.pid ~xs domid with | None -> (* after expected qemu stop or domain xs tree destroyed: this event arrived too late, nothing to do *) @@ -4504,7 +4102,9 @@ module Dm = struct | Some _ -> (* before expected qemu stop: qemu-pid is available in domain xs tree: signal action to take *) - xs.Xs.write (Qemu.pid_path_signal domid) crash_reason + xs.Xs.write + (Service.Qemu.pid_path_signal domid) + crash_reason ) ) @@ -4521,7 +4121,7 @@ module Dm = struct let suspend_varstored (_ : Xenops_task.task_handle) ~xs domid ~vm_uuid = debug "Called Dm.suspend_varstored (domid=%d)" domid ; - Varstored.stop ~xs domid ; + Service.Varstored.stop ~xs domid ; Xenops_sandbox.Varstore_guard.read ~domid efivars_save_path ~vm_uuid let restore_varstored (_ : Xenops_task.task_handle) ~xs ~efivars domid = @@ -4539,7 +4139,7 @@ module Dm = struct debug "Called Dm.suspend_vtpms (domid=%d)" domid ; Option.map (fun (Xenops_interface.Vm.Vtpm _vtpm_uuid) -> - Swtpm.suspend ~xs ~domid ~vm_uuid + Service.Swtpm.suspend ~xs ~domid ~vm_uuid ) vtpm |> Option.to_list @@ -4548,7 +4148,7 @@ module Dm = struct 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 + Service.Swtpm.restore ~domid ~vm_uuid contents end (* Dm *) @@ -4591,16 +4191,16 @@ let clean_shutdown (task : Xenops_task.task_handle) ~xs (x : device) = let get_vnc_port ~xs ~dm domid = (* Check whether a qemu exists for this domain *) - let qemu_exists = Qemu.is_running ~xs domid in + let qemu_exists = Service.Qemu.is_running ~xs domid in if qemu_exists then Dm.get_vnc_port ~xs ~dm domid else - PV_Vnc.get_vnc_port ~xs domid + Service.PV_Vnc.get_vnc_port ~xs domid let get_tc_port ~xs domid = (* Check whether a qemu exists for this domain *) - let qemu_exists = Qemu.is_running ~xs domid in + let qemu_exists = Service.Qemu.is_running ~xs domid in if qemu_exists then Dm.get_tc_port ~xs domid else - PV_Vnc.get_tc_port ~xs domid + Service.PV_Vnc.get_tc_port ~xs domid diff --git a/ocaml/xenopsd/xc/device.mli b/ocaml/xenopsd/xc/device.mli index 051b46f29e8..24e4b9eddfe 100644 --- a/ocaml/xenopsd/xc/device.mli +++ b/ocaml/xenopsd/xc/device.mli @@ -58,11 +58,6 @@ module Profile : sig [fallback] if an invalid name is provided. *) end -(** Represent an IPC endpoint *) -module Socket : sig - type t = Unix of string | Port of int -end - module Generic : sig val rm_device_state : xs:Xenstore.Xs.xsh -> device -> unit @@ -225,55 +220,6 @@ module Vcpu : sig val status : xs:Xenstore.Xs.xsh -> dm:Profile.t -> devid:int -> int -> bool end -module PV_Vnc : sig - exception Failed_to_start - - val save : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit - - val get_statefile : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> string option - - val start : - ?statefile:string - -> xs:Xenstore.Xs.xsh - -> ?ip:string - -> Xenctrl.domid - -> unit - - val stop : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit - - val get_vnc_port : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> Socket.t option - - val get_tc_port : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option -end - -module Qemu : sig - module SignalMask : sig - type t - - val create : unit -> t - - val set : t -> int -> unit - - val unset : t -> int -> unit - - val has : t -> int -> bool - end - - val signal_mask : SignalMask.t - - val pid_path_signal : Xenctrl.domid -> string - - val pid : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option - - val is_running : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> bool -end - -module Vgpu : sig - val pid : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option - - val is_running : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> bool -end - module PCI : sig open Xenops_interface.Pci @@ -392,7 +338,10 @@ module Dm : sig } val get_vnc_port : - xs:Xenstore.Xs.xsh -> dm:Profile.t -> Xenctrl.domid -> Socket.t option + xs:Xenstore.Xs.xsh + -> dm:Profile.t + -> Xenctrl.domid + -> Xenops_utils.Socket.t option val get_tc_port : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option @@ -549,6 +498,9 @@ module Vusb : sig end val get_vnc_port : - xs:Xenstore.Xs.xsh -> dm:Profile.t -> Xenctrl.domid -> Socket.t option + xs:Xenstore.Xs.xsh + -> dm:Profile.t + -> Xenctrl.domid + -> Xenops_utils.Socket.t option val get_tc_port : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option diff --git a/ocaml/xenopsd/xc/domain.ml b/ocaml/xenopsd/xc/domain.ml index e0493984365..b16eef54374 100644 --- a/ocaml/xenopsd/xc/domain.ml +++ b/ocaml/xenopsd/xc/domain.ml @@ -694,7 +694,7 @@ let destroy (task : Xenops_task.task_handle) ~xc ~xs ~qemu_domid ~vtpm ~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) + (fun () -> Service.PV_Vnc.stop ~xs domid) () ; (* Forcibly shutdown every backend *) List.iter diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index 228f45996b0..1fd194cdd8f 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -5,6 +5,8 @@ module Unixext = Xapi_stdext_unix.Unixext module Xenops_task = Xenops_task.Xenops_task module Chroot = Xenops_sandbox.Chroot module Path = Chroot.Path +module Xs = Xenstore.Xs +module Socket = Xenops_utils.Socket let defer f g = Xapi_stdext_pervasives.Pervasiveext.finally g f @@ -164,3 +166,407 @@ let start_and_wait_for_readyness ~task ~service = (wait ~for_s:service.timeout_seconds ~service_name:syslog_key) ; debug "Service %s initialized" syslog_key + +module type DAEMONPIDPATH = sig + val name : string + + val use_pidfile : bool + + val pid_path : int -> string +end + +module DaemonMgmt (D : DAEMONPIDPATH) = struct + module SignalMask = struct + module H = Hashtbl + + type t = (int, bool) H.t + + let create () = H.create 16 + + let set tbl key = H.replace tbl key true + + let unset tbl key = H.remove tbl key + + let has tbl key = H.mem tbl key + end + + let signal_mask = SignalMask.create () + + let name = D.name + + let pid_path = D.pid_path + + let pid_path_signal domid = pid_path domid ^ "-signal" + + let pidfile_path domid = + if D.use_pidfile then + Some + (Printf.sprintf "%s/%s-%d.pid" Device_common.var_run_xen_path D.name + domid + ) + else + None + + let pid ~xs domid = + try + match pidfile_path domid with + | Some path when Sys.file_exists path -> + let pid = + path |> Unixext.string_of_file |> String.trim |> int_of_string + in + Unixext.with_file path [Unix.O_RDONLY] 0 (fun fd -> + try + Unix.lockf fd Unix.F_TRLOCK 0 ; + (* we succeeded taking the lock: original process is dead. + * some other process might've reused its pid *) + None + with Unix.Unix_error (Unix.EAGAIN, _, _) -> + (* cannot obtain lock: process is alive *) + Some pid + ) + | _ -> + (* backward compatibility during update installation: only has + xenstore pid *) + let pid = xs.Xs.read (pid_path domid) in + Some (int_of_string pid) + with _ -> None + + let is_running ~xs domid = + match pid ~xs domid with + | None -> + false + | Some p -> ( + try Unix.kill p 0 ; (* This checks the existence of pid p *) + true + with _ -> false + ) + + let stop ~xs domid = + match pid ~xs domid with + | None -> + () + | Some pid -> ( + let best_effort = Xenops_utils.best_effort in + let really_kill = Xenops_utils.really_kill in + debug "%s: stopping %s with SIGTERM (domid = %d pid = %d)" D.name D.name + domid pid ; + best_effort (Printf.sprintf "killing %s" D.name) (fun () -> + really_kill pid + ) ; + let key = pid_path domid in + best_effort (Printf.sprintf "removing XS key %s" key) (fun () -> + xs.Xs.rm key + ) ; + match pidfile_path domid with + | None -> + () + | Some path -> + best_effort (Printf.sprintf "removing %s" path) (fun () -> + Unix.unlink path + ) + ) + + let syslog_key ~domid = Printf.sprintf "%s-%d" D.name domid + + let start ~fds ~syslog_key path args = + let syslog_stdout = Forkhelpers.Syslog_WithKey syslog_key in + let redirect_stderr_to_stdout = true in + let pid = + Forkhelpers.safe_close_and_exec None None None fds ~syslog_stdout + ~redirect_stderr_to_stdout path args + in + debug + "%s: should be running in the background (stdout -> syslog); (fd,pid) = \ + %s" + D.name + (Forkhelpers.string_of_pidty pid) ; + pid + + (* Forks a daemon and then returns the pid. *) + let start_daemon ~path ~args ~domid ?(fds = []) () = + let syslog_key = syslog_key ~domid in + debug "Starting daemon: %s with args [%s]" path (String.concat "; " args) ; + let pid = start ~fds ~syslog_key path args in + debug "Daemon started: %s" syslog_key ; + pid +end + +module Qemu = DaemonMgmt (struct + let name = "qemu-dm" + + let use_pidfile = true + + let pid_path domid = Printf.sprintf "/local/domain/%d/qemu-pid" domid +end) + +module Vgpu = DaemonMgmt (struct + let name = "vgpu" + + let use_pidfile = false + + let pid_path domid = Printf.sprintf "/local/domain/%d/vgpu-pid" domid +end) + +module SystemdDaemonMgmt (D : DAEMONPIDPATH) = struct + (* backward compat: for daemons running during an update *) + module Compat = DaemonMgmt (D) + + let pidfile_path = Compat.pidfile_path + + let pid_path = Compat.pid_path + + let of_domid domid = + let key = Compat.syslog_key ~domid in + if Fe_systemctl.exists ~service:key then + Some key + else + None + + let is_running ~xs domid = + match of_domid domid with + | None -> + Compat.is_running ~xs domid + | Some key -> + Fe_systemctl.is_active ~service:key + + let alive service _ = + if Fe_systemctl.is_active ~service then + true + else + let status = Fe_systemctl.show ~service in + let open Fe_systemctl in + error + "%s: unexpected termination \ + (Result=%s,ExecMainPID=%d,ExecMainStatus=%d,ActiveState=%s)" + service status.result status.exec_main_pid status.exec_main_status + status.active_state ; + false + + let stop ~xs domid = + match of_domid domid with + | None -> + Compat.stop ~xs domid + | Some service -> + (* xenstore cleanup is done by systemd unit file *) + let (_ : Fe_systemctl.status) = Fe_systemctl.stop ~service in + () + + let start_daemon ~path ~args ~domid () = + debug "Starting daemon: %s with args [%s]" path (String.concat "; " args) ; + let service = Compat.syslog_key ~domid in + let pidpath = D.pid_path domid in + let properties = + ("ExecStopPost", "-/usr/bin/xenstore-rm " ^ pidpath) + :: + ( match Compat.pidfile_path domid with + | None -> + [] + | Some path -> + [("ExecStopPost", "-/bin/rm -f " ^ path)] + ) + in + Fe_systemctl.start_transient ~properties ~service path args ; + debug "Daemon started: %s" service ; + service +end + +module Varstored = SystemdDaemonMgmt (struct + let name = "varstored" + + let use_pidfile = true + + let pid_path domid = Printf.sprintf "/local/domain/%d/varstored-pid" domid +end) + +(* 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 pid_path domid = Printf.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 ~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 ~chroot ~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 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 ~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 + let name = "vncterm" + + let use_pidfile = false + + let pid_path domid = Printf.sprintf "/local/domain/%d/vncterm-pid" domid + end) + + let vnc_console_path domid = Printf.sprintf "/local/domain/%d/console" domid + + let vnc_port_path domid = + Printf.sprintf "/local/domain/%d/console/vnc-port" domid + + let tc_port_path domid = + Printf.sprintf "/local/domain/%d/console/tc-port" domid + + let pid ~xs domid = D.pid ~xs domid + + (* Look up the commandline args for the vncterm pid; *) + (* Check that they include the vncterm binary path and the xenstore console + path for the supplied domid. *) + let is_cmdline_valid domid pid = + try + let cmdline = + Printf.sprintf "/proc/%d/cmdline" pid + |> Unixext.string_of_file + |> Astring.String.cuts ~sep:"\000" + in + List.mem !Xc_resources.vncterm cmdline + && List.mem (vnc_console_path domid) cmdline + with _ -> false + + let is_vncterm_running ~xs domid = + match pid ~xs domid with + | None -> + false + | Some p -> + D.is_running ~xs domid && is_cmdline_valid domid p + + let get_vnc_port ~xs domid = + if not (is_vncterm_running ~xs domid) then + None + else + try Some (Socket.Port (int_of_string (xs.Xs.read (vnc_port_path domid)))) + with _ -> None + + let get_tc_port ~xs domid = + if not (is_vncterm_running ~xs domid) then + None + else + try Some (int_of_string (xs.Xs.read (tc_port_path domid))) + with _ -> None + + let load_args = function + | None -> + [] + | Some filename -> + if Sys.file_exists filename then + ["-l"; filename] + else + [] + + exception Failed_to_start + + let vncterm_statefile pid = + Printf.sprintf "/var/xen/vncterm/%d/vncterm.statefile" pid + + let get_statefile ~xs domid = + match pid ~xs domid with + | None -> + None + | Some pid -> + let filename = vncterm_statefile pid in + if Sys.file_exists filename then + Some filename + else + None + + let save ~xs domid = + match pid ~xs domid with + | Some pid -> + Unix.kill pid Sys.sigusr1 ; + let filename = vncterm_statefile pid in + let delay = 10. in + let start_time = Unix.time () in + (* wait at most ten seconds *) + while + (not (Sys.file_exists filename)) || Unix.time () -. start_time > delay + do + debug "Device.PV_Vnc.save: waiting for %s to appear" filename ; + Thread.delay 1. + done ; + if Unix.time () -. start_time > delay then + debug "Device.PV_Vnc.save: timeout while waiting for %s to appear" + filename + else + debug "Device.PV_Vnc.save: %s has appeared" filename + | None -> + () + + let start ?statefile ~xs ?ip domid = + debug "In PV_Vnc.start" ; + let ip = Option.value ~default:"127.0.0.1" ip in + let l = + [ + "-x" + ; Printf.sprintf "/local/domain/%d/console" domid + ; "-T" + ; (* listen for raw connections *) + "-v" + ; ip ^ ":1" + ] + @ load_args statefile + in + (* Now add the close fds wrapper *) + let pid = D.start_daemon ~path:!Xc_resources.vncterm ~args:l ~domid () in + let path = D.pid_path domid in + xs.Xs.write path (string_of_int (Forkhelpers.getpid pid)) ; + Forkhelpers.dontwaitpid pid + + let stop ~xs domid = D.stop ~xs domid +end diff --git a/ocaml/xenopsd/xc/service.mli b/ocaml/xenopsd/xc/service.mli index 0f23cbb24da..f876d7a75fc 100644 --- a/ocaml/xenopsd/xc/service.mli +++ b/ocaml/xenopsd/xc/service.mli @@ -13,3 +13,127 @@ type t = { val start_and_wait_for_readyness : task:Xenops_task.Xenops_task.task_handle -> service:t -> unit + +module Qemu : sig + module SignalMask : sig + type t + + val create : unit -> t + + val set : t -> int -> unit + + val unset : t -> int -> unit + + val has : t -> int -> bool + end + + val signal_mask : SignalMask.t + + val name : string + + val pid_path_signal : Xenctrl.domid -> string + + val pidfile_path : Xenctrl.domid -> string option + (** path of file containing the pid value *) + + val pid_path : Xenctrl.domid -> string + (** xenstore key containing the pid value *) + + val start_daemon : + path:string + -> args:string list + -> domid:Xenctrl.domid + -> ?fds:(string * Unix.file_descr) list + -> unit + -> Forkhelpers.pidty + + val pid : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option + + val is_running : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> bool +end + +module Vgpu : sig + val start_daemon : + path:string + -> args:string list + -> domid:Xenctrl.domid + -> ?fds:(string * Unix.file_descr) list + -> unit + -> Forkhelpers.pidty + + val pid : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option + + val is_running : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> bool + + val stop : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit +end + +module PV_Vnc : sig + exception Failed_to_start + + val vnc_port_path : Xenctrl.domid -> string + + val tc_port_path : Xenctrl.domid -> string + + val save : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit + + val get_statefile : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> string option + + val start : + ?statefile:string + -> xs:Xenstore.Xs.xsh + -> ?ip:string + -> Xenctrl.domid + -> unit + + val stop : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit + + val get_vnc_port : + xs:Xenstore.Xs.xsh -> Xenctrl.domid -> Xenops_utils.Socket.t option + + val get_tc_port : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option +end + +module Varstored : sig + val pidfile_path : Xenctrl.domid -> string option + (** path of file containing the pid value *) + + val pid_path : Xenctrl.domid -> string + (** xenstore key containing the pid value *) + + val start_daemon : + path:string -> args:string list -> domid:Xenctrl.domid -> unit -> string + + val alive : string -> 'a -> bool + + val stop : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit +end + +module Swtpm : sig + val state_path : Xenops_sandbox.Chroot.Path.t + + val start_daemon : + string + -> xs:Xenstore.Xs.xsh + -> chroot:Xenops_sandbox.Chroot.t + -> path:string + -> args:string list + -> domid:Xenctrl.domid + -> vm_uuid:string + -> vtpm_uuid:Varstore_privileged_interface.Uuidm.t + -> index:int + -> unit + -> string + + val restore : domid:int -> vm_uuid:string -> string -> unit + + val suspend : xs:Xenstore.Xs.xsh -> domid:int -> vm_uuid:string -> string + + val stop : + string + -> xs:Xenstore.Xs.xsh + -> domid:int + -> vm_uuid:string + -> vtpm_uuid:Varstore_privileged_interface.Uuidm.t + -> unit +end diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index ea98a813f3a..f60f4f32b31 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -1684,7 +1684,7 @@ module VM = struct ) () ; log_exn_continue "Error stoping vncterm, already dead ?" - (fun () -> Device.PV_Vnc.stop ~xs domid) + (fun () -> Service.PV_Vnc.stop ~xs domid) () (* If qemu is in a different domain to storage, detach disks *) ) @@ -1742,7 +1742,7 @@ module VM = struct (fun () -> (* Finally, discard any device caching for the domid destroyed *) DeviceCache.discard device_cache di.Xenctrl.domid ; - Device.(Qemu.SignalMask.unset Qemu.signal_mask di.Xenctrl.domid) + Service.Qemu.(SignalMask.unset signal_mask di.Xenctrl.domid) ) ) @@ -2256,7 +2256,7 @@ module VM = struct match vm.Vm.ty with | Vm.PV {vncterm= true; vncterm_ip= ip; _} | Vm.PVinPVH {vncterm= true; vncterm_ip= ip; _} -> - Device.PV_Vnc.start ~xs ?ip di.Xenctrl.domid + Service.PV_Vnc.start ~xs ?ip di.Xenctrl.domid | _ -> () with Device.Ioemu_failed (name, msg) -> @@ -2731,9 +2731,9 @@ module VM = struct let vnc = Option.map (function - | Device.Socket.Port port -> + | Xenops_utils.Socket.Port port -> {Vm.protocol= Vm.Rfb; port; path= ""} - | Device.Socket.Unix path -> + | Xenops_utils.Socket.Unix path -> {Vm.protocol= Vm.Rfb; port= 0; path} ) (Device.get_vnc_port ~xs ~dm:(dm_of ~vm) di.Xenctrl.domid) @@ -3442,9 +3442,9 @@ module VGPU = struct let emulator_pid = match vgpu.implementation with | Empty | MxGPU _ | GVT_g _ -> - Device.Qemu.pid ~xs frontend_domid + Service.Qemu.pid ~xs frontend_domid | Nvidia _ -> - Device.Vgpu.pid ~xs frontend_domid + Service.Vgpu.pid ~xs frontend_domid in match emulator_pid with | Some _ -> @@ -3463,7 +3463,7 @@ module VUSB = struct let get_state vm vusb = on_frontend (fun _ xs frontend_domid _ -> - let emulator_pid = Device.Qemu.pid ~xs frontend_domid in + let emulator_pid = Service.Qemu.pid ~xs frontend_domid in debug "Qom list to get vusb state" ; let peripherals = Device.Vusb.qom_list ~xs ~domid:frontend_domid in let found = List.mem (snd vusb.Vusb.id) peripherals in @@ -4877,7 +4877,7 @@ module Actions = struct ; sprintf "/local/domain/%d/memory/uncooperative" domid ; sprintf "/local/domain/%d/console/vnc-port" domid ; sprintf "/local/domain/%d/console/tc-port" domid - ; Device.Qemu.pid_path_signal domid + ; Service.Qemu.pid_path_signal domid ; sprintf "/local/domain/%d/control" domid ; sprintf "/local/domain/%d/device" domid ; sprintf "/local/domain/%d/rrd" domid @@ -5054,7 +5054,8 @@ module Actions = struct debug "Ignoring qemu-pid-signal watch on shutdown domain %d" d else let signal = - try Some (xs.Xs.read (Device.Qemu.pid_path_signal d)) with _ -> None + try Some (xs.Xs.read (Service.Qemu.pid_path_signal d)) + with _ -> None in match signal with | None -> From c516727be6e6433403b36639b4d9f052fb30daa1 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 19 May 2022 14:26:47 +0100 Subject: [PATCH 27/53] xenopsd/xc/service: add licensing header Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/service.ml | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index 1fd194cdd8f..63f1e9bf744 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -1,3 +1,16 @@ +(* Copyright (C) Citrix Systems Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published + by the Free Software Foundation; version 2.1 only. with the special + exception on linking described in file LICENSE. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + *) + module D = Debug.Make (struct let name = "service" end) open! D From 500bbab1e5e0bac85cf9ac73972cabb1ef8e2bf1 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 19 May 2022 14:47:46 +0100 Subject: [PATCH 28/53] CP-39894: Move all swtpm starting code to service module This allows to remove the waiting function from the interface Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/device.ml | 39 +------------------------------- ocaml/xenopsd/xc/service.ml | 43 ++++++++++++++++++++++++++++++++---- ocaml/xenopsd/xc/service.mli | 29 ++++-------------------- 3 files changed, 44 insertions(+), 67 deletions(-) diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index 492f4e21b2e..65454ec7599 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -3804,43 +3804,6 @@ module Dm = struct (* the following functions depend on the functions above that use the qemu backend Q *) - 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 = !Resources.swtpm_wrapper in - let name = "swtpm" in - let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuid.to_string in - - let chroot, _socket_path = - Xenops_sandbox.Swtpm_guard.start (Xenops_task.get_dbg task) ~vm_uuid - ~domid ~paths:[] - in - let tpm_root = - Xenops_sandbox.Chroot.(absolute_path_outside chroot Path.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 Service.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 dbg = Xenops_task.get_dbg task in - let execute = - Service.Swtpm.start_daemon dbg ~xs ~chroot ~vtpm_uuid ~vm_uuid ~index - in - let service = - {Service.name; domid; exec_path; chroot; args; execute; timeout_seconds} - in - Service.start_and_wait_for_readyness ~task ~service ; - (* return the socket path so qemu can have a reference to it*) - Xenops_sandbox.Chroot.( - absolute_path_outside chroot (Path.of_string ~relative:"swtpm-sock") - ) - let start_varstored ~xs ~nvram ?(restore = false) (task : Xenops_task.task_handle) domid = let open Xenops_types in @@ -4002,7 +3965,7 @@ module Dm = struct match info.tpm with | Some (Vtpm vtpm_uuid) -> let tpm_socket_path = - start_swtpm ~xs task domid ~vtpm_uuid ~index:0 + Service.Swtpm.start ~xs task domid ~vtpm_uuid ~index:0 in [ "-chardev" diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index 63f1e9bf744..8748b106640 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -9,7 +9,7 @@ but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. - *) +*) module D = Debug.Make (struct let name = "service" end) @@ -421,12 +421,41 @@ module Swtpm = struct ) else debug "vTPM state for domid %d is empty: not restoring" domid - let start_daemon dbg ~xs ~chroot ~path ~args ~domid ~vm_uuid ~vtpm_uuid ~index - () = + let start ~xs ~vtpm_uuid ~index task domid = + debug "Preparing to start swtpm-wrapper to provide a vTPM (domid=%d)" domid ; + 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 + + let chroot, _socket_path = + Xenops_sandbox.Swtpm_guard.start (Xenops_task.get_dbg task) ~vm_uuid + ~domid ~paths:[] + in + let tpm_root = + Xenops_sandbox.Chroot.(absolute_path_outside chroot Path.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 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 = D.start_daemon in + let service = + {name; domid; exec_path; chroot; args; execute; timeout_seconds} + in + + let dbg = Xenops_task.get_dbg task in let state = Varstore_privileged_client.Client.vtpm_get_contents dbg vtpm_uuid |> Base64.decode_exn in + let abs_path = Xenops_sandbox.Chroot.absolute_path_outside chroot state_path in @@ -435,10 +464,16 @@ module Swtpm = struct else restore ~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 () + + start_and_wait_for_readyness ~task ~service ; + (* return the socket path so qemu can have a reference to it*) + Xenops_sandbox.Chroot.( + absolute_path_outside chroot (Path.of_string ~relative:"swtpm-sock") + ) let suspend ~xs ~domid ~vm_uuid = D.stop ~xs domid ; diff --git a/ocaml/xenopsd/xc/service.mli b/ocaml/xenopsd/xc/service.mli index f876d7a75fc..b5cdb023205 100644 --- a/ocaml/xenopsd/xc/service.mli +++ b/ocaml/xenopsd/xc/service.mli @@ -1,19 +1,5 @@ exception Service_failed of (string * string) -type t = { - name: string - ; domid: Xenctrl.domid - ; exec_path: string - ; chroot: Xenops_sandbox.Chroot.t - ; timeout_seconds: float - ; args: string list - ; execute: - path:string -> args:string list -> domid:Xenctrl.domid -> unit -> string -} - -val start_and_wait_for_readyness : - task:Xenops_task.Xenops_task.task_handle -> service:t -> unit - module Qemu : sig module SignalMask : sig type t @@ -110,19 +96,12 @@ module Varstored : sig end module Swtpm : sig - val state_path : Xenops_sandbox.Chroot.Path.t - - val start_daemon : - string - -> xs:Xenstore.Xs.xsh - -> chroot:Xenops_sandbox.Chroot.t - -> path:string - -> args:string list - -> domid:Xenctrl.domid - -> vm_uuid:string + val start : + xs:Xenstore.Xs.xsh -> vtpm_uuid:Varstore_privileged_interface.Uuidm.t -> index:int - -> unit + -> Xenops_task.Xenops_task.task_handle + -> Xenctrl.domid -> string val restore : domid:int -> vm_uuid:string -> string -> unit From 816d4abdb0698c7be7f02abf3964dc1e4eb2ee62 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 19 May 2022 15:10:17 +0100 Subject: [PATCH 29/53] CP-39894: move all varstored starting code to service module This forces to move the wait_path function there as well as the efivar variables. They all need to be exposed in the interface so they can be used from device.ml. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/device.ml | 98 ++-------------------------- ocaml/xenopsd/xc/service.ml | 122 ++++++++++++++++++++++++++++++++--- ocaml/xenopsd/xc/service.mli | 29 ++++++--- 3 files changed, 139 insertions(+), 110 deletions(-) diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index 65454ec7599..8dc517a49a7 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -2052,11 +2052,9 @@ module Dm_Common = struct let vnc_socket_path = (sprintf "%s/vnc-%d") Device_common.var_run_xen_path - let efivars_resume_path = - Xenops_sandbox.Chroot.Path.of_string ~relative:"efi-vars-resume.dat" + let efivars_resume_path = Service.Varstored.efivars_resume_path - let efivars_save_path = - Xenops_sandbox.Chroot.Path.of_string ~relative:"efi-vars-save.dat" + let efivars_save_path = Service.Varstored.efivars_save_path let get_vnc_port ~xs domid ~f = match Service.Qemu.is_running ~xs domid with true -> f () | false -> None @@ -2362,26 +2360,6 @@ module Dm_Common = struct error "%s: unexpected signal: %d" name n ; false - (* Waits for a daemon to signal startup by writing to a xenstore path - (optionally with a given value) If this doesn't happen in the timeout then - an exception is raised *) - let wait_path ~pidalive ~task ~name ~domid ~xs ~ready_path ~timeout ~cancel _ - = - let syslog_key = Printf.sprintf "%s-%d" name domid in - let watch = Watch.value_to_appear ready_path |> Watch.map (fun _ -> ()) in - Xenops_task.check_cancelling task ; - ( try - let (_ : bool) = - cancellable_watch cancel [watch] [] task ~xs ~timeout () - in - () - with Watch.Timeout _ -> - if pidalive name then - raise (Ioemu_failed (name, "Timeout reached while starting daemon")) ; - raise (Ioemu_failed (name, "Daemon exited unexpectedly")) - ) ; - debug "Daemon initialised: %s" syslog_key - let gimtool_m = Mutex.create () let resume (task : Xenops_task.task_handle) ~xs ~qemu_domid domid = @@ -3804,70 +3782,6 @@ module Dm = struct (* the following functions depend on the functions above that use the qemu backend Q *) - let start_varstored ~xs ~nvram ?(restore = false) - (task : Xenops_task.task_handle) domid = - let open Xenops_types in - debug "Preparing to start varstored for UEFI boot (domid=%d)" domid ; - let path = !Xc_resources.varstored in - let name = "varstored" in - let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuid.to_string in - let reset_on_boot = - nvram.Nvram_uefi_variables.on_boot = Nvram_uefi_variables.Reset - in - let backend = nvram.Nvram_uefi_variables.backend in - let open Fe_argv in - let argf fmt = ksprintf (fun s -> ["--arg"; s]) fmt in - let on cond value = if cond then value else return () in - let chroot, socket_path = - Xenops_sandbox.Varstore_guard.start (Xenops_task.get_dbg task) ~vm_uuid - ~domid ~paths:[efivars_save_path] - in - let args = - Add.many - [ - "--domain" - ; string_of_int domid - ; "--chroot" - ; chroot.root - ; "--depriv" - ; "--uid" - ; string_of_int chroot.uid - ; "--gid" - ; string_of_int chroot.gid - ; "--backend" - ; backend - ; "--arg" - ; Printf.sprintf "socket:%s" socket_path - ] - >>= fun () -> - (Service.Varstored.pidfile_path domid |> function - | None -> - return () - | Some x -> - Add.many ["--pidfile"; x] - ) - >>= fun () -> - Add.many @@ argf "uuid:%s" vm_uuid >>= fun () -> - on reset_on_boot @@ Add.arg "--nonpersistent" >>= fun () -> - on restore @@ Add.arg "--resume" >>= fun () -> - on restore - @@ Add.many - @@ argf "resume:%s" - (Xenops_sandbox.Chroot.chroot_path_inside efivars_resume_path) - >>= fun () -> - Add.many - @@ argf "save:%s" - (Xenops_sandbox.Chroot.chroot_path_inside efivars_save_path) - in - let args = Fe_argv.run args |> snd |> Fe_argv.argv in - let service = Service.Varstored.start_daemon ~path ~args ~domid () in - let ready_path = Service.Varstored.pid_path domid in - wait_path - ~pidalive:(Service.Varstored.alive service) - ~task ~name ~domid ~xs ~ready_path - ~timeout:!Xenopsd.varstored_ready_timeout - ~cancel:(Cancel_utils.Varstored domid) () - let start_vgpu ~xc:_ ~xs task ?(restore = false) domid vgpus vcpus profile = let open Xenops_interface.Vgpu in match vgpus with @@ -3884,8 +3798,8 @@ module Dm = struct Service.Vgpu.start_daemon ~path:!Xc_resources.vgpu ~args ~domid ~fds:[] () in - wait_path ~pidalive:(pid_alive vgpu_pid) ~task ~name:"vgpu" ~domid ~xs - ~ready_path:state_path + Service.Vgpu.wait_path ~pidalive:(pid_alive vgpu_pid) ~task + ~name:"vgpu" ~domid ~xs ~ready_path:state_path ~timeout:!Xenopsd.vgpu_ready_timeout ~cancel () ; Forkhelpers.dontwaitpid vgpu_pid @@ -3954,8 +3868,8 @@ module Dm = struct (* start varstored if appropriate *) ( match info.firmware with | Uefi nvram_uefi -> - start_varstored ~restore:(action = Restore) ~xs ~nvram:nvram_uefi task - domid + Service.Varstored.start ~restore:(action = Restore) ~xs + ~nvram:nvram_uefi task domid | Bios -> () ) ; diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index 8748b106640..ddc81921ae6 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -180,6 +180,25 @@ let start_and_wait_for_readyness ~task ~service = debug "Service %s initialized" syslog_key +(* Waits for a daemon to signal startup by writing to a xenstore path + (optionally with a given value) If this doesn't happen in the timeout then + an exception is raised *) +let wait_path ~pidalive ~task ~name ~domid ~xs ~ready_path ~timeout ~cancel _ = + let syslog_key = Printf.sprintf "%s-%d" name domid in + let watch = Watch.value_to_appear ready_path |> Watch.map (fun _ -> ()) in + Xenops_task.check_cancelling task ; + ( try + let (_ : bool) = + Cancel_utils.cancellable_watch cancel [watch] [] task ~xs ~timeout () + in + () + with Watch.Timeout _ -> + if pidalive name then + raise (Service_failed (name, "Timeout reached while starting daemon")) ; + raise (Service_failed (name, "Daemon exited unexpectedly")) + ) ; + debug "Daemon initialised: %s" syslog_key + module type DAEMONPIDPATH = sig val name : string @@ -312,13 +331,25 @@ module Qemu = DaemonMgmt (struct let pid_path domid = Printf.sprintf "/local/domain/%d/qemu-pid" domid end) -module Vgpu = DaemonMgmt (struct - let name = "vgpu" +module Vgpu = struct + module D = DaemonMgmt (struct + let name = "vgpu" - let use_pidfile = false + let use_pidfile = false - let pid_path domid = Printf.sprintf "/local/domain/%d/vgpu-pid" domid -end) + let pid_path domid = Printf.sprintf "/local/domain/%d/vgpu-pid" domid + end) + + let start_daemon = D.start_daemon + + let pid = D.pid + + let is_running = D.is_running + + let stop = D.stop + + let wait_path = wait_path +end module SystemdDaemonMgmt (D : DAEMONPIDPATH) = struct (* backward compat: for daemons running during an update *) @@ -383,13 +414,84 @@ module SystemdDaemonMgmt (D : DAEMONPIDPATH) = struct service end -module Varstored = SystemdDaemonMgmt (struct - let name = "varstored" +module Varstored = struct + module D = SystemdDaemonMgmt (struct + let name = "varstored" + + let use_pidfile = true - let use_pidfile = true + let pid_path domid = Printf.sprintf "/local/domain/%d/varstored-pid" domid + end) - let pid_path domid = Printf.sprintf "/local/domain/%d/varstored-pid" domid -end) + let efivars_resume_path = + Xenops_sandbox.Chroot.Path.of_string ~relative:"efi-vars-resume.dat" + + let efivars_save_path = + Xenops_sandbox.Chroot.Path.of_string ~relative:"efi-vars-save.dat" + + let start ~xs ~nvram ?(restore = false) task domid = + let open Xenops_types in + debug "Preparing to start varstored for UEFI boot (domid=%d)" domid ; + let path = !Xc_resources.varstored in + let name = "varstored" in + let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuid.to_string in + let reset_on_boot = + nvram.Nvram_uefi_variables.on_boot = Nvram_uefi_variables.Reset + in + let backend = nvram.Nvram_uefi_variables.backend in + let open Fe_argv in + let argf fmt = Printf.ksprintf (fun s -> ["--arg"; s]) fmt in + let on cond value = if cond then value else return () in + let chroot, socket_path = + Xenops_sandbox.Varstore_guard.start (Xenops_task.get_dbg task) ~vm_uuid + ~domid ~paths:[efivars_save_path] + in + let args = + Add.many + [ + "--domain" + ; string_of_int domid + ; "--chroot" + ; chroot.root + ; "--depriv" + ; "--uid" + ; string_of_int chroot.uid + ; "--gid" + ; string_of_int chroot.gid + ; "--backend" + ; backend + ; "--arg" + ; Printf.sprintf "socket:%s" socket_path + ] + >>= fun () -> + (D.pidfile_path domid |> function + | None -> + return () + | Some x -> + Add.many ["--pidfile"; x] + ) + >>= fun () -> + Add.many @@ argf "uuid:%s" vm_uuid >>= fun () -> + on reset_on_boot @@ Add.arg "--nonpersistent" >>= fun () -> + on restore @@ Add.arg "--resume" >>= fun () -> + on restore + @@ Add.many + @@ argf "resume:%s" + (Xenops_sandbox.Chroot.chroot_path_inside efivars_resume_path) + >>= fun () -> + Add.many + @@ argf "save:%s" + (Xenops_sandbox.Chroot.chroot_path_inside efivars_save_path) + in + let args = Fe_argv.run args |> snd |> Fe_argv.argv in + let service = D.start_daemon ~path ~args ~domid () in + let ready_path = D.pid_path domid in + wait_path ~pidalive:(D.alive service) ~task ~name ~domid ~xs ~ready_path + ~timeout:!Xenopsd.varstored_ready_timeout + ~cancel:(Cancel_utils.Varstored domid) () + + let stop = D.stop +end (* TODO: struct and include and uri to uri mapper, etc. also xapi needs default backend set diff --git a/ocaml/xenopsd/xc/service.mli b/ocaml/xenopsd/xc/service.mli index b5cdb023205..57c89b1fe7b 100644 --- a/ocaml/xenopsd/xc/service.mli +++ b/ocaml/xenopsd/xc/service.mli @@ -52,6 +52,18 @@ module Vgpu : sig val is_running : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> bool val stop : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit + + val wait_path : + pidalive:(string -> bool) + -> task:Xenops_task.Xenops_task.task_handle + -> name:string + -> domid:int + -> xs:Xenstore.Xs.xsh + -> ready_path:Watch.path + -> timeout:float + -> cancel:Cancel_utils.key + -> 'a + -> unit end module PV_Vnc : sig @@ -81,16 +93,17 @@ module PV_Vnc : sig end module Varstored : sig - val pidfile_path : Xenctrl.domid -> string option - (** path of file containing the pid value *) + val efivars_save_path : Xenops_sandbox.Chroot.Path.t - val pid_path : Xenctrl.domid -> string - (** xenstore key containing the pid value *) + val efivars_resume_path : Xenops_sandbox.Chroot.Path.t - val start_daemon : - path:string -> args:string list -> domid:Xenctrl.domid -> unit -> string - - val alive : string -> 'a -> bool + val start : + xs:Xenstore.Xs.xsh + -> nvram:Xenops_types.Nvram_uefi_variables.t + -> ?restore:bool + -> Xenops_task.Xenops_task.task_handle + -> Xenctrl.domid + -> unit val stop : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit end From baccccdff13ac3980444e0b2c93a7cc3e7981589 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 19 May 2022 15:51:50 +0100 Subject: [PATCH 30/53] CP-39894: move vgpu starting code to service module This allows to hide the arg-building into the module, as well as removing wait_path from the interface. Not all starting code can be moved, as this creates a module dependency loop because of the use of the PCI module. This means that the usage of the xenstore key as a cancellable watch has to leak through the interface. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/device.ml | 124 ++--------------------------------- ocaml/xenopsd/xc/service.ml | 121 +++++++++++++++++++++++++++++++++- ocaml/xenopsd/xc/service.mli | 29 ++++---- 3 files changed, 134 insertions(+), 140 deletions(-) diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index 8dc517a49a7..bab9f29306f 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -2202,100 +2202,6 @@ module Dm_Common = struct in {argv; fd_map= []} - let vgpu_args_of_nvidia domid vcpus vgpus restore = - let open Xenops_interface.Vgpu in - let virtual_pci_address_compare vgpu1 vgpu2 = - match (vgpu1, vgpu2) with - | ( {implementation= Nvidia {virtual_pci_address= pci1; _}; _} - , {implementation= Nvidia {virtual_pci_address= pci2; _}; _} ) -> - Stdlib.compare pci1.dev pci2.dev - | other1, other2 -> - Stdlib.compare other1 other2 - in - let device_args = - let make addr args = - Printf.sprintf "--device=%s" - (Xcp_pci.string_of_address addr :: args - |> List.filter (fun str -> str <> "") - |> String.concat "," - ) - in - vgpus - |> List.sort virtual_pci_address_compare - |> List.map (fun vgpu -> - let addr = - match vgpu.virtual_pci_address with - | Some pci -> - pci (* pass VF in case of SRIOV *) - | None -> - vgpu.physical_pci_address - in - (* pass PF otherwise *) - match vgpu.implementation with - (* 1. Upgrade case, migrate from a old host with old vGPU having - config_path 2. Legency case, run with old Nvidia host driver *) - | Nvidia - { - virtual_pci_address - ; config_file= Some config_file - ; extra_args - ; _ - } -> - (* The VGPU UUID is not available. Create a fresh one; xapi - will deal with it. *) - let uuid = Uuid.(to_string (make ())) in - debug "NVidia vGPU config: using config file %s and uuid %s" - config_file uuid ; - make addr - [ - config_file - ; Xcp_pci.string_of_address virtual_pci_address - ; uuid - ; extra_args - ] - | Nvidia - { - virtual_pci_address - ; type_id= Some type_id - ; uuid= Some uuid - ; extra_args - ; _ - } -> - debug "NVidia vGPU config: using type id %s and uuid: %s" - type_id uuid ; - make addr - [ - type_id - ; Xcp_pci.string_of_address virtual_pci_address - ; uuid - ; extra_args - ] - | Nvidia {type_id= None; config_file= None; _} -> - (* No type_id _and_ no config_file: something is wrong *) - raise - (Xenopsd_error - (Internal_error - (Printf.sprintf "NVidia vGPU metadata incomplete (%s)" - __LOC__ - ) - ) - ) - | _ -> - "" - ) - in - let suspend_file = sprintf demu_save_path domid in - let base_args = - [ - "--domain=" ^ string_of_int domid - ; "--vcpus=" ^ string_of_int vcpus - ; "--suspend=" ^ suspend_file - ] - @ device_args - in - let fd_arg = if restore then ["--resume"] else [] in - List.concat [base_args; fd_arg] - let write_vgpu_data ~xs domid devid keys = let path = xenops_vgpu_path domid devid in xs.Xs.writev path keys @@ -2349,17 +2255,6 @@ module Dm_Common = struct let prepend_wrapper_args domid args = string_of_int domid :: "--syslog" :: args - let pid_alive pid name = - match Forkhelpers.waitpid_nohang pid with - | 0, Unix.WEXITED 0 -> - true - | _, Unix.WEXITED n -> - error "%s: unexpected exit with code: %d" name n ; - false - | _, (Unix.WSIGNALED n | Unix.WSTOPPED n) -> - error "%s: unexpected signal: %d" name n ; - false - let gimtool_m = Mutex.create () let resume (task : Xenops_task.task_handle) ~xs ~qemu_domid domid = @@ -3787,27 +3682,17 @@ module Dm = struct match vgpus with | {implementation= Nvidia _; _} :: _ -> (* Start DEMU and wait until it has reached the desired state *) - let state_path = Printf.sprintf "/local/domain/%d/vgpu/state" domid in - let cancel = Cancel_utils.Vgpu domid in if not (Service.Vgpu.is_running ~xs domid) then ( let pcis = List.map (fun x -> x.physical_pci_address) vgpus in PCI.bind pcis PCI.Nvidia ; let module Q = (val Backend.of_profile profile) in - let args = vgpu_args_of_nvidia domid vcpus vgpus restore in - let vgpu_pid = - Service.Vgpu.start_daemon ~path:!Xc_resources.vgpu ~args ~domid - ~fds:[] () - in - Service.Vgpu.wait_path ~pidalive:(pid_alive vgpu_pid) ~task - ~name:"vgpu" ~domid ~xs ~ready_path:state_path - ~timeout:!Xenopsd.vgpu_ready_timeout - ~cancel () ; - Forkhelpers.dontwaitpid vgpu_pid + Service.Vgpu.start ~xs ~vcpus ~vgpus ~restore task domid ) else info "Daemon %s is already running for domain %d" !Xc_resources.vgpu domid ; (* Keep waiting until DEMU's state becomes "initialising" or "running", or an error occurred. *) + let state_path = Service.Vgpu.state_path domid in let good_watches = [ Watch.value_to_become state_path "initialising" @@ -3817,8 +3702,9 @@ module Dm = struct in let error_watch = Watch.value_to_become state_path "error" in if - cancellable_watch cancel good_watches [error_watch] task ~xs - ~timeout:3600. () + cancellable_watch + (Service.Vgpu.cancel_key domid) + good_watches [error_watch] task ~xs ~timeout:3600. () then info "Daemon vgpu is ready" else diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index ddc81921ae6..b01ea252dfb 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -199,6 +199,17 @@ let wait_path ~pidalive ~task ~name ~domid ~xs ~ready_path ~timeout ~cancel _ = ) ; debug "Daemon initialised: %s" syslog_key +let pid_alive pid name = + match Forkhelpers.waitpid_nohang pid with + | 0, Unix.WEXITED 0 -> + true + | _, Unix.WEXITED n -> + error "%s: unexpected exit with code: %d" name n ; + false + | _, (Unix.WSIGNALED n | Unix.WSTOPPED n) -> + error "%s: unexpected signal: %d" name n ; + false + module type DAEMONPIDPATH = sig val name : string @@ -340,15 +351,119 @@ module Vgpu = struct let pid_path domid = Printf.sprintf "/local/domain/%d/vgpu-pid" domid end) - let start_daemon = D.start_daemon + let vgpu_args_of_nvidia domid vcpus vgpus restore = + let open Xenops_interface.Vgpu in + let virtual_pci_address_compare vgpu1 vgpu2 = + match (vgpu1, vgpu2) with + | ( {implementation= Nvidia {virtual_pci_address= pci1; _}; _} + , {implementation= Nvidia {virtual_pci_address= pci2; _}; _} ) -> + Stdlib.compare pci1.dev pci2.dev + | other1, other2 -> + Stdlib.compare other1 other2 + in + let device_args = + let make addr args = + Printf.sprintf "--device=%s" + (Xcp_pci.string_of_address addr :: args + |> List.filter (fun str -> str <> "") + |> String.concat "," + ) + in + vgpus + |> List.sort virtual_pci_address_compare + |> List.map (fun vgpu -> + let addr = + match vgpu.virtual_pci_address with + | Some pci -> + pci (* pass VF in case of SRIOV *) + | None -> + vgpu.physical_pci_address + in + (* pass PF otherwise *) + match vgpu.implementation with + (* 1. Upgrade case, migrate from a old host with old vGPU having + config_path 2. Legency case, run with old Nvidia host driver *) + | Nvidia + { + virtual_pci_address + ; config_file= Some config_file + ; extra_args + ; _ + } -> + (* The VGPU UUID is not available. Create a fresh one; xapi + will deal with it. *) + let uuid = Uuidm.to_string (Uuidm.create `V4) in + debug "NVidia vGPU config: using config file %s and uuid %s" + config_file uuid ; + make addr + [ + config_file + ; Xcp_pci.string_of_address virtual_pci_address + ; uuid + ; extra_args + ] + | Nvidia + { + virtual_pci_address + ; type_id= Some type_id + ; uuid= Some uuid + ; extra_args + ; _ + } -> + debug "NVidia vGPU config: using type id %s and uuid: %s" + type_id uuid ; + make addr + [ + type_id + ; Xcp_pci.string_of_address virtual_pci_address + ; uuid + ; extra_args + ] + | Nvidia {type_id= None; config_file= None; _} -> + (* No type_id _and_ no config_file: something is wrong *) + raise + (Xenops_interface.Xenopsd_error + (Internal_error + (Printf.sprintf "NVidia vGPU metadata incomplete (%s)" + __LOC__ + ) + ) + ) + | _ -> + "" + ) + in + let suspend_file = Printf.sprintf Device_common.demu_save_path domid in + let base_args = + [ + "--domain=" ^ string_of_int domid + ; "--vcpus=" ^ string_of_int vcpus + ; "--suspend=" ^ suspend_file + ] + @ device_args + in + let fd_arg = if restore then ["--resume"] else [] in + List.concat [base_args; fd_arg] + + let state_path domid = Printf.sprintf "/local/domain/%d/vgpu/state" domid + + let cancel_key domid = Cancel_utils.Vgpu domid + + let start ~xs ~vcpus ~vgpus ~restore task domid = + let args = vgpu_args_of_nvidia domid vcpus vgpus restore in + let cancel = cancel_key domid in + let pid = D.start_daemon ~path:!Xc_resources.vgpu ~args ~domid ~fds:[] () in + wait_path ~pidalive:(pid_alive pid) ~task ~name:D.name ~domid ~xs + ~ready_path:(state_path domid) + ~timeout:!Xenopsd.vgpu_ready_timeout + ~cancel () ; + Forkhelpers.dontwaitpid pid let pid = D.pid let is_running = D.is_running let stop = D.stop - - let wait_path = wait_path end module SystemdDaemonMgmt (D : DAEMONPIDPATH) = struct diff --git a/ocaml/xenopsd/xc/service.mli b/ocaml/xenopsd/xc/service.mli index 57c89b1fe7b..d3749817f2f 100644 --- a/ocaml/xenopsd/xc/service.mli +++ b/ocaml/xenopsd/xc/service.mli @@ -39,31 +39,24 @@ module Qemu : sig end module Vgpu : sig - val start_daemon : - path:string - -> args:string list - -> domid:Xenctrl.domid - -> ?fds:(string * Unix.file_descr) list + val start : + xs:Xenstore.Xs.xsh + -> vcpus:int + -> vgpus:Xenops_interface.Vgpu.t list + -> restore:bool + -> Xenops_task.Xenops_task.task_handle + -> int -> unit - -> Forkhelpers.pidty + + val cancel_key : Xenctrl.domid -> Cancel_utils.key + + val state_path : Xenctrl.domid -> string val pid : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option val is_running : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> bool val stop : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> unit - - val wait_path : - pidalive:(string -> bool) - -> task:Xenops_task.Xenops_task.task_handle - -> name:string - -> domid:int - -> xs:Xenstore.Xs.xsh - -> ready_path:Watch.path - -> timeout:float - -> cancel:Cancel_utils.key - -> 'a - -> unit end module PV_Vnc : sig From 5caee4474a87a59251459a0d27042489f188d905 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 23 May 2022 09:30:13 +0100 Subject: [PATCH 31/53] CP-39894: Replace is_pidfile and pid_path with pid_location This forces the daemon modules to define which of the two paths they use to advertise availability. The translation is as follows: use_pidfile = false means that only xenstore is used use_pidfile = true means that both xenstore and the filesystem are used, depending on situation. Note that this exposes a current issue in swtpm: it is forced to define a xenstore path when it is not used at all and the filepath is hardcoded in the waiting function. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/service.ml | 71 +++++++++++++++++++++++-------------- 1 file changed, 44 insertions(+), 27 deletions(-) diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index b01ea252dfb..0d8add25f50 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -210,12 +210,25 @@ let pid_alive pid name = error "%s: unexpected signal: %d" name n ; false +let pidfile_path root daemon_name domid = + Printf.sprintf "%s/%s-%d.pid" root daemon_name domid + +let pidfile_path_tmpfs daemon_name domid = + pidfile_path Device_common.var_run_xen_path daemon_name domid + +module Pid = struct + type both = {key: int -> string; file: int -> string} + + type path = + | Xenstore of (int -> string) + (* | File of (int -> string) *) + | Path_of of both +end + module type DAEMONPIDPATH = sig val name : string - val use_pidfile : bool - - val pid_path : int -> string + val pid_location : Pid.path end module DaemonMgmt (D : DAEMONPIDPATH) = struct @@ -237,23 +250,23 @@ module DaemonMgmt (D : DAEMONPIDPATH) = struct let name = D.name - let pid_path = D.pid_path + let pid_path domid = + match D.pid_location with Xenstore key | Path_of {key; _} -> key domid let pid_path_signal domid = pid_path domid ^ "-signal" let pidfile_path domid = - if D.use_pidfile then - Some - (Printf.sprintf "%s/%s-%d.pid" Device_common.var_run_xen_path D.name - domid - ) - else - None + match D.pid_location with + | Path_of {file; _} -> + Some (file domid) + | _ -> + None let pid ~xs domid = try - match pidfile_path domid with - | Some path when Sys.file_exists path -> + match D.pid_location with + | Path_of {file; _} when Sys.file_exists (file domid) -> + let path = file domid in let pid = path |> Unixext.string_of_file |> String.trim |> int_of_string in @@ -267,10 +280,10 @@ module DaemonMgmt (D : DAEMONPIDPATH) = struct (* cannot obtain lock: process is alive *) Some pid ) - | _ -> + | Xenstore key | Path_of {key; _} -> (* backward compatibility during update installation: only has - xenstore pid *) - let pid = xs.Xs.read (pid_path domid) in + xenstore pid available *) + let pid = xs.Xs.read (key domid) in Some (int_of_string pid) with _ -> None @@ -337,18 +350,18 @@ end module Qemu = DaemonMgmt (struct let name = "qemu-dm" - let use_pidfile = true - let pid_path domid = Printf.sprintf "/local/domain/%d/qemu-pid" domid + + let pid_location = Pid.Path_of {key= pid_path; file= pidfile_path_tmpfs name} end) module Vgpu = struct module D = DaemonMgmt (struct let name = "vgpu" - let use_pidfile = false - let pid_path domid = Printf.sprintf "/local/domain/%d/vgpu-pid" domid + + let pid_location = Pid.Xenstore pid_path end) let vgpu_args_of_nvidia domid vcpus vgpus restore = @@ -513,7 +526,9 @@ module SystemdDaemonMgmt (D : DAEMONPIDPATH) = struct let start_daemon ~path ~args ~domid () = debug "Starting daemon: %s with args [%s]" path (String.concat "; " args) ; let service = Compat.syslog_key ~domid in - let pidpath = D.pid_path domid in + let pidpath = + match D.pid_location with Xenstore key | Path_of {key; _} -> key domid + in let properties = ("ExecStopPost", "-/usr/bin/xenstore-rm " ^ pidpath) :: @@ -533,9 +548,10 @@ module Varstored = struct module D = SystemdDaemonMgmt (struct let name = "varstored" - let use_pidfile = true - let pid_path domid = Printf.sprintf "/local/domain/%d/varstored-pid" domid + + let pid_location = + Pid.Path_of {key= pid_path; file= pidfile_path_tmpfs name} end) let efivars_resume_path = @@ -615,9 +631,10 @@ module Swtpm = struct module D = SystemdDaemonMgmt (struct let name = "swtpm-wrapper" - let use_pidfile = false - let pid_path domid = Printf.sprintf "/local/domain/%d/varstored-pid" domid + + (* XXX: the xenstore key is not used, the daemon should define the pidfile *) + let pid_location = Pid.Xenstore pid_path end) let xs_path ~domid = Device_common.get_private_path domid ^ "/vtpm" @@ -716,9 +733,9 @@ module PV_Vnc = struct module D = DaemonMgmt (struct let name = "vncterm" - let use_pidfile = false - let pid_path domid = Printf.sprintf "/local/domain/%d/vncterm-pid" domid + + let pid_location = Pid.Xenstore pid_path end) let vnc_console_path domid = Printf.sprintf "/local/domain/%d/console" domid From 5a6d61a32e731811254bd46d3aca6f617b58b621 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 23 May 2022 10:56:17 +0100 Subject: [PATCH 32/53] CP-39894: tweak Service.Qemu interface This allows for clearer meaning in the paths offered by the module, as well as removing the xenstore path by integrating the stop code in it and simplify building of the arguments, which hasn't been pulled into the module due to complexity. The Vusb code has been simplified, it was checking twice the pid of Qemu, this removes a race condition that could lead to a spurious error. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/device.ml | 97 +++++++-------------------- ocaml/xenopsd/xc/service.ml | 56 ++++++++++++++-- ocaml/xenopsd/xc/service.mli | 10 +-- ocaml/xenopsd/xc/xenops_server_xen.ml | 4 +- 4 files changed, 83 insertions(+), 84 deletions(-) diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml index bab9f29306f..0b93c6740c3 100644 --- a/ocaml/xenopsd/xc/device.ml +++ b/ocaml/xenopsd/xc/device.ml @@ -341,8 +341,6 @@ module Generic = struct "Device.Generic.hard_shutdown about to blow away backend and error paths" ; rm_device_state ~xs x - let really_kill = Xenops_utils.really_kill - let best_effort = Xenops_utils.best_effort end @@ -1865,36 +1863,29 @@ module Vusb = struct speed id ; get_bus_from_version () in - if Service.Qemu.is_running ~xs domid then ( - let bus, prepare_bus = get_bus () in - prepare_bus () ; - (* Need to reset USB device before passthrough to vm according to - CP-24616. Also need to do deprivileged work in usb_reset script if QEMU - is deprivileged. *) - ( match Service.Qemu.pid ~xs domid with - | Some pid -> - usb_reset_attach ~hostbus ~hostport ~domid ~pid ~privileged - | _ -> - raise - (Xenopsd_error - (Internal_error - (Printf.sprintf "qemu pid does not exist for vm %d" domid) - ) - ) - ) ; - let cmd = - Qmp.( - Device_add - Device. - { - driver= "usb-host" - ; device= USB {USB.id; params= Some USB.{bus; hostbus; hostport}} - } - - ) - in - qmp_send_cmd domid cmd |> ignore - ) + match Service.Qemu.pid ~xs domid with + | Some pid -> + (* Need to reset USB device before passthrough to vm according to + CP-24616. Also need to do deprivileged work in usb_reset script if QEMU + is deprivileged. *) + let bus, prepare_bus = get_bus () in + prepare_bus () ; + usb_reset_attach ~hostbus ~hostport ~domid ~pid ~privileged ; + + let cmd = + Qmp.( + Device_add + Device. + { + driver= "usb-host" + ; device= USB {USB.id; params= Some {bus; hostbus; hostport}} + } + + ) + in + qmp_send_cmd domid cmd |> ignore + | None -> + () let vusb_unplug ~xs ~privileged ~domid ~id ~hostbus ~hostport = debug "vusb_unplug: unplug VUSB device %s" id ; @@ -2192,12 +2183,7 @@ module Dm_Common = struct ) |> List.concat ; (info.monitor |> function None -> [] | Some x -> ["-monitor"; x]) - ; (Service.Qemu.pidfile_path domid |> function - | None -> - [] - | Some x -> - ["-pidfile"; x] - ) + ; ["-pidfile"; Service.Qemu.pidfile_path domid] ] in {argv; fd_map= []} @@ -2262,40 +2248,9 @@ module Dm_Common = struct (* Called by every domain destroy, even non-HVM *) let stop ~xs ~qemu_domid ~vtpm domid = - let qemu_pid_path = Service.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 - let stop_qemu () = - match Service.Qemu.pid ~xs domid with - | None -> - () (* nothing to do *) - | Some qemu_pid -> ( - debug "qemu-dm: stopping qemu-dm with SIGTERM (domid = %d)" domid ; - let open Generic in - best_effort - "signalling that qemu is ending as expected, mask further signals" - (fun () -> Service.Qemu.(SignalMask.set signal_mask domid) - ) ; - best_effort "killing qemu-dm" (fun () -> really_kill qemu_pid) ; - best_effort "removing qemu-pid from xenstore" (fun () -> - xs.Xs.rm qemu_pid_path - ) ; - best_effort - "unmasking signals, qemu-pid is already gone from xenstore" - (fun () -> Service.Qemu.(SignalMask.unset signal_mask domid) - ) ; - best_effort "removing device model path from xenstore" (fun () -> - xs.Xs.rm (device_model_path ~qemu_domid domid) - ) ; - match Service.Qemu.pidfile_path domid with - | None -> - () - | Some path -> - best_effort (sprintf "removing %s" path) (fun () -> - Unix.unlink path - ) - ) - in + let stop_qemu () = Service.Qemu.stop ~xs ~qemu_domid domid in let stop_swptm () = Option.iter (fun (Xenops_interface.Vm.Vtpm vtpm_uuid) -> @@ -3866,7 +3821,7 @@ module Dm = struct (* before expected qemu stop: qemu-pid is available in domain xs tree: signal action to take *) xs.Xs.write - (Service.Qemu.pid_path_signal domid) + (Service.Qemu.pidxenstore_path_signal domid) crash_reason ) ) diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index 0d8add25f50..2de9452e49e 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -253,8 +253,6 @@ module DaemonMgmt (D : DAEMONPIDPATH) = struct let pid_path domid = match D.pid_location with Xenstore key | Path_of {key; _} -> key domid - let pid_path_signal domid = pid_path domid ^ "-signal" - let pidfile_path domid = match D.pid_location with | Path_of {file; _} -> @@ -347,13 +345,59 @@ module DaemonMgmt (D : DAEMONPIDPATH) = struct pid end -module Qemu = DaemonMgmt (struct +module Qemu = struct let name = "qemu-dm" - let pid_path domid = Printf.sprintf "/local/domain/%d/qemu-pid" domid + let pidfile_path = pidfile_path_tmpfs name + + let pidxenstore_path domid = Printf.sprintf "/local/domain/%d/qemu-pid" domid + + let pidxenstore_path_signal domid = pidxenstore_path domid ^ "-signal" + + module D = DaemonMgmt (struct + let name = name + + let pid_location = Pid.Path_of {key= pidxenstore_path; file= pidfile_path} + end) + + module SignalMask = D.SignalMask + + let signal_mask = D.signal_mask + + let start_daemon = D.start_daemon + + let pid = D.pid + + let is_running = D.is_running - let pid_location = Pid.Path_of {key= pid_path; file= pidfile_path_tmpfs name} -end) + let stop ~xs ~qemu_domid domid = + match pid ~xs domid with + | None -> + () (* nothing to do *) + | Some pid -> + let xenstore_path = pidxenstore_path domid in + let best_effort = Xenops_utils.best_effort in + let really_kill = Xenops_utils.really_kill in + debug "qemu-dm: stopping qemu-dm with SIGTERM (domid = %d)" domid ; + best_effort + "signalling that qemu is ending as expected, mask further signals" + (fun () -> SignalMask.set signal_mask domid + ) ; + best_effort "killing qemu-dm" (fun () -> really_kill pid) ; + best_effort "removing qemu-pid from xenstore" (fun () -> + xs.Xs.rm xenstore_path + ) ; + best_effort "unmasking signals, qemu-pid is already gone from xenstore" + (fun () -> SignalMask.unset signal_mask domid + ) ; + best_effort "removing device model path from xenstore" (fun () -> + xs.Xs.rm (Device_common.device_model_path ~qemu_domid domid) + ) ; + let file_path = pidfile_path domid in + best_effort (Printf.sprintf "removing %s" file_path) (fun () -> + Unix.unlink file_path + ) +end module Vgpu = struct module D = DaemonMgmt (struct diff --git a/ocaml/xenopsd/xc/service.mli b/ocaml/xenopsd/xc/service.mli index d3749817f2f..c17b3aa8360 100644 --- a/ocaml/xenopsd/xc/service.mli +++ b/ocaml/xenopsd/xc/service.mli @@ -17,14 +17,11 @@ module Qemu : sig val name : string - val pid_path_signal : Xenctrl.domid -> string + val pidxenstore_path_signal : Xenctrl.domid -> string - val pidfile_path : Xenctrl.domid -> string option + val pidfile_path : Xenctrl.domid -> string (** path of file containing the pid value *) - val pid_path : Xenctrl.domid -> string - (** xenstore key containing the pid value *) - val start_daemon : path:string -> args:string list @@ -36,6 +33,9 @@ module Qemu : sig val pid : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> int option val is_running : xs:Xenstore.Xs.xsh -> Xenctrl.domid -> bool + + val stop : + xs:Xenstore.Xs.xsh -> qemu_domid:Xenctrl.domid -> Xenctrl.domid -> unit end module Vgpu : sig diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml index f60f4f32b31..e56cbdecf43 100644 --- a/ocaml/xenopsd/xc/xenops_server_xen.ml +++ b/ocaml/xenopsd/xc/xenops_server_xen.ml @@ -4877,7 +4877,7 @@ module Actions = struct ; sprintf "/local/domain/%d/memory/uncooperative" domid ; sprintf "/local/domain/%d/console/vnc-port" domid ; sprintf "/local/domain/%d/console/tc-port" domid - ; Service.Qemu.pid_path_signal domid + ; Service.Qemu.pidxenstore_path_signal domid ; sprintf "/local/domain/%d/control" domid ; sprintf "/local/domain/%d/device" domid ; sprintf "/local/domain/%d/rrd" domid @@ -5054,7 +5054,7 @@ module Actions = struct debug "Ignoring qemu-pid-signal watch on shutdown domain %d" d else let signal = - try Some (xs.Xs.read (Service.Qemu.pid_path_signal d)) + try Some (xs.Xs.read (Service.Qemu.pidxenstore_path_signal d)) with _ -> None in match signal with From 6173e09b11d2c6d8cf2196a9edb11a213c92b04b Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 23 May 2022 14:28:16 +0100 Subject: [PATCH 33/53] CP-39894: Use pid_location for file and xenstore cleanups This allows for clearer logic regarding which conditions trigger each cleanup. Also quite a bit of code from the functions can be removed as the client modules take control of the code. Prevent error messages when trying to shutdown swtpm and varstored for a domain that does not need them so they are not running. Instead print an informational message about not bothering to shut it down. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/service.ml | 137 +++++++++++++++--------------------- 1 file changed, 58 insertions(+), 79 deletions(-) diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index 2de9452e49e..55d921fc2ae 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -36,7 +36,7 @@ type t = { path:string -> args:string list -> domid:Xenctrl.domid -> unit -> string } -let alive service = +let alive service _ = let is_active = Fe_systemctl.is_active ~service in ( if not is_active then let status = Fe_systemctl.show ~service in @@ -146,7 +146,7 @@ let start_and_wait_for_readyness ~task ~service = Error (ECancelled task) | Waiting -> let err_msg = - if alive service_name then + if alive service_name () then "Timeout reached while starting service" else "Service exited unexpectedly" @@ -250,16 +250,6 @@ module DaemonMgmt (D : DAEMONPIDPATH) = struct let name = D.name - let pid_path domid = - match D.pid_location with Xenstore key | Path_of {key; _} -> key domid - - let pidfile_path domid = - match D.pid_location with - | Path_of {file; _} -> - Some (file domid) - | _ -> - None - let pid ~xs domid = try match D.pid_location with @@ -307,17 +297,22 @@ module DaemonMgmt (D : DAEMONPIDPATH) = struct best_effort (Printf.sprintf "killing %s" D.name) (fun () -> really_kill pid ) ; - let key = pid_path domid in - best_effort (Printf.sprintf "removing XS key %s" key) (fun () -> - xs.Xs.rm key - ) ; - match pidfile_path domid with - | None -> - () - | Some path -> - best_effort (Printf.sprintf "removing %s" path) (fun () -> - Unix.unlink path - ) + let remove_key key = + best_effort (Printf.sprintf "removing XS key %s" key) (fun () -> + xs.Xs.rm key + ) + in + let remove_file path = + best_effort (Printf.sprintf "removing %s" path) (fun () -> + Unix.unlink path + ) + in + match D.pid_location with + | Xenstore key -> + remove_key (key domid) + | Path_of {key; file} -> + remove_key (key domid) ; + remove_file (file domid) ) let syslog_key ~domid = Printf.sprintf "%s-%d" D.name domid @@ -527,10 +522,6 @@ module SystemdDaemonMgmt (D : DAEMONPIDPATH) = struct (* backward compat: for daemons running during an update *) module Compat = DaemonMgmt (D) - let pidfile_path = Compat.pidfile_path - - let pid_path = Compat.pid_path - let of_domid domid = let key = Compat.syslog_key ~domid in if Fe_systemctl.exists ~service:key then @@ -545,43 +536,34 @@ module SystemdDaemonMgmt (D : DAEMONPIDPATH) = struct | Some key -> Fe_systemctl.is_active ~service:key - let alive service _ = - if Fe_systemctl.is_active ~service then - true - else - let status = Fe_systemctl.show ~service in - let open Fe_systemctl in - error - "%s: unexpected termination \ - (Result=%s,ExecMainPID=%d,ExecMainStatus=%d,ActiveState=%s)" - service status.result status.exec_main_pid status.exec_main_status - status.active_state ; - false - let stop ~xs domid = - match of_domid domid with - | None -> + match (of_domid domid, is_running ~xs domid) with + | None, true -> Compat.stop ~xs domid - | Some service -> + | Some service, true -> (* xenstore cleanup is done by systemd unit file *) let (_ : Fe_systemctl.status) = Fe_systemctl.stop ~service in () + | Some service, false -> + info "Not trying to stop %s since it's not running" service + | None, false -> + info "Not trying to stop %s for domid %i since it's not running" D.name + domid let start_daemon ~path ~args ~domid () = debug "Starting daemon: %s with args [%s]" path (String.concat "; " args) ; let service = Compat.syslog_key ~domid in - let pidpath = - match D.pid_location with Xenstore key | Path_of {key; _} -> key domid - in let properties = - ("ExecStopPost", "-/usr/bin/xenstore-rm " ^ pidpath) - :: - ( match Compat.pidfile_path domid with - | None -> - [] - | Some path -> - [("ExecStopPost", "-/bin/rm -f " ^ path)] - ) + let remove_key path = ("ExecStopPost", "-/usr/bin/xenstore-rm " ^ path) in + let remove_file path = ("ExecStopPost", "-/bin/rm -f " ^ path) in + match D.pid_location with + | Xenstore get_path -> + let key_path = get_path domid in + [remove_key key_path] + | Path_of {key; file} -> + let key_path = key domid in + let file_path = file domid in + [remove_key key_path; remove_file file_path] in Fe_systemctl.start_transient ~properties ~service path args ; debug "Daemon started: %s" service ; @@ -589,13 +571,17 @@ module SystemdDaemonMgmt (D : DAEMONPIDPATH) = struct end module Varstored = struct - module D = SystemdDaemonMgmt (struct - let name = "varstored" + let name = "varstored" - let pid_path domid = Printf.sprintf "/local/domain/%d/varstored-pid" domid + let pidxenstore_path domid = + Printf.sprintf "/local/domain/%d/varstored-pid" domid - let pid_location = - Pid.Path_of {key= pid_path; file= pidfile_path_tmpfs name} + let pidfile_path = pidfile_path_tmpfs name + + module D = SystemdDaemonMgmt (struct + let name = name + + let pid_location = Pid.Path_of {key= pidxenstore_path; file= pidfile_path} end) let efivars_resume_path = @@ -608,19 +594,16 @@ module Varstored = struct let open Xenops_types in debug "Preparing to start varstored for UEFI boot (domid=%d)" domid ; let path = !Xc_resources.varstored in - let name = "varstored" in let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuid.to_string in - let reset_on_boot = - nvram.Nvram_uefi_variables.on_boot = Nvram_uefi_variables.Reset - in + let reset_on_boot = Nvram_uefi_variables.(nvram.on_boot = Reset) in let backend = nvram.Nvram_uefi_variables.backend in - let open Fe_argv in - let argf fmt = Printf.ksprintf (fun s -> ["--arg"; s]) fmt in - let on cond value = if cond then value else return () in let chroot, socket_path = Xenops_sandbox.Varstore_guard.start (Xenops_task.get_dbg task) ~vm_uuid ~domid ~paths:[efivars_save_path] in + let open Fe_argv in + let argf fmt = Printf.ksprintf (fun s -> ["--arg"; s]) fmt in + let on cond value = if cond then value else return () in let args = Add.many [ @@ -637,15 +620,10 @@ module Varstored = struct ; backend ; "--arg" ; Printf.sprintf "socket:%s" socket_path + ; "--pidfile" + ; pidfile_path domid ] >>= fun () -> - (D.pidfile_path domid |> function - | None -> - return () - | Some x -> - Add.many ["--pidfile"; x] - ) - >>= fun () -> Add.many @@ argf "uuid:%s" vm_uuid >>= fun () -> on reset_on_boot @@ Add.arg "--nonpersistent" >>= fun () -> on restore @@ Add.arg "--resume" >>= fun () -> @@ -660,8 +638,8 @@ module Varstored = struct in let args = Fe_argv.run args |> snd |> Fe_argv.argv in let service = D.start_daemon ~path ~args ~domid () in - let ready_path = D.pid_path domid in - wait_path ~pidalive:(D.alive service) ~task ~name ~domid ~xs ~ready_path + let ready_path = pidxenstore_path domid in + wait_path ~pidalive:(alive service) ~task ~name ~domid ~xs ~ready_path ~timeout:!Xenopsd.varstored_ready_timeout ~cancel:(Cancel_utils.Varstored domid) () @@ -774,12 +752,13 @@ module Swtpm = struct end module PV_Vnc = struct + let pidxenstore_path domid = + Printf.sprintf "/local/domain/%d/vncterm-pid" domid + module D = DaemonMgmt (struct let name = "vncterm" - let pid_path domid = Printf.sprintf "/local/domain/%d/vncterm-pid" domid - - let pid_location = Pid.Xenstore pid_path + let pid_location = Pid.Xenstore pidxenstore_path end) let vnc_console_path domid = Printf.sprintf "/local/domain/%d/console" domid @@ -890,7 +869,7 @@ module PV_Vnc = struct in (* Now add the close fds wrapper *) let pid = D.start_daemon ~path:!Xc_resources.vncterm ~args:l ~domid () in - let path = D.pid_path domid in + let path = pidxenstore_path domid in xs.Xs.write path (string_of_int (Forkhelpers.getpid pid)) ; Forkhelpers.dontwaitpid pid From 584bf462249c50abdb69670dff33df267e534a69 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 23 May 2022 15:39:39 +0100 Subject: [PATCH 34/53] CP-39894: Add Pid.File and use it in Swtpm This means the code will not try to read or write to xenstore for any operation regarding swtpm and the filesystem will be cleaned up as needed as well. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/service.ml | 38 ++++++++++++++++++++++++++----------- 1 file changed, 27 insertions(+), 11 deletions(-) diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index 55d921fc2ae..c28d6e385df 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -29,6 +29,7 @@ type t = { name: string ; domid: Xenctrl.domid ; exec_path: string + ; pid_filename: string ; chroot: Chroot.t ; timeout_seconds: float ; args: string list @@ -86,7 +87,6 @@ let start_and_wait_for_readyness ~task ~service = Chroot.absolute_path_outside service.chroot (Path.of_string ~relative:p) in - let pid_name = Printf.sprintf "%s-%d.pid" service.name service.domid in let cancel_name = Printf.sprintf "%s-%s.cancel" service.name (Xenops_task.get_dbg task) in @@ -111,11 +111,11 @@ let start_and_wait_for_readyness ~task ~service = (* treat deleted directory or pidfile as cancelling *) | Cancelled, _, _ | _, (Inotify.Ignored | Inotify.Delete_self), _ -> Cancelled - | _, Inotify.Delete, Some name when name = pid_name -> + | _, Inotify.Delete, Some name when name = service.pid_filename -> Cancelled | _, Inotify.Create, Some name when name = cancel_name -> Cancelled - | _, Inotify.Create, Some name when name = pid_name -> + | _, Inotify.Create, Some name when name = service.pid_filename -> Created | _, _, _ -> acc @@ -221,7 +221,7 @@ module Pid = struct type path = | Xenstore of (int -> string) - (* | File of (int -> string) *) + | File of (int -> string) | Path_of of both end @@ -253,7 +253,7 @@ module DaemonMgmt (D : DAEMONPIDPATH) = struct let pid ~xs domid = try match D.pid_location with - | Path_of {file; _} when Sys.file_exists (file domid) -> + | (File file | Path_of {file; _}) when Sys.file_exists (file domid) -> let path = file domid in let pid = path |> Unixext.string_of_file |> String.trim |> int_of_string @@ -273,6 +273,8 @@ module DaemonMgmt (D : DAEMONPIDPATH) = struct xenstore pid available *) let pid = xs.Xs.read (key domid) in Some (int_of_string pid) + | _ -> + None with _ -> None let is_running ~xs domid = @@ -310,6 +312,8 @@ module DaemonMgmt (D : DAEMONPIDPATH) = struct match D.pid_location with | Xenstore key -> remove_key (key domid) + | File file -> + remove_file (file domid) | Path_of {key; file} -> remove_key (key domid) ; remove_file (file domid) @@ -560,6 +564,9 @@ module SystemdDaemonMgmt (D : DAEMONPIDPATH) = struct | Xenstore get_path -> let key_path = get_path domid in [remove_key key_path] + | File get_path -> + let file_path = get_path domid in + [remove_file file_path] | Path_of {key; file} -> let key_path = key domid in let file_path = file domid in @@ -650,13 +657,12 @@ end also xapi needs default backend set *) module Swtpm = struct + let pidfile_path domid = Printf.sprintf "swtpm-%d.pid" domid + module D = SystemdDaemonMgmt (struct let name = "swtpm-wrapper" - let pid_path domid = Printf.sprintf "/local/domain/%d/varstored-pid" domid - - (* XXX: the xenstore key is not used, the daemon should define the pidfile *) - let pid_location = Pid.Xenstore pid_path + let pid_location = Pid.File pidfile_path end) let xs_path ~domid = Device_common.get_private_path domid ^ "/vtpm" @@ -679,8 +685,9 @@ module Swtpm = struct let start ~xs ~vtpm_uuid ~index task domid = debug "Preparing to start swtpm-wrapper to provide a vTPM (domid=%d)" domid ; - let exec_path = !Resources.swtpm_wrapper in let name = "swtpm" in + let exec_path = !Resources.swtpm_wrapper in + let pid_filename = pidfile_path domid in let vm_uuid = Xenops_helpers.uuid_of_domid ~xs domid |> Uuid.to_string in let chroot, _socket_path = @@ -703,7 +710,16 @@ module Swtpm = struct let timeout_seconds = !Xenopsd.swtpm_ready_timeout in let execute = D.start_daemon in let service = - {name; domid; exec_path; chroot; args; execute; timeout_seconds} + { + name + ; domid + ; exec_path + ; pid_filename + ; chroot + ; args + ; execute + ; timeout_seconds + } in let dbg = Xenops_task.get_dbg task in From 6e4a3ca640e717ad461c2870daabf9a16f24f906 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 26 May 2022 11:26:47 +0100 Subject: [PATCH 35/53] CA-366479: Remove Qemu's pidfile on domain shutdown Also replaces the code to read the pidfile to use the common function in Unixext. Signed-off-by: Pau Ruiz Safont --- ocaml/xenopsd/xc/service.ml | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/ocaml/xenopsd/xc/service.ml b/ocaml/xenopsd/xc/service.ml index c28d6e385df..5709d2f873a 100644 --- a/ocaml/xenopsd/xc/service.ml +++ b/ocaml/xenopsd/xc/service.ml @@ -255,9 +255,8 @@ module DaemonMgmt (D : DAEMONPIDPATH) = struct match D.pid_location with | (File file | Path_of {file; _}) when Sys.file_exists (file domid) -> let path = file domid in - let pid = - path |> Unixext.string_of_file |> String.trim |> int_of_string - in + let ( let* ) = Option.bind in + let* pid = Unixext.pidfile_read path in Unixext.with_file path [Unix.O_RDONLY] 0 (fun fd -> try Unix.lockf fd Unix.F_TRLOCK 0 ; @@ -370,9 +369,10 @@ module Qemu = struct let is_running = D.is_running let stop ~xs ~qemu_domid domid = + let file_path = pidfile_path domid in match pid ~xs domid with | None -> - () (* nothing to do *) + Unixext.unlink_safe file_path | Some pid -> let xenstore_path = pidxenstore_path domid in let best_effort = Xenops_utils.best_effort in @@ -392,7 +392,6 @@ module Qemu = struct best_effort "removing device model path from xenstore" (fun () -> xs.Xs.rm (Device_common.device_model_path ~qemu_domid domid) ) ; - let file_path = pidfile_path domid in best_effort (Printf.sprintf "removing %s" file_path) (fun () -> Unix.unlink file_path ) From 684b76c96c42a77223d19e7a4b8df8f0d66e2779 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 27 Jun 2022 17:15:19 +0100 Subject: [PATCH 36/53] CA-368106: Do not encode vtpm contents twice Doing it once is enough for our purposes Add a check before saving so we can ensure the contents are base64-encoded. Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/xapi_vtpm.ml | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/ocaml/xapi/xapi_vtpm.ml b/ocaml/xapi/xapi_vtpm.ml index d97e40ef74c..403862aa576 100644 --- a/ocaml/xapi/xapi_vtpm.ml +++ b/ocaml/xapi/xapi_vtpm.ml @@ -45,11 +45,16 @@ let destroy ~__context ~self = let get_contents ~__context ~self = let secret = Db.VTPM.get_contents ~__context ~self in - Base64.decode_exn (Db.Secret.get_value ~__context ~self:secret) + Db.Secret.get_value ~__context ~self:secret let set_contents ~__context ~self ~contents = let previous_secret = Db.VTPM.get_contents ~__context ~self in - let encoded = Base64.encode_exn contents in - let secret = Xapi_secret.create ~__context ~value:encoded ~other_config:[] in + let _ = + (* verify contents to be already base64-encoded *) + try Base64.decode contents + with Invalid_argument err -> + raise Api_errors.(Server_error (internal_error, [err])) + in + let secret = Xapi_secret.create ~__context ~value:contents ~other_config:[] in Db.VTPM.set_contents ~__context ~self ~value:secret ; Db.Secret.destroy ~__context ~self:previous_secret From 6965944f05ca978f5bacb8fd2f90a26a59a5b3bc Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 28 Jun 2022 11:01:13 +0100 Subject: [PATCH 37/53] CA-368231: Require only a VM reference for vtpm-create We don't want users of the constructor to have full control of the record, in particular control over the contents. This is because this leaks the concrete storage backend, which makes this very brittle. Instead limit the constructor to take only a VM reference. In the future the constructor we probably want to change the constructor to accept the profile the VTPM needs to have. Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_vtpm.ml | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/ocaml/idl/datamodel_vtpm.ml b/ocaml/idl/datamodel_vtpm.ml index d7f4fb13013..44c242bd272 100644 --- a/ocaml/idl/datamodel_vtpm.ml +++ b/ocaml/idl/datamodel_vtpm.ml @@ -16,6 +16,27 @@ open Datamodel_types open Datamodel_common open Datamodel_roles +let create = + call ~name:"create" + ~lifecycle: + [ + (Published, rel_rio, "") + ; ( Changed + , rel_next + , "Require only a VM reference to create a VTPM instance" + ) + ] + ~doc:"Create a new VTPM instance, and return its handle." + ~params:[(Ref _vm, "vM", "The VM reference the VTPM will be attached to")] + ~result:(Ref _vtpm, "The reference of the newly created VTPM") + ~allowed_roles:_R_POOL_ADMIN () + +let destroy = + call ~name:"destroy" ~lifecycle:[(Published, rel_rio, "")] + ~doc:"Destroy the specified VTPM instance, along with its state." + ~params:[(Ref _vtpm, "self", "The reference to the VTPM object")] + ~allowed_roles:_R_POOL_ADMIN () + let get_contents = call ~name:"get_contents" ~in_product_since:"rel_next" ~doc:"Obtain the contents of the TPM" ~secret:true @@ -42,7 +63,7 @@ let t = ; (Extended, rel_next, "Added VTPM profiles") ; (Changed, rel_next, "Removed backend field") ] - ~gen_constructor_destructor:true ~name:_vtpm ~descr:"A virtual TPM device" + ~gen_constructor_destructor:false ~name:_vtpm ~descr:"A virtual TPM device" ~gen_events:false ~doccomments:[] ~messages_default_allowed_roles:_R_POOL_ADMIN ~contents: @@ -58,5 +79,5 @@ let t = ~lifecycle:[(Published, rel_next, "Added VTPM contents")] "contents" "The contents of the TPM" ] - ~messages:[get_contents; set_contents] + ~messages:[create; destroy; get_contents; set_contents] () From b2c86cb3eaeba66a74867ffc54c46cbaa470a2df Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 4 Jul 2022 11:07:32 +0100 Subject: [PATCH 38/53] CA-368231: change role for creating and destroying VTPMs VM admin is allowed to manage VM devices, so change vtpm create and destroy VTPM allowed roles Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_vtpm.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ocaml/idl/datamodel_vtpm.ml b/ocaml/idl/datamodel_vtpm.ml index 44c242bd272..078e5c0a074 100644 --- a/ocaml/idl/datamodel_vtpm.ml +++ b/ocaml/idl/datamodel_vtpm.ml @@ -29,13 +29,13 @@ let create = ~doc:"Create a new VTPM instance, and return its handle." ~params:[(Ref _vm, "vM", "The VM reference the VTPM will be attached to")] ~result:(Ref _vtpm, "The reference of the newly created VTPM") - ~allowed_roles:_R_POOL_ADMIN () + ~allowed_roles:_R_VM_ADMIN () let destroy = call ~name:"destroy" ~lifecycle:[(Published, rel_rio, "")] ~doc:"Destroy the specified VTPM instance, along with its state." ~params:[(Ref _vtpm, "self", "The reference to the VTPM object")] - ~allowed_roles:_R_POOL_ADMIN () + ~allowed_roles:_R_VM_ADMIN () let get_contents = call ~name:"get_contents" ~in_product_since:"rel_next" From e6ae94be52f56c22fb087855802b432322b5b1c9 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 16 May 2022 16:13:05 +0100 Subject: [PATCH 39/53] CP-39136: Reintroduce backends for VTPMs Reintroduces the previous "backend" field which is unused, kept to avoid issues with updating the schema database, now it's DynamicRO as it's not used in the constructor. Introduced the persistence backend field to declare how is the VTPM stored. For now there's only a single possible value: xapi's DB. This is intended to permit several persistence backends at the same time only for the benefit of developers and it's not meant to allow changing the backend for any single VTPM. Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_common.ml | 2 +- ocaml/idl/datamodel_vtpm.ml | 11 ++++++++++- ocaml/idl/schematest.ml | 2 +- ocaml/xapi/xapi_vtpm.ml | 15 +++++++++++---- ocaml/xapi/xapi_xenops.ml | 2 +- 5 files changed, 24 insertions(+), 8 deletions(-) diff --git a/ocaml/idl/datamodel_common.ml b/ocaml/idl/datamodel_common.ml index 201177699ef..29267d8dce0 100644 --- a/ocaml/idl/datamodel_common.ml +++ b/ocaml/idl/datamodel_common.ml @@ -9,7 +9,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 = 753 +let schema_minor_vsn = 754 (* Historical schema versions just in case this is useful later *) let rio_schema_major_vsn = 5 diff --git a/ocaml/idl/datamodel_vtpm.ml b/ocaml/idl/datamodel_vtpm.ml index 078e5c0a074..c66c1a3d127 100644 --- a/ocaml/idl/datamodel_vtpm.ml +++ b/ocaml/idl/datamodel_vtpm.ml @@ -16,6 +16,9 @@ open Datamodel_types open Datamodel_common open Datamodel_roles +let persistence_backend = + Enum ("persistence_backend", [("xapi", "This VTPM is persisted in XAPI's DB")]) + let create = call ~name:"create" ~lifecycle: @@ -61,7 +64,7 @@ let t = (Published, rel_rio, "Added VTPM stub") ; (Extended, rel_next, "Added ability to manipulate contents") ; (Extended, rel_next, "Added VTPM profiles") - ; (Changed, rel_next, "Removed backend field") + ; (Extended, rel_next, "Added Persistence backed") ] ~gen_constructor_destructor:false ~name:_vtpm ~descr:"A virtual TPM device" ~gen_events:false ~doccomments:[] @@ -71,6 +74,12 @@ let t = uid _vtpm ; field ~qualifier:StaticRO ~ty:(Ref _vm) "VM" "The virtual machine the TPM is attached to" + ; field ~qualifier:DynamicRO ~ty:(Ref _vm) "backend" + ~default_value:(Some (VRef null_ref)) + "The domain where the backend is located (unused)" + ; field ~qualifier:DynamicRO ~ty:persistence_backend + ~default_value:(Some (VEnum "xapi")) ~lifecycle:[] + "persistence_backend" "The backend where the vTPM is persisted" ; field ~qualifier:DynamicRO ~ty:(Map (String, String)) ~lifecycle:[(Published, rel_next, "Added VTPM profiles")] diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index 6920aabcdbe..aa78571cebe 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -1,7 +1,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly *) -let last_known_schema_hash = "eefd4e2daeb4acdb9945a3a3689cab1a" +let last_known_schema_hash = "31528dd0d66fa1dc6cbea5a25c44e79c" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/xapi/xapi_vtpm.ml b/ocaml/xapi/xapi_vtpm.ml index 403862aa576..fe6dd7569dc 100644 --- a/ocaml/xapi/xapi_vtpm.ml +++ b/ocaml/xapi/xapi_vtpm.ml @@ -20,19 +20,26 @@ let assert_no_vtpm_associated ~__context vm = let amount = List.length vtpms |> Int.to_string in raise Api_errors.(Server_error (vtpm_max_amount_reached, [amount])) -let introduce ~__context ~uuid ~vM ~profile ~contents = +let introduce ~__context ~uuid ~vM ~backend ~persistence_backend ~profile + ~contents = let ref = Ref.make () in - Db.VTPM.create ~__context ~ref ~uuid ~vM ~profile ~contents ; + Db.VTPM.create ~__context ~ref ~uuid ~vM ~backend ~persistence_backend + ~profile ~contents ; ref let create ~__context ~vM = assert_no_vtpm_associated ~__context vM ; Xapi_vm_lifecycle.assert_initial_power_state_is ~__context ~self:vM ~expected:`Halted ; - let uuid = Uuid.(to_string (make ())) in let profile = Db.VM.get_default_vtpm_profile ~__context ~self:vM in + let uuid = Uuid.(to_string (make ())) in + let backend = Ref.null in + let persistence_backend = `xapi in let contents = Xapi_secret.create ~__context ~value:"" ~other_config:[] in - let ref = introduce ~__context ~uuid ~vM ~profile ~contents in + let ref = + introduce ~__context ~uuid ~vM ~backend ~persistence_backend ~profile + ~contents + in ref let destroy ~__context ~self = diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index e50cc0aae9b..5c1adb29874 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -405,7 +405,7 @@ let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu = ~value:"" ~other_config ; let vtpm_uuid = uuid () in Db.VTPM.create ~__context ~ref:(ref ()) ~uuid:vtpm_uuid ~vM:vmref - ~profile ~contents ; + ~profile ~backend:Ref.null ~persistence_backend:`xapi ~contents ; Some vtpm_uuid ) else None From 48817f6221285e76af103e58a63ebbb6b0f1ef66 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 7 Jul 2022 11:23:40 +0100 Subject: [PATCH 40/53] idl: enable events for vtpm objects The behaviour was disabled because the class was unused. Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_vtpm.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ocaml/idl/datamodel_vtpm.ml b/ocaml/idl/datamodel_vtpm.ml index c66c1a3d127..dbf5aae93c6 100644 --- a/ocaml/idl/datamodel_vtpm.ml +++ b/ocaml/idl/datamodel_vtpm.ml @@ -67,7 +67,7 @@ let t = ; (Extended, rel_next, "Added Persistence backed") ] ~gen_constructor_destructor:false ~name:_vtpm ~descr:"A virtual TPM device" - ~gen_events:false ~doccomments:[] + ~gen_events:true ~doccomments:[] ~messages_default_allowed_roles:_R_POOL_ADMIN ~contents: [ From d79a4450521e5a19085f3e7fa3312364f8f5a566 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 7 Jul 2022 14:06:01 +0100 Subject: [PATCH 41/53] CP-40087: replace vtpm profile with individual fields is_unique is now required for creating vtpm objects. When creating VTPMs from templates where it has the vtpm in platform data, is_unique:false is used. This is because the mechanism is only needed for having a backwards-compatible way to create VMs that can run windows 11. Wanting to create unique VTPsM is not part of this so a new SDK will be needed to use this feature. This means removing the default vtpm profile from vms as well. I've also removed some duplication that was present in xapi_xenops for creating an empty vtpm. Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_common.ml | 2 +- ocaml/idl/datamodel_vm.ml | 5 ----- ocaml/idl/datamodel_vtpm.ml | 21 ++++++++++++++------- ocaml/idl/schematest.ml | 2 +- ocaml/tests/common/test_common.ml | 4 ++-- ocaml/xapi-cli-server/cli_operations.ml | 11 +++++++++-- ocaml/xapi-cli-server/records.ml | 14 +++++--------- ocaml/xapi/create_misc.ml | 2 +- ocaml/xapi/xapi_vm.ml | 4 ++-- ocaml/xapi/xapi_vm.mli | 1 - ocaml/xapi/xapi_vm_clone.ml | 3 +-- ocaml/xapi/xapi_vtpm.ml | 17 ++++------------- ocaml/xapi/xapi_vtpm.mli | 3 ++- ocaml/xapi/xapi_xenops.ml | 23 +++++++---------------- 14 files changed, 49 insertions(+), 63 deletions(-) diff --git a/ocaml/idl/datamodel_common.ml b/ocaml/idl/datamodel_common.ml index 29267d8dce0..1004b84021c 100644 --- a/ocaml/idl/datamodel_common.ml +++ b/ocaml/idl/datamodel_common.ml @@ -9,7 +9,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 = 754 +let schema_minor_vsn = 755 (* Historical schema versions just in case this is useful later *) let rio_schema_major_vsn = 5 diff --git a/ocaml/idl/datamodel_vm.ml b/ocaml/idl/datamodel_vm.ml index d5ed864a9c5..251c6d0345d 100644 --- a/ocaml/idl/datamodel_vm.ml +++ b/ocaml/idl/datamodel_vm.ml @@ -2118,11 +2118,6 @@ let t = ~ty:(Set update_guidances) "pending_guidances" ~default_value:(Some (VSet [])) "The set of pending guidances after applying updates" - ; field ~qualifier:StaticRO ~in_product_since:rel_next - ~ty:(Map (String, String)) - ~default_value:(Some (VMap [])) "default_vtpm_profile" - "The security properties that will be used by default when \ - creating a TPMs attached to the VM / template" ] ) () diff --git a/ocaml/idl/datamodel_vtpm.ml b/ocaml/idl/datamodel_vtpm.ml index dbf5aae93c6..e14c3ca4fa4 100644 --- a/ocaml/idl/datamodel_vtpm.ml +++ b/ocaml/idl/datamodel_vtpm.ml @@ -26,11 +26,15 @@ let create = (Published, rel_rio, "") ; ( Changed , rel_next - , "Require only a VM reference to create a VTPM instance" + , "Require only a VM reference and uniqueness to create a VTPM instance" ) ] ~doc:"Create a new VTPM instance, and return its handle." - ~params:[(Ref _vm, "vM", "The VM reference the VTPM will be attached to")] + ~params: + [ + (Ref _vm, "vM", "The VM reference the VTPM will be attached to") + ; (Bool, "is_unique", "Whether the VTPM must be unique") + ] ~result:(Ref _vtpm, "The reference of the newly created VTPM") ~allowed_roles:_R_VM_ADMIN () @@ -63,7 +67,7 @@ let t = [ (Published, rel_rio, "Added VTPM stub") ; (Extended, rel_next, "Added ability to manipulate contents") - ; (Extended, rel_next, "Added VTPM profiles") + ; (Extended, rel_next, "Added VTPM unique and protected properties") ; (Extended, rel_next, "Added Persistence backed") ] ~gen_constructor_destructor:false ~name:_vtpm ~descr:"A virtual TPM device" @@ -80,10 +84,13 @@ let t = ; field ~qualifier:DynamicRO ~ty:persistence_backend ~default_value:(Some (VEnum "xapi")) ~lifecycle:[] "persistence_backend" "The backend where the vTPM is persisted" - ; field ~qualifier:DynamicRO - ~ty:(Map (String, String)) - ~lifecycle:[(Published, rel_next, "Added VTPM profiles")] - "profile" "The security properties that define how the TPM is handled" + ; field ~qualifier:StaticRO ~ty:Bool ~default_value:(Some (VBool false)) + ~lifecycle:[] "is_unique" + "Whether the contents are never copied, satisfying the TPM spec" + ; field ~qualifier:DynamicRO ~ty:Bool ~default_value:(Some (VBool false)) + ~lifecycle:[] "is_protected" + "Whether the contents of the VTPM are secured according to the TPM \ + spec" ; field ~qualifier:DynamicRO ~ty:(Ref _secret) ~internal_only:true ~lifecycle:[(Published, rel_next, "Added VTPM contents")] "contents" "The contents of the TPM" diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index aa78571cebe..0bac8180bff 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -1,7 +1,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly *) -let last_known_schema_hash = "31528dd0d66fa1dc6cbea5a25c44e79c" +let last_known_schema_hash = "611368f97e9312aaf62e8918c0936142" let current_schema_hash : string = let open Datamodel_types in diff --git a/ocaml/tests/common/test_common.ml b/ocaml/tests/common/test_common.ml index a0c9b32ffd9..01a9d4b6c1a 100644 --- a/ocaml/tests/common/test_common.ml +++ b/ocaml/tests/common/test_common.ml @@ -144,7 +144,7 @@ let make_vm ~__context ?(name_label = "name_label") ?(hardware_platform_version = 0L) ?has_vendor_device:_ ?(has_vendor_device = false) ?(reference_label = "") ?(domain_type = `hvm) ?(nVRAM = []) ?(last_booted_record = "") ?(last_boot_CPU_flags = []) - ?(power_state = `Halted) ?(default_vtpm_profile = []) () = + ?(power_state = `Halted) () = Xapi_vm.create ~__context ~name_label ~name_description ~user_version ~is_a_template ~affinity ~memory_target ~memory_static_max ~memory_dynamic_max ~memory_dynamic_min ~memory_static_min ~vCPUs_params @@ -157,7 +157,7 @@ let make_vm ~__context ?(name_label = "name_label") ~start_delay ~shutdown_delay ~order ~suspend_SR ~suspend_VDI ~snapshot_schedule ~is_vmss_snapshot ~version ~generation_id ~hardware_platform_version ~has_vendor_device ~reference_label ~domain_type - ~last_booted_record ~last_boot_CPU_flags ~default_vtpm_profile ~power_state + ~last_booted_record ~last_boot_CPU_flags ~power_state let make_host ~__context ?(uuid = make_uuid ()) ?(name_label = "host") ?(name_description = "description") ?(hostname = "localhost") diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index 212eedef351..0ca95bb7fd6 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -2744,7 +2744,7 @@ let vm_create printer rpc session_id params = ~suspend_VDI:Ref.null ~version:0L ~generation_id:"" ~hardware_platform_version:0L ~has_vendor_device:false ~reference_label:"" ~domain_type:`unspecified ~nVRAM:[] ~last_booted_record:"" - ~last_boot_CPU_flags:[] ~default_vtpm_profile:[] ~power_state:`Halted + ~last_boot_CPU_flags:[] ~power_state:`Halted in let uuid = Client.VM.get_uuid ~rpc ~session_id ~self:vm in printer (Cli_printer.PList [uuid]) @@ -7845,7 +7845,14 @@ module VTPM = struct let create printer rpc session_id params = let vm_uuid = List.assoc "vm-uuid" params in let vM = Client.VM.get_by_uuid ~rpc ~session_id ~uuid:vm_uuid in - let ref = Client.VTPM.create ~rpc ~session_id ~vM in + let is_unique = + match List.assoc_opt "is_unique" params with + | Some value -> + bool_of_string "is_unique" value + | None -> + false + in + let ref = Client.VTPM.create ~rpc ~session_id ~vM ~is_unique in let uuid = Client.VTPM.get_uuid ~rpc ~session_id ~self:ref in printer (Cli_printer.PList [uuid]) diff --git a/ocaml/xapi-cli-server/records.ml b/ocaml/xapi-cli-server/records.ml index 5403d1eab3e..1177771654b 100644 --- a/ocaml/xapi-cli-server/records.ml +++ b/ocaml/xapi-cli-server/records.ml @@ -2522,11 +2522,6 @@ let vm_record rpc session_id vm = ; make_field ~name:"vtpm" ~get:(fun () -> get_uuids_from_refs (x ()).API.vM_VTPMs) () - ; make_field ~name:"default_vtpm_profile" - ~get:(fun () -> - Record_util.s2sm_to_string "; " (x ()).API.vM_default_vtpm_profile - ) - () ] } @@ -5181,10 +5176,11 @@ let vtpm_record rpc session_id vtpm = ; make_field ~name:"vm" ~get:(fun () -> get_uuid_from_ref (x ()).API.vTPM_VM) () - ; make_field ~name:"profile" - ~get:(fun () -> - Record_util.s2sm_to_string "; " (x ()).API.vTPM_profile - ) + ; make_field ~name:"unique" + ~get:(fun () -> string_of_bool (x ()).API.vTPM_is_unique) + () + ; make_field ~name:"protected" + ~get:(fun () -> string_of_bool (x ()).API.vTPM_is_protected) () ] } diff --git a/ocaml/xapi/create_misc.ml b/ocaml/xapi/create_misc.ml index ce0e5149de8..5cc0af418f4 100644 --- a/ocaml/xapi/create_misc.ml +++ b/ocaml/xapi/create_misc.ml @@ -320,7 +320,7 @@ and create_domain_zero_record ~__context ~domain_zero_ref (host_info : host_info ~version:0L ~generation_id:"" ~hardware_platform_version:0L ~has_vendor_device:false ~requires_reboot:false ~reference_label:"" ~domain_type:Xapi_globs.domain_zero_domain_type ~nVRAM:[] - ~pending_guidances:[] ~default_vtpm_profile:[] ; + ~pending_guidances:[] ; ensure_domain_zero_metrics_record ~__context ~domain_zero_ref host_info ; Db.Host.set_control_domain ~__context ~self:localhost ~value:domain_zero_ref ; Xapi_vm_helpers.update_memory_overhead ~__context ~vm:domain_zero_ref diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 9b23f510231..d7fede1cbe4 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -594,7 +594,7 @@ let create ~__context ~name_label ~name_description ~power_state ~user_version ~is_snapshot_from_vmpp:_ ~snapshot_schedule:_ ~is_vmss_snapshot:_ ~appliance ~start_delay ~shutdown_delay ~order ~suspend_SR ~version ~generation_id ~hardware_platform_version ~has_vendor_device ~reference_label ~domain_type - ~nVRAM ~default_vtpm_profile : API.ref_VM = + ~nVRAM : API.ref_VM = if has_vendor_device then Pool_features.assert_enabled ~__context ~f:Features.PCI_device_for_auto_update ; @@ -674,7 +674,7 @@ let create ~__context ~name_label ~name_description ~power_state ~user_version ~snapshot_schedule:Ref.null ~is_vmss_snapshot:false ~appliance ~start_delay ~shutdown_delay ~order ~suspend_SR ~version ~generation_id ~hardware_platform_version ~has_vendor_device ~requires_reboot:false - ~reference_label ~domain_type ~pending_guidances:[] ~default_vtpm_profile ; + ~reference_label ~domain_type ~pending_guidances:[] ; Xapi_vm_lifecycle.update_allowed_operations ~__context ~self:vm_ref ; update_memory_overhead ~__context ~vm:vm_ref ; update_vm_virtual_hardware_platform_version ~__context ~vm:vm_ref ; diff --git a/ocaml/xapi/xapi_vm.mli b/ocaml/xapi/xapi_vm.mli index be1c0b52d09..aae51f764df 100644 --- a/ocaml/xapi/xapi_vm.mli +++ b/ocaml/xapi/xapi_vm.mli @@ -203,7 +203,6 @@ val create : -> reference_label:string -> domain_type:API.domain_type -> nVRAM:(string * string) list - -> default_vtpm_profile:(string * string) list -> API.ref_VM val destroy : __context:Context.t -> self:[`VM] Ref.t -> unit diff --git a/ocaml/xapi/xapi_vm_clone.ml b/ocaml/xapi/xapi_vm_clone.ml index 18565d93329..858e9fdf97b 100644 --- a/ocaml/xapi/xapi_vm_clone.ml +++ b/ocaml/xapi/xapi_vm_clone.ml @@ -395,8 +395,7 @@ let copy_vm_record ?snapshot_info_record ~__context ~vm ~disk_op ~new_name ~has_vendor_device:all.Db_actions.vM_has_vendor_device ~requires_reboot:false ~reference_label:all.Db_actions.vM_reference_label ~domain_type:all.Db_actions.vM_domain_type ~nVRAM:all.Db_actions.vM_NVRAM - ~pending_guidances:[] - ~default_vtpm_profile:all.Db_actions.vM_default_vtpm_profile ; + ~pending_guidances:[] ; (* update the VM's parent field in case of snapshot. Note this must be done after "ref" has been created, so that its "children" field can be updated by the database layer *) ( match disk_op with diff --git a/ocaml/xapi/xapi_vtpm.ml b/ocaml/xapi/xapi_vtpm.ml index fe6dd7569dc..7e29eff4ff3 100644 --- a/ocaml/xapi/xapi_vtpm.ml +++ b/ocaml/xapi/xapi_vtpm.ml @@ -20,26 +20,17 @@ let assert_no_vtpm_associated ~__context vm = let amount = List.length vtpms |> Int.to_string in raise Api_errors.(Server_error (vtpm_max_amount_reached, [amount])) -let introduce ~__context ~uuid ~vM ~backend ~persistence_backend ~profile - ~contents = - let ref = Ref.make () in - Db.VTPM.create ~__context ~ref ~uuid ~vM ~backend ~persistence_backend - ~profile ~contents ; - ref - -let create ~__context ~vM = +let create ~__context ~vM ~is_unique = assert_no_vtpm_associated ~__context vM ; Xapi_vm_lifecycle.assert_initial_power_state_is ~__context ~self:vM ~expected:`Halted ; - let profile = Db.VM.get_default_vtpm_profile ~__context ~self:vM in + let ref = Ref.make () in let uuid = Uuid.(to_string (make ())) in let backend = Ref.null in let persistence_backend = `xapi in let contents = Xapi_secret.create ~__context ~value:"" ~other_config:[] in - let ref = - introduce ~__context ~uuid ~vM ~backend ~persistence_backend ~profile - ~contents - in + Db.VTPM.create ~__context ~ref ~uuid ~vM ~backend ~persistence_backend + ~is_unique ~is_protected:false ~contents ; ref let destroy ~__context ~self = diff --git a/ocaml/xapi/xapi_vtpm.mli b/ocaml/xapi/xapi_vtpm.mli index 31c6c3c5a9d..ee768c4801c 100644 --- a/ocaml/xapi/xapi_vtpm.mli +++ b/ocaml/xapi/xapi_vtpm.mli @@ -12,7 +12,8 @@ GNU Lesser General Public License for more details. *) -val create : __context:Context.t -> vM:[`VM] API.Ref.t -> [`VTPM] Ref.t +val create : + __context:Context.t -> vM:[`VM] API.Ref.t -> is_unique:bool -> [`VTPM] Ref.t val destroy : __context:Context.t -> self:[`VTPM] Ref.t -> unit diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 5c1adb29874..72cf25a8b46 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -389,31 +389,22 @@ let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu = let tpm_of_vm () = let ( let* ) = Option.bind in - let* uuid = + let* vtpm = match vm.API.vM_VTPMs with | [] -> (* The vtpm parameter in platform data only has influence when the VM does not have a VTPM associated, otherwise the associated VTPM gets always attached. *) - if bool vm.API.vM_platform false "vtpm" then ( - 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 ~backend:Ref.null ~persistence_backend:`xapi ~contents ; - Some vtpm_uuid - ) else + if bool vm.API.vM_platform false "vtpm" then + Some (Xapi_vtpm.create ~__context ~vM:vmref ~is_unique:false) + else None - | [self] -> - Some (Db.VTPM.get_uuid ~__context ~self) + | [vtpm] -> + Some vtpm | _ :: _ :: _ -> failwith "Multiple vTPMs are not supported" in + let uuid = Db.VTPM.get_uuid ~__context ~self:vtpm in Some (Xenops_interface.Vm.Vtpm (Uuidm.of_string uuid |> Option.get)) in From ffd9ca8f7b3d54c2f84850de482a25e7eee401e7 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 7 Jul 2022 16:31:55 +0100 Subject: [PATCH 42/53] vtpm: allow the lifecycle of the vtpm contents to be autogenerated Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_vtpm.ml | 3 +-- ocaml/idl/schematest.ml | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/ocaml/idl/datamodel_vtpm.ml b/ocaml/idl/datamodel_vtpm.ml index e14c3ca4fa4..7883e627036 100644 --- a/ocaml/idl/datamodel_vtpm.ml +++ b/ocaml/idl/datamodel_vtpm.ml @@ -92,8 +92,7 @@ let t = "Whether the contents of the VTPM are secured according to the TPM \ spec" ; field ~qualifier:DynamicRO ~ty:(Ref _secret) ~internal_only:true - ~lifecycle:[(Published, rel_next, "Added VTPM contents")] - "contents" "The contents of the TPM" + ~lifecycle:[] "contents" "The contents of the TPM" ] ~messages:[create; destroy; get_contents; set_contents] () diff --git a/ocaml/idl/schematest.ml b/ocaml/idl/schematest.ml index 0bac8180bff..e813dae06c6 100644 --- a/ocaml/idl/schematest.ml +++ b/ocaml/idl/schematest.ml @@ -1,7 +1,7 @@ let hash x = Digest.string x |> Digest.to_hex (* BEWARE: if this changes, check that schema has been bumped accordingly *) -let last_known_schema_hash = "611368f97e9312aaf62e8918c0936142" +let last_known_schema_hash = "7959564ea47f1bad8ab6935ccbaa1f6c" let current_schema_hash : string = let open Datamodel_types in From 8792bca66f440bcc8f79ba5118f224fb2f0943c4 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 29 Jul 2022 16:25:12 +0100 Subject: [PATCH 43/53] db_upgrade: use module name for debug messages Using xapi is not helpful, despite what the comment states Signed-off-by: Pau Ruiz Safont --- ocaml/database/db_upgrade.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/ocaml/database/db_upgrade.ml b/ocaml/database/db_upgrade.ml index fc8040c930f..9e06a0c9e48 100644 --- a/ocaml/database/db_upgrade.ml +++ b/ocaml/database/db_upgrade.ml @@ -12,9 +12,7 @@ * GNU Lesser General Public License for more details. *) -module D = Debug.Make (struct - let name = "xapi" (* this is set to 'xapi' deliberately! :) *) -end) +module D = Debug.Make (struct let name = __MODULE__ end) open D open Db_cache_types From c2cdf8521cc53b01f2fe3d59790edb6a51eac553 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 1 Aug 2022 17:44:30 +0100 Subject: [PATCH 44/53] database: use accurate message when a field lacks a default on update The previous message could be confusing and give no leads on how it could be fixed Signed-off-by: Pau Ruiz Safont --- ocaml/database/database_test.ml | 11 ++++++++++- ocaml/database/db_cache_types.ml | 7 ++++++- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/ocaml/database/database_test.ml b/ocaml/database/database_test.ml index fc11adbce20..51e28dbf387 100644 --- a/ocaml/database/database_test.ml +++ b/ocaml/database/database_test.ml @@ -84,6 +84,15 @@ functor -> () + let expect_missing_default name f = + try f () + with + | Db_exn.DBCache_NotFound + ("missing default value in datamodel for new field", name', _) + when name' = name + -> + () + let expect_missing_field name f = try f () with @@ -515,7 +524,7 @@ functor ) ; Printf.printf "create_row \n" ; - expect_missing_field name_label (fun () -> + expect_missing_default name_label (fun () -> let broken_vm = List.filter (fun (k, _) -> k <> name_label) diff --git a/ocaml/database/db_cache_types.ml b/ocaml/database/db_cache_types.ml index d0a58d6e27b..02659e64107 100644 --- a/ocaml/database/db_cache_types.ml +++ b/ocaml/database/db_cache_types.ml @@ -171,7 +171,12 @@ module Row = struct add g c.Schema.Column.name default t | None -> raise - (DBCache_NotFound ("missing field", c.Schema.Column.name, "")) + (DBCache_NotFound + ( "missing default value in datamodel for new field" + , c.Schema.Column.name + , "" + ) + ) else t ) From b2ae0c41be24f0ba0dab26a0d8ef2c74a2579948 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 2 Aug 2022 17:27:32 +0100 Subject: [PATCH 45/53] maintenance: comment whitespace Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/xapi_vdi.ml | 16 ++++++++-------- ocaml/xapi/xapi_vm_clone.ml | 26 +++++++++++++++----------- 2 files changed, 23 insertions(+), 19 deletions(-) diff --git a/ocaml/xapi/xapi_vdi.ml b/ocaml/xapi/xapi_vdi.ml index a9316d4696d..74903e3b199 100644 --- a/ocaml/xapi/xapi_vdi.ml +++ b/ocaml/xapi/xapi_vdi.ml @@ -1096,15 +1096,15 @@ let clone ~__context ~vdi ~driver_params = in try (* Remove the vdi_clone from the SR's current operations, this prevents the whole - SR being locked for the duration of the slow copy *) + SR being locked for the duration of the slow copy *) let task_id = Ref.string_of (Context.get_task_id __context) in Db.SR.remove_from_current_operations ~__context ~self:a.Db_actions.vDI_SR ~key:task_id ; Xapi_sr_operations.update_allowed_operations ~__context ~self:a.Db_actions.vDI_SR ; (* Remove the clone from the VDI's current operations since the dom0 block-attach - will protect the VDI anyway. There's no point refreshing the VDI's allowed operations - because they're going to change when the VBD.plug happens. *) + will protect the VDI anyway. There's no point refreshing the VDI's allowed operations + because they're going to change when the VBD.plug happens. *) Db.VDI.remove_from_current_operations ~__context ~self:vdi ~key:task_id ; Sm_fs_ops.copy_vdi ~__context vdi newvdi ; @@ -1125,11 +1125,11 @@ let copy ~__context ~vdi ~sr ~base_vdi ~into_vdi = let src = Db.VDI.get_record ~__context ~self:vdi in (* If 'into' is a valid VDI then we will write into that. - Otherwise we'll create a fresh VDI in 'sr'. *) + Otherwise we'll create a fresh VDI in 'sr'. *) (* Note that we should destroy 'dst' on failure IFF we created it - here. We really ought to have a persistent log of cleanup actions, - since this will get lost over process restart. *) + here. We really ought to have a persistent log of cleanup actions, + since this will get lost over process restart. *) let vdi_to_cleanup = ref None in try let dst = @@ -1137,8 +1137,8 @@ let copy ~__context ~vdi ~sr ~base_vdi ~into_vdi = into_vdi else (* When creating a new VDI, clone as many properties of the - original as we can. If we're not cloning a property, please - explain why in a comment. *) + original as we can. If we're not cloning a property, please + explain why in a comment. *) Helpers.call_api_functions ~__context (fun rpc session_id -> let new_vdi = Client.VDI.create ~rpc ~session_id diff --git a/ocaml/xapi/xapi_vm_clone.ml b/ocaml/xapi/xapi_vm_clone.ml index 858e9fdf97b..e2ac95ed6a6 100644 --- a/ocaml/xapi/xapi_vm_clone.ml +++ b/ocaml/xapi/xapi_vm_clone.ml @@ -410,7 +410,8 @@ let copy_vm_record ?snapshot_info_record ~__context ~vm ~disk_op ~new_name let make_driver_params () = [(Constants._sm_epoch_hint, Uuid.to_string (Uuid.make ()))] -(* NB this function may be called when the VM is suspended for copy/clone operations. Snapshot can be done in live.*) +(* NB this function may be called when the VM is suspended for copy/clone + operations. Snapshot can be done in live. *) let clone ?snapshot_info_record ?(ignore_vdis = []) disk_op ~__context ~vm ~new_name = Helpers.call_api_functions ~__context (fun rpc session_id -> @@ -419,8 +420,8 @@ let clone ?snapshot_info_record ?(ignore_vdis = []) disk_op ~__context ~vm let vifs = Db.VM.get_VIFs ~__context ~self:vm in let vgpus = Db.VM.get_VGPUs ~__context ~self:vm in let power_state = Db.VM.get_power_state ~__context ~self:vm in - (* if we do a snaphshot on a VM, then the new VM must remain halted. *) - (* Otherwise, we keep the same power-state as the initial VM *) + (* If a VM is snapshotted, then the new VM must remain halted. + Otherwise, we keep the same power-state as the initial VM *) let new_power_state = match (disk_op, power_state) with | Disk_op_checkpoint, (`Running | `Suspended) -> @@ -445,8 +446,9 @@ let clone ?snapshot_info_record ?(ignore_vdis = []) disk_op ~__context ~vm vbds in - (* Check licence permission before copying disks, since the copy can take a long time. - * We always allow snapshotting a VM, but check before clone/copy of an existing snapshot or template. *) + (* Check licence permission before copying disks, since the copy can take + a long time. We always allow snapshotting a VM, but check before + clone/copy of an existing snapshot or template. *) if Db.VM.get_has_vendor_device ~__context ~self:vm && not is_a_snapshot then Pool_features.assert_enabled ~__context @@ -463,9 +465,9 @@ let clone ?snapshot_info_record ?(ignore_vdis = []) disk_op ~__context ~vm copy_vm_record ?snapshot_info_record ~__context ~vm ~disk_op ~new_name ~new_power_state () in - (* copy every VBD using the new VDI as backend *) - (* if this fails halfway through, delete the VM and the VDIs, but don't worry *) - (* about any VBDs left hanging around, as these will be GC'd later *) + (* Copy every VBD using the new VDI as backend. If this fails halfway + through, delete the VM and the VDIs, but don't worry about any VBDs + left hanging around, as these will be GC'd later. *) try (* copy VBDs *) List.iter @@ -473,9 +475,11 @@ let clone ?snapshot_info_record ?(ignore_vdis = []) disk_op ~__context ~vm let vbd = Xapi_vbd_helpers.copy ~__context ~vm:ref ~vdi:newvdi vbd in - (* CA-58405: when we make a clone/snapshot/checkpoint we consider the clone/snapshot/checkpoint VM - to "own" all the clone/snapshot/checkpoint *disks* irrespective of the ownership of the original - disks. We wish the clone/snapshot/checkpoint disks to be cleaned up with the VM. *) + (* CA-58405: when we make a clone/snapshot/checkpoint we consider + the clone / snapshot / checkpoint VM to "own" all the clone / + snapshot / checkpoint *disks* irrespective of the ownership of + the original disks. We wish the clone / snapshot / checkpoint + disks to be cleaned up with the VM. *) if Db.VBD.get_type ~__context ~self:vbd = `Disk then let other_config = Db.VBD.get_other_config ~__context ~self:vbd From 19ce597f6305583b142de058226ecc1b09e1174e Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 9 Aug 2022 17:24:18 +0100 Subject: [PATCH 46/53] CP-39850: Copy VTPM on clone The current persistence backend needs to add copying to secrets, this should be removed as soon as the backend is removed, we want to avoid other code to depend on it. The is_unique flag prevents copying the vtpm contents when cloning, instead a new vtpm is recreated, this breaks Guest features like bitlocker on the newly created VM. Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/xapi_secret.ml | 7 +++++++ ocaml/xapi/xapi_vm_clone.ml | 5 +++++ ocaml/xapi/xapi_vtpm.ml | 37 +++++++++++++++++++++++++++++++------ ocaml/xapi/xapi_vtpm.mli | 3 +++ 4 files changed, 46 insertions(+), 6 deletions(-) diff --git a/ocaml/xapi/xapi_secret.ml b/ocaml/xapi/xapi_secret.ml index a9d6388a7d3..26f2ef7267d 100644 --- a/ocaml/xapi/xapi_secret.ml +++ b/ocaml/xapi/xapi_secret.ml @@ -45,6 +45,13 @@ let clean_out_passwds ~__context strmap = let secrets = List.map snd (List.filter check_key strmap) in List.iter delete_secret secrets +let copy ~__context ~secret = + let uuid = Uuid.(to_string (make ())) in + let value = Db.Secret.get_value ~__context ~self:secret in + let other_config = Db.Secret.get_other_config ~__context ~self:secret in + let ref = introduce ~__context ~uuid ~value ~other_config in + ref + (* Modify a ((string * string) list) by duplicating all the passwords found in * it *) let duplicate_passwds ~__context strmap = diff --git a/ocaml/xapi/xapi_vm_clone.ml b/ocaml/xapi/xapi_vm_clone.ml index e2ac95ed6a6..31eca2411bc 100644 --- a/ocaml/xapi/xapi_vm_clone.ml +++ b/ocaml/xapi/xapi_vm_clone.ml @@ -419,6 +419,7 @@ let clone ?snapshot_info_record ?(ignore_vdis = []) disk_op ~__context ~vm let vbds = Db.VM.get_VBDs ~__context ~self:vm in let vifs = Db.VM.get_VIFs ~__context ~self:vm in let vgpus = Db.VM.get_VGPUs ~__context ~self:vm in + let vtpms = Db.VM.get_VTPMs ~__context ~self:vm in let power_state = Db.VM.get_power_state ~__context ~self:vm in (* If a VM is snapshotted, then the new VM must remain halted. Otherwise, we keep the same power-state as the initial VM *) @@ -502,6 +503,10 @@ let clone ?snapshot_info_record ?(ignore_vdis = []) disk_op ~__context ~vm let (_ : [`VGPU] Ref.t list) = List.map (fun vgpu -> Xapi_vgpu.copy ~__context ~vm:ref vgpu) vgpus in + (* copy vTPMs *) + let (_ : [`VTPM] Ref.t list) = + List.map (fun vtpm -> Xapi_vtpm.copy ~__context ~vM:ref vtpm) vtpms + in (* copy the suspended VDI if needed *) let suspend_VDI = Helpers.call_api_functions ~__context (fun rpc session_id -> diff --git a/ocaml/xapi/xapi_vtpm.ml b/ocaml/xapi/xapi_vtpm.ml index 7e29eff4ff3..f5ea2ead1d3 100644 --- a/ocaml/xapi/xapi_vtpm.ml +++ b/ocaml/xapi/xapi_vtpm.ml @@ -20,19 +20,44 @@ let assert_no_vtpm_associated ~__context vm = let amount = List.length vtpms |> Int.to_string in raise Api_errors.(Server_error (vtpm_max_amount_reached, [amount])) -let create ~__context ~vM ~is_unique = - assert_no_vtpm_associated ~__context vM ; - Xapi_vm_lifecycle.assert_initial_power_state_is ~__context ~self:vM - ~expected:`Halted ; +let introduce ~__context ~vM ~persistence_backend ~contents ~is_unique = let ref = Ref.make () in let uuid = Uuid.(to_string (make ())) in let backend = Ref.null in - let persistence_backend = `xapi in - let contents = Xapi_secret.create ~__context ~value:"" ~other_config:[] in Db.VTPM.create ~__context ~ref ~uuid ~vM ~backend ~persistence_backend ~is_unique ~is_protected:false ~contents ; ref +(** Contents from unique vtpms cannot be copied! *) +let get_contents ~__context ?from () = + let create () = Xapi_secret.create ~__context ~value:"" ~other_config:[] in + let copy ref = + let contents = Db.VTPM.get_contents ~__context ~self:ref in + Xapi_secret.copy ~__context ~secret:contents + in + let maybe_copy ref = + if Db.VTPM.get_is_unique ~__context ~self:ref then + create () + else + copy ref + in + Option.fold ~none:(create ()) ~some:maybe_copy from + +let create ~__context ~vM ~is_unique = + assert_no_vtpm_associated ~__context vM ; + Xapi_vm_lifecycle.assert_initial_power_state_is ~__context ~self:vM + ~expected:`Halted ; + let persistence_backend = `xapi in + let contents = get_contents ~__context () in + introduce ~__context ~vM ~persistence_backend ~contents ~is_unique + +let copy ~__context ~vM ref = + let vtpm = Db.VTPM.get_record ~__context ~self:ref in + let persistence_backend = vtpm.vTPM_persistence_backend in + let is_unique = vtpm.vTPM_is_unique in + let contents = get_contents ~__context ~from:ref () in + introduce ~__context ~vM ~persistence_backend ~contents ~is_unique + let destroy ~__context ~self = let vm = Db.VTPM.get_VM ~__context ~self in Xapi_vm_lifecycle.assert_initial_power_state_is ~__context ~self:vm diff --git a/ocaml/xapi/xapi_vtpm.mli b/ocaml/xapi/xapi_vtpm.mli index ee768c4801c..5a7b4f5e643 100644 --- a/ocaml/xapi/xapi_vtpm.mli +++ b/ocaml/xapi/xapi_vtpm.mli @@ -15,6 +15,9 @@ val create : __context:Context.t -> vM:[`VM] API.Ref.t -> is_unique:bool -> [`VTPM] Ref.t +val copy : + __context:Context.t -> vM:[`VM] Ref.t -> [`VTPM] Ref.t -> [`VTPM] Ref.t + val destroy : __context:Context.t -> self:[`VTPM] Ref.t -> unit val get_contents : __context:Context.t -> self:[`VTPM] Ref.t -> string From 191ae1fb00be94e54119737c48d01eb567c1a102 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 11 Aug 2022 14:08:59 +0100 Subject: [PATCH 47/53] CP-39850: Block live snapshots for VMs with vTPM This fails because xapi's DB may not have the contents of the VTPM at the time the snapshot is taken. This means that taking a snapshot could lead to data loss, instead block it. Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/xapi_vm_clone.ml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/ocaml/xapi/xapi_vm_clone.ml b/ocaml/xapi/xapi_vm_clone.ml index 31eca2411bc..a60a2c0c4f8 100644 --- a/ocaml/xapi/xapi_vm_clone.ml +++ b/ocaml/xapi/xapi_vm_clone.ml @@ -421,6 +421,18 @@ let clone ?snapshot_info_record ?(ignore_vdis = []) disk_op ~__context ~vm let vgpus = Db.VM.get_VGPUs ~__context ~self:vm in let vtpms = Db.VM.get_VTPMs ~__context ~self:vm in let power_state = Db.VM.get_power_state ~__context ~self:vm in + ( match (power_state, vtpms) with + | `Running, _ :: _ -> + error "%s: Running VMs with VTPMs cannot be snapshotted yet" + __FUNCTION__ ; + raise + Api_errors.( + Server_error + (not_implemented, ["VM.clone of running VM with VTPM"]) + ) + | _ -> + () + ) ; (* If a VM is snapshotted, then the new VM must remain halted. Otherwise, we keep the same power-state as the initial VM *) let new_power_state = From b059fd3ca0c7eb6aafefe42be78d490469f3e09f Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Mon, 15 Aug 2022 15:29:25 +0100 Subject: [PATCH 48/53] CP-40284: Gate VTPM creation behind an experimental feature This also blocks creation of VMs from templates with vtpm in the platform data. Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/xapi_vtpm.ml | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/ocaml/xapi/xapi_vtpm.ml b/ocaml/xapi/xapi_vtpm.ml index f5ea2ead1d3..3d6e477be43 100644 --- a/ocaml/xapi/xapi_vtpm.ml +++ b/ocaml/xapi/xapi_vtpm.ml @@ -12,6 +12,17 @@ GNU Lesser General Public License for more details. *) +(** Don't allow unless VTPM is enabled as an experimental feature *) +let assert_not_restricted ~__context = + let pool = Helpers.get_pool ~__context in + let restrictions = Db.Pool.get_restrictions ~__context ~self:pool in + let feature = "restrict_vtpm" in + match List.assoc_opt feature restrictions with + | Some "false" -> + () + | _ -> + raise Api_errors.(Server_error (feature_restricted, [feature])) + let assert_no_vtpm_associated ~__context vm = match Db.VM.get_VTPMs ~__context ~self:vm with | [] -> @@ -44,6 +55,7 @@ let get_contents ~__context ?from () = Option.fold ~none:(create ()) ~some:maybe_copy from let create ~__context ~vM ~is_unique = + assert_not_restricted ~__context ; assert_no_vtpm_associated ~__context vM ; Xapi_vm_lifecycle.assert_initial_power_state_is ~__context ~self:vM ~expected:`Halted ; From ea90f23d265c58b4ade7578b650c6bc47d086ce0 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 16 Aug 2022 10:18:33 +0100 Subject: [PATCH 49/53] CP-39874: Prevent VTPMs and HA from coexisting The state of VTPMs and xapi's database are usually out-of-sync. Using them while HA is enabled can lead to data loss. Block the two features from being used at the same time. Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/helpers.ml | 7 +++++++ ocaml/xapi/xapi_cluster.ml | 1 + ocaml/xapi/xapi_pool.ml | 3 ++- ocaml/xapi/xapi_vtpm.ml | 16 +++++++++++++++- 4 files changed, 25 insertions(+), 2 deletions(-) diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index 7ab933bf2bb..79f85d6a248 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -888,6 +888,13 @@ let is_platform_version_same_on_master ~__context ~host = (LocalObject host) = 0 +let assert_ha_vtpms_compatible ~__context = + let on_db = {|field "persistence_backend"="xapi"|} in + let vtpms_on_db = Db.VTPM.get_all_records_where ~__context ~expr:on_db in + if vtpms_on_db <> [] then + let message = "VTPM persistence when HA or clustering is enabled" in + raise Api_errors.(Server_error (not_implemented, [message])) + let assert_platform_version_is_same_on_master ~__context ~host ~self = if not (is_platform_version_same_on_master ~__context ~host) then raise diff --git a/ocaml/xapi/xapi_cluster.ml b/ocaml/xapi/xapi_cluster.ml index d72fee8f782..b856c7ecea6 100644 --- a/ocaml/xapi/xapi_cluster.ml +++ b/ocaml/xapi/xapi_cluster.ml @@ -34,6 +34,7 @@ let validate_params ~token_timeout ~token_timeout_coefficient = let create ~__context ~pIF ~cluster_stack ~pool_auto_join ~token_timeout ~token_timeout_coefficient = assert_cluster_stack_valid ~cluster_stack ; + Helpers.assert_ha_vtpms_compatible ~__context ; (* Currently we only support corosync. If we support more cluster stacks, this * should be replaced by a general function that checks the given cluster_stack *) Pool_features.assert_enabled ~__context ~f:Features.Corosync ; diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index ea8a448784e..11113a5abce 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -2338,12 +2338,13 @@ let create_VLAN_from_PIF ~__context ~pif ~network ~vLAN = let enable_disable_m = Mutex.create () let enable_ha ~__context ~heartbeat_srs ~configuration = + Helpers.assert_ha_vtpms_compatible ~__context ; if not (Helpers.pool_has_different_host_platform_versions ~__context) then with_lock enable_disable_m (fun () -> Xapi_ha.enable __context heartbeat_srs configuration ) else - raise (Api_errors.Server_error (Api_errors.not_supported_during_upgrade, [])) + raise Api_errors.(Server_error (not_supported_during_upgrade, [])) let disable_ha ~__context = with_lock enable_disable_m (fun () -> Xapi_ha.disable __context) diff --git a/ocaml/xapi/xapi_vtpm.ml b/ocaml/xapi/xapi_vtpm.ml index 3d6e477be43..48badea70e3 100644 --- a/ocaml/xapi/xapi_vtpm.ml +++ b/ocaml/xapi/xapi_vtpm.ml @@ -23,6 +23,19 @@ let assert_not_restricted ~__context = | _ -> raise Api_errors.(Server_error (feature_restricted, [feature])) +(** The state in the xapi backend is only up-to-date when the VMs are halted *) +let assert_no_fencing ~__context ~persistence_backend = + let pool = Helpers.get_pool ~__context in + let ha_enabled = Db.Pool.get_ha_enabled ~__context ~self:pool in + let clustering_enabled = Db.Cluster.get_all ~__context <> [] in + let may_fence = ha_enabled || clustering_enabled in + match (persistence_backend, may_fence) with + | `xapi, true -> + let message = "VTPM.create with HA or clustering enabled" in + raise Api_errors.(Server_error (not_implemented, [message])) + | _ -> + () + let assert_no_vtpm_associated ~__context vm = match Db.VM.get_VTPMs ~__context ~self:vm with | [] -> @@ -55,11 +68,12 @@ let get_contents ~__context ?from () = Option.fold ~none:(create ()) ~some:maybe_copy from let create ~__context ~vM ~is_unique = + let persistence_backend = `xapi in assert_not_restricted ~__context ; + assert_no_fencing ~__context ~persistence_backend ; assert_no_vtpm_associated ~__context vM ; Xapi_vm_lifecycle.assert_initial_power_state_is ~__context ~self:vM ~expected:`Halted ; - let persistence_backend = `xapi in let contents = get_contents ~__context () in introduce ~__context ~vM ~persistence_backend ~contents ~is_unique From 97b958c7d54a1123efb47e2b177712887aea40ae Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Thu, 18 Aug 2022 09:44:08 +0100 Subject: [PATCH 50/53] CP-40087: Display the correct names of VTPM profiles in the CLI Signed-off-by: Pau Ruiz Safont --- ocaml/xapi-cli-server/records.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ocaml/xapi-cli-server/records.ml b/ocaml/xapi-cli-server/records.ml index 1177771654b..68f0f55cdd7 100644 --- a/ocaml/xapi-cli-server/records.ml +++ b/ocaml/xapi-cli-server/records.ml @@ -5176,10 +5176,10 @@ let vtpm_record rpc session_id vtpm = ; make_field ~name:"vm" ~get:(fun () -> get_uuid_from_ref (x ()).API.vTPM_VM) () - ; make_field ~name:"unique" + ; make_field ~name:"is_unique" ~get:(fun () -> string_of_bool (x ()).API.vTPM_is_unique) () - ; make_field ~name:"protected" + ; make_field ~name:"is_protected" ~get:(fun () -> string_of_bool (x ()).API.vTPM_is_protected) () ] From 3ecb5bdf32c681a9a341c8b1abe55628df033040 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Fri, 26 Aug 2022 13:49:51 +0100 Subject: [PATCH 51/53] CP-40444: Add swtpm-wrapper to the repository Relevant messages from its changelog: CP-35104: Add swtpm-wrapper for proper logging CP-35054: Start SWTPM daemon deprivilideged CP-40195: Only call swtpm_setup for manufacture swtpm_setup is run as root and handles guest data on subsequent boots after TPM manufacture. Avoid running it completely after the initial manufacture to avoid any possible security issues. The '.lock' will only be present after running swtpm_setup so run chown conditionally. At the same time, handle errors from chown rather than silently ignoring them. CA-369317: Don't ignore errors from swtpm_setup Signed-off-by: Pau Ruiz Safont --- Makefile | 1 + ocaml/xenopsd/scripts/swtpm-wrapper | 168 ++++++++++++++++++++++++++++ 2 files changed, 169 insertions(+) create mode 100755 ocaml/xenopsd/scripts/swtpm-wrapper diff --git a/Makefile b/Makefile index eefb0a1e759..d24ee21a05f 100644 --- a/Makefile +++ b/Makefile @@ -173,6 +173,7 @@ install: build doc sdk doc-json install -D ./ocaml/xenopsd/scripts/common.py $(DESTDIR)/$(XENOPSD_LIBEXECDIR)/common.py install -D ./ocaml/xenopsd/scripts/igmp_query_injector.py $(DESTDIR)/$(XENOPSD_LIBEXECDIR)/igmp_query_injector.py install -D ./ocaml/xenopsd/scripts/qemu-wrapper $(DESTDIR)/$(QEMU_WRAPPER_DIR)/qemu-wrapper + install -D ./ocaml/xenopsd/scripts/swtpm-wrapper $(DESTDIR)/$(QEMU_WRAPPER_DIR)/swtpm-wrapper DESTDIR=$(DESTDIR) SBINDIR=$(SBINDIR) QEMU_WRAPPER_DIR=$(QEMU_WRAPPER_DIR) XENOPSD_LIBEXECDIR=$(XENOPSD_LIBEXECDIR) ETCDIR=$(ETCDIR) ./ocaml/xenopsd/scripts/make-custom-xenopsd.conf # squeezed install -D _build/install/default/bin/squeezed $(DESTDIR)/$(SBINDIR)/squeezed diff --git a/ocaml/xenopsd/scripts/swtpm-wrapper b/ocaml/xenopsd/scripts/swtpm-wrapper new file mode 100755 index 00000000000..492fd1e9764 --- /dev/null +++ b/ocaml/xenopsd/scripts/swtpm-wrapper @@ -0,0 +1,168 @@ +#! /usr/bin/python +# +# Copyright (C) 2022 Citrix Systems R&D Ltd. +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU Lesser General Public License as published +# by the Free Software Foundation; version 2.1 only. with the special +# exception on linking described in file LICENSE. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Lesser General Public License for more details. + +from __future__ import print_function +import os +import stat +import sys +import pwd +import grp +import subprocess +import ctypes +import ctypes.util +from resource import getrlimit, RLIMIT_CORE, RLIMIT_FSIZE, setrlimit + + +STATE_FILE = 'tpm2-00.permall' + +CLONE_NEWNS = 0x00020000 # mount namespace +CLONE_NEWNET = 0x40000000 # network namespace +CLONE_NEWIPC = 0x08000000 # IPC namespace + +# Set cgroup_slice to the name of the cgroup slice the swtpm process +# should live in. +# - None means leave in the same slice as the parent process. +# - '' means move it into the default slice. +# - 'system.slice' means move it into the system slice, etc. +# If the nominated slice does not already exist, the process will be +# left in its parent's slice. +cgroup_slice = '' + +def unshare(flags): + libc = ctypes.CDLL(ctypes.util.find_library('c'), use_errno=True) + unshare_prototype = ctypes.CFUNCTYPE(ctypes.c_int, ctypes.c_int, use_errno=True) + unshare = unshare_prototype(('unshare', libc)) + ret = unshare(flags) + if ret < 0: + raise OSError(ctypes.get_errno(), os.strerror(ctypes.get_errno())) + +def enable_core_dumps(): + + limit = 64 * 1024 * 1024 + oldlimits = getrlimit(RLIMIT_CORE) + hardlimit = oldlimits[1] + if limit > hardlimit: + hardlimit = limit + setrlimit(RLIMIT_CORE, (limit, hardlimit)) + return limit + +def prepare_exec(): + """Set up the execution environment for SWTPM.""" + + if cgroup_slice is not None: + # Move to nominated cgroup slice + print("Moving to cgroup slice '%s'" % cgroup_slice) + try: + # Note the default slice uses /sys/fs/cgroup/cpu/tasks but + # other.slice uses /sys/fs/cgroup/cpu/other.slice/tasks. + g = open("/sys/fs/cgroup/cpu/%s/tasks" % cgroup_slice, 'w') + g.write(str(os.getpid())) + g.close() + except IOError as e: + print("Warning: writing pid to '%s' tasks file: %s" \ + % (cgroup_slice, e)) + + core_dump_limit = enable_core_dumps() + print("core dump limit: %d" % core_dump_limit) + + limit = 256 * 1024 + setrlimit(RLIMIT_FSIZE, (limit, limit)) + + flags = CLONE_NEWNS | CLONE_NEWIPC | CLONE_NEWNET + unshare(flags) + + sys.stdout.flush() + sys.stderr.flush() + +def main(argv): + print("Arguments: %s" % " ".join(argv[1:])) + + if len(argv) < 3: + return + + domid = int(argv[1]) + tpm_dir = argv[2] + tpm_path = tpm_dir + depriv = True + + n= 3 + while n < len(argv): + if argv[n] == "-priv": + depriv = False + continue + n += 1 + + tpm_env = dict(os.environ) + tpm_env["LD_LIBRARY_PATH"] = "/usr/lib:" + + if not os.path.exists(os.path.join(tpm_dir, STATE_FILE)): + # Initial manufacture + + tpm_exe = '/usr/bin/swtpm_setup' + tpm_args = ["swtpm_setup", "--tpm2", "--tpm-state", tpm_dir, "--createek", "--create-ek-cert", "--create-platform-cert", "--lock-nvram", "--not-overwrite"] + subprocess.check_call(tpm_args, executable=tpm_exe, env=tpm_env) + + tpm_exe = '/usr/bin/swtpm' + uid = pwd.getpwnam('swtpm_base').pw_uid + domid + tpm_args = [] + + if depriv: + tpm_args = ["--chroot", tpm_dir, + "--runas", str(uid)] + try: + dev_dir = os.path.join(tpm_dir, "dev") + if not os.path.isdir(dev_dir): + os.mkdir(dev_dir) + + urandom = os.path.join(dev_dir, "urandom") + if not os.path.exists(urandom): + os.mknod(urandom, 0666 | stat.S_IFCHR, os.makedev(1, 9)) + + os.chown(tpm_dir, uid, uid) + if os.path.exists(os.path.join(tpm_dir, ".lock")): + os.chown(os.path.join(tpm_dir, ".lock"), uid, uid) + os.chown(os.path.join(tpm_dir, STATE_FILE), uid, uid) + + except OSError as error: + print(error) + return + + tpm_path = '/' + + swtpm_sock = os.path.join(tpm_path, "swtpm-sock") + swtpm_pid = os.path.join(tpm_path, "swtpm-%d.pid" % domid) + + tpm_args = ["swtpm-%d" % domid, "socket", + "--tpm2", + "--tpmstate", "dir=%s" % tpm_path, + "--ctrl", "type=unixio,path=%s" % swtpm_sock, + "--log", "level=1", + "--pid", "file=%s" % swtpm_pid, + "-t"] + tpm_args + + swtpm = subprocess.Popen(tpm_args,executable=tpm_exe, preexec_fn=prepare_exec(), env=tpm_env, stdout=subprocess.PIPE, stderr=subprocess.STDOUT) + print("Exec: %s %s" % (tpm_exe, " ".join(tpm_args))) + + sys.stdout.flush() + sys.stderr.flush() + + # Redirect output from SWTPM to logger + os.dup2(swtpm.stdout.fileno(), 0) + swtpm.stdout.close() + + os.execvp('logger', ['logger', '-p', 'daemon.info', '-t', + 'swtpm-%d[%d]' % (domid, swtpm.pid)]) + +if __name__ == '__main__': + raise SystemExit(main(sys.argv)) From 9acd4dd989e56d1f1160230fc836fccabf29c6f5 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Tue, 30 Aug 2022 15:11:46 +0100 Subject: [PATCH 52/53] CP-40444: Mark VTPM class as prototype Although the module has existed since the Rio release, it doesn't make sense to state so. This is because until now it was impossible to create vtpm objects in the database, trying to create one of them resulted in an exception. This has the added benefit to mark all the parts of the class to be prototypes and this will make them easier to change before the feature becomes stable. Signed-off-by: Pau Ruiz Safont --- ocaml/idl/datamodel_vtpm.ml | 29 +++++++---------------------- 1 file changed, 7 insertions(+), 22 deletions(-) diff --git a/ocaml/idl/datamodel_vtpm.ml b/ocaml/idl/datamodel_vtpm.ml index 7883e627036..118a9b83464 100644 --- a/ocaml/idl/datamodel_vtpm.ml +++ b/ocaml/idl/datamodel_vtpm.ml @@ -20,15 +20,7 @@ let persistence_backend = Enum ("persistence_backend", [("xapi", "This VTPM is persisted in XAPI's DB")]) let create = - call ~name:"create" - ~lifecycle: - [ - (Published, rel_rio, "") - ; ( Changed - , rel_next - , "Require only a VM reference and uniqueness to create a VTPM instance" - ) - ] + call ~name:"create" ~lifecycle:[] ~doc:"Create a new VTPM instance, and return its handle." ~params: [ @@ -39,20 +31,20 @@ let create = ~allowed_roles:_R_VM_ADMIN () let destroy = - call ~name:"destroy" ~lifecycle:[(Published, rel_rio, "")] + call ~name:"destroy" ~lifecycle:[] ~doc:"Destroy the specified VTPM instance, along with its state." ~params:[(Ref _vtpm, "self", "The reference to the VTPM object")] ~allowed_roles:_R_VM_ADMIN () let get_contents = - call ~name:"get_contents" ~in_product_since:"rel_next" - ~doc:"Obtain the contents of the TPM" ~secret:true + call ~name:"get_contents" ~lifecycle:[] ~doc:"Obtain the contents of the TPM" + ~secret:true ~params:[(Ref _vtpm, "self", "The VTPM reference")] ~result:(String, "The contents") ~hide_from_docs:true ~allowed_roles:_R_LOCAL_ROOT_ONLY () let set_contents = - call ~name:"set_contents" ~in_product_since:"rel_next" + call ~name:"set_contents" ~lifecycle:[] ~doc:"Introduce new contents for the TPM" ~secret:true ~params: [ @@ -63,15 +55,8 @@ let set_contents = let t = create_obj ~in_db:true ~in_oss_since:oss_since_303 ~persist:PersistEverything - ~lifecycle: - [ - (Published, rel_rio, "Added VTPM stub") - ; (Extended, rel_next, "Added ability to manipulate contents") - ; (Extended, rel_next, "Added VTPM unique and protected properties") - ; (Extended, rel_next, "Added Persistence backed") - ] - ~gen_constructor_destructor:false ~name:_vtpm ~descr:"A virtual TPM device" - ~gen_events:true ~doccomments:[] + ~lifecycle:[] ~gen_constructor_destructor:false ~name:_vtpm + ~descr:"A virtual TPM device" ~gen_events:true ~doccomments:[] ~messages_default_allowed_roles:_R_POOL_ADMIN ~contents: [ From 7b8e0f2291d18f633603e9d780e271ef4b7095f8 Mon Sep 17 00:00:00 2001 From: Pau Ruiz Safont Date: Wed, 7 Sep 2022 15:22:23 +0100 Subject: [PATCH 53/53] CP-40672: set platform/tpm_version xenstore key on vm construction This allows hvmloader to load the correct acpi table for guests using tpm, while retaining the previous acpi table for existing guests Signed-off-by: Pau Ruiz Safont --- ocaml/xapi/vm_platform.ml | 2 ++ ocaml/xapi/xapi_xenops.ml | 9 +++++++++ 2 files changed, 11 insertions(+) diff --git a/ocaml/xapi/vm_platform.ml b/ocaml/xapi/vm_platform.ml index e87efae2825..bfa2378dde6 100644 --- a/ocaml/xapi/vm_platform.ml +++ b/ocaml/xapi/vm_platform.ml @@ -63,6 +63,8 @@ let nested_virt = "nested-virt" let vcpu_unrestricted = "vcpu-unrestricted" +let tpm_version = "tpm_version" + (* The default value of device model should be set as 'qemu-trad', 'qemu-upstream-compat', 'qemu-upstream' according to QEMU-upstream feature release stages *) let fallback_device_model_stage_1 = "qemu-trad" diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml index 72cf25a8b46..d79f77538b7 100644 --- a/ocaml/xapi/xapi_xenops.ml +++ b/ocaml/xapi/xapi_xenops.ml @@ -1261,6 +1261,15 @@ module MD = struct else platformdata in + (* Add TPM version 2 iff there's a tpm attached to the VM, this allows + hvmloader to load the TPM 2.0 ACPI table while maintaing the current + ACPI table for other guests *) + let platformdata = + if vm.API.vM_VTPMs <> [] || bool vm.API.vM_platform false "vtpm" then + (Vm_platform.tpm_version, "2") :: platformdata + else + platformdata + in let pci_msitranslate = true in (* default setting *) (* CA-55754: allow VM.other_config:msitranslate to override the bus-wide setting *)