CP-26717: Remove Camlp4 dependency, add rules to make gpumon CLI

Signed-off-by: Akanksha Mathur <[email protected]>

fixup! CP-26717: Minor edits and refactoring

- no global opens in Gpumon_client
- reformatted Gpumon_interface
- rewrote compatibility type docstring in Gpumon_interface

Signed-off-by: Akanksha Mathur <[email protected]>

Author: Akanksha Mathur

gpumon/gpumon_client.ml

@@ -12,18 +12,14 @@
  * GNU Lesser General Public License for more details.
  *)
 
-open Gpumon_interface
-open Xcp_client
-
-let xml_url () = "file:" ^ xml_path
+let xml_url () = "file:" ^ Gpumon_interface.xml_path
 
 let rpc call =
-  if !use_switch
-  then json_switch_rpc queue_name call
-  else xml_http_rpc
-      ~srcstr:(get_user_agent ())
+  if !Xcp_client.use_switch
+  then Xcp_client.json_switch_rpc Gpumon_interface.queue_name call
+  else Xcp_client.xml_http_rpc
+      ~srcstr:(Xcp_client.get_user_agent ())
       ~dststr:"gpumon"
       xml_url
       call
-module Client = RPC_API(Idl.GenClientExnRpc(struct let rpc=rpc end))
-include Client
+module Client = Gpumon_interface.RPC_API(Idl.GenClientExnRpc(struct let rpc=rpc end))

gpumon/gpumon_interface.ml

@@ -35,7 +35,7 @@ type incompatibility_reason =
   | Other
 [@@deriving rpcty]
 
-(** Boolean: compatible? *)
+(** Compatibility between virtual and physical GPU *)
 type compatibility =
   | Compatible
   | Incompatible of incompatibility_reason list
@@ -90,69 +90,83 @@ module RPC_API(R : RPC) = struct
               ; description =
                   [ "This interface is used by Xapi and Gpumon to monitor "
                   ; "physical and virtual GPUs."]
-              ;
-                version=(1,0,0)
+              ; version=(1,0,0)
               }
 
   let implementation = implement description
 
-  (** common API call parameters *)
+  (** Compatibility checking interface for Nvidia vGPUs *)
+  module Nvidia = struct
 
-  let debug_info_p = param ~description:
-      ["Uninterpreted string used for debugging."]
-      debug_info
+    (** common API call parameters *)
 
-  let domid_p = param ~description:
-      ["Domain ID of the VM in which the vGPU(s) is running."]
-      domid
+    let debug_info_p = param ~description:
+        ["Uninterpreted string used for debugging."]
+        debug_info
 
-  let pgpu_address_p = param ~description:
-      ["PCI bus ID of the pGPU in which the VM is currently running"
-      ;"in the form `domain:bus:device.function` PCI identifier."]
-      pgpu_address
+    let domid_p = param ~description:
+        ["Domain ID of the VM in which the vGPU(s) is running."]
+        domid
 
-  let nvidia_pgpu_metadata_p = param ~description:
-      ["Metadata of Nvidia physical GPU."]
-      nvidia_pgpu_metadata
+    let pgpu_address_p = param ~description:
+        ["PCI bus ID of the pGPU in which the VM is currently running"
+        ;"in the form `domain:bus:device.function` PCI identifier."]
+        pgpu_address
 
-  let nvidia_vgpu_metadata_p = param ~description:
-      ["Metadata of Nvidia virtual GPU."]
-      nvidia_vgpu_metadata
+    let nvidia_pgpu_metadata_p = param ~description:
+        ["Metadata of Nvidia physical GPU."]
+        nvidia_pgpu_metadata
 
-  let nvidia_vgpu_metadata_list_p = param ~description:
-      ["Metadata list of Nvidia virtual GPU."]
-      nvidia_vgpu_metadata_list
+    let nvidia_vgpu_metadata_p = param ~description:
+        ["Metadata of Nvidia virtual GPU."]
+        nvidia_vgpu_metadata
 
-  let compatibility_p = param ~description:
-      ["Value indicating whether two or more GPUs are compatible with each other."]
-      compatibility
+    let nvidia_vgpu_metadata_list_p = param ~description:
+        ["Metadata list of Nvidia virtual GPU."]
+        nvidia_vgpu_metadata_list
 
-  (** Compatibility checking interface for Nvidia vGPUs *)
-  module Nvidia = struct
+    let compatibility_p = param ~description:
+        [ "Value indicating whether two or more GPUs are compatible with each other." ]
+        compatibility
 
     let get_pgpu_metadata =
       declare "get_pgpu_metadata"
-        ["Gets the metadata for a pGPU, given its address (PCI bus ID)."]
-        (debug_info_p @->  pgpu_address_p @-> returning nvidia_pgpu_metadata_p gpu_err )
+        [ "Gets the metadata for a pGPU, given its address (PCI bus ID)." ]
+        (debug_info_p
+         @-> pgpu_address_p
+         @-> returning nvidia_pgpu_metadata_p gpu_err
+        )
 
     let get_pgpu_vm_compatibility =
       declare "get_pgpu_vm_compatibility"
-        ["Checks compatibility between a VM's vGPU(s) and another pGPU."]
-        (debug_info_p @->  pgpu_address_p @-> domid_p @-> nvidia_pgpu_metadata_p @-> returning compatibility_p gpu_err )
+        [ "Checks compatibility between a VM's vGPU(s) and another pGPU." ]
+        (debug_info_p
+         @-> pgpu_address_p
+         @-> domid_p
+         @-> nvidia_pgpu_metadata_p
+         @-> returning compatibility_p gpu_err
+        )
 
     let get_vgpu_metadata =
       declare "get_vgpu_metadata"
-        ["Obtains metadata for all vGPUs running in a domain."]
-        ( debug_info_p @->  domid_p @-> pgpu_address_p @-> returning nvidia_vgpu_metadata_list_p gpu_err )
-
-    (** The use case is VM.suspend/VM.resume: before
-     * VM.resume [nvidia_vgpu_metadata] of the suspended VM is checked
-     * against the [nvidia_pgpu_metadata] on the host where the VM is
-     * resumed.
-     * *)
+        [ "Obtains metadata for all vGPUs running in a domain." ]
+        ( debug_info_p
+         @-> domid_p
+         @-> pgpu_address_p
+         @-> returning nvidia_vgpu_metadata_list_p gpu_err
+        )
+
     let get_pgpu_vgpu_compatibility =
       declare "get_pgpu_vgpu_compatibility"
-        ["Checks compatibility between a pGPU (on a host) and a list of vGPUs (assigned to a VM). Note: A VM may use several vGPUs."]
-        ( debug_info_p @->  nvidia_pgpu_metadata_p @-> nvidia_vgpu_metadata_list_p @-> returning compatibility_p gpu_err )
+        [ "Checks compatibility between a pGPU (on a host) and a list of vGPUs "
+        ; "(assigned to a VM). Note: A VM may use several vGPUs."
+        ; "The use case is VM.suspend/VM.resume:"
+        ; "before VM.resume [nvidia_vgpu_metadata] of the suspended VM is "
+        ; "checked against the [nvidia_pgpu_metadata] on the host where the VM "
+        ; "is resumed." ]
+        ( debug_info_p
+          @-> nvidia_pgpu_metadata_p
+          @-> nvidia_vgpu_metadata_list_p
+          @-> returning compatibility_p gpu_err)
   end
 end

gpumon/jbuild

@@ -22,35 +22,30 @@ let coverage_rewriter =
   else
     ""
 
-let rewriters_camlp4 = ["rpclib.idl -syntax camlp4o"]
-let rewriters_ppx = ["ppx_deriving_rpc"; "ppx_sexp_conv"]
+let rewriters = ["ppx_deriving_rpc"]
 
 let () = Printf.ksprintf Jbuild_plugin.V1.send {|
 (jbuild_version 1)
 
-(library
- ((name xapi_gpumon_interface)
-  (public_name xcp.gpumon.interface)
-  (modules (gpumon_interface))
-  (flags (:standard -w -39 %s))
-  (libraries
-   (rpclib
-    threads
-    xcp))
-  (wrapped false)
-  %s))
-
 (library
  ((name xapi_gpumon)
   (public_name xcp.gpumon)
-  (modules (:standard \ gpumon_interface))
   (flags (:standard -w -39-33 %s))
+  (modules (:standard \ gpumon_cli ))
   (libraries
    (rpclib
     threads
-    xcp
-    xapi_gpumon_interface))
+    xcp))
   (wrapped false)
   %s))
 
-|} (flags rewriters_camlp4) coverage_rewriter (flags rewriters_ppx) coverage_rewriter
+(executable
+ ((name gpumon_cli)
+  (modules (gpumon_cli))
+  (libraries
+   (cmdliner
+    rpclib.cmdliner
+    rpclib.markdown
+    xcp.gpumon))))
+
+|} (flags rewriters) coverage_rewriter