Merge pull request #5542 from xcp-ng/pci-hide-api

ocaml/idl/datamodel.ml

@@ -6520,14 +6520,55 @@ module Network_sriov = struct
 end
 
 (** PCI devices *)
+let pci_dom0_access =
+  Enum
+    ( "pci_dom0_access"
+    , [
+        ("enabled", "dom0 can access this device as normal")
+      ; ( "disable_on_reboot"
+        , "On host reboot dom0 will be blocked from accessing this device"
+        )
+      ; ("disabled", "dom0 cannot access this device")
+      ; ( "enable_on_reboot"
+        , "On host reboot dom0 will be allowed to access this device"
+        )
+      ]
+    )
 
 module PCI = struct
+  let disable_dom0_access =
+    call ~name:"disable_dom0_access" ~lifecycle:[]
+      ~doc:
+        "Hide a PCI device from the dom0 kernel. (Takes affect after next \
+         boot.)"
+      ~params:[(Ref _pci, "self", "The PCI to hide")]
+      ~result:(pci_dom0_access, "The accessibility of this PCI from dom0")
+      ~allowed_roles:_R_POOL_OP ()
+
+  let enable_dom0_access =
+    call ~name:"enable_dom0_access" ~lifecycle:[]
+      ~doc:
+        "Unhide a PCI device from the dom0 kernel. (Takes affect after next \
+         boot.)"
+      ~params:[(Ref _pci, "self", "The PCI to unhide")]
+      ~result:(pci_dom0_access, "The accessibility of this PCI from dom0")
+      ~allowed_roles:_R_POOL_OP ()
+
+  let get_dom0_access_status =
+    call ~name:"get_dom0_access_status" ~lifecycle:[]
+      ~doc:"Return a PCI device dom0 access status."
+      ~params:[(Ref _pci, "self", "The PCI")]
+      ~result:(pci_dom0_access, "The accessibility of this PCI from dom0")
+      ~allowed_roles:_R_POOL_OP ()
+
   let t =
     create_obj ~name:_pci ~descr:"A PCI device" ~doccomments:[]
       ~gen_constructor_destructor:false ~gen_events:true ~in_db:true
       ~lifecycle:[(Published, rel_boston, "")]
-      ~messages:[] ~messages_default_allowed_roles:_R_POOL_OP
-      ~persist:PersistEverything ~in_oss_since:None ~db_logging:Log_destroy
+      ~messages:
+        [disable_dom0_access; enable_dom0_access; get_dom0_access_status]
+      ~messages_default_allowed_roles:_R_POOL_OP ~persist:PersistEverything
+      ~in_oss_since:None ~db_logging:Log_destroy
       ~contents:
         [
           uid _pci ~lifecycle:[(Published, rel_boston, "")]
@@ -6621,21 +6662,6 @@ end
 (** Physical GPUs (pGPU) *)
 
 module PGPU = struct
-  let dom0_access =
-    Enum
-      ( "pgpu_dom0_access"
-      , [
-          ("enabled", "dom0 can access this device as normal")
-        ; ( "disable_on_reboot"
-          , "On host reboot dom0 will be blocked from accessing this device"
-          )
-        ; ("disabled", "dom0 cannot access this device")
-        ; ( "enable_on_reboot"
-          , "On host reboot dom0 will be allowed to access this device"
-          )
-        ]
-      )
-
   let add_enabled_VGPU_types =
     call ~name:"add_enabled_VGPU_types"
       ~lifecycle:[(Published, rel_vgpu_tech_preview, "")]
@@ -6756,7 +6782,11 @@ module PGPU = struct
 
   let enable_dom0_access =
     call ~name:"enable_dom0_access"
-      ~lifecycle:[(Published, rel_cream, "")]
+      ~lifecycle:
+        [
+          (Published, rel_cream, "")
+        ; (Deprecated, "24.14.0", "Use PCI.enable_dom0_access instead.")
+        ]
       ~versioned_params:
         [
           {
@@ -6767,12 +6797,16 @@ module PGPU = struct
           ; param_default= None
           }
         ]
-      ~result:(dom0_access, "The accessibility of this PGPU from dom0")
+      ~result:(pci_dom0_access, "The accessibility of this PGPU from dom0")
       ~allowed_roles:_R_POOL_OP ()
 
   let disable_dom0_access =
     call ~name:"disable_dom0_access"
-      ~lifecycle:[(Published, rel_cream, "")]
+      ~lifecycle:
+        [
+          (Published, rel_cream, "")
+        ; (Deprecated, "24.14.0", "Use PCI.disable_dom0_access instead.")
+        ]
       ~versioned_params:
         [
           {
@@ -6783,7 +6817,7 @@ module PGPU = struct
           ; param_default= None
           }
         ]
-      ~result:(dom0_access, "The accessibility of this PGPU from dom0")
+      ~result:(pci_dom0_access, "The accessibility of this PGPU from dom0")
       ~allowed_roles:_R_POOL_OP ()
 
   let t =
@@ -6844,8 +6878,15 @@ module PGPU = struct
             "A map relating each VGPU type supported on this GPU to the \
              maximum number of VGPUs of that type which can run simultaneously \
              on this GPU"
-        ; field ~qualifier:DynamicRO ~ty:dom0_access
-            ~lifecycle:[(Published, rel_cream, "")]
+        ; field ~qualifier:DynamicRO ~ty:pci_dom0_access
+            ~lifecycle:
+              [
+                (Published, rel_cream, "")
+              ; ( Deprecated
+                , "24.14.0"
+                , "Use PCI.get_dom0_access_status instead."
+                )
+              ]
             ~default_value:(Some (VEnum "enabled")) "dom0_access"
             "The accessibility of this device from dom0"
         ; field ~qualifier:DynamicRO ~ty:Bool

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

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

ocaml/xapi-cli-server/cli_frontend.ml

@@ -3683,6 +3683,33 @@ let rec cmdtable_data : (string * cmd_spec) list =
       ; flags= []
       }
     )
+  ; ( "pci-enable-dom0-access"
+    , {
+        reqd= ["uuid"]
+      ; optn= []
+      ; help= "Enable PCI access to dom0."
+      ; implementation= No_fd Cli_operations.pci_enable_dom0_access
+      ; flags= []
+      }
+    )
+  ; ( "pci-disable-dom0-access"
+    , {
+        reqd= ["uuid"]
+      ; optn= []
+      ; help= "Disable PCI access to dom0."
+      ; implementation= No_fd Cli_operations.pci_disable_dom0_access
+      ; flags= []
+      }
+    )
+  ; ( "pci-get-dom0-access-status"
+    , {
+        reqd= ["uuid"]
+      ; optn= []
+      ; help= "Return a PCI device's dom0 access status."
+      ; implementation= No_fd Cli_operations.get_dom0_access_status
+      ; flags= []
+      }
+    )
   ]
 
 let cmdtable : (string, cmd_spec) Hashtbl.t = Hashtbl.create 50

ocaml/xapi-cli-server/cli_operations.ml

@@ -1144,7 +1144,7 @@ let gen_cmds rpc session_id =
       )
     ; Client.PGPU.(
         mk get_all_records_where get_by_uuid pgpu_record "pgpu" []
-          ["uuid"; "vendor-name"; "device-name"; "gpu-group-uuid"]
+          ["uuid"; "pci-uuid"; "vendor-name"; "device-name"; "gpu-group-uuid"]
           rpc session_id
       )
     ; Client.GPU_group.(
@@ -1331,6 +1331,11 @@ let gen_cmds rpc session_id =
           ]
           rpc session_id
       )
+    ; Client.PCI.(
+        mk get_all_records_where get_by_uuid pci_record "pci" []
+          ["uuid"; "vendor-name"; "device-name"; "pci-id"]
+          rpc session_id
+      )
     ]
 
 let message_create (_ : printer) rpc session_id params =
@@ -7483,13 +7488,13 @@ let pgpu_enable_dom0_access printer rpc session_id params =
   let uuid = List.assoc "uuid" params in
   let ref = Client.PGPU.get_by_uuid ~rpc ~session_id ~uuid in
   let result = Client.PGPU.enable_dom0_access ~rpc ~session_id ~self:ref in
-  printer (Cli_printer.PMsg (Record_util.pgpu_dom0_access_to_string result))
+  printer (Cli_printer.PMsg (Record_util.pci_dom0_access_to_string result))
 
 let pgpu_disable_dom0_access printer rpc session_id params =
   let uuid = List.assoc "uuid" params in
   let ref = Client.PGPU.get_by_uuid ~rpc ~session_id ~uuid in
   let result = Client.PGPU.disable_dom0_access ~rpc ~session_id ~self:ref in
-  printer (Cli_printer.PMsg (Record_util.pgpu_dom0_access_to_string result))
+  printer (Cli_printer.PMsg (Record_util.pci_dom0_access_to_string result))
 
 let lvhd_enable_thin_provisioning _printer rpc session_id params =
   let sr_uuid = List.assoc "sr-uuid" params in
@@ -7513,6 +7518,24 @@ let lvhd_enable_thin_provisioning _printer rpc session_id params =
        ["sr-uuid"; "initial-allocation"; "allocation-quantum"]
     )
 
+let pci_enable_dom0_access printer rpc session_id params =
+  let uuid = List.assoc "uuid" params in
+  let ref = Client.PCI.get_by_uuid ~rpc ~session_id ~uuid in
+  let result = Client.PCI.enable_dom0_access ~rpc ~session_id ~self:ref in
+  printer (Cli_printer.PMsg (Record_util.pci_dom0_access_to_string result))
+
+let pci_disable_dom0_access printer rpc session_id params =
+  let uuid = List.assoc "uuid" params in
+  let ref = Client.PCI.get_by_uuid ~rpc ~session_id ~uuid in
+  let result = Client.PCI.disable_dom0_access ~rpc ~session_id ~self:ref in
+  printer (Cli_printer.PMsg (Record_util.pci_dom0_access_to_string result))
+
+let get_dom0_access_status printer rpc session_id params =
+  let uuid = List.assoc "uuid" params in
+  let ref = Client.PCI.get_by_uuid ~rpc ~session_id ~uuid in
+  let result = Client.PCI.get_dom0_access_status ~rpc ~session_id ~self:ref in
+  printer (Cli_printer.PMsg (Record_util.pci_dom0_access_to_string result))
+
 module PVS_site = struct
   let introduce printer rpc session_id params =
     let name_label = List.assoc "name-label" params in

ocaml/xapi-cli-server/record_util.ml

@@ -737,7 +737,7 @@ let host_numa_affinity_policy_of_string = function
            ("Expected 'any', 'best_effort' or 'default_policy', got " ^ s)
         )
 
-let pgpu_dom0_access_to_string x = host_display_to_string x
+let pci_dom0_access_to_string x = host_display_to_string x
 
 let string_to_vdi_onboot s =
   match String.lowercase_ascii s with

ocaml/xapi-cli-server/records.ml

@@ -4127,6 +4127,9 @@ let pgpu_record rpc session_id pgpu =
   ; fields=
       [
         make_field ~name:"uuid" ~get:(fun () -> (x ()).API.pGPU_uuid) ()
+      ; make_field ~name:"pci-uuid"
+          ~get:(fun () -> try (xp ()).API.pCI_uuid with _ -> nid)
+          ()
       ; make_field ~name:"vendor-name"
           ~get:(fun () -> try (xp ()).API.pCI_vendor_name with _ -> nid)
           ()
@@ -4135,7 +4138,7 @@ let pgpu_record rpc session_id pgpu =
           ()
       ; make_field ~name:"dom0-access"
           ~get:(fun () ->
-            Record_util.pgpu_dom0_access_to_string (x ()).API.pGPU_dom0_access
+            Record_util.pci_dom0_access_to_string (x ()).API.pGPU_dom0_access
           )
           ()
       ; make_field ~name:"is-system-display-device"
@@ -5500,3 +5503,80 @@ let observer_record rpc session_id observer =
           ()
       ]
   }
+
+let pci_record rpc session_id pci =
+  let _ref = ref pci in
+  let empty_record =
+    ToGet (fun () -> Client.PCI.get_record ~rpc ~session_id ~self:!_ref)
+  in
+  let record = ref empty_record in
+  let x () = lzy_get record in
+  let pci_record p =
+    ref (ToGet (fun () -> Client.PCI.get_record ~rpc ~session_id ~self:p))
+  in
+  let xp0 p = lzy_get (pci_record p) 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.pCI_uuid) ()
+      ; make_field ~name:"vendor-name"
+          ~get:(fun () -> try (x ()).API.pCI_vendor_name with _ -> nid)
+          ()
+      ; make_field ~name:"device-name"
+          ~get:(fun () -> try (x ()).API.pCI_device_name with _ -> nid)
+          ()
+      ; make_field ~name:"driver-name"
+          ~get:(fun () -> try (x ()).API.pCI_driver_name with _ -> nid)
+          ()
+      ; make_field ~name:"host-uuid"
+          ~get:(fun () ->
+            try get_uuid_from_ref (x ()).API.pCI_host with _ -> nid
+          )
+          ()
+      ; make_field ~name:"host-name-label"
+          ~get:(fun () ->
+            try get_name_from_ref (x ()).API.pCI_host with _ -> nid
+          )
+          ()
+      ; make_field ~name:"pci-id"
+          ~get:(fun () -> try (x ()).API.pCI_pci_id with _ -> nid)
+          ()
+      ; make_field ~name:"dependencies"
+          ~get:(fun () ->
+            map_and_concat
+              (fun pci -> (xp0 pci).API.pCI_pci_id)
+              (x ()).API.pCI_dependencies
+          )
+          ~get_set:(fun () ->
+            List.map
+              (fun pci -> (xp0 pci).API.pCI_pci_id)
+              (x ()).API.pCI_dependencies
+          )
+          ()
+      ; make_field ~name:"other-config"
+          ~get:(fun () ->
+            Record_util.s2sm_to_string "; " (x ()).API.pCI_other_config
+          )
+          ~add_to_map:(fun key value ->
+            Client.PCI.add_to_other_config ~rpc ~session_id ~self:pci ~key
+              ~value
+          )
+          ~remove_from_map:(fun key ->
+            Client.PCI.remove_from_other_config ~rpc ~session_id ~self:pci ~key
+          )
+          ~get_map:(fun () -> (x ()).API.pCI_other_config)
+          ()
+      ]
+  }

ocaml/xapi/message_forwarding.ml

@@ -5867,7 +5867,31 @@ functor
 
     module Secret = Local.Secret
 
-    module PCI = struct end
+    module PCI = struct
+      let disable_dom0_access ~__context ~self =
+        info "PCI.disable_dom0_access: pci = '%s'" (pci_uuid ~__context self) ;
+        let host = Db.PCI.get_host ~__context ~self in
+        let local_fn = Local.PCI.disable_dom0_access ~self in
+        do_op_on ~__context ~local_fn ~host (fun session_id rpc ->
+            Client.PCI.disable_dom0_access ~rpc ~session_id ~self
+        )
+
+      let enable_dom0_access ~__context ~self =
+        info "PCI.enable_dom0_access: pci = '%s'" (pci_uuid ~__context self) ;
+        let host = Db.PCI.get_host ~__context ~self in
+        let local_fn = Local.PCI.enable_dom0_access ~self in
+        do_op_on ~__context ~local_fn ~host (fun session_id rpc ->
+            Client.PCI.enable_dom0_access ~rpc ~session_id ~self
+        )
+
+      let get_dom0_access_status ~__context ~self =
+        info "PCI.get_dom0_access_status: pci = '%s'" (pci_uuid ~__context self) ;
+        let host = Db.PCI.get_host ~__context ~self in
+        let local_fn = Local.PCI.get_dom0_access_status ~self in
+        do_op_on ~__context ~local_fn ~host (fun session_id rpc ->
+            Client.PCI.get_dom0_access_status ~rpc ~session_id ~self
+        )
+    end
 
     module VTPM = struct
       let create ~__context ~vM ~is_unique =