sync master to feature branch

configure.ml

@@ -58,7 +58,7 @@ let args =
   ; flag "yumpluginconfdir" ~doc:"DIR YUM plugins conf dir"
       ~default:"/etc/yum/pluginconf.d"
   ; flag "xapi_api_version_major" ~doc:"xapi api major version" ~default:"2"
-  ; flag "xapi_api_version_minor" ~doc:"xapi api minor version" ~default:"21"
+  ; flag "xapi_api_version_minor" ~doc:"xapi api minor version" ~default:"23"
   ]
   |> Arg.align
 

dune-project

@@ -50,6 +50,7 @@
 
 (package
  (name tgroup)
+ (synopsis "Thread group management library")
  (depends xapi-log xapi-stdext-unix))
 
 (package

ocaml/idl/api_version.ml

@@ -18,4 +18,4 @@
 
 let api_version_major = 2L
 
-let api_version_minor = 21L
+let api_version_minor = 23L

ocaml/idl/datamodel_common.ml

@@ -10,7 +10,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 = 902
+let schema_minor_vsn = 903
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/idl/datamodel_lifecycle.ml

@@ -145,6 +145,8 @@ let prototyped_of_field = function
       Some "26.2.0"
   | "VM_metrics", "numa_optimised" ->
       Some "26.2.0"
+  | "VM", "secureboot_certificates_state" ->
+      Some "26.14.0"
   | "VM", "groups" ->
       Some "24.19.1"
   | "VM", "pending_guidances_full" ->
@@ -289,6 +291,8 @@ let prototyped_of_message = function
       Some "24.0.0"
   | "VM", "sysprep" ->
       Some "25.24.0"
+  | "VM", "update_secureboot_certificates_on_boot" ->
+      Some "26.14.0"
   | "VM", "get_secureboot_readiness" ->
       Some "24.17.0"
   | "VM", "set_uefi_mode" ->

ocaml/idl/datamodel_types.ml

@@ -101,6 +101,8 @@ let rel_nile_preview = "nile-preview"
 
 let rel_nile = "nile"
 
+let rel_orinoco = "orinoco"
+
 type api_release = {
     code_name: string option
   ; version_major: int
@@ -352,6 +354,13 @@ let release_order_full =
     ; branding= "XenServer 8"
     ; release_date= None
     }
+  ; {
+      code_name= Some rel_orinoco
+    ; version_major= 2
+    ; version_minor= 23
+    ; branding= "XenServer 9"
+    ; release_date= None
+    }
   ]
 (* When you add a new release, use the version number of the latest release, "Unreleased"
    for the branding, and Some "" for the release date, until the actual values are finalised. *)

ocaml/idl/datamodel_vm.ml

@@ -2353,7 +2353,45 @@ let set_HVM_boot_policy =
 let set_NVRAM_EFI_variables =
   call ~flags:[`Session] ~name:"set_NVRAM_EFI_variables"
     ~lifecycle:[(Published, rel_naples, "")]
-    ~params:[(Ref _vm, "self", "The VM"); (String, "value", "The value")]
+    ~versioned_params:
+      [
+        {
+          param_type= Ref _vm
+        ; param_name= "self"
+        ; param_doc= "The VM"
+        ; param_release= naples_release
+        ; param_default= None
+        }
+      ; {
+          param_type= String
+        ; param_name= "value"
+        ; param_doc= "The EFI-variables value"
+        ; param_release= naples_release
+        ; param_default= None
+        }
+      ; {
+          param_type=
+            Enum
+              ( "update_status"
+              , [
+                  ("yes", "Set secureboot_certificates_state to ok")
+                ; ("no", "Leave secureboot_certificates_state unchanged")
+                ; ( "unspecified"
+                  , "Check certificates and update \
+                     secureboot_certificates_state accordingly"
+                  )
+                ]
+              )
+        ; param_name= "update"
+        ; param_doc=
+            "If 'yes', set secureboot_certificates_state to ok. If 'no', keep \
+             the current secureboot_certificates_state unchanged. If omitted \
+             (defaults to 'unspecified'), run certificate check to determine \
+             the state."
+        ; param_release= numbered_release "26.12.0"
+        ; param_default= Some (VEnum "unspecified")
+        }
+      ]
     ~hide_from_docs:true ~allowed_roles:_R_LOCAL_ROOT_ONLY ()
 
 let restart_device_models =
@@ -2508,6 +2546,40 @@ let set_uefi_mode =
     ~result:(String, "Result from the varstore-sb-state call")
     ~doc:"Set the UEFI mode of a VM" ~allowed_roles:_R_POOL_ADMIN ()
 
+let vm_secureboot_certificates_state =
+  Enum
+    ( "vm_secureboot_certificates_state"
+    , [
+        ( "ok"
+        , "The VM's certificates do not need to be updated (including the case \
+           where Secure Boot does not apply to this VM, e.g. BIOS VM)."
+        )
+      ; ( "update_available"
+        , "The Secure Boot certificates are due to expire or have already \
+           expired."
+        )
+      ; ( "update_on_boot"
+        , "An update of the certificates will be triggered whenever the VM \
+           boots. This includes VM.start, VM.reboot and a guest-triggered \
+           reboot."
+        )
+      ]
+    )
+
+let update_secureboot_certificates_on_boot =
+  call ~name:"update_secureboot_certificates_on_boot" ~lifecycle:[]
+    ~params:
+      [
+        (Ref _vm, "self", "The VM")
+      ; ( Bool
+        , "mark"
+        , "If true: mark certificates for update on next boot. If false: \
+           remove the mark"
+        )
+      ]
+    ~doc:"Mark or unmark secure boot certificate update on VM boot"
+    ~allowed_roles:_R_VM_ADMIN ()
+
 let vm_secureboot_readiness =
   Enum
     ( "vm_secureboot_readiness"
@@ -2682,6 +2754,7 @@ let t =
       ; restart_device_models
       ; set_uefi_mode
       ; get_secureboot_readiness
+      ; update_secureboot_certificates_on_boot
       ; set_blocked_operations
       ; add_to_blocked_operations
       ; remove_from_blocked_operations
@@ -3293,6 +3366,11 @@ let t =
              'average user' doesn't need to"
         ; field ~qualifier:DynamicRO ~lifecycle:[] ~ty:(Set (Ref _vm_group))
             "groups" "VM groups associated with the VM"
+        ; field ~qualifier:DynamicRO ~lifecycle:[]
+            ~ty:vm_secureboot_certificates_state
+            ~default_value:(Some (VEnum "ok")) "secureboot_certificates_state"
+            "The state of the Secure Boot certificates, showing whether an \
+             update is available, already scheduled, or not needed."
         ]
       )
     ()

ocaml/idl/schematest.ml

@@ -3,7 +3,7 @@ let hash x = Digest.string x |> Digest.to_hex
 (* BEWARE: if this changes, check that schema has been bumped accordingly in
    ocaml/idl/datamodel_common.ml, usually schema_minor_vsn *)
 
-let last_known_schema_hash = "2d8501063ef6b243facc24a3dbdc2a5d"
+let last_known_schema_hash = "fe75fa03d7ce97f9e51426bfb9b078fe"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/libs/stunnel/dune

@@ -1,21 +1,19 @@
 (library
-  (name stunnel)
-  (public_name stunnel)
-  (wrapped false)
-  (libraries
-    astring
-    forkexec
-    safe-resources
-    threads.posix
-    unix
-    uuid
-    xapi-consts
-    xapi-inventory
-    xapi-log
-    xapi-stdext-pervasives
-    xapi-stdext-std
-    xapi-stdext-threads
-    xapi-stdext-unix
-  )
-)
-
+ (name stunnel)
+ (public_name stunnel)
+ (wrapped false)
+ (libraries
+  astring
+  forkexec
+  mtime
+  safe-resources
+  threads.posix
+  unix
+  uuid
+  xapi-consts
+  xapi-inventory
+  xapi-log
+  xapi-stdext-pervasives
+  xapi-stdext-std
+  xapi-stdext-threads
+  xapi-stdext-unix))

ocaml/libs/stunnel/stunnel.ml

@@ -639,6 +639,7 @@ end
     This is useful for TOFU (Trust-On-First-Use) scenarios. *)
 let fetch_server_cert ~remote_host ~remote_port =
   try
+    let timeout = Mtime.Span.(30 * s) in
     let openssl = !Constants.openssl_path in
     (* First get the certificate with s_client *)
     let s_client_args =
@@ -650,13 +651,14 @@ let fetch_server_cert ~remote_host ~remote_port =
       ]
     in
     let cert_output, _ =
-      Forkhelpers.execute_command_get_output_send_stdin openssl s_client_args ""
+      Forkhelpers.execute_command_get_output_send_stdin ~timeout openssl
+        s_client_args ""
     in
     (* Then parse it with x509 to get PEM format *)
     let x509_args = ["x509"; "-outform"; "PEM"] in
     let pem_output, _ =
-      Forkhelpers.execute_command_get_output_send_stdin openssl x509_args
-        cert_output
+      Forkhelpers.execute_command_get_output_send_stdin ~timeout openssl
+        x509_args cert_output
     in
     if
       String.length pem_output > 0

ocaml/tests/test_vm.ml

@@ -191,4 +191,128 @@ module VMSetBiosStrings = Generic.MakeStateful (struct
     `QuickAndAutoDocumented tests
 end)
 
-let tests = [("test_vm_set_bios_strings", VMSetBiosStrings.tests)]
+module VMSecurebootCertificatesStateField = Generic.MakeStateful (struct
+  module Io = struct
+    type input_t = [`ok | `update_available | `update_on_boot]
+
+    type output_t = [`ok | `update_available | `update_on_boot]
+
+    let string_of_state = function
+      | `ok ->
+          "ok"
+      | `update_available ->
+          "update_available"
+      | `update_on_boot ->
+          "update_on_boot"
+
+    let string_of_input_t = string_of_state
+
+    let string_of_output_t = string_of_state
+  end
+
+  module State = Test_state.XapiDb
+
+  let name_label = "secureboot-certs-state"
+
+  let load_input __context state =
+    let self = Test_common.make_vm ~__context ~name_label () in
+    Db.VM.set_secureboot_certificates_state ~__context ~self ~value:state
+
+  let extract_output __context _ =
+    let self =
+      List.nth (Db.VM.get_by_name_label ~__context ~label:name_label) 0
+    in
+    Db.VM.get_secureboot_certificates_state ~__context ~self
+
+  let tests =
+    `QuickAndAutoDocumented
+      [
+        (`ok, `ok)
+      ; (`update_available, `update_available)
+      ; (`update_on_boot, `update_on_boot)
+      ]
+end)
+
+module VMUpdateSecurebootCertificatesOnBoot = Generic.MakeStateful (struct
+  module Io = struct
+    type input_t = [`ok | `update_available | `update_on_boot] * bool
+
+    type output_t =
+      ([`ok | `update_available | `update_on_boot], string * string list) result
+
+    let string_of_state = function
+      | `ok ->
+          "ok"
+      | `update_available ->
+          "update_available"
+      | `update_on_boot ->
+          "update_on_boot"
+
+    let string_of_input_t (state, mark) =
+      Printf.sprintf "(%s, mark=%b)" (string_of_state state) mark
+
+    let string_of_output_t = function
+      | Ok state ->
+          Printf.sprintf "Ok %s" (string_of_state state)
+      | Error (code, args) ->
+          Printf.sprintf "Error %s(%s)" code (String.concat ", " args)
+  end
+
+  module State = Test_state.XapiDb
+
+  let name_label = "update-secureboot-certs-on-boot"
+
+  let load_input __context (state, _) =
+    let self = Test_common.make_vm ~__context ~name_label () in
+    Db.VM.set_secureboot_certificates_state ~__context ~self ~value:state
+
+  let extract_output __context (_, mark) =
+    let self =
+      List.nth (Db.VM.get_by_name_label ~__context ~label:name_label) 0
+    in
+    try
+      Xapi_vm.update_secureboot_certificates_on_boot ~__context ~self ~mark ;
+      Ok (Db.VM.get_secureboot_certificates_state ~__context ~self)
+    with Api_errors.Server_error (code, args) -> Error (code, args)
+
+  let tests =
+    `QuickAndAutoDocumented
+      [
+        (* transitions *)
+        ((`update_available, true), Ok `update_on_boot)
+      ; ((`update_on_boot, false), Ok `update_available)
+        (* idempotent: already in desired state *)
+      ; ((`update_on_boot, true), Ok `update_on_boot)
+      ; ((`update_available, false), Ok `update_available)
+        (* irrelevant state: raises *)
+      ; ( (`ok, true)
+        , Error
+            ( Api_errors.operation_not_allowed
+            , [
+                "Cannot set update_on_boot: VM.secureboot_certificates_state \
+                 is not in a valid state"
+              ]
+            )
+        )
+      ; ( (`ok, false)
+        , Error
+            ( Api_errors.operation_not_allowed
+            , [
+                "Cannot clear update_on_boot: VM.secureboot_certificates_state \
+                 is not in a valid state"
+              ]
+            )
+        )
+      ]
+end)
+
+let tests =
+  [
+    ("test_vm_set_bios_strings", VMSetBiosStrings.tests)
+  ; ( "test_vm_secureboot_certificates_state_field"
+    , VMSecurebootCertificatesStateField.tests
+    )
+  ; ( "test_vm_update_secureboot_certificates_on_boot"
+    , VMUpdateSecurebootCertificatesOnBoot.tests
+    )
+  ]

ocaml/tests/test_vm_check_operation_error.ml

@@ -52,7 +52,7 @@ let test_vm_set_nvram_running () =
       let new_vars = "CCCC" in
       let new_nvram = [("EFI-variables", new_vars)] in
       Api_server_common.Forwarder.VM.set_NVRAM_EFI_variables ~__context
-        ~self:vm_ref ~value:new_vars ;
+        ~self:vm_ref ~value:new_vars ~update:`no ;
       let read_nvram = Db.VM.get_NVRAM ~__context ~self:vm_ref in
       Alcotest.(check (list (pair string string)))
         "NVRAM updated" new_nvram read_nvram