Merge master to feature branch (#6425)

Author: minglumlu

.github/workflows/docs.yml

@@ -31,15 +31,23 @@ jobs:
       - name: Update Ubuntu repositories
         run: sudo apt-get update
 
+      # We set DUNE_CACHE_STORAGE_MODE, it is required for dune cache to work inside opam for now,
+      # otherwise it gets EXDEV and considers it a cache miss
       - name: Use ocaml
-        uses: ocaml/setup-ocaml@v2
+        uses: ocaml/setup-ocaml@v3
         with:
           ocaml-compiler: ${{ steps.dotenv.outputs.ocaml_version_full }}
           opam-repositories: |
             xs-opam: ${{ steps.dotenv.outputs.repository }}
+          dune-cache: true
+          opam-pin: false
+          cache-prefix: v3-${{ steps.system-info.outputs.name }}-${{ steps.system-info.outputs.release }}
+        env:
+          DUNE_CACHE_STORAGE_MODE: copy
 
       - name: Install dependencies
-        run: opam pin list --short | xargs opam install --deps-only -v
+        shell: bash
+        run: opam install . --deps-only -v
 
       - name: Generate xapi-storage docs
         run: |

Makefile

@@ -155,8 +155,8 @@ DUNE_IU_PACKAGES1+=gzip http-lib pciutil sexpr stunnel uuid xml-light2 zstd xapi
 DUNE_IU_PACKAGES1+=message-switch message-switch-cli message-switch-core message-switch-lwt
 DUNE_IU_PACKAGES1+=message-switch-unix xapi-idl xapi-forkexecd xapi-storage xapi-storage-script xapi-storage-cli
 DUNE_IU_PACKAGES1+=xapi-nbd varstored-guard xapi-log xapi-open-uri xapi-tracing xapi-tracing-export xapi-expiry-alerts cohttp-posix
-DUNE_IU_PACKAGES1+=xapi-rrd xapi-inventory clock xapi-sdk
-DUNE_IU_PACKAGES1+=xapi-stdext-date xapi-stdext-encodings xapi-stdext-pervasives xapi-stdext-std xapi-stdext-threads xapi-stdext-unix xapi-stdext-zerocheck xapi-tools
+DUNE_IU_PACKAGES1+=xapi-rrd xapi-inventory clock xapi-sdk tgroup
+DUNE_IU_PACKAGES1+=xapi-stdext-encodings xapi-stdext-pervasives xapi-stdext-std xapi-stdext-threads xapi-stdext-unix xapi-stdext-zerocheck xapi-tools
 
 
 install-dune1:

dune-project

@@ -3,6 +3,7 @@
 (formatting (enabled_for ocaml))
 (using menhir 2.0)
 (using directory-targets 0.1)
+(opam_file_location inside_opam_directory)
 
 (cram enable)
 (implicit_transitive_deps false)
@@ -669,16 +670,6 @@ This package provides an Lwt compatible interface to the library.")
   (name xapi-inventory)
 )
 
-(package
-  (name xapi-stdext-date)
-  (synopsis "Xapi's standard library extension, Dates")
-  (authors "Jonathan Ludlam")
-  (depends
-    (clock (= :version))
-    ptime
-  )
-)
-
 (package
   (name xapi-stdext-encodings)
   (synopsis "Xapi's standard library extension, Encodings")
@@ -720,12 +711,14 @@ This package provides an Lwt compatible interface to the library.")
   (synopsis "Xapi's standard library extension, Threads")
   (authors "Jonathan Ludlam")
   (depends
+    ambient-context
     base-threads
     base-unix
     (alcotest :with-test)
     (clock (= :version))
     (fmt :with-test)
     mtime
+    tgroup
     (xapi-log (= :version))
     (xapi-stdext-pervasives (= :version))
     (xapi-stdext-unix (= :version))

ocaml/idl/datamodel.ml

@@ -7621,6 +7621,10 @@ module VM_guest_metrics = struct
             ~ty:Bool ~default_value:(Some (VBool false)) "PV_drivers_detected"
             "At least one of the guest's devices has successfully connected to \
              the backend."
+        ; field ~qualifier:DynamicRO ~lifecycle:[]
+            ~ty:(Map (String, String))
+            ~default_value:(Some (VMap [])) "services"
+            "The guest's services data."
         ]
       ()
 end
@@ -8972,7 +8976,7 @@ module Message = struct
   let get_all_records_where =
     call ~name:"get_all_records_where"
       ~lifecycle:[(Published, rel_orlando, "")]
-      ~params:[(String, "expr", "The expression to match (not currently used)")]
+      ~params:[(String, "expr", "The expression to match")]
       ~flags:[`Session]
       ~result:(Map (Ref _message, Record _message), "The messages")
       ~allowed_roles:_R_READ_ONLY ()
@@ -10539,12 +10543,12 @@ let all_system =
 (**
    These are the pairs of (object, field) which are bound together in
    the database schema.
-   
+
    It is assumed that, for any entry (p, p'), neither p nor p'
    appears in any other entry. It may be the case that p = p', which
    is the only instance where some object-field pair may appear more
    than once.
-   
+
    This is implicitly assumed by other code which treats this list -
    and its symmetric closure - as an association list
    without duplicate keys. *)

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 = 786
+let schema_minor_vsn = 788
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/idl/datamodel_lifecycle.ml

@@ -109,6 +109,8 @@ let prototyped_of_field = function
       Some "22.27.0"
   | "host", "last_software_update" ->
       Some "22.20.0"
+  | "VM_guest_metrics", "services" ->
+      Some "25.15.0"
   | "VM_guest_metrics", "netbios_name" ->
       Some "24.28.0"
   | "VM", "groups" ->
@@ -121,6 +123,8 @@ let prototyped_of_field = function
       Some "23.18.0"
   | "VM", "actions__after_softreboot" ->
       Some "23.1.0"
+  | "pool", "ha_reboot_vm_on_internal_shutdown" ->
+      Some "25.15.0-next"
   | "pool", "license_server" ->
       Some "25.6.0"
   | "pool", "recommendations" ->

ocaml/idl/datamodel_pool.ml

@@ -2191,6 +2191,12 @@ let t =
             ~ty:(Map (String, String))
             ~default_value:(Some (VMap [])) "license_server"
             "Licensing data shared within the whole pool"
+        ; field ~writer_roles:_R_POOL_OP ~qualifier:RW ~lifecycle:[] ~ty:Bool
+            ~default_value:(Some (VBool true))
+            "ha_reboot_vm_on_internal_shutdown"
+            "Indicates whether an HA-protected VM that is shut down from \
+             inside (not through the API) should be automatically rebooted \
+             when HA is enabled"
         ]
       )
     ()

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 = "ad67a64cd47cdea32085518c1fb38d27"
+let last_known_schema_hash = "e10b420b0863116ee188eea9e63b1349"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/libs/resources/test/dune

@@ -4,6 +4,7 @@
   (action (run %{test} -e))
   (libraries
     safe-resources
+    logs
     logs.fmt
     alcotest
   )

ocaml/libs/tgroup/tgroup.ml

@@ -253,6 +253,11 @@ module Group = struct
         External.name // External.Unauthenticated.name
 
   let to_string g = match g with Group group -> to_cgroup group
+
+  let authenticated_root =
+    of_creator (Creator.make ~identity:Identity.root_identity ())
+
+  let unauthenticated = Group External_Unauthenticated
 end
 
 module Cgroup = struct

ocaml/libs/tgroup/tgroup.mli

@@ -37,7 +37,7 @@ module Group : sig
 
     val of_string : string -> t
     (** [of_string s] creates an originator from a string [s].
-        
+
         e.g create an originator based on a http header. *)
 
     val to_string : t -> string
@@ -76,6 +76,14 @@ module Group : sig
 
   val to_string : t -> string
   (** [to_string g] returns the string representation of the group [g].*)
+
+  val authenticated_root : t
+  (** [authenticated_root] represents the main classification of internal xapi
+      threads. *)
+
+  val unauthenticated : t
+  (** [unauthenticated] represents the classification of xapi threads for
+      unauthenticated users. *)
 end
 
 (** [Cgroup] module encapsulates different function for managing the cgroups
@@ -87,7 +95,7 @@ module Cgroup : sig
   val dir_of : Group.t -> t option
   (** [dir_of group] returns the full path of the cgroup directory corresponding
           to the group [group] as [Some dir].
-          
+
           Returns [None] if [init dir] has not been called. *)
 
   val init : string -> unit

ocaml/libs/tracing/tracing.ml

@@ -437,10 +437,7 @@ module Span = struct
 
   let to_propagation_context span =
     let traceparent = span |> get_context |> SpanContext.to_traceparent in
-    span
-    |> get_context
-    |> SpanContext.context_of_span_context
-    |> TraceContext.with_traceparent (Some traceparent)
+    span |> get_trace_context |> TraceContext.with_traceparent (Some traceparent)
 
   let with_trace_context span trace_context =
     let span_context =

ocaml/libs/tracing/tracing_export.ml

@@ -83,10 +83,7 @@ module Content = struct
              )
         in
         let tags =
-          let span_context = Span.get_context s in
-          let trace_context =
-            SpanContext.context_of_span_context span_context
-          in
+          let trace_context = Span.get_trace_context s in
           let baggage =
             TraceContext.baggage_of trace_context |> Option.value ~default:[]
           in