Merge branch 'master' into private/asultanov/opt-refactoring

Signed-off-by: Andriy Sultanov <53952748+last-genius@users.noreply.github.com>

Author: last-genius

dune-project

@@ -225,6 +225,27 @@
 
 (package
   (name xapi-networkd)
+  (authors "Jon Ludlam")
+  (synopsis "The XCP networking daemon")
+  (depends
+    (alcotest :with-test)
+    astring
+    base-threads
+    (forkexec (= :version))
+    (http-lib (= :version))
+    mtime
+    netlink
+    re
+    rpclib
+    (xapi-idl (= :version))
+    xapi-inventory
+    (xapi-stdext-pervasives (= :version))
+    (xapi-stdext-std (= :version))
+    (xapi-stdext-threads (= :version))
+    (xapi-stdext-unix (= :version))
+    xapi-test-utils
+    (xen-api-client (= :version))
+  )
 )
 
 (package
@@ -241,6 +262,14 @@
 
 (package
   (name xapi-forkexecd)
+  (synopsis "Sub-process control service for xapi")
+  (description "This daemon creates and manages sub-processes on behalf of xapi.")
+  (depends
+   astring
+   (forkexec (= :version))
+   (uuid (= :version))
+   (xapi-stdext-unix (= :version))
+  )
 )
 
 (package
@@ -444,6 +473,19 @@ This package provides an Lwt compatible interface to the library.")
 
 (package
   (name forkexec)
+  (synopsis "Process-spawning library")
+  (description "Client and server library to spawn processes.")
+  (depends
+    base-threads
+    (fd-send-recv (>= "2.0.0"))
+    ppx_deriving_rpc
+    rpclib
+    (uuid (= :version))
+    (xapi-log (= :version))
+    (xapi-stdext-pervasives (= :version))
+    (xapi-stdext-unix (= :version))
+    (xapi-tracing (= :version))
+  )
 )
 
 (package
@@ -513,7 +555,6 @@ This package provides an Lwt compatible interface to the library.")
   (synopsis "Xapi's standard library extension, Threads")
   (authors "Jonathan Ludlam")
   (depends
-    ocaml
     base-threads
     base-unix
     (odoc :with-doc)
@@ -541,7 +582,6 @@ This package provides an Lwt compatible interface to the library.")
   (synopsis "Xapi's standard library extension, Zerocheck")
   (authors "Jonathan Ludlam")
   (depends
-    ocaml
     (odoc :with-doc)
   )
 )

forkexec.opam

@@ -1,31 +1,37 @@
 # This file is generated by dune, edit dune-project instead
-license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception"
 opam-version: "2.0"
-maintainer: "xen-api@lists.xen.org"
-authors: "xen-api@lists.xen.org"
-homepage: "https://github.com/xapi-project/"
+synopsis: "Process-spawning library"
+description: "Client and server library to spawn processes."
+maintainer: ["Xapi project maintainers"]
+authors: ["xen-api@lists.xen.org"]
+license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception"
+homepage: "https://xapi-project.github.io/"
 bug-reports: "https://github.com/xapi-project/xen-api/issues"
-dev-repo: "git+https://github.com/xapi-project/xen-api.git"
-tags: [ "org:xapi-project" ]
-
-build: [[ "dune" "build" "-p" name "-j" jobs ]]
-
 depends: [
-  "ocaml"
-  "dune"
+  "dune" {>= "3.0"}
   "base-threads"
-  "fd-send-recv"
+  "fd-send-recv" {>= "2.0.0"}
   "ppx_deriving_rpc"
   "rpclib"
-  "uuid"
-  "xapi-log"
-  "xapi-stdext-pervasives"
-  "xapi-stdext-unix"
-  "xapi-tracing"
+  "uuid" {= version}
+  "xapi-log" {= version}
+  "xapi-stdext-pervasives" {= version}
+  "xapi-stdext-unix" {= version}
+  "xapi-tracing" {= version}
+  "odoc" {with-doc}
 ]
-synopsis: "Sub-process control service for xapi"
-description:
-  "This daemon creates and manages sub-processes on behalf of xapi."
-url {
-  src: "https://github.com/xapi-project/xen-api/archive/master.tar.gz"
-}
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/xapi-project/xen-api.git"

forkexec.opam.template

@@ -221,9 +221,10 @@ let test_internal_failure_error () =
     Forkhelpers.safe_close_and_exec None (Some fd) None [] exe args |> ignore ;
     fail "Expected an exception"
   with
-  | Fd_send_recv.Unix_error _ ->
+  | Fd_send_recv.Unix_error _ | Unix.Unix_error (Unix.EBADF, _, _) ->
       leak_fd_detect ()
   | e ->
+      Printexc.print_backtrace stderr ;
       fail "Failed with unexpected exception: %s" (Printexc.to_string e)
 
 let master fds =

ocaml/forkexecd/test/fe_test.ml

@@ -1,4 +1,6 @@
 let prototyped_of_class = function
+  | "VM_group" ->
+      Some "24.18.0-next"
   | "Observer" ->
       Some "23.14.0"
   | "VTPM" ->
@@ -7,6 +9,10 @@ let prototyped_of_class = function
       None
 
 let prototyped_of_field = function
+  | "VM_group", "VMs" ->
+      Some "24.18.0-next"
+  | "VM_group", "placement" ->
+      Some "24.18.0-next"
   | "Observer", "enabled" ->
       Some "23.14.0"
   | "Observer", "components" ->
@@ -55,6 +61,8 @@ let prototyped_of_field = function
       Some "22.27.0"
   | "host", "last_software_update" ->
       Some "22.20.0"
+  | "VM", "groups" ->
+      Some "24.18.0-next"
   | "VM", "pending_guidances_full" ->
       Some "24.10.0"
   | "VM", "pending_guidances_recommended" ->
@@ -63,6 +71,8 @@ let prototyped_of_field = function
       Some "23.18.0"
   | "VM", "actions__after_softreboot" ->
       Some "23.1.0"
+  | "pool", "recommendations" ->
+      Some "24.18.0-next"
   | "pool", "update_sync_enabled" ->
       Some "23.18.0"
   | "pool", "update_sync_day" ->
@@ -139,6 +149,8 @@ let prototyped_of_message = function
       Some "24.17.0"
   | "VM", "restart_device_models" ->
       Some "23.30.0"
+  | "VM", "set_groups" ->
+      Some "24.18.0-next"
   | "pool", "get_guest_secureboot_readiness" ->
       Some "24.17.0"
   | "pool", "set_ext_auth_max_threads" ->

ocaml/idl/datamodel_lifecycle.ml

@@ -41,7 +41,7 @@ let is_element = function Element (_, _, _) -> true | _ -> false
 let string_of_attribute = function
   | Attribute (n, options, default) ->
       let opt_string =
-        if List.length options = 0 then
+        if options = [] then
           "CDATA"
         else
           "(" ^ String.concat " | " options ^ ")"
@@ -59,7 +59,7 @@ let string_of_attribute = function
       sprintf "%s %s %s" n opt_string def_string
 
 let strings_of_attributes parent atts =
-  if List.length atts > 0 then
+  if atts <> [] then
     let prefix = sprintf "<!ATTLIST %s " parent in
     let body = List.map string_of_attribute atts in
     (prefix :: body) @ [">"]

ocaml/idl/dtd_backend.ml

@@ -51,7 +51,7 @@ let wait_for ~xs ?(timeout = 300.) (x : 'a t) =
         Thread.create
           (fun () ->
             let r, _, _ = Unix.select [p1] [] [] timeout in
-            if List.length r > 0 then
+            if r <> [] then
               ()
             else
               try Xs_client_unix.Task.cancel task with _ -> ()

ocaml/libs/ezxenstore/core/watch.ml

@@ -80,7 +80,7 @@ let fill_buf ~buffered ic timeout =
   let buf_size = Bytes.length ic.buf in
   let fill_no_exc timeout len =
     let l, _, _ = Unix.select [ic.fd] [] [] timeout in
-    if List.length l <> 0 then (
+    if l <> [] then (
       let n = Unix.read ic.fd ic.buf ic.max len in
       ic.max <- n + ic.max ;
       if n = 0 && len <> 0 then raise Eof ;

ocaml/libs/http-lib/buf_io.ml

@@ -208,15 +208,6 @@ let parse_keyvalpairs xs =
       )
     kvpairs
 
-let parse_uri x =
-  match Astring.String.cuts ~sep:"?" x with
-  | [uri] ->
-      (uri, [])
-  | [uri; params] ->
-      (uri, parse_keyvalpairs params)
-  | _ ->
-      raise Http_parse_failure
-
 type authorization = Basic of string * string | UnknownAuth of string
 [@@deriving rpc]
 
@@ -629,42 +620,6 @@ module Request = struct
 
   let get_version x = x.version
 
-  let of_request_line x =
-    match Astring.String.fields ~empty:false x with
-    | [m; uri; version] -> (
-        (* Request-Line   = Method SP Request-URI SP HTTP-Version CRLF *)
-        let uri, query = parse_uri uri in
-        (* strip the "HTTP/" prefix from the version string *)
-        match Astring.String.cut ~sep:"/" version with
-        | Some (_, version) ->
-            {
-              m= method_t_of_string m
-            ; frame= false
-            ; uri
-            ; query
-            ; content_length= None
-            ; transfer_encoding= None
-            ; accept= None
-            ; version
-            ; cookie= []
-            ; auth= None
-            ; task= None
-            ; subtask_of= None
-            ; content_type= None
-            ; host= None
-            ; user_agent= None
-            ; close= false
-            ; additional_headers= []
-            ; body= None
-            ; traceparent= None
-            }
-        | None ->
-            error "Failed to parse: %s" x ;
-            raise Http_parse_failure
-      )
-    | _ ->
-        raise Http_parse_failure
-
   let to_string x =
     let kvpairs x =
       String.concat "; " (List.map (fun (k, v) -> k ^ "=" ^ v) x)

ocaml/libs/http-lib/http.ml

@@ -119,10 +119,6 @@ module Request : sig
   val get_version : t -> string
   (** [get_version t] returns the HTTP protocol version *)
 
-  val of_request_line : string -> t
-  (** [of_request_line l] parses [l] of the form "METHOD HTTP/VERSION" and
-      		returns the corresponding [t] *)
-
   val to_string : t -> string
   (** [to_string t] returns a short string summarising [t] *)
 
@@ -176,8 +172,6 @@ end
 
 val authorization_of_string : string -> authorization
 
-val parse_uri : string -> string * (string * string) list
-
 val http_403_forbidden : ?version:string -> unit -> string list
 
 val http_200_ok : ?version:string -> ?keep_alive:bool -> unit -> string list