diff --git a/ocaml/database/db_interface.ml b/ocaml/database/db_interface.ml
index 096368c857d..1e9adda155e 100644
--- a/ocaml/database/db_interface.ml
+++ b/ocaml/database/db_interface.ml
@@ -12,9 +12,7 @@
* GNU Lesser General Public License for more details.
*)
-type response =
- | String of string
- | Bigbuf of Xapi_stdext_bigbuffer.Bigbuffer.t
+type response = string
(** A generic RPC interface *)
module type RPC = sig
diff --git a/ocaml/database/db_remote_cache_access_v1.ml b/ocaml/database/db_remote_cache_access_v1.ml
index 8e644a7e39c..e82f9bdb485 100644
--- a/ocaml/database/db_remote_cache_access_v1.ml
+++ b/ocaml/database/db_remote_cache_access_v1.ml
@@ -124,6 +124,6 @@ let handler req bio _ =
let body = Http_svr.read_body ~limit:Db_globs.http_limit_max_rpc_size req bio in
let body_xml = Xml.parse_string body in
let reply_xml = DBCacheRemoteListener.process_xmlrpc body_xml in
- let response = Xml.to_bigbuffer reply_xml in
- Http_svr.response_fct req fd (Xapi_stdext_bigbuffer.Bigbuffer.length response)
- (fun fd -> Xapi_stdext_bigbuffer.Bigbuffer.to_fct response (fun s -> ignore(Unix.write fd s 0 (String.length s))))
+ let response = Xml.to_string reply_xml in
+ Http_svr.response_fct req fd (Int64.of_int @@ String.length response)
+ (fun fd -> Unix.write fd response 0 (String.length response) |> ignore)
diff --git a/ocaml/database/db_rpc_client_v1.ml b/ocaml/database/db_rpc_client_v1.ml
index 43e8c892bd5..81eb1593b36 100644
--- a/ocaml/database/db_rpc_client_v1.ml
+++ b/ocaml/database/db_rpc_client_v1.ml
@@ -49,9 +49,8 @@ module Make = functor(RPC: Db_interface.RPC) -> struct
let do_remote_call marshall_args unmarshall_resp fn_name args =
let xml = marshall_args args in
let xml = XMLRPC.To.array [XMLRPC.To.string fn_name; XMLRPC.To.string "" (* unused *); xml] in
- let resp = match RPC.rpc (Xml.to_string xml) with
- | Db_interface.String s -> Xml.parse_string s
- | Db_interface.Bigbuf b -> Xml.parse_bigbuffer b
+ let resp =
+ RPC.rpc (Xml.to_string xml) |> Xml.parse_string
in
match XMLRPC.From.array (fun x->x) resp with
[status_xml; resp_xml] ->
diff --git a/ocaml/database/db_rpc_client_v2.ml b/ocaml/database/db_rpc_client_v2.ml
index 0ceecc4cfac..c8845512aa4 100644
--- a/ocaml/database/db_rpc_client_v2.ml
+++ b/ocaml/database/db_rpc_client_v2.ml
@@ -20,9 +20,7 @@ open Db_exn
module Make = functor(RPC: Db_interface.RPC) -> struct
let initialise = RPC.initialise
let rpc x =
- match RPC.rpc (Jsonrpc.to_string x) with
- | Db_interface.String s -> Jsonrpc.of_string s
- | Db_interface.Bigbuf b -> raise (Failure "Response too large - cannot convert bigbuffer to json!")
+ RPC.rpc (Jsonrpc.to_string x) |> Jsonrpc.of_string
let process (x: Request.t) =
let y : Response.t = Response.t_of_rpc (rpc (Request.rpc_of_t x)) in
diff --git a/ocaml/database/db_rpc_common_v2.ml b/ocaml/database/db_rpc_common_v2.ml
index aab47604b2c..c38e723c528 100644
--- a/ocaml/database/db_rpc_common_v2.ml
+++ b/ocaml/database/db_rpc_common_v2.ml
@@ -25,7 +25,6 @@ module Request = struct
| Read_field_where of Db_cache_types.where_record
| Db_get_by_uuid of string * string
| Db_get_by_name_label of string * string
- | Read_set_ref of Db_cache_types.where_record
| Create_row of string * (string * string) list * string
| Delete_row of string * string
| Write_field of string * string * string * string
@@ -57,7 +56,6 @@ module Response = struct
| Read_field_where of string list
| Db_get_by_uuid of string
| Db_get_by_name_label of string list
- | Read_set_ref of string list
| Create_row of unit
| Delete_row of unit
| Write_field of unit
diff --git a/ocaml/database/jbuild b/ocaml/database/jbuild
index 0d76cc54ce4..07a23a82c22 100644
--- a/ocaml/database/jbuild
+++ b/ocaml/database/jbuild
@@ -47,7 +47,6 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {|
http-svr
gzip
uuid
- xapi-stdext-bigbuffer
xapi-stdext-encodings
xapi-stdext-monadic
xapi-stdext-pervasives
@@ -74,6 +73,15 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {|
)
)
+(executable
+ ((name db_cache_test)
+ (modules (db_cache_test))
+ (libraries (
+ oUnit
+ xapi-database
+ ))
+))
+
(executable
((name unit_test_marshall)
(modules (
@@ -130,4 +138,12 @@ let () = Printf.ksprintf Jbuild_plugin.V1.send {|
)
)
+(alias
+ ((name runtest)
+ (deps (db_cache_test.exe))
+ (package xapi-database)
+ (action (run ${<}))
+ )
+)
+
|} (flags rewriters) coverage_rewriter
diff --git a/ocaml/database/master_connection.ml b/ocaml/database/master_connection.ml
index 4400ea153fb..3f69da42f3a 100644
--- a/ocaml/database/master_connection.ml
+++ b/ocaml/database/master_connection.ml
@@ -156,7 +156,7 @@ exception Content_length_required
let do_db_xml_rpc_persistent_with_reopen ~host ~path (req: string) : Db_interface.response =
let time_call_started = Unix.gettimeofday() in
let write_ok = ref false in
- let result = ref (Db_interface.String "") in
+ let result = ref "" in
let surpress_no_timeout_logs = ref false in
let backoff_delay = ref 2.0 in (* initial delay = 2s *)
let update_backoff_delay () =
@@ -185,19 +185,12 @@ let do_db_xml_rpc_persistent_with_reopen ~host ~path (req: string) : Db_interfac
with_timestamp (fun () ->
with_http request (fun (response, _) ->
(* XML responses must have a content-length because we cannot use the Xml.parse_in
- in_channel function: the input channel will buffer an arbitrary amount of stuff
- and we'll be out of sync with the next request. *)
+ in_channel function: the input channel will buffer an arbitrary amount of stuff
+ and we'll be out of sync with the next request. *)
let res = match response.Http.Response.content_length with
| None -> raise Content_length_required
- | Some l -> begin
- let open Xapi_stdext_unix in
- if (Int64.to_int l) <= Sys.max_string_length then
- Db_interface.String (Unixext.really_read_string fd (Int64.to_int l))
- else
- let buf = Xapi_stdext_bigbuffer.Bigbuffer.make () in
- Unixext.really_read_bigbuffer fd buf l;
- Db_interface.Bigbuf buf
- end
+ | Some l ->
+ Xapi_stdext_unix.Unixext.really_read_string fd (Int64.to_int l)
in
write_ok := true;
result := res (* yippeee! return and exit from while loop *)
diff --git a/ocaml/graph/graph.ml b/ocaml/graph/graph.ml
index 4f362f80e36..cfa5ff5907e 100644
--- a/ocaml/graph/graph.ml
+++ b/ocaml/graph/graph.ml
@@ -22,11 +22,11 @@ let refs_of_record cls record =
let fields = Datamodel_utils.fields_of_obj obj in
let rec refs_of ty xml = match ty with
| Ref _ -> [ XMLRPC.From.string xml ]
- | Set t -> List.concat (API.Legacy.From.set (refs_of t) xml)
- | Map(k, v) ->
- let pairs = API.Legacy.From.map (fun x -> x) (refs_of v) xml in
+ | Set t -> List.concat (XMLRPC.From.array (refs_of t) xml)
+ | Map(kt, vt) ->
+ let pairs = List.map (fun (k, v) -> k, refs_of vt v) (XMLRPC.From.structure xml) in
let vs = List.concat (List.map snd pairs) in
- begin match k with
+ begin match kt with
| Ref _ -> List.map fst pairs @ vs
| _ -> vs
end
@@ -48,8 +48,8 @@ let name_label_of_record cls record =
let all_classes = List.map (fun x -> x.name)
(Dm_api.objects_of_api Datamodel.all_api)
-open XMLRPC
let do_rpc rpc name args =
+ let open XMLRPC in
match From.methodResponse(rpc(To.methodCall name args)) with
| Fault _ -> invalid_arg "Fault"
| Failure(code, strings) -> raise (Api_errors.Server_error(code, strings))
@@ -60,8 +60,8 @@ let do_rpc rpc name args =
let get_all rpc session_id cls =
let name = Printf.sprintf "%s.get_all_records_where" cls in
- let args = [ To.string (Ref.string_of session_id); To.string "true" ] in
- API.Legacy.From.map (fun x -> x) (fun x -> x) (do_rpc rpc name args)
+ let args = [ XMLRPC.To.string (Ref.string_of session_id); XMLRPC.To.string "true" ] in
+ XMLRPC.From.structure (do_rpc rpc name args)
type node = { id: string; label: string; cls: string }
type edge = { a: string; b: string }
diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml
index 58a5f479d5e..3038b3b2d21 100644
--- a/ocaml/idl/datamodel.ml
+++ b/ocaml/idl/datamodel.ml
@@ -1183,6 +1183,9 @@ module PIF = struct
field ~lifecycle:[Published, rel_creedence, ""] ~qualifier:DynamicRO ~ty:(Map(String, String)) ~default_value:(Some (VMap [])) "properties" "Additional configuration properties for the interface.";
field ~lifecycle:[Published, rel_dundee, ""] ~qualifier:DynamicRO ~ty:(Set(String)) ~default_value:(Some (VSet [])) "capabilities" "Additional capabilities on the interface.";
field ~lifecycle:[Published, rel_inverness, ""] ~qualifier:DynamicRO ~ty:igmp_status ~default_value:(Some (VEnum "unknown")) "igmp_snooping_status" "The IGMP snooping status of the corresponding network bridge";
+ field ~in_oss_since:None ~ty:(Set (Ref _network_sriov)) ~in_product_since:rel_kolkata ~qualifier:DynamicRO "sriov_physical_PIF_of" "Indicates which network_sriov this interface is physical of";
+ field ~in_oss_since:None ~ty:(Set (Ref _network_sriov)) ~in_product_since:rel_kolkata ~qualifier:DynamicRO "sriov_logical_PIF_of" "Indicates which network_sriov this interface is logical of";
+ field ~qualifier:DynamicRO ~ty:(Ref _pci) ~lifecycle:[Published, rel_kolkata, ""] ~default_value:(Some (VRef null_ref)) "PCI" "Link to underlying PCI device";
]
()
end
@@ -1643,6 +1646,7 @@ module VIF = struct
field ~ty:ipv6_configuration_mode ~in_product_since:rel_dundee ~qualifier:DynamicRO "ipv6_configuration_mode" "Determines whether IPv6 addresses are configured on the VIF" ~default_value:(Some (VEnum "None"));
field ~ty:(Set (String)) ~in_product_since:rel_dundee ~qualifier:DynamicRO "ipv6_addresses" "IPv6 addresses in CIDR format" ~default_value:(Some (VSet []));
field ~ty:String ~in_product_since:rel_dundee ~qualifier:DynamicRO "ipv6_gateway" "IPv6 gateway (the empty string means that no gateway is set)" ~default_value:(Some (VString ""));
+ field ~ty:(Ref _pci) ~in_product_since:rel_kolkata ~internal_only:true ~qualifier:DynamicRO "reserved_pci" "pci of network SR-IOV VF which is reserved for this vif" ~default_value:(Some (VRef null_ref));
])
()
end
@@ -4220,6 +4224,68 @@ let alert =
()
*)
+(** network sriov **)
+module Network_sriov = struct
+ let lifecycle = [Published, rel_kolkata, ""]
+
+ let sriov_configuration_mode = Enum ("sriov_configuration_mode",
+ [
+ "sysfs", "Configure network sriov by sysfs, do not need reboot";
+ "modprobe", "Configure network sriov by modprobe, need reboot";
+ "unknown", "Unknown mode";
+ ])
+
+ let create = call
+ ~name:"create"
+ ~doc:"Enable SR-IOV on the specific PIF. It will create a network-sriov based on the specific PIF and automatically create a logical PIF to connect the specific network."
+ ~params:[Ref _pif, "pif", "PIF on which to enable SR-IOV";
+ Ref _network, "network", "Network to connect SR-IOV virtual functions with VM VIFs"]
+ ~result:(Ref _network_sriov, "The reference of the created network_sriov object")
+ ~lifecycle
+ ~allowed_roles:_R_POOL_OP
+ ()
+
+ let destroy = call
+ ~name:"destroy"
+ ~doc:"Disable SR-IOV on the specific PIF. It will destroy the network-sriov and the logical PIF accordingly."
+ ~params:[Ref _network_sriov, "self", "SRIOV to destroy"]
+ ~lifecycle
+ ~allowed_roles:_R_POOL_OP
+ ()
+
+ let get_remaining_capacity = call
+ ~name:"get_remaining_capacity"
+ ~doc:"Get the number of free SR-IOV VFs on the associated PIF"
+ ~params:[Ref _network_sriov, "self", "the NETWORK_SRIOV object"]
+ ~lifecycle
+ ~result:(Int, "The number of free SR-IOV VFs on the associated PIF")
+ ~allowed_roles:_R_READ_ONLY
+ ()
+
+ let t =
+ create_obj
+ ~name:_network_sriov
+ ~descr:"network-sriov which connects logical pif and physical pif"
+ ~doccomments:[]
+ ~gen_constructor_destructor:false
+ ~gen_events:true
+ ~in_db:true
+ ~lifecycle
+ ~messages:[create; destroy; get_remaining_capacity]
+ ~messages_default_allowed_roles:_R_POOL_OP
+ ~persist:PersistEverything
+ ~in_oss_since:None
+ ~contents:
+ ([
+ uid _network_sriov;
+ field ~qualifier:StaticRO ~ty:(Ref _pif) ~lifecycle "physical_PIF" "The PIF that has SR-IOV enabled" ~default_value:(Some (VRef ""));
+ field ~qualifier:StaticRO ~ty:(Ref _pif) ~lifecycle "logical_PIF" "The logical PIF to connect to the SR-IOV network after enable SR-IOV on the physical PIF" ~default_value:(Some (VRef ""));
+ field ~qualifier:DynamicRO ~ty:Bool ~lifecycle "requires_reboot" "Indicates whether the host need to be rebooted before SR-IOV is enabled on the physical PIF" ~default_value:(Some (VBool false));
+ field ~qualifier:DynamicRO ~ty:sriov_configuration_mode ~lifecycle "configuration_mode" "The mode for configure network sriov" ~default_value:(Some (VEnum "unknown"));
+ ])
+ ()
+end
+
(** PCI devices *)
module PCI = struct
@@ -4258,6 +4324,7 @@ module PCI = struct
field ~qualifier:StaticRO ~ty:String ~lifecycle:[] "subsystem_device_id" "Subsystem device ID" ~default_value:(Some (VString "")) ~internal_only:true;
field ~qualifier:StaticRO ~ty:String ~lifecycle:[Published, rel_clearwater_whetstone, ""] "subsystem_device_name" "Subsystem device name" ~default_value:(Some (VString ""));
field ~qualifier:DynamicRO ~ty:(Ref _vm) ~lifecycle:[Published, rel_falcon, ""] ~internal_only:true "scheduled_to_be_attached_to" "The VM to which this PCI device is scheduled to be attached (passed through)" ~default_value:(Some (VRef null_ref));
+ field ~qualifier:StaticRO ~ty:String ~lifecycle:[Published, rel_kolkata, ""] "driver_name" "Driver name" ~default_value:(Some (VString ""));
]
()
end
@@ -5255,6 +5322,7 @@ let all_system =
Message.t;
Secret.t;
Tunnel.t;
+ Network_sriov.t;
PCI.t;
PGPU.t;
GPU_group.t;
@@ -5366,6 +5434,8 @@ let all_relations =
(_vusb, "VM"), (_vm, "VUSBs");
(_feature, "host"), (_host, "features");
+ (_network_sriov, "physical_PIF"), (_pif, "sriov_physical_PIF_of");
+ (_network_sriov, "logical_PIF"), (_pif, "sriov_logical_PIF_of");
]
(** the full api specified here *)
@@ -5457,6 +5527,7 @@ let expose_get_all_messages_for = [
_pvs_cache_storage;
_feature;
_sdn_controller;
+ _network_sriov;
(* _vdi_nbd_server_info must NOT be included here *)
_pusb;
_usb_group;
diff --git a/ocaml/idl/datamodel_common.ml b/ocaml/idl/datamodel_common.ml
index d964fb8a902..8bc60b77595 100644
--- a/ocaml/idl/datamodel_common.ml
+++ b/ocaml/idl/datamodel_common.ml
@@ -169,6 +169,7 @@ let _vdi_nbd_server_info = "vdi_nbd_server_info"
let _pusb = "PUSB"
let _usb_group = "USB_group"
let _vusb = "VUSB"
+let _network_sriov = "network_sriov"
let _cluster = "Cluster"
let _cluster_host = "Cluster_host"
diff --git a/ocaml/idl/datamodel_errors.ml b/ocaml/idl/datamodel_errors.ml
index 52f9ad1c2b6..3b9b4698d9d 100644
--- a/ocaml/idl/datamodel_errors.ml
+++ b/ocaml/idl/datamodel_errors.ml
@@ -118,6 +118,32 @@ let _ =
error Api_errors.user_is_not_local_superuser [ "msg" ]
~doc:"Only the local superuser can execute this operation" ();
+ (* SR-IOV errors *)
+ error Api_errors.network_sriov_insufficient_capacity [ "network" ]
+ ~doc:"There is insufficient capacity for VF reservation" ();
+ error Api_errors.network_sriov_already_enabled ["PIF"]
+ ~doc:"The PIF selected for the SR-IOV network is already enabled" ();
+ error Api_errors.network_sriov_enable_failed ["PIF"; "msg"]
+ ~doc:"Failed to enable SR-IOV on PIF" ();
+ error Api_errors.network_sriov_disable_failed ["PIF"; "msg"]
+ ~doc:"Failed to disable SR-IOV on PIF" ();
+ error Api_errors.network_has_incompatible_sriov_pifs ["PIF"; "network"]
+ ~doc:"The PIF is not compatible with the selected SR-IOV network" ();
+ error Api_errors.network_has_incompatible_vlan_on_sriov_pifs ["PIF"; "network"]
+ ~doc:"VLAN on the PIF is not compatible with the selected SR-IOV VLAN network" ();
+ error Api_errors.network_incompatible_with_sriov ["network"]
+ ~doc:"The network is incompatible with sriov" ();
+ error Api_errors.network_incompatible_with_vlan_on_bridge ["network"]
+ ~doc:"The network is incompatible with vlan on bridge" ();
+ error Api_errors.network_incompatible_with_vlan_on_sriov ["network"]
+ ~doc:"The network is incompatible with vlan on sriov" ();
+ error Api_errors.network_incompatible_with_bond ["network"]
+ ~doc:"The network is incompatible with bond" ();
+ error Api_errors.network_incompatible_with_tunnel ["network"]
+ ~doc:"The network is incompatible with tunnel" ();
+ error Api_errors.pool_joining_host_has_network_sriovs []
+ ~doc:"The host joining the pool must not have any network SR-IOVs." ();
+
(* PIF/VIF/Network errors *)
error Api_errors.network_unmanaged [ "network" ]
~doc:"The network is not managed by xapi." ();
@@ -129,9 +155,12 @@ let _ =
~doc:"You tried to add a purpose to a network but the new purpose is not compatible with an existing purpose of the network or other networks." ();
error Api_errors.pif_is_physical ["PIF"]
~doc:"You tried to destroy a PIF, but it represents an aspect of the physical host configuration, and so cannot be destroyed. The parameter echoes the PIF handle you gave." ();
+ error Api_errors.pif_is_not_physical ["PIF"]
+ ~doc:"You tried to perform an operation which is only available on physical PIF" ();
error Api_errors.pif_is_vlan ["PIF"]
~doc:"You tried to create a VLAN on top of another VLAN - use the underlying physical PIF/bond instead" ();
-
+ error Api_errors.pif_is_sriov_logical ["PIF"]
+ ~doc:"You tried to create a bond on top of a network SR-IOV logical PIF - use the underlying physical PIF instead" ();
error Api_errors.pif_vlan_exists ["PIF"]
~doc:"You tried to create a PIF, but it already exists." ();
error Api_errors.pif_vlan_still_exists [ "PIF" ]
@@ -164,20 +193,30 @@ let _ =
~doc:"The operation you requested cannot be performed because the specified PIF has FCoE SR in use." ();
error Api_errors.pif_unmanaged [ "PIF" ]
~doc:"The operation you requested cannot be performed because the specified PIF is not managed by xapi." ();
+ error Api_errors.pif_is_not_sriov_capable [ "PIF" ]
+ ~doc:"The selected PIF is not capable of network SR-IOV" ();
error Api_errors.pif_has_no_network_configuration [ "PIF" ]
~doc:"PIF has no IP configuration (mode currently set to 'none')" ();
error Api_errors.pif_has_no_v6_network_configuration [ "PIF" ]
~doc:"PIF has no IPv6 configuration (mode currently set to 'none')" ();
error Api_errors.pif_incompatible_primary_address_type [ "PIF" ]
~doc:"The primary address types are not compatible" ();
+ error Api_errors.pif_sriov_still_exists [ "PIF" ]
+ ~doc:"The PIF is still related with a network SR-IOV" ();
error Api_errors.cannot_plug_bond_slave ["PIF"]
~doc:"This PIF is a bond slave and cannot be plugged." ();
error Api_errors.cannot_add_vlan_to_bond_slave ["PIF"]
~doc:"This PIF is a bond slave and cannot have a VLAN on it." ();
error Api_errors.cannot_add_tunnel_to_bond_slave ["PIF"]
~doc:"This PIF is a bond slave and cannot have a tunnel on it." ();
+ error Api_errors.cannot_add_tunnel_to_sriov_logical ["PIF"]
+ ~doc:"This is a network SR-IOV logical PIF and cannot have a tunnel on it." ();
+ error Api_errors.cannot_add_tunnel_to_vlan_on_sriov_logical ["PIF"]
+ ~doc:"This is a vlan PIF on network SR-IOV and cannot have a tunnel on it." ();
error Api_errors.cannot_change_pif_properties ["PIF"]
~doc:"This properties of this PIF cannot be changed. Only the properties of non-bonded physical PIFs, or bond masters can be changed." ();
+ error Api_errors.cannot_forget_sriov_logical [ "PIF" ]
+ ~doc:"This is a network SR-IOV logical PIF and cannot do forget on it" ();
error Api_errors.incompatible_pif_properties []
~doc:"These PIFs can not be bonded, because their properties are different." ();
error Api_errors.slave_requires_management_iface []
@@ -587,6 +626,8 @@ let _ =
~doc:"VM cannot be resumed because it has no suspend VDI" ();
error Api_errors.vm_migrate_failed [ "vm"; "source"; "destination"; "msg" ]
~doc:"An error occurred during the migration process." ();
+ error Api_errors.vm_migrate_contact_remote_service_failed []
+ ~doc:"Failed to contact service on the destination host." ();
error Api_errors.vm_has_too_many_snapshots [ "vm" ]
~doc:"You attempted to migrate a VM with more than one snapshot." ();
error Api_errors.vm_has_checkpoint [ "vm" ]
diff --git a/ocaml/idl/datamodel_values.ml b/ocaml/idl/datamodel_values.ml
index c02586b2f9c..0a86b2e4e7c 100644
--- a/ocaml/idl/datamodel_values.ml
+++ b/ocaml/idl/datamodel_values.ml
@@ -36,34 +36,28 @@ let rec to_rpc v =
| VRef r -> Rpc.String r
| VCustom (_,_) -> failwith "Can't RPC up a custom value"
-let rec to_xml v =
- match v with
- VString s -> XMLRPC.To.string s
- | VInt i -> XMLRPC.To.string (Int64.to_string i)
- | VFloat f -> XMLRPC.To.double f
- | VBool b -> XMLRPC.To.boolean b
- | VDateTime d -> XMLRPC.To.datetime d
- | VEnum e -> XMLRPC.To.string e
- | VMap vvl -> XMLRPC.To.structure (List.map (fun (v1,v2)-> to_string v1, to_xml v2) vvl)
- | VSet vl -> XMLRPC.To.array (List.map (fun v->to_xml v) vl)
- | VRef r -> XMLRPC.To.string r
- | VCustom (_,y) -> to_xml y
-
open Printf
-let to_ocaml_string v =
+let to_ocaml_string ?(v2=false) v =
let rec aux = function
| Rpc.Null -> "Rpc.Null"
| Rpc.String s -> sprintf "Rpc.String \"%s\"" s
- | Rpc.Int i -> sprintf "Rpc.Int %LdL" i
- | Rpc.Int32 i -> sprintf "Rpc.Int32 %ldl" i
- | Rpc.Float f -> sprintf "Rpc.Float %f" f
+ | Rpc.Int i -> sprintf "Rpc.Int (%LdL)" i
+ | Rpc.Int32 i -> sprintf "Rpc.Int32 (%ldl)" i
+ | Rpc.Float f -> sprintf "Rpc.Float (%f)" f
| Rpc.Bool b -> sprintf "Rpc.Bool %b" b
| Rpc.Dict d -> sprintf "Rpc.Dict [%s]" (String.concat ";" (List.map (fun (n,v) -> sprintf "(\"%s\",%s)" n (aux v)) d))
| Rpc.Enum l -> sprintf "Rpc.Enum [%s]" (String.concat ";" (List.map aux l))
| Rpc.DateTime t -> sprintf "Rpc.DateTime %s" t in
match v with
- | VCustom (x,_) -> x
+ | VCustom (s,v') ->
+ if v2 then
+ (* s can contain stringified body of ocaml functions, and will break
+ * the aPI.ml code, we need to use the v' in that case. The version
+ * switch allows us to use this other version in gen_api.ml without
+ * having to duplicate lots of code *)
+ aux (to_rpc v')
+ else s
| _ -> aux (to_rpc v)
let rec to_db v =
diff --git a/ocaml/idl/errors.sh b/ocaml/idl/errors.sh
index 662238d7a7c..5a1ec032b29 100644
--- a/ocaml/idl/errors.sh
+++ b/ocaml/idl/errors.sh
@@ -1,6 +1,6 @@
#!/bin/bash
-for f in `cat api_errors.ml | grep let | awk '{print $2}' | sort ` ;
+for f in `cat ../xapi-consts/api_errors.ml | grep let | awk '{print $2}' | sort ` ;
do
if grep $f datamodel.ml >/dev/null 2>&1 ;
then echo "$f yes" ;
diff --git a/ocaml/idl/make-gnu-fdl-release.sh b/ocaml/idl/make-gnu-fdl-release.sh
deleted file mode 100644
index 579d7f58730..00000000000
--- a/ocaml/idl/make-gnu-fdl-release.sh
+++ /dev/null
@@ -1,38 +0,0 @@
-#!/bin/sh
-
-set -eu
-
-function get_tex()
-{
- cat OMakefile | sed -n "s#$1 = \\(.*\\)\$#\\1#p"
-}
-
-tex="$(get_tex 'SHARED_TEX') $(get_tex 'OPEN_TEX')"
-eps="$(get_tex 'SHARED_EPS') $(get_tex 'OPEN_EPS')"
-dot=$(ls ${eps//.eps/.dot} 2>/dev/null || true)
-
-tempdir=$(mktemp -d)
-
-dir=$(dirname "$0")
-
-cd "$dir"
-
-omake clean
-omake xenapi.pdf
-
-version=$(cat xenapi-coversheet.tex |
- sed -n 's#.*revstring[^0-9]*\([0-9][0-9.]*\).*$#\1#p')
-
-mkdir "$tempdir/xenapi-src-$version"
-cp xenapi.pdf "$tempdir/xenapi-$version.pdf"
-cp xenapi.ps "$tempdir/xenapi-$version.ps"
-for file in $tex
-do
- sed $file -e 's#% All rights reserved.#% Permission is granted to copy, distribute and/or modify this document under\n% the terms of the GNU Free Documentation License, Version 1.2 or any later\n% version published by the Free Software Foundation; with no Invariant\n% Sections, no Front-Cover Texts and no Back-Cover Texts. A copy of the\n% license is included in the section entitled\n% "GNU Free Documentation License" or the file fdl.tex.#g' \
- >"$tempdir/xenapi-src-$version/$file"
-done
-cp fdl.tex $eps $dot "$tempdir/xenapi-src-$version/"
-
-tar cjf "xenapi-src-$version.tar.bz2" -C "$tempdir" "xenapi-src-$version"
-
-echo -e "\n\nYour release is in $tempdir."
diff --git a/ocaml/idl/ocaml_backend/README b/ocaml/idl/ocaml_backend/README
deleted file mode 100644
index b3719fce056..00000000000
--- a/ocaml/idl/ocaml_backend/README
+++ /dev/null
@@ -1,38 +0,0 @@
-Overview
---------
-
-This is an IDL compiler written in OCaml that generates OCaml code to implement
-the Xen Management API for both client and server, connected to each other via
-XML RPC.
-
-This compiler generates code to marshal the necessary types to and from XML,
-using the XML Light library.
-
-The generated code totals around 4kLOC, takes ~3s to compile to native code
-and results in a 650k 64-bit binary.
-
-Building this project generates example clients and servers. The test_server
-program applies a fake RPC module to the client functor to generate a Hooker
-module that can be used for incremental development of a real server. The
-test_client module is a simple OCaml client that invokes a single remote
-procedure call over XML-RPC and http. The python directory contains a tiny
-python program that invokes the same call but the use of a third-party XML-RPC
-library gives more credibility to our generated XML-RPC bindings.
-
-
-Build
------
-
-The compiler requires the datamodel description and back-end API generator from
-the directory above. Make those first.
-
-Build in this directory using:
-
- omake
-
-Documentation for the API, client and server bindings and for the XML-RPC
-marshalling code can be built using:
-
- omake doc
-
-the former goes in "./doc" and the latter in "./xmlrpc_doc".
diff --git a/ocaml/idl/ocaml_backend/genOCaml.ml b/ocaml/idl/ocaml_backend/genOCaml.ml
deleted file mode 100644
index f0a63a145d8..00000000000
--- a/ocaml/idl/ocaml_backend/genOCaml.ml
+++ /dev/null
@@ -1,185 +0,0 @@
-(*
- * Copyright (C) 2006-2009 Citrix Systems Inc.
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as published
- * by the Free Software Foundation; version 2.1 only. with the special
- * exception on linking described in file LICENSE.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU Lesser General Public License for more details.
- *)
-(** Convert backend API into OCaml code. *)
-open Datamodel_types
-open Format
-open Ocaml_utils
-open Gen_db_actions
-
-let ( @- ) a b = a @ List.map (( ^ ) " ") b
-let ( @-- ) a b = a @ List.map (( ^ ) " ") b
-
-
-
-
-(** Generate a block with an indented, space-separated middle. *)
-let block head middle tail =
- let open Xapi_stdext_std.Listext in
- (head @-
- List.flatten (List.between [""] middle)) @
- tail
-
-let gen_type ty accu = match ty with
- | String | Int | Float | Bool -> accu
- | ty -> ("type "^alias_of_ty ty^" = "^ocaml_of_ty ty) :: accu
-
-(** Generate code to marshal from the given datamodel type to XML-RPC. *)
-let ty_to_xmlrpc api ty =
- let indent = String.make 23 ' ' in
- let f = match ty with
- | Bool -> "To.boolean"
- | DateTime -> "To.datetime"
- | Enum(_, cs) ->
- let aux (c, _) = constructor_of c^" -> \""^c^"\"" in
- " fun v -> To.string(match v with\n "^indent^
- String.concat ("\n"^indent^"| ") (List.map aux cs)^")"
- | Float -> "To.double"
- | Int -> "fun n -> To.string(Int64.to_string n)"
- | Map(key, value) ->
- let kf = begin match key with
- | Ref x -> "tostring_reference"
- | Enum (name, cs) ->
- let aux (c, _) = Printf.sprintf "%s -> \"%s\"" (constructor_of c) (String.lowercase_ascii c) in
- " function " ^ (String.concat ("\n" ^ indent ^ "| ") (List.map aux cs))
- | key -> "ToString." ^ (alias_of_ty key)
- end in
- let vf = alias_of_ty value in
- "fun m -> map ("^kf^") ("^vf^") m"
- | Ref _ -> "fun r -> To.string (Ref.string_of r)"
-(*
- | Ref "session" -> "fun uuid -> To.string(Uuid.string_of_cookie uuid)"
- | Ref s -> "fun uuid -> To.string(Uuid.string_of_uuid uuid)"
-*)
- | Set ty -> "fun s -> set "^alias_of_ty ty^" s"
- | String -> "To.string"
- | Record x ->
- let fields = DU.fields_of_obj (Dm_api.get_obj_by_name api ~objname:x) in
- let kvs = List.map
- (fun fld ->
- alias_of_ty fld.ty ^ " x." ^
- (OU.ocaml_of_record_field (x::fld.full_name)),
- String.concat "_" fld.full_name) fields in
- let kvs = List.map (fun (record, v) -> "\"" ^ v ^ "\", " ^ record) kvs in
- "fun x -> To.structure [ " ^ (String.concat "; " kvs) ^ " ]"
- in
- ["and "^alias_of_ty ty^" : "^alias_of_ty ty^" -> xml =";
- " "^f]
-
-(** Generate a module of datamodel type to XML-RPC marshalling functions. *)
-let gen_to_xmlrpc api tys = block
- ["module To = struct"]
- ([["open Xml"];
-
- ["let methodCall = To.methodCall"];
- ["let methodResponse f x = To.methodResponse (f x)"; ];
- ["let tostring_reference = Ref.string_of"];
- ["let set f l =";
- " To.array (List.map f l)"];
- ["let map fk fv m =";
- " let elements = List.map (fun (k, v) -> fk k, fv v) m in";
- " XMLRPC.To.structure elements";
-(*
- " set (fun (k, v) -> XMLRPC.To.structure [\"key\", fk k; \"value\", fv v]) m"
-*)
- ];
- ["let structure = To.structure"];
- ["let rec unused' = ()"]] @
- (List.map (ty_to_xmlrpc api) tys))
- ["end"]
-
-(** Generate code to marshal from the given datamodel type to XML-RPC. *)
-let ty_of_xmlrpc api ty =
- let alias_of_ty_param t = "("^(alias_of_ty t)^" param)" in
- let wrap var_binding b = "fun " ^ var_binding ^ " -> try ("^b^") with e -> Backtrace.reraise e (Api_errors.Server_error (Api_errors.field_type_error,[param]))" in
- let f = match ty with
- | Bool -> wrap "xml" "From.boolean xml"
- | DateTime -> wrap "xml" "From.datetime xml"
- | Enum(name, cs) ->
- let aux (c, _) = "\""^(String.lowercase_ascii c)^"\" -> "^constructor_of c in
- wrap "xml"
- ("\n match String.lowercase_ascii (From.string xml) with\n "^
- String.concat "\n | " (List.map aux cs)^
- "\n | _ -> log_backtrace(); raise (RunTimeTypeError(\""^name^"\", xml))")
- | Float -> wrap "xml" "From.double xml"
- | Int -> wrap "xml" "Int64.of_string(From.string xml)"
- | Map(key, value) ->
- let kf = begin match key with
- | Ref x -> "fromstring_reference"
- | Enum (name, cs) ->
- let aux (c, _) = "\""^(String.lowercase_ascii c)^"\" -> "^constructor_of c in
- wrap "txt"
- ("\n match String.lowercase_ascii txt with\n "^
- String.concat "\n | " (List.map aux cs)^
- "\n | _ -> raise (RunTimeTypeError(\""^name^"\", Xml.parse_string txt))")
- | key -> "FromString." ^ (alias_of_ty key)
- end in
- let vf = alias_of_ty_param value in
- wrap "xml" ("map ("^kf^") ("^vf^") xml")
- | Ref _ -> wrap "xml" "Ref.of_string (From.string xml)"
-(*
- | Ref "session" -> "fun uuid -> Uuid.cookie_of_string(From.string uuid)"
- | Ref s -> "fun uuid -> Uuid.uuid_of_string(From.string uuid)"
-*)
- | Set ty -> wrap "xml" ("set "^alias_of_ty_param ty^" xml")
- | String -> wrap "xml" "From.string xml"
- | Record x ->
- let fields = DU.fields_of_obj (Dm_api.get_obj_by_name api ~objname:x) in
- let fields =
- List.map (fun fld ->
- (OU.ocaml_of_record_field (x::fld.full_name)) ^ " = " ^
- (alias_of_ty_param fld.ty) ^
- (
- (* generate code to insert default value if none in xml structure *)
- let field_name = String.concat "_" fld.full_name in
- let default_value =
- match fld.DT.ty with
- DT.Set (DT.Ref _) -> Some (DT.VSet [])
- | _ -> fld.DT.default_value in
- match default_value with
- None -> "(my_assoc \"" ^ field_name ^ "\" all)"
- | Some default ->
- Printf.sprintf "(if (List.mem_assoc \"%s\" all) then (my_assoc \"%s\" all) else %s)"
- field_name field_name
- ("Xml.parse_string (\""^(Xml.to_string (Datamodel_values.to_xml default))^"\")")
- ))
- fields in
- let fields = if fields = [] then [ "__unused=()" ] else fields in
- wrap "xml" ("let all = From.structure xml in { " ^
- (String.concat ";\n " fields) ^ " }") in
- let f = "fun param -> ("^f^")" in
- ["and "^alias_of_ty ty^" : string -> xml -> "^alias_of_ty ty^" =";
- " "^f]
-
-(** Generate a module of datamodel type to XML-RPC marshalling functions. *)
-let gen_of_xmlrpc api tys = block
- ["module From = struct"]
- ([["open Xml"];
- ["exception Dispatcher_FieldNotFound of string"];
- ["let my_assoc fld assoc_list = try List.assoc fld assoc_list with Not_found -> raise (Dispatcher_FieldNotFound fld)"];
- ["let fromstring_reference = Ref.of_string"];
- ["let methodCall = From.methodCall"];
- ["let methodResponse = From.methodResponse"];
- ["let set f (xml: XMLRPC.xmlrpc) =";
- " From.array f xml"];
- ["let map fk fv (xml: XMLRPC.xmlrpc) =";
- " List.map (fun (k, v) -> fk k, fv v) (From.structure xml)"
-(*
- " let f m = fk (List.assoc \"key\" m), fv (List.assoc \"value\" m) in";
- " set (fun b -> f (From.structure b)) xml"
-*)
- ];
- ["let structure = From.structure"];
- ["let rec unused' = ()"]] @
- (List.map (ty_of_xmlrpc api) tys))
- ["end"]
diff --git a/ocaml/idl/ocaml_backend/gen_api.ml b/ocaml/idl/ocaml_backend/gen_api.ml
index 9e679aefcd4..8c6e47768bb 100644
--- a/ocaml/idl/ocaml_backend/gen_api.ml
+++ b/ocaml/idl/ocaml_backend/gen_api.ml
@@ -82,10 +82,19 @@ let gen_record_type ~with_module highapi tys =
sprintf "\"%s\",rpc_of_%s x.%s" (String.concat "_" fld.DT.full_name)
(OU.alias_of_ty fld.DT.ty) (OU.ocaml_of_record_field (obj_name :: fld.DT.full_name))
in
-
+ let get_default fld =
+ let default_value =
+ match fld.DT.ty with
+ | DT.Set (DT.Ref _) -> Some (DT.VSet [])
+ | _ -> fld.DT.default_value
+ in
+ match default_value with
+ None -> "None"
+ | Some default -> sprintf "(Some (%s))" (Datamodel_values.to_ocaml_string ~v2:true default)
+ in
let make_to_field fld =
- sprintf "%s = %s_of_rpc (List.assoc \"%s\" x)" (field fld) (OU.alias_of_ty fld.DT.ty)
- (String.concat "_" fld.DT.full_name)
+ sprintf {|%s = %s_of_rpc (assocer "%s" x %s)|} (field fld) (OU.alias_of_ty fld.DT.ty)
+ (String.concat "_" fld.DT.full_name) (get_default fld)
in
let type_t = sprintf "type %s_t = { %s }" obj_name (map_fields regular_def) in
@@ -154,18 +163,19 @@ let gen_client_types highapi =
" let iso8601_of_rpc = function String x | DateTime x -> Date.of_string x | _ -> failwith \"Date.iso8601_of_rpc\"";
"end";
]; [
- "let on_dict f = function | Rpc.Dict x -> f x | _ -> failwith \"Expected Dictionary\""
+ "let on_dict f = function | Rpc.Dict x -> f x | _ -> failwith \"Expected Dictionary\"";
+ ]; [
+ "let assocer key map default = ";
+ " try";
+ " List.assoc key map";
+ " with Not_found ->";
+ " match default with";
+ " | Some d -> d";
+ " | None -> failwith (Printf.sprintf \"Field %s not present in rpc\" key)"
];
gen_non_record_type highapi all_types;
gen_record_type ~with_module:true highapi all_types;
O.Signature.strings_of (Gen_client.gen_signature highapi);
- [ "module Legacy = struct";
- "open XMLRPC";
- "module D=Debug.Make(struct let name=\"legacy_marshallers\" end)";
- "open D" ];
- GenOCaml.gen_of_xmlrpc highapi all_types;
- GenOCaml.gen_to_xmlrpc highapi all_types;
- ["end"];
])
let gen_server highapi =
diff --git a/ocaml/tests/suite.ml b/ocaml/tests/suite.ml
index 54ae467e60a..94f1e40fd22 100644
--- a/ocaml/tests/suite.ml
+++ b/ocaml/tests/suite.ml
@@ -22,17 +22,13 @@ let base_suite =
Test_http.test;
Test_pool_db_backup.test;
Test_xapi_db_upgrade.test;
- Test_ca91480.test;
Test_ha_vm_failover.test;
Test_map_check.test;
- Test_pool_apply_edition.test;
Test_pool_license.test;
Test_features.test;
Test_pool_restore_database.test;
- Test_pool_update.test;
Test_platformdata.test;
Test_sm_features.test;
- Test_gpu_group.test;
Test_pci_helpers.test;
Test_vgpu_type.test;
Test_pgpu.test;
@@ -40,7 +36,6 @@ let base_suite =
Test_storage_migrate_state.test;
Test_vm.test;
Test_vm_helpers.test;
- Test_vm_migrate.test;
Test_xenopsd_metadata.test;
Test_workload_balancing.test;
Test_cpuid_helpers.test;
@@ -48,20 +43,19 @@ let base_suite =
(* Test_ca121350.test; *)
Test_dbsync_master.test;
Test_xapi_xenops.test;
- Test_no_migrate.test;
- Test_pvs_site.test;
- Test_pvs_proxy.test;
Test_pvs_server.test;
Test_pvs_cache_storage.test;
Test_sdn_controller.test;
Test_event.test;
Test_extauth_plugin_ADpbis.test;
Test_guest_agent.test;
+ Test_tunnel.test;
+ Test_bond.test;
+ Test_network_sriov.test;
Test_xapi_vbd_helpers.test;
Test_sr_update_vdis.test;
Test_network_event_loop.test;
Test_network.test;
- Test_pusb.test;
Test_host_helpers.test;
Test_clustering_allowed_operations.test;
Test_clustering.test;
diff --git a/ocaml/tests/suite_alcotest.ml b/ocaml/tests/suite_alcotest.ml
index 5b4a9a526d6..ac4a9252462 100644
--- a/ocaml/tests/suite_alcotest.ml
+++ b/ocaml/tests/suite_alcotest.ml
@@ -7,6 +7,8 @@ let () =
Alcotest.run "Base suite"
[ "Test_valid_ref_list", Test_valid_ref_list.test
; "Test_vdi_allowed_operations", Test_vdi_allowed_operations.test
+ ; "Test_vm_migrate", Test_vm_migrate.test
+ ; "Test_no_migrate", Test_no_migrate.test
; "Test_vm_check_operation_error", Test_vm_check_operation_error.test
; "Test_host", Test_host.test
; "Test_vdi_cbt", Test_vdi_cbt.test
@@ -17,4 +19,11 @@ let () =
; "Test_cluster", Test_cluster.test
; "Test_cluster_host", Test_cluster_host.test
; "Test_client", Test_client.test
+ ; "Test_ca91480", Test_ca91480.test
+ ; "Test_gpu_group", Test_gpu_group.test
+ ; "Test_pool_apply_edition", Test_pool_apply_edition.test
+ ; "Test_pool_update", Test_pool_update.test
+ ; "Test_pusb", Test_pusb.test
+ ; "Test_pvs_site", Test_pvs_site.test
+ ; "Test_pvs_proxy", Test_pvs_proxy.test
]
diff --git a/ocaml/tests/test_bond.ml b/ocaml/tests/test_bond.ml
new file mode 100644
index 00000000000..cc23e3a84df
--- /dev/null
+++ b/ocaml/tests/test_bond.ml
@@ -0,0 +1,164 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open OUnit
+open Test_common
+
+let gen_members = mknlist 2
+
+let test_create_on_unmanaged_pif () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let create_member = create_physical_pif ~__context ~host ~managed:false in
+ let network = make_network ~__context () in
+ let members = gen_members create_member in
+ assert_raises_api_error
+ Api_errors.pif_unmanaged
+ ~args:[Ref.string_of (List.hd members)]
+ (fun () -> Xapi_bond.create ~__context ~network ~members ~mAC:"ff:ff:ff:ff:ff:ff" ~mode:`activebackup ~properties:[])
+
+let test_create_network_already_connected () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let network = make_network ~__context () in
+ let connected_pif = create_physical_pif ~__context ~network ~host () in
+ let create_member = create_physical_pif ~__context ~host in
+ let members = gen_members create_member in
+ assert_raises_api_error
+ Api_errors.network_already_connected
+ ~args:[Ref.string_of host; Ref.string_of connected_pif]
+ (fun () -> Xapi_bond.create ~__context ~network ~members ~mAC:"ff:ff:ff:ff:ff:ff" ~mode:`activebackup ~properties:[])
+
+let test_create_member_is_bond_slave () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let network = make_network ~__context () in
+ let create_member () =
+ let members = gen_members (create_physical_pif ~__context ~host) in
+ let _ = create_bond_pif ~__context ~host ~members () in
+ List.hd members
+ in
+ let members = gen_members create_member in
+ assert_raises_api_error
+ Api_errors.pif_already_bonded
+ ~args:[Ref.string_of (List.hd members)]
+ (fun () -> Xapi_bond.create ~__context ~network ~members ~mAC:"ff:ff:ff:ff:ff:ff" ~mode:`activebackup ~properties:[])
+
+let test_create_member_is_vlan_master_on_physical () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let network = make_network ~__context () in
+ let create_member () =
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ create_vlan_pif ~__context ~host ~pif:physical_PIF ~vlan:1L ()
+ in
+ let members = gen_members create_member in
+ assert_raises_api_error
+ Api_errors.pif_vlan_exists
+ ~args:[Db.PIF.get_device_name ~__context ~self:(List.hd members)]
+ (fun () -> Xapi_bond.create ~__context ~network ~members ~mAC:"ff:ff:ff:ff:ff:ff" ~mode:`activebackup ~properties:[])
+
+let test_create_member_is_vlan_master_on_sriov () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let network = make_network ~__context () in
+ let create_member () =
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ create_vlan_pif ~__context ~host ~pif:sriov_logical_PIF ~vlan:1L ()
+ in
+ let members = gen_members create_member in
+ assert_raises_api_error
+ Api_errors.pif_vlan_exists
+ ~args:[Db.PIF.get_device_name ~__context ~self:(List.hd members)]
+ (fun () -> Xapi_bond.create ~__context ~network ~members ~mAC:"ff:ff:ff:ff:ff:ff" ~mode:`activebackup ~properties:[])
+
+let test_create_member_is_sriov_logical () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let network = make_network ~__context () in
+ let create_member () =
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ create_sriov_pif ~__context ~pif:physical_PIF ()
+ in
+ let members = gen_members create_member in
+ assert_raises_api_error
+ Api_errors.pif_is_sriov_logical
+ ~args:[Ref.string_of (List.hd members)]
+ (fun () -> Xapi_bond.create ~__context ~network ~members ~mAC:"ff:ff:ff:ff:ff:ff" ~mode:`activebackup ~properties:[])
+
+let test_create_member_is_tunnel_access () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let network = make_network ~__context () in
+ let create_member () =
+ let transport_PIF = create_physical_pif ~__context ~host () in
+ create_tunnel_pif ~__context ~host ~pif:transport_PIF ()
+ in
+ let members = gen_members create_member in
+ assert_raises_api_error
+ Api_errors.is_tunnel_access_pif
+ ~args:[Ref.string_of (List.hd members)]
+ (fun () -> Xapi_bond.create ~__context ~network ~members ~mAC:"ff:ff:ff:ff:ff:ff" ~mode:`activebackup ~properties:[])
+
+let test_create_bond_into_sriov_network () =
+ let __context = make_test_database () in
+ let sriov_network =
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ Db.PIF.get_network ~__context ~self:sriov_logical_PIF
+ in
+ let members =
+ let host = make_host ~__context () in
+ let create_member = create_physical_pif ~__context ~host in
+ gen_members create_member
+ in
+ assert_raises_api_error
+ Api_errors.network_incompatible_with_bond
+ ~args:[Ref.string_of sriov_network]
+ (fun () -> Xapi_bond.create ~__context ~network:sriov_network ~members ~mAC:"ff:ff:ff:ff:ff:ff" ~mode:`activebackup ~properties:[])
+
+let test_create_bond_into_sriov_vlan_network () =
+ let __context = make_test_database () in
+ let sriov_vlan_network =
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ let vlan_pif = create_vlan_pif ~__context ~host ~vlan:1L ~pif:sriov_logical_PIF () in
+ Db.PIF.get_network ~__context ~self:vlan_pif
+ in
+ let members =
+ let host = make_host ~__context () in
+ let create_member = create_physical_pif ~__context ~host in
+ gen_members create_member
+ in
+ assert_raises_api_error
+ Api_errors.network_incompatible_with_bond
+ ~args:[Ref.string_of sriov_vlan_network]
+ (fun () -> Xapi_bond.create ~__context ~network:sriov_vlan_network ~members ~mAC:"ff:ff:ff:ff:ff:ff" ~mode:`activebackup ~properties:[])
+
+let test =
+ "test_bond" >:::
+ [
+ "test_create_on_unmanaged_pif" >:: test_create_on_unmanaged_pif;
+ "test_create_network_already_connected" >:: test_create_network_already_connected;
+ "test_create_member_is_bond_slave" >:: test_create_member_is_bond_slave;
+ "test_create_member_is_vlan_master_on_physical" >:: test_create_member_is_vlan_master_on_physical;
+ "test_create_member_is_vlan_master_on_sriov" >:: test_create_member_is_vlan_master_on_sriov;
+ "test_create_member_is_sriov_logical" >:: test_create_member_is_sriov_logical;
+ "test_create_member_is_tunnel_access" >:: test_create_member_is_tunnel_access;
+ "test_create_bond_into_sriov_network" >:: test_create_bond_into_sriov_network;
+ "test_create_bond_into_sriov_vlan_network" >:: test_create_bond_into_sriov_vlan_network;
+ ]
diff --git a/ocaml/tests/test_ca91480.ml b/ocaml/tests/test_ca91480.ml
index f920c2e4e39..4c0933a90dc 100644
--- a/ocaml/tests/test_ca91480.ml
+++ b/ocaml/tests/test_ca91480.ml
@@ -2,12 +2,9 @@
VBDs, VIFs, VGPUs, PCIs, VM_metrics, and VM_guest_metrics, but none
of these objects should actually exist in the DB. *)
-open OUnit
-open Test_common
-
let setup_fixture () =
- let __context = make_test_database () in
- let self = make_vm ~__context () in
+ let __context = Test_common.make_test_database () in
+ let self = Test_common.make_vm ~__context () in
let fake_v f = f ~__context ~self ~value:(Ref.make ())
and fake_m f = f ~__context ~self ~key:"fake" ~value:(Ref.make ())
@@ -26,7 +23,5 @@ let test_vm_destroy () =
Xapi_vm_helpers.destroy ~__context ~self
let test =
- "test_ca91480" >:::
- [
- "test_vm_destroy" >:: test_vm_destroy;
+ [ "test_vm_destroy", `Quick, test_vm_destroy
]
diff --git a/ocaml/tests/test_common.ml b/ocaml/tests/test_common.ml
index 3311f007904..5abea98f34c 100644
--- a/ocaml/tests/test_common.ml
+++ b/ocaml/tests/test_common.ml
@@ -167,6 +167,17 @@ let make_pif ~__context ~network ~host ?(device="eth0") ?(mAC="C0:FF:EE:C0:FF:EE
~iP ~netmask ~gateway ~dNS ~bond_slave_of ~vLAN_master_of ~management ~other_config ~disallow_unplug
~ipv6_configuration_mode ~iPv6 ~ipv6_gateway ~primary_address_type ~managed ~properties
+let make_vlan ~__context ~tagged_PIF ~untagged_PIF ~tag ?(other_config=[]) () =
+ Xapi_vlan.pool_introduce ~__context ~tagged_PIF ~untagged_PIF ~tag ~other_config
+
+let make_network_sriov = Xapi_network_sriov.create_internal
+
+let make_bond ~__context ?(ref=Ref.make ()) ?(uuid=make_uuid ()) ~master ?(other_config=[]) ?(primary_slave=Ref.null) ?(mode=`activebackup) ?(properties=[]) () =
+ Db.Bond.create ~__context ~ref ~uuid ~master ~other_config ~primary_slave ~mode ~properties ~links_up:0L;
+ ref
+
+let make_tunnel = Xapi_tunnel.create_internal
+
let make_network ~__context ?(name_label="net") ?(name_description="description") ?(mTU=1500L)
?(other_config=[]) ?(bridge="xenbr0") ?(managed=true) ?(purpose=[]) () =
Xapi_network.pool_introduce ~__context ~name_label ~name_description ~mTU ~other_config ~bridge ~managed ~purpose
@@ -187,7 +198,7 @@ let make_vif ~__context ?(ref=Ref.make ()) ?(uuid=make_uuid ())
~currently_attached ~status_code ~status_detail ~runtime_properties
~other_config ~metrics ~locking_mode ~ipv4_allowed ~ipv6_allowed
~ipv4_configuration_mode ~ipv4_addresses ~ipv4_gateway
- ~ipv6_configuration_mode ~ipv6_addresses ~ipv6_gateway;
+ ~ipv6_configuration_mode ~ipv6_addresses ~ipv6_gateway ~reserved_pci:Ref.null;
ref
let make_pool ~__context ~master ?(name_label="") ?(name_description="")
@@ -287,11 +298,12 @@ let make_pci ~__context ?(ref=Ref.make ()) ?(uuid=make_uuid ()) ?(class_id="")
?(device_name="") ?(host=Ref.null) ?(pci_id="0000:00:00.0") ?(functions=0L)
?(physical_function=Ref.null) ?(dependencies=[]) ?(other_config=[]) ?(subsystem_vendor_id="")
?(subsystem_vendor_name="") ?(subsystem_device_id="")
- ?(subsystem_device_name="") ?(scheduled_to_be_attached_to=Ref.null) () =
+ ?(subsystem_device_name="") ?(driver_name="")
+ ?(scheduled_to_be_attached_to=Ref.null) () =
Db.PCI.create ~__context ~ref ~uuid ~class_id ~class_name ~vendor_id
~vendor_name ~device_id ~device_name ~host ~pci_id ~functions ~physical_function
~dependencies ~other_config ~subsystem_vendor_id ~subsystem_vendor_name
- ~subsystem_device_id ~subsystem_device_name ~scheduled_to_be_attached_to;
+ ~subsystem_device_id ~driver_name ~subsystem_device_name ~scheduled_to_be_attached_to;
ref
let make_pgpu ~__context ?(ref=Ref.make ()) ?(uuid=make_uuid ()) ?(pCI=Ref.null)
@@ -417,6 +429,64 @@ let make_client_params ~__context =
in
(rpc, session_id)
+let create_physical_pif ~__context ~host ?network ?(bridge="xapi0") ?(managed=true) () =
+ let network = match network with
+ | Some network -> network
+ | None -> make_network ~__context ~bridge ()
+ in
+ make_pif ~__context ~network ~host ~managed ()
+
+let create_vlan_pif ~__context ~host ~vlan ~pif ?(bridge="xapi0") ()=
+ let network = make_network ~__context ~bridge () in
+ let vlan_pif = make_pif ~__context ~network ~host ~vLAN:vlan ~physical:false () in
+ let _ = make_vlan ~__context ~tagged_PIF:pif ~untagged_PIF:vlan_pif ~tag:vlan () in
+ vlan_pif
+
+let create_tunnel_pif ~__context ~host ~pif ?(bridge="xapi0") () =
+ let network = make_network ~__context ~bridge () in
+ let tunnel, access_pif = make_tunnel ~__context ~transport_PIF:pif ~network ~host in
+ access_pif
+
+let create_sriov_pif ~__context ~pif ?network ?(bridge="xapi0") () =
+ let sriov_network = match network with
+ | Some network -> network
+ | None -> make_network ~__context ~bridge ()
+ in
+ let physical_rec = Db.PIF.get_record ~__context ~self:pif in
+ let sriov, sriov_logical_pif = make_network_sriov ~__context ~physical_PIF:pif ~physical_rec ~network:sriov_network in
+ Db.Network_sriov.set_configuration_mode ~__context ~self:sriov ~value:`sysfs;
+ sriov_logical_pif
+
+let create_bond_pif ~__context ~host ~members ?(bridge="xapi0") () =
+ let network = make_network ~__context ~bridge () in
+ let bond_master = make_pif ~__context ~network ~host ~physical:false () in
+ let bond = make_bond ~__context ~master:bond_master () in
+ List.iter (fun member ->
+ Db.PIF.set_bond_slave_of ~__context ~self:member ~value:bond
+ ) members;
+ bond_master
+
+let mknlist n f =
+ let rec aux result = function
+ | 0 -> result
+ | n ->
+ let result = f () :: result in
+ aux result (n-1)
+ in
+ aux [] n
+
+let make_vfs_on_pf ~__context ~pf ~num =
+ let rec make_vf num =
+ if num > 0L then begin
+ let vf = make_pci ~__context ~functions:1L () in
+ Db.PCI.set_physical_function ~__context ~self:vf ~value:pf;
+ let functions = Db.PCI.get_functions ~__context ~self:pf in
+ Db.PCI.set_functions ~__context ~self:pf ~value:(Int64.add functions 1L);
+ make_vf (Int64.sub num 1L);
+ end
+ in
+ make_vf num
+
let make_cluster_host ~__context ?(ref=Ref.make ()) ?(uuid=make_uuid ())
?(cluster=Ref.null) ?(host=Ref.null) ?(enabled=true)
?(allowed_operations=[]) ?(current_operations=[]) ?(other_config=[]) () =
diff --git a/ocaml/tests/test_gpu_group.ml b/ocaml/tests/test_gpu_group.ml
index 605ff23abc9..dfb88dcf016 100644
--- a/ocaml/tests/test_gpu_group.ml
+++ b/ocaml/tests/test_gpu_group.ml
@@ -12,9 +12,10 @@
* GNU Lesser General Public License for more details.
*)
-open OUnit
open Test_vgpu_common
+let assert_true msg b = Alcotest.(check bool) msg true b
+
let test_supported_enabled_types () =
let __context = Test_common.make_test_database () in
(* Create a GPU group containing a single K2 PGPU. *)
@@ -49,8 +50,8 @@ let test_supported_enabled_types () =
"GPU group does not list %s as enabled"
vgpu_type.Xapi_vgpu_type.model_name
in
- assert_bool msg_supported (List.mem vgpu_type_ref group_supported_types);
- assert_bool msg_enabled (List.mem vgpu_type_ref group_enabled_types))
+ assert_true msg_supported (List.mem vgpu_type_ref group_supported_types);
+ assert_true msg_enabled (List.mem vgpu_type_ref group_enabled_types))
vgpu_types_and_refs;
(* Invalidate the PGPU's host ref, and run a GC pass; this should destroy the
* pgpu, and clear the group's supported and enabled types. *)
@@ -62,18 +63,16 @@ let test_supported_enabled_types () =
let group_enabled_types =
Db.GPU_group.get_enabled_VGPU_types ~__context ~self:gPU_group
in
- assert_equal
- ~msg:"PGPU has not been destroyed"
- (Db.is_valid_ref __context pgpu) false;
- assert_equal
- ~msg:"GPU group still has supported types after GC"
- group_supported_types [];
- assert_equal
- ~msg:"GPU group still has enabled types after GC"
- group_enabled_types []
+ Alcotest.(check bool)
+ "PGPU has not been destroyed"
+ false (Db.is_valid_ref __context pgpu);
+ Alcotest.(check (list ((Alcotest_comparators.ref ()))))
+ "GPU group still has supported types after GC"
+ [] group_supported_types;
+ Alcotest.(check (list ((Alcotest_comparators.ref ()))))
+ "GPU group still has enabled types after GC"
+ [] group_enabled_types
let test =
- "test_gpu_group" >:::
- [
- "test_supported_enabled_types" >:: test_supported_enabled_types;
+ [ "test_supported_enabled_types", `Quick, test_supported_enabled_types
]
diff --git a/ocaml/tests/test_guest_agent.ml b/ocaml/tests/test_guest_agent.ml
index 0d17a6452b8..80a92c453e7 100644
--- a/ocaml/tests/test_guest_agent.ml
+++ b/ocaml/tests/test_guest_agent.ml
@@ -57,7 +57,10 @@ module Networks = Generic.Make (struct
let transform input =
let tree = List.fold_left construct_tree (T("", [])) input in
- Xapi_guest_agent.networks "attr" (list tree)
+ List.concat [
+ Xapi_guest_agent.networks "attr" "vif" (list tree)
+ ; Xapi_guest_agent.networks "xenserver/attr" "net-sriov-vf" (list tree)
+ ]
let tests = [
(* basic cases *)
@@ -263,11 +266,20 @@ module Initial_guest_metrics = Generic.Make (struct
], [ "0/ipv6/0", "fe80:0000:0000:0000:7870:94ff:fe52:dd06";
];
+ [ "xenserver/attr/net-sriov-vf/0/ipv6/0", "fe80:0000:0000:0000:7870:94ff:fe52:dd06";
+ ], [ "0/ipv6/0", "fe80:0000:0000:0000:7870:94ff:fe52:dd06";
+ ];
+
[ "attr/vif/0/ipv4/0", "192.168.0.1";
], [ "0/ip", "192.168.0.1";
"0/ipv4/0", "192.168.0.1";
];
+ [ "xenserver/attr/net-sriov-vf/0/ipv4/0", "192.168.0.1";
+ ], [ "0/ip", "192.168.0.1";
+ "0/ipv4/0", "192.168.0.1";
+ ];
+
[ "attr/eth0/ip", "192.168.0.1";
], [ "0/ip", "192.168.0.1";
"0/ipv4/0", "192.168.0.1";
@@ -282,6 +294,10 @@ module Initial_guest_metrics = Generic.Make (struct
], [ "1/ipv6/2", "fe80:0000:0000:0000:7870:94ff:fe52:dd06";
];
+ [ "xenserver/attr/net-sriov-vf/1/ipv6/2", "fe80:0000:0000:0000:7870:94ff:fe52:dd06";
+ ], [ "1/ipv6/2", "fe80:0000:0000:0000:7870:94ff:fe52:dd06";
+ ];
+
[ "attr/vif/1/ipv4/2", "192.168.0.1";
], [ "1/ip", "192.168.0.1";
"1/ipv4/2", "192.168.0.1";
@@ -303,6 +319,12 @@ module Initial_guest_metrics = Generic.Make (struct
"0/ipv6/0", "fe80:0000:0000:0000:7870:94ff:fe52:dd06";
];
+ [ "xenserver/attr/net-sriov-vf/0/ipv6/0", "fe80:0000:0000:0000:7870:94ff:fe52:dd06";
+ "xenserver/attr/net-sriov-vf/0/ipv6/1", "fe80:0000:0000:0000:7870:94ff:fe52:dd07";
+ ], [ "0/ipv6/1", "fe80:0000:0000:0000:7870:94ff:fe52:dd07";
+ "0/ipv6/0", "fe80:0000:0000:0000:7870:94ff:fe52:dd06";
+ ];
+
[ "attr/vif/0/ipv4/0", "192.168.0.1";
"attr/vif/0/ipv4/1", "192.168.1.1";
], [ "0/ipv4/1", "192.168.1.1";
@@ -356,10 +378,37 @@ module Initial_guest_metrics = Generic.Make (struct
"1/ipv4/0", "192.168.1.1";
];
+ (* combined SRIOV VF and plain VIF *)
+ [ "attr/vif/0/ipv4/0", "192.168.0.1";
+ "attr/vif/0/ipv4/1", "192.168.0.2";
+ "attr/vif/1/ipv4/0", "192.168.1.1";
+ "attr/vif/1/ipv4/1", "192.168.1.2";
+ "xenserver/attr/net-sriov-vf/2/ipv4/0", "192.168.2.1";
+ "xenserver/attr/net-sriov-vf/2/ipv4/1", "192.168.2.2";
+ "xenserver/attr/net-sriov-vf/3/ipv4/0", "192.168.3.1";
+ "xenserver/attr/net-sriov-vf/3/ipv4/1", "192.168.3.2";
+ ], [ "0/ipv4/1", "192.168.0.2";
+ "0/ip", "192.168.0.1";
+ "0/ipv4/0", "192.168.0.1";
+ "1/ipv4/1", "192.168.1.2";
+ "1/ip", "192.168.1.1";
+ "1/ipv4/0", "192.168.1.1";
+ "2/ipv4/1", "192.168.2.2";
+ "2/ip", "192.168.2.1";
+ "2/ipv4/0", "192.168.2.1";
+ "3/ipv4/1", "192.168.3.2";
+ "3/ip", "192.168.3.1";
+ "3/ipv4/0", "192.168.3.1";
+ ];
+
(* exceptions *)
[ "attr/vif/0/ipv4/a", "192.168.0.1";
"attr/vif/0/ipv4/1", "192.168.0.1";
], [];
+
+ [ "xenserver/attr/net-sriov-vf/0/ipv4/a", "192.168.0.1";
+ "xenserver/attr/net-sriov-vf/0/ipv4/1", "192.168.0.1";
+ ], [];
]
end)
diff --git a/ocaml/tests/test_network_sriov.ml b/ocaml/tests/test_network_sriov.ml
new file mode 100644
index 00000000000..c5e239dfa55
--- /dev/null
+++ b/ocaml/tests/test_network_sriov.ml
@@ -0,0 +1,379 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open OUnit
+open Test_common
+
+let test_create_internal () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let physical_rec = Db.PIF.get_record ~__context ~self:physical_PIF in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ let sriov, logical_PIF = Xapi_network_sriov.create_internal ~__context ~physical_PIF ~physical_rec ~network in
+ assert_equal sriov (List.hd (Db.PIF.get_sriov_physical_PIF_of ~__context ~self:physical_PIF));
+ assert_equal sriov (List.hd (Db.PIF.get_sriov_logical_PIF_of ~__context ~self:logical_PIF));
+ assert_equal physical_PIF (Db.Network_sriov.get_physical_PIF ~__context ~self:sriov);
+ assert_equal logical_PIF (Db.Network_sriov.get_logical_PIF ~__context ~self:sriov);
+ assert_equal network (Db.PIF.get_network ~__context ~self:logical_PIF);
+ assert_equal host (Db.PIF.get_host ~__context ~self:logical_PIF)
+
+let test_create_on_unmanaged_pif () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host ~managed:false () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ assert_raises_api_error
+ Api_errors.pif_unmanaged
+ ~args:[Ref.string_of physical_PIF]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif:physical_PIF ~network)
+
+let test_create_network_already_connected () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let network = make_network ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host ~network () in
+ Db.PIF.set_capabilities ~__context ~self:physical_PIF ~value:["sriov"];
+ assert_raises_api_error
+ Api_errors.network_already_connected
+ ~args:[Ref.string_of host; Ref.string_of physical_PIF]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif:physical_PIF ~network)
+
+let test_create_on_bond_master () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let pif =
+ let members = mknlist 2 (create_physical_pif ~__context ~host) in
+ create_bond_pif ~__context ~host ~members ()
+ in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ assert_raises_api_error
+ Api_errors.pif_is_not_physical
+ ~args:[Ref.string_of pif]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif ~network)
+
+let test_create_on_tunnel_access () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let pif =
+ let transport_PIF = create_physical_pif ~__context ~host () in
+ create_tunnel_pif ~__context ~host ~pif:transport_PIF ()
+ in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ assert_raises_api_error
+ Api_errors.pif_is_not_physical
+ ~args:[Ref.string_of pif]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif ~network)
+
+let test_create_on_sriov_logical () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let pif =
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ create_sriov_pif ~__context ~pif:physical_PIF ()
+ in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ assert_raises_api_error
+ Api_errors.pif_is_not_physical
+ ~args:[Ref.string_of pif]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif ~network)
+
+let test_create_on_vlan () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let pif =
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ create_vlan_pif ~__context ~host ~vlan:1L ~pif:physical_PIF ()
+ in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ assert_raises_api_error
+ Api_errors.pif_is_not_physical
+ ~args:[Ref.string_of pif]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif ~network)
+
+let test_create_on_vlan_on_sriov_logical () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let pif =
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ create_vlan_pif ~__context ~host ~vlan:1L ~pif:sriov_logical_PIF ()
+ in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ assert_raises_api_error
+ Api_errors.pif_is_not_physical
+ ~args:[Ref.string_of pif]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif ~network)
+
+let test_create_on_pif_already_enabled_sriov () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let pif =
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let _ = create_sriov_pif ~__context ~pif:physical_PIF () in
+ physical_PIF
+ in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ assert_raises_api_error
+ Api_errors.network_sriov_already_enabled
+ ~args:[Ref.string_of pif]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif ~network)
+
+let test_create_on_pif_not_have_sriov_capability () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let pif = create_physical_pif ~__context ~host () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ assert_raises_api_error
+ Api_errors.pif_is_not_sriov_capable
+ ~args:[Ref.string_of pif]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif ~network)
+
+let test_create_on_network_not_compatible_sriov () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ let _ =
+ (* attach non sriov PIF to the network *)
+ let host = make_host ~__context () in
+ create_physical_pif ~__context ~host ~network ()
+ in
+ let pif = create_physical_pif ~__context ~host () in
+ Db.PIF.set_capabilities ~__context ~self:pif ~value:["sriov"];
+ assert_raises_api_error
+ Api_errors.network_incompatible_with_sriov
+ ~args:[Ref.string_of network]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif ~network)
+
+let test_create_sriov_with_different_pci_type_into_one_network () =
+ let __context = make_test_database () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ let _ =
+ (* attach sriov PIF to the network *)
+ let host = make_host ~__context () in
+ let physical_PIF =
+ let pif = create_physical_pif ~__context ~host ~network () in
+ Db.PIF.set_capabilities ~__context ~self:pif ~value:["sriov"];
+ let pci = make_pci ~__context ~vendor_id:"101" ~device_id:"2" () in
+ Db.PIF.set_PCI ~__context ~self:pif ~value:pci;
+ pif
+ in
+ create_sriov_pif ~__context ~pif:physical_PIF ~network ()
+ in
+ let pif =
+ let host = make_host ~__context () in
+ let pif = create_physical_pif ~__context ~host () in
+ Db.PIF.set_capabilities ~__context ~self:pif ~value:["sriov"];
+ let pci = make_pci ~__context ~vendor_id:"99" ~device_id:"1" () in
+ Db.PIF.set_PCI ~__context ~self:pif ~value:pci;
+ pif
+ in
+ Db.PIF.set_capabilities ~__context ~self:pif ~value:["sriov"];
+ assert_raises_api_error
+ Api_errors.network_has_incompatible_sriov_pifs
+ ~args:[Ref.string_of pif; Ref.string_of network]
+ (fun () -> Xapi_network_sriov.create ~__context ~pif ~network)
+
+let test_require_operation_on_pci_device_not_attached_not_need_reboot () =
+ let __context = make_test_database () in
+ let sriov_logical_PIF, sriov=
+ let host = make_host ~__context () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ let physical_PIF = create_physical_pif ~__context ~host ~network () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF ~network () in
+ Db.PIF.set_currently_attached ~__context ~self:sriov_logical_PIF ~value:false;
+ let sriov = List.hd (Db.PIF.get_sriov_logical_PIF_of ~__context ~self:sriov_logical_PIF) in
+ Db.Network_sriov.set_requires_reboot ~__context ~self:sriov ~value:false;
+ sriov_logical_PIF, sriov
+ in
+ assert_equal false (Xapi_network_sriov_helpers.require_operation_on_pci_device ~__context ~sriov ~self:sriov_logical_PIF)
+
+let test_require_operation_on_pci_device_sysfs () =
+ (* Need operate pci device when Network_sriov.configuration_mode = `sysfs *)
+ let __context = make_test_database () in
+ let sriov_logical_PIF, sriov =
+ let host = make_host ~__context () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ let physical_PIF = create_physical_pif ~__context ~host ~network () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF ~network () in
+ Db.PIF.set_currently_attached ~__context ~self:sriov_logical_PIF ~value:true;
+ let sriov = List.hd (Db.PIF.get_sriov_logical_PIF_of ~__context ~self:sriov_logical_PIF) in
+ Db.Network_sriov.set_requires_reboot ~__context ~self:sriov ~value:false;
+ Db.Network_sriov.set_configuration_mode ~__context ~self:sriov ~value:`sysfs;
+ sriov_logical_PIF, sriov
+ in
+ assert_equal true (Xapi_network_sriov_helpers.require_operation_on_pci_device ~__context ~sriov ~self:sriov_logical_PIF)
+
+let test_require_operation_on_pci_device_unknown () =
+ (* Need not operate pci device when Network_sriov.configuration_mode = `Unknown *)
+ let __context = make_test_database () in
+ let sriov_logical_PIF, sriov =
+ let host = make_host ~__context () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ let physical_PIF = create_physical_pif ~__context ~host ~network () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF ~network () in
+ Db.PIF.set_currently_attached ~__context ~self:sriov_logical_PIF ~value:true;
+ let sriov = List.hd (Db.PIF.get_sriov_logical_PIF_of ~__context ~self:sriov_logical_PIF) in
+ Db.Network_sriov.set_requires_reboot ~__context ~self:sriov ~value:false;
+ Db.Network_sriov.set_configuration_mode ~__context ~self:sriov ~value:`unknown;
+ sriov_logical_PIF, sriov
+ in
+ assert_equal false (Xapi_network_sriov_helpers.require_operation_on_pci_device ~__context ~sriov ~self:sriov_logical_PIF)
+
+let create_physical_pif_with_driver ~__context ~host ~network ?(driver_name="") () =
+ let physical_PIF = create_physical_pif ~__context ~host ~network () in
+ let pci = make_pci ~__context ~vendor_id:"99" ~device_id:"1" ~driver_name () in
+ Db.PIF.set_PCI ~__context ~self:physical_PIF ~value:pci;
+ physical_PIF
+
+(* Network_sriov.configuration_mode = `modprobe *)
+let test_require_operation_on_pci_device_modprobe_0 () =
+ (* No other sriov has same driver with me.
+ I am currently attached.
+ So operate the device.*)
+ let __context = make_test_database () in
+ let sriov_logical_PIF, sriov =
+ let host = make_host ~__context () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ let physical_PIF = create_physical_pif_with_driver ~__context ~host ~network () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF ~network () in
+ Db.PIF.set_currently_attached ~__context ~self:sriov_logical_PIF ~value:true;
+ let sriov = List.hd (Db.PIF.get_sriov_logical_PIF_of ~__context ~self:sriov_logical_PIF) in
+ Db.Network_sriov.set_requires_reboot ~__context ~self:sriov ~value:false;
+ Db.Network_sriov.set_configuration_mode ~__context ~self:sriov ~value:`modprobe;
+ sriov_logical_PIF, sriov
+ in
+ assert_equal true (Xapi_network_sriov_helpers.require_operation_on_pci_device ~__context ~sriov ~self:sriov_logical_PIF)
+
+let test_require_operation_on_pci_device_modprobe_1 () =
+ (* No other sriov has same driver with me.
+ I am not currently attached but will enable after reboot
+ So operate the device.*)
+ let __context = make_test_database () in
+ let sriov_logical_PIF, sriov =
+ let host = make_host ~__context () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ let physical_PIF = create_physical_pif_with_driver ~__context ~host ~network () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF ~network () in
+ Db.PIF.set_currently_attached ~__context ~self:sriov_logical_PIF ~value:false;
+ let sriov = List.hd (Db.PIF.get_sriov_logical_PIF_of ~__context ~self:sriov_logical_PIF) in
+ Db.Network_sriov.set_requires_reboot ~__context ~self:sriov ~value:true;
+ Db.Network_sriov.set_configuration_mode ~__context ~self:sriov ~value:`modprobe;
+ sriov_logical_PIF, sriov
+ in
+ assert_equal true (Xapi_network_sriov_helpers.require_operation_on_pci_device ~__context ~sriov ~self:sriov_logical_PIF)
+
+let create_modprobe_sriov_logical_pif_with_driver ~__context ~host ~network ~driver_name ~currently_attached ~requires_reboot =
+ let physical_PIF = create_physical_pif_with_driver ~__context ~host ~network ~driver_name () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF ~network () in
+ Db.PIF.set_currently_attached ~__context ~self:sriov_logical_PIF ~value:currently_attached;
+ let sriov = List.hd (Db.PIF.get_sriov_logical_PIF_of ~__context ~self:sriov_logical_PIF) in
+ Db.Network_sriov.set_requires_reboot ~__context ~self:sriov ~value:requires_reboot;
+ Db.Network_sriov.set_configuration_mode ~__context ~self:sriov ~value:`modprobe;
+ sriov_logical_PIF, sriov
+
+let test_require_operation_on_pci_device_modprobe_2 () =
+ (* There are 1 other sriov has same driver name with me.
+ I am currently attached but the other one is not currently attached and do not require reboot.
+ So operate the device. *)
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let driver_name = "mock_driver" in
+ let _ =
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ create_modprobe_sriov_logical_pif_with_driver ~__context ~host ~network ~driver_name ~currently_attached:false ~requires_reboot:false
+ in
+ let sriov_logical_PIF, sriov =
+ let network = make_network ~__context ~bridge:"xapi1" () in
+ create_modprobe_sriov_logical_pif_with_driver ~__context ~host ~network ~driver_name ~currently_attached:true ~requires_reboot:false
+ in
+ assert_equal true (Xapi_network_sriov_helpers.require_operation_on_pci_device ~__context ~sriov ~self:sriov_logical_PIF)
+
+let test_require_operation_on_pci_device_modprobe_3 () =
+ (* There are 1 other sriov has same driver name with me.
+ I am currently attached and the other one is currently attached.
+ So do NOT operate the device. *)
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let driver_name = "mock_driver" in
+ let _ =
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ create_modprobe_sriov_logical_pif_with_driver ~__context ~host ~network ~driver_name ~currently_attached:true ~requires_reboot:false
+ in
+ let sriov_logical_PIF, sriov =
+ let network = make_network ~__context ~bridge:"xapi1" () in
+ create_modprobe_sriov_logical_pif_with_driver ~__context ~host ~network ~driver_name ~currently_attached:true ~requires_reboot:false
+ in
+ assert_equal false (Xapi_network_sriov_helpers.require_operation_on_pci_device ~__context ~sriov ~self:sriov_logical_PIF)
+
+let test_require_operation_on_pci_device_modprobe_4 () =
+ (* There are 1 other sriov has same driver name with me.
+ I am NOT currently attached but require reboot. The other one is NOT currently attached and NOT require reboot.
+ So operate the device.*)
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let driver_name = "mock_driver" in
+ let _ =
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ create_modprobe_sriov_logical_pif_with_driver ~__context ~host ~network ~driver_name ~currently_attached:false ~requires_reboot:false
+ in
+ let sriov_logical_PIF, sriov =
+ let network = make_network ~__context ~bridge:"xapi1" () in
+ create_modprobe_sriov_logical_pif_with_driver ~__context ~host ~network ~driver_name ~currently_attached:false ~requires_reboot:true
+ in
+ assert_equal true (Xapi_network_sriov_helpers.require_operation_on_pci_device ~__context ~sriov ~self:sriov_logical_PIF)
+
+let test_require_operation_on_pci_device_modprobe_5 () =
+ (* There are 1 other sriov has same driver name with me.
+ I am NOT currently attached and require reboot. The other one is NOT currently attached but require reboot.
+ So do NOT operate the device. *)
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let driver_name = "mock_driver" in
+ let _ =
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ create_modprobe_sriov_logical_pif_with_driver ~__context ~host ~network ~driver_name ~currently_attached:false ~requires_reboot:true
+ in
+ let sriov_logical_PIF, sriov =
+ let network = make_network ~__context ~bridge:"xapi1" () in
+ create_modprobe_sriov_logical_pif_with_driver ~__context ~host ~network ~driver_name ~currently_attached:false ~requires_reboot:true
+ in
+ assert_equal false (Xapi_network_sriov_helpers.require_operation_on_pci_device ~__context ~sriov ~self:sriov_logical_PIF)
+
+
+let test =
+ "test_network_sriov" >:::
+ [
+ "test_create_internal" >:: test_create_internal;
+ "test_create_on_unmanaged_pif" >:: test_create_on_unmanaged_pif;
+ "test_create_network_already_connected" >:: test_create_network_already_connected;
+ "test_create_on_bond_master" >:: test_create_on_bond_master;
+ "test_create_on_tunnel_access" >:: test_create_on_tunnel_access;
+ "test_create_on_sriov_logical" >:: test_create_on_sriov_logical;
+ "test_create_on_vlan" >:: test_create_on_vlan;
+ "test_create_on_vlan_on_sriov_logical" >:: test_create_on_vlan_on_sriov_logical;
+ "test_create_on_pif_already_enabled_sriov" >:: test_create_on_pif_already_enabled_sriov;
+ "test_create_on_pif_not_have_sriov_capability" >:: test_create_on_pif_not_have_sriov_capability;
+ "test_create_on_network_not_compatible_sriov" >:: test_create_on_network_not_compatible_sriov;
+ "test_create_sriov_with_different_pci_type_into_one_network" >:: test_create_sriov_with_different_pci_type_into_one_network;
+ "test_require_operation_on_pci_device_not_attached_not_need_reboot" >:: test_require_operation_on_pci_device_not_attached_not_need_reboot;
+ "test_require_operation_on_pci_device_sysfs" >:: test_require_operation_on_pci_device_sysfs;
+ "test_require_operation_on_pci_device_unknown" >:: test_require_operation_on_pci_device_unknown;
+ "test_require_operation_on_pci_device_modprobe_0" >:: test_require_operation_on_pci_device_modprobe_0;
+ "test_require_operation_on_pci_device_modprobe_1" >:: test_require_operation_on_pci_device_modprobe_1;
+ "test_require_operation_on_pci_device_modprobe_2" >:: test_require_operation_on_pci_device_modprobe_2;
+ "test_require_operation_on_pci_device_modprobe_3" >:: test_require_operation_on_pci_device_modprobe_3;
+ "test_require_operation_on_pci_device_modprobe_4" >:: test_require_operation_on_pci_device_modprobe_4;
+ "test_require_operation_on_pci_device_modprobe_5" >:: test_require_operation_on_pci_device_modprobe_5;
+ ]
diff --git a/ocaml/tests/test_no_migrate.ml b/ocaml/tests/test_no_migrate.ml
index 02a87a02bbf..7ec95655e7b 100644
--- a/ocaml/tests/test_no_migrate.ml
+++ b/ocaml/tests/test_no_migrate.ml
@@ -12,11 +12,6 @@
* GNU Lesser General Public License for more details.
*)
-open OUnit
-open Test_common
-
-module LC = Xapi_vm_lifecycle
-
let ops =
[ `suspend
; `checkpoint
@@ -32,7 +27,7 @@ let op_string = function
| _ -> "other"
let testcases =
- (*nest , nomig, force, permitted *)
+ (* nest , nomig, force, permitted *)
[ false, false, false, true
; false, false, true , true
; false, true , false, false
@@ -47,30 +42,30 @@ let testcases =
make no sense for PV (e.g. nested virt). The logic's all the same though and
it means we can avoid making up a VM_guest_metrics record with the feature
flags set *)
-let test (nv, nm, force, permitted) op =
- let __context = make_test_database () in
- let vm = make_vm ~__context ~hVM_boot_policy:"" ~domain_type:`pv () in
+let run_test (nv, nm, force, permitted) op =
+ let __context = Test_common.make_test_database () in
+ let vm = Test_common.make_vm ~__context ~hVM_boot_policy:"" ~domain_type:`pv () in
let metrics = Db.VM.get_metrics ~__context ~self:vm in
let strict = not force in
( Db.VM.set_power_state ~__context ~self:vm ~value:`Running
; Db.VM_metrics.set_current_domain_type ~__context ~self:metrics ~value:(Db.VM.get_domain_type ~__context ~self:vm)
; Db.VM_metrics.set_nested_virt ~__context ~self:metrics ~value:nv
; Db.VM_metrics.set_nomigrate ~__context ~self:metrics ~value:nm
- ; LC.get_operation_error ~__context ~self:vm ~op ~strict
+ ; Xapi_vm_lifecycle.get_operation_error ~__context ~self:vm ~op ~strict
|> function
- | None when permitted -> assert_bool "success" true
- | None -> assert_failure (Printf.sprintf "nv=%b nm=%b force=%b permitted=%b op=%s" nv nm force permitted (op_string op))
- | Some (x,xs) when not permitted -> assert_bool "success" true
- | Some (x,xs) -> assert_failure (Printf.sprintf "nv=%b nm=%b force=%b permitted=%b op=%s error was=%s" nv nm force permitted (op_string op) x)
+ | None when permitted -> ()
+ | None -> Alcotest.fail (Printf.sprintf "nv=%b nm=%b force=%b permitted=%b op=%s" nv nm force permitted (op_string op))
+ | Some (x,xs) when not permitted -> ()
+ | Some (x,xs) -> Alcotest.fail (Printf.sprintf "nv=%b nm=%b force=%b permitted=%b op=%s error was=%s" nv nm force permitted (op_string op) x)
)
let test' op =
- testcases |> List.iter (fun t -> test t op)
+ List.iter (fun t -> run_test t op) testcases
-let test = "test_no_migrate" >:::
- [ "test_no_migrate_00" >:: (fun () -> test' `suspend)
- ; "test_no_migrate_01" >:: (fun () -> test' `checkpoint)
- ; "test_no_migrate_02" >:: (fun () -> test' `pool_migrate)
- ; "test_no_migrate_03" >:: (fun () -> test' `migrate_send)
- ]
+let test =
+ [ "test_no_migrate_00", `Quick, (fun () -> test' `suspend)
+ ; "test_no_migrate_01", `Quick, (fun () -> test' `checkpoint)
+ ; "test_no_migrate_02", `Quick, (fun () -> test' `pool_migrate)
+ ; "test_no_migrate_03", `Quick, (fun () -> test' `migrate_send)
+ ]
diff --git a/ocaml/tests/test_pool_apply_edition.ml b/ocaml/tests/test_pool_apply_edition.ml
index 007cbfbed79..ec04734c577 100644
--- a/ocaml/tests/test_pool_apply_edition.ml
+++ b/ocaml/tests/test_pool_apply_edition.ml
@@ -12,14 +12,12 @@
* GNU Lesser General Public License for more details.
*)
-open OUnit
-
let apply_edition_succeed ~__context ~host ~edition =
Db.Host.set_edition ~__context ~self:host ~value:edition
let apply_edition_fail_host_offline ~__context ~host ~edition =
- raise (Api_errors.Server_error
- (Api_errors.host_offline, [Ref.string_of host]))
+ raise Api_errors.(Server_error
+ (host_offline, [Ref.string_of host]))
let setup ~host_count ~edition =
let __context = Test_common.make_test_database () in
@@ -41,10 +39,10 @@ let test_basic_operation () =
List.iter
(fun host ->
let new_edition = Db.Host.get_edition ~__context ~self:host in
- assert_equal
- ~msg:(Printf.sprintf
- "Testing that host %s has had the new license applied"
- (Ref.string_of host))
+ Alcotest.(check string)
+ (Printf.sprintf
+ "Testing that host %s has had the new license applied"
+ (Ref.string_of host))
"per-socket"
new_edition)
hosts
@@ -61,26 +59,23 @@ let test_rollback_logic () =
then apply_edition_fail_host_offline ~__context ~host ~edition
else apply_edition_succeed ~__context ~host ~edition
in
- assert_raises ~msg:"Testing that HOST_OFFLINE is successfully propagated"
- (Api_errors.Server_error
- (Api_errors.host_offline, [Ref.string_of offline_host]))
+ Alcotest.check_raises "Testing that HOST_OFFLINE is successfully propagated"
+ Api_errors.(Server_error (host_offline, [Ref.string_of offline_host]))
(fun () ->
Xapi_pool_license.apply_edition_with_rollback
~__context ~hosts ~edition:"per-socket" ~apply_fn);
List.iter
(fun host ->
let new_edition = Db.Host.get_edition ~__context ~self:host in
- assert_equal
- ~msg:(Printf.sprintf
- "Testing that host %s has been rolled back to free edition"
- (Ref.string_of host))
+ Alcotest.(check string)
+ (Printf.sprintf
+ "Testing that host %s has been rolled back to free edition"
+ (Ref.string_of host))
"free"
new_edition)
hosts
let test =
- "pool_apply_edition" >:::
- [
- "test_basic_operation" >:: test_basic_operation;
- "test_rollback_logic" >:: test_rollback_logic;
+ [ "test_basic_operation", `Quick, test_basic_operation
+ ; "test_rollback_logic", `Quick, test_rollback_logic
]
diff --git a/ocaml/tests/test_pool_update.ml b/ocaml/tests/test_pool_update.ml
index a8f6f1cd06e..6f5efecc3c1 100644
--- a/ocaml/tests/test_pool_update.ml
+++ b/ocaml/tests/test_pool_update.ml
@@ -12,17 +12,18 @@
* GNU Lesser General Public License for more details.
*)
-open OUnit
open Test_common
-open Stdext.Unixext
let test_pool_update_destroy () =
let __context = make_test_database () in
let self = make_pool_update ~__context () in
Xapi_pool_update.destroy ~__context ~self;
- assert_equal (Db.is_valid_ref __context self) false
+ Alcotest.(check bool)
+ "test_pool_update_destroy: pool update ref should be invalid"
+ false (Db.is_valid_ref __context self)
let test_pool_update_refcount () =
+ let assert_equal = Alcotest.(check int) "assertion called by test_pool_update_refcount" in
let __context = Mock.make_context_with_new_db "Mock context" in
let uuid = Helpers.get_localhost_uuid () in
let vdi = make_vdi ~__context ~virtual_size:4096L () in
@@ -33,13 +34,13 @@ let test_pool_update_refcount () =
let test_assert_space_available () =
let free_bytes = 1_000_000L in
- assert_raises_api_error Api_errors.out_of_space
+ Alcotest.check_raises
+ "test_assert_space_available should raise out_of_space"
+ Api_errors.(Server_error (out_of_space, [Xapi_globs.host_update_dir]))
(fun () -> Xapi_pool_update.assert_space_available ~get_free_bytes:(fun _ -> free_bytes) "./" (Int64.div free_bytes 2L))
let test =
- "test_pool_update" >:::
- [
- "test_pool_update_destroy" >:: test_pool_update_destroy;
- "test_pool_update_refcount" >:: test_pool_update_refcount;
- "test_assert_space_available" >:: test_assert_space_available;
+ [ "test_pool_update_destroy", `Quick, test_pool_update_destroy
+ ; "test_pool_update_refcount", `Quick, test_pool_update_refcount
+ ; "test_assert_space_available", `Quick, test_assert_space_available
]
diff --git a/ocaml/tests/test_pusb.ml b/ocaml/tests/test_pusb.ml
index b53782d0a55..d92227b6eb4 100644
--- a/ocaml/tests/test_pusb.ml
+++ b/ocaml/tests/test_pusb.ml
@@ -12,12 +12,9 @@
* GNU Lesser General Public License for more details.
*)
-open OUnit
-open Test_common
-
let create_base_environment () =
- let __context = make_test_database () in
- let pusb = make_sr ~__context () in
+ let __context = Test_common.make_test_database () in
+ let pusb = Test_common. make_sr ~__context () in
__context, pusb
let start_thread ~__context info =
@@ -26,7 +23,7 @@ let start_thread ~__context info =
Xapi_pusb.start_thread f
let test_scan_with_usb_add_and_remove () =
- let __context = make_test_database () in
+ let __context = Test_common.make_test_database () in
let test_pusb = "[{
\"product-desc\": \"\",
\"product-id\": \"5591\",
@@ -51,10 +48,10 @@ let test_scan_with_usb_add_and_remove () =
Xapi_pusb.scan ~__context ~host;
Thread.delay 1.0;
- assert_equal 1 (List.length (Db.PUSB.get_all_records ~__context))
+ Alcotest.(check int)
+ "test_scan_with_usb_add_and_remove called assertion for number of PUSB records"
+ 1 (List.length (Db.PUSB.get_all_records ~__context))
let test =
- "test_pusb" >:::
- [
- "test_scan_with_usb_add_and_remove" >:: test_scan_with_usb_add_and_remove;
+ [ "test_scan_with_usb_add_and_remove", `Quick, test_scan_with_usb_add_and_remove
]
diff --git a/ocaml/tests/test_pvs_proxy.ml b/ocaml/tests/test_pvs_proxy.ml
index 0c10158d0df..97eebe55532 100644
--- a/ocaml/tests/test_pvs_proxy.ml
+++ b/ocaml/tests/test_pvs_proxy.ml
@@ -12,88 +12,113 @@
* GNU Lesser General Public License for more details.
*)
-open OUnit
-open Test_common
+module T = Test_common
let test_unlicensed () =
- let __context = make_test_database ~features:[] () in
- let site = make_pvs_site ~__context () in
- let vIF = make_vif ~__context ~device:"0" () in
- assert_raises
+ let __context = T.make_test_database ~features:[] () in
+ let site = T.make_pvs_site ~__context () in
+ let vIF = T.make_vif ~__context ~device:"0" () in
+ Alcotest.check_raises
+ "test_unlicensed should raise license_restriction"
Api_errors.(Server_error (license_restriction, ["PVS_proxy"]))
- (fun () -> Xapi_pvs_proxy.create ~__context ~site ~vIF)
+ (fun () -> ignore (Xapi_pvs_proxy.create ~__context ~site ~vIF))
let test_create_ok () =
- let __context = make_test_database () in
- let site = make_pvs_site ~__context () in
- let vIF = make_vif ~__context ~device:"0" () in
+ let __context = T.make_test_database () in
+ let site = T.make_pvs_site ~__context () in
+ let vIF = T.make_vif ~__context ~device:"0" () in
let pvs_proxy = Xapi_pvs_proxy.create ~__context
~site ~vIF in
- assert_equal site (Db.PVS_proxy.get_site ~__context ~self:pvs_proxy);
- assert_equal vIF (Db.PVS_proxy.get_VIF ~__context ~self:pvs_proxy)
+ Alcotest.(check (Alcotest_comparators.ref ()))
+ "test_create_ok testing get_site"
+ site (Db.PVS_proxy.get_site ~__context ~self:pvs_proxy);
+ Alcotest.(check (Alcotest_comparators.ref ()))
+ "test_create_ok testing get_VIF"
+ vIF (Db.PVS_proxy.get_VIF ~__context ~self:pvs_proxy)
let test_create_invalid_device () =
- let __context = make_test_database () in
- let site = make_pvs_site ~__context () in
- let vIF = make_vif ~__context ~device:"1" () in
- assert_raises_api_error
- Api_errors.invalid_device
- ~args:["1"]
- (fun () -> Xapi_pvs_proxy.create ~__context ~site ~vIF)
+ let __context = T.make_test_database () in
+ let site = T.make_pvs_site ~__context () in
+ let vIF = T.make_vif ~__context ~device:"1" () in
+ Alcotest.check_raises
+ "test_create_invalid_device should raise invalid_device"
+ Api_errors.(Server_error
+ (invalid_device, ["1"]))
+ (fun () -> ignore (Xapi_pvs_proxy.create ~__context ~site ~vIF))
let test_create_invalid_site () =
- let __context = make_test_database () in
+ let __context = T.make_test_database () in
let site = Ref.make () in
- let vIF = make_vif ~__context ~device:"0" () in
- assert_raises_api_error
- Api_errors.invalid_value
- ~args:["site"; Ref.string_of site]
- (fun () -> Xapi_pvs_proxy.create ~__context ~site ~vIF)
+ let vIF = T.make_vif ~__context ~device:"0" () in
+ Alcotest.check_raises
+ "test_create_invalid_site should raise invalid_value"
+ Api_errors.(Server_error
+ (invalid_value, ["site"; Ref.string_of site]))
+ (fun () -> ignore (Xapi_pvs_proxy.create ~__context ~site ~vIF))
let test_create_invalid_vif () =
- let __context = make_test_database () in
- let site = make_pvs_site ~__context () in
+ let __context = T.make_test_database () in
+ let site = T.make_pvs_site ~__context () in
let vIF = Ref.make () in
- assert_raises_api_error
- Api_errors.invalid_value
- ~args:["VIF"; Ref.string_of vIF]
- (fun () -> Xapi_pvs_proxy.create ~__context ~site ~vIF)
+ Alcotest.check_raises
+ "test_create_invalid_vif should raise invalid_value"
+ Api_errors.(Server_error
+ (invalid_value, ["VIF"; Ref.string_of vIF]))
+ (fun () -> ignore (Xapi_pvs_proxy.create ~__context ~site ~vIF))
let test_destroy () =
- let __context = make_test_database () in
- let site = make_pvs_site ~__context () in
- let vIF = make_vif ~__context ~device:"0" () in
+ let __context = T.make_test_database () in
+ let site = T.make_pvs_site ~__context () in
+ let vIF = T.make_vif ~__context ~device:"0" () in
let pvs_proxy = Xapi_pvs_proxy.create ~__context ~site ~vIF in
Xapi_pvs_proxy.destroy ~__context ~self:pvs_proxy;
- assert_equal (Db.is_valid_ref __context pvs_proxy) false
+ Alcotest.(check bool)
+ "test_destroy: PVS proxy ref should no longer be valid"
+ false (Db.is_valid_ref __context pvs_proxy)
let test_gc_proxy () =
- let __context = make_test_database () in
- let site = make_pvs_site ~__context () in
- let vIF = make_vif ~__context ~device:"0" () in
+ let __context = T.make_test_database () in
+ let site = T.make_pvs_site ~__context () in
+ let vIF = T.make_vif ~__context ~device:"0" () in
let proxy = Xapi_pvs_proxy.create ~__context ~site ~vIF in
+ (* compare API refs *)
+ let compare_refs msg x y =
+ Alcotest.(check (Alcotest_comparators.ref ()))
+ msg
+ x y
+ in
( Db_gc_util.gc_PVS_proxies ~__context
- ; assert_equal (Db.PVS_proxy.get_site ~__context ~self:proxy) site
- ; assert_equal (Db.PVS_proxy.get_VIF ~__context ~self:proxy) vIF
+ ; compare_refs
+ "test_gc_proxy: get_site"
+ site (Db.PVS_proxy.get_site ~__context ~self:proxy)
+ ; compare_refs
+ "test_gc_proxy: get_VIF"
+ vIF (Db.PVS_proxy.get_VIF ~__context ~self:proxy)
; Db.PVS_proxy.set_site ~__context ~self:proxy ~value:Ref.null
; Db_gc_util.gc_PVS_proxies ~__context (* should collect the proxy *)
- ; assert_equal false (Db.is_valid_ref __context proxy));
+ ; Alcotest.(check bool)
+ "test_gc_proxy: proxy ref should be invalid"
+ false (Db.is_valid_ref __context proxy));
let proxy = Xapi_pvs_proxy.create ~__context ~site ~vIF in
( Db_gc_util.gc_PVS_proxies ~__context
- ; assert_equal (Db.PVS_proxy.get_site ~__context ~self:proxy) site
- ; assert_equal (Db.PVS_proxy.get_VIF ~__context ~self:proxy) vIF
+ ; compare_refs
+ "test_gc_proxy: get_site (newly created proxy)"
+ site (Db.PVS_proxy.get_site ~__context ~self:proxy)
+ ; compare_refs
+ "test_gc_proxy: get_VIF (newly created proxy)"
+ vIF (Db.PVS_proxy.get_VIF ~__context ~self:proxy)
; Db.PVS_proxy.set_VIF ~__context ~self:proxy ~value:Ref.null
; Db_gc_util.gc_PVS_proxies ~__context (* should collect the proxy *)
- ; assert_equal false (Db.is_valid_ref __context proxy))
+ ; Alcotest.(check bool)
+ "test_gc_proxy: proxy ref has been set to null"
+ false (Db.is_valid_ref __context proxy))
let test =
- "test_pvs_proxy" >:::
- [
- "test_unlicensed" >:: test_unlicensed;
- "test_create_ok" >:: test_create_ok;
- "test_create_invalid_device" >:: test_create_invalid_device;
- "test_create_invalid_site" >:: test_create_invalid_site;
- "test_create_invalid_vif" >:: test_create_invalid_vif;
- "test_destroy" >:: test_destroy;
- "test_gc_proxy" >:: test_gc_proxy
+ [ "test_unlicensed", `Quick, test_unlicensed
+ ; "test_create_ok", `Quick, test_create_ok
+ ; "test_create_invalid_device", `Quick, test_create_invalid_device
+ ; "test_create_invalid_site", `Quick, test_create_invalid_site
+ ; "test_create_invalid_vif", `Quick, test_create_invalid_vif
+ ; "test_destroy", `Quick, test_destroy
+ ; "test_gc_proxy", `Quick, test_gc_proxy
]
diff --git a/ocaml/tests/test_pvs_site.ml b/ocaml/tests/test_pvs_site.ml
index 118769fecf5..15cbfa8d467 100644
--- a/ocaml/tests/test_pvs_site.ml
+++ b/ocaml/tests/test_pvs_site.ml
@@ -12,8 +12,7 @@
* GNU Lesser General Public License for more details.
*)
-open OUnit
-open Test_common
+module T = Test_common
let name_label = "my_pvs_site"
let name_description = "about my_pvs_site"
@@ -22,70 +21,79 @@ let pVS_uuid = "my_pvs_uuid"
let cleanup_storage _ _ = ()
let test_unlicensed () =
- let __context = make_test_database ~features:[] () in
- assert_raises
+ let __context = T.make_test_database ~features:[] () in
+ Alcotest.check_raises
+ "test_unlicensed: should raise license_restriction"
Api_errors.(Server_error (license_restriction, ["PVS_proxy"]))
- (fun () -> Xapi_pvs_site.introduce ~__context ~name_label ~name_description ~pVS_uuid)
+ (fun () -> ignore (Xapi_pvs_site.introduce ~__context ~name_label ~name_description ~pVS_uuid))
let test_introduce () =
- let __context = make_test_database () in
+ let __context = T.make_test_database () in
let pvs_site = Xapi_pvs_site.introduce ~__context ~name_label ~name_description ~pVS_uuid in
- assert_equal name_label (Db.PVS_site.get_name_label ~__context ~self:pvs_site);
- assert_equal [] (Db.PVS_site.get_cache_storage ~__context ~self:pvs_site)
+ Alcotest.(check string)
+ "test_introduce: checking name_label"
+ name_label (Db.PVS_site.get_name_label ~__context ~self:pvs_site);
+ Alcotest.(check (list (Alcotest_comparators.ref ())))
+ "test_introduce: cache storage should be empty"
+ [] (Db.PVS_site.get_cache_storage ~__context ~self:pvs_site)
let test_forget_ok () =
- let __context = make_test_database () in
+ let __context = T.make_test_database () in
let pvs_site = Xapi_pvs_site.introduce ~__context ~name_label ~name_description ~pVS_uuid in
Xapi_pvs_site.forget_internal ~__context ~self:pvs_site ~cleanup_storage;
- assert_equal (Db.is_valid_ref __context pvs_site) false
+ Alcotest.(check bool)
+ "test_forget_ok: PVS site ref should no longer be recognised"
+ false (Db.is_valid_ref __context pvs_site)
let test_forget_stopped_proxy () =
- let __context = make_test_database () in
+ let __context = T.make_test_database () in
let pvs_site = Xapi_pvs_site.introduce ~__context ~name_label ~name_description ~pVS_uuid in
let (_: API.ref_PVS_proxy) =
- make_pvs_proxy ~__context ~site:pvs_site ~currently_attached:false () in
+ T.make_pvs_proxy ~__context ~site:pvs_site ~currently_attached:false () in
Xapi_pvs_site.forget_internal ~__context ~self:pvs_site ~cleanup_storage;
- assert_equal (Db.is_valid_ref __context pvs_site) false
+ Alcotest.(check bool)
+ "test_forget_stopped_proxy: PVS site ref should no longer be recognised"
+ false (Db.is_valid_ref __context pvs_site)
let test_forget_running_proxy () =
- let __context = make_test_database () in
+ let __context = T.make_test_database () in
let pvs_site = Xapi_pvs_site.introduce ~__context ~name_label ~name_description ~pVS_uuid in
let pvs_proxy =
- make_pvs_proxy ~__context ~site:pvs_site ~currently_attached:true () in
- assert_raises_api_error
- Api_errors.pvs_site_contains_running_proxies
- ~args:[Ref.string_of pvs_proxy]
+ T.make_pvs_proxy ~__context ~site:pvs_site ~currently_attached:true () in
+ Alcotest.check_raises
+ "test_forget_running_proxy should raise Api_errors.pvs_site_contains_running_proxies"
+ Api_errors.(Server_error
+ (pvs_site_contains_running_proxies, [Ref.string_of pvs_proxy]))
(fun () -> Xapi_pvs_site.forget_internal ~__context ~self:pvs_site ~cleanup_storage)
let test_forget_server () =
- let __context = make_test_database () in
+ let __context = T.make_test_database () in
let pvs_site = Xapi_pvs_site.introduce ~__context ~name_label ~name_description ~pVS_uuid in
- let pvs_server = make_pvs_server ~__context ~site:pvs_site () in
- assert_raises_api_error
- Api_errors.pvs_site_contains_servers
- ~args:[Ref.string_of pvs_server]
+ let pvs_server = T.make_pvs_server ~__context ~site:pvs_site () in
+ Alcotest.check_raises
+ "test_forget_server should raise Api_errors.pvs_site_contains_servers"
+ Api_errors.(Server_error
+ (pvs_site_contains_servers, [Ref.string_of pvs_server]))
(fun () -> Xapi_pvs_site.forget_internal ~__context ~self:pvs_site ~cleanup_storage)
let test_forget_running_proxy_and_server () =
- let __context = make_test_database () in
+ let __context = T.make_test_database () in
let pvs_site = Xapi_pvs_site.introduce ~__context ~name_label ~name_description ~pVS_uuid in
let pvs_proxy =
- make_pvs_proxy ~__context ~site:pvs_site ~currently_attached:true () in
- let (_: API.ref_PVS_server) = make_pvs_server ~__context ~site:pvs_site () in
- assert_raises_api_error
- Api_errors.pvs_site_contains_running_proxies
- ~args:[Ref.string_of pvs_proxy]
+ T.make_pvs_proxy ~__context ~site:pvs_site ~currently_attached:true () in
+ let (_: API.ref_PVS_server) = T.make_pvs_server ~__context ~site:pvs_site () in
+ Alcotest.check_raises
+ "test_forget_running_proxy_and_server: should raise pvs_site_contains_running_proxies"
+ Api_errors.(Server_error
+ (pvs_site_contains_running_proxies, [Ref.string_of pvs_proxy]))
(fun () -> Xapi_pvs_site.forget_internal ~__context ~self:pvs_site ~cleanup_storage)
let test =
- "test_pvs_site" >:::
- [
- "test_unlicensed" >:: test_unlicensed;
- "test_introduce" >:: test_introduce;
- "test_forget_ok" >:: test_forget_ok;
- "test_forget_stopped_proxy" >:: test_forget_stopped_proxy;
- "test_forget_running_proxy" >:: test_forget_running_proxy;
- "test_forget_server" >:: test_forget_server;
- "test_forget_running_proxy_and_server" >::
- test_forget_running_proxy_and_server;
+ [ "test_unlicensed", `Quick, test_unlicensed
+ ; "test_introduce", `Quick, test_introduce
+ ; "test_forget_ok", `Quick, test_forget_ok
+ ; "test_forget_stopped_proxy", `Quick, test_forget_stopped_proxy
+ ; "test_forget_running_proxy", `Quick, test_forget_running_proxy
+ ; "test_forget_server", `Quick, test_forget_server
+ ; "test_forget_running_proxy_and_server", `Quick, test_forget_running_proxy_and_server
]
diff --git a/ocaml/tests/test_tunnel.ml b/ocaml/tests/test_tunnel.ml
new file mode 100644
index 00000000000..947d61db887
--- /dev/null
+++ b/ocaml/tests/test_tunnel.ml
@@ -0,0 +1,150 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open OUnit
+open Test_common
+
+
+let test_create_internal () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let network = make_network ~__context () in
+ let transport_PIF = make_pif ~__context ~network ~host () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ let tunnel, access_PIF = Xapi_tunnel.create_internal ~__context ~transport_PIF ~network ~host in
+ assert_equal tunnel (List.hd (Db.PIF.get_tunnel_access_PIF_of ~__context ~self:access_PIF));
+ assert_equal tunnel (List.hd (Db.PIF.get_tunnel_transport_PIF_of ~__context ~self:transport_PIF));
+ assert_equal transport_PIF (Db.Tunnel.get_transport_PIF ~__context ~self:tunnel);
+ assert_equal access_PIF (Db.Tunnel.get_access_PIF ~__context ~self:tunnel);
+ assert_equal network (Db.PIF.get_network ~__context ~self:access_PIF);
+ assert_equal host (Db.PIF.get_host ~__context ~self:access_PIF)
+
+let test_create_on_unmanaged_pif () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let transport_PIF = create_physical_pif ~__context ~host ~managed:false () in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ assert_raises_api_error
+ Api_errors.pif_unmanaged
+ ~args:[Ref.string_of transport_PIF]
+ (fun () -> Xapi_tunnel.create ~__context ~transport_PIF ~network)
+
+let test_create_network_already_connected () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let network = make_network ~__context () in
+ let transport_PIF = create_physical_pif ~__context ~host ~network ~managed:false () in
+ assert_raises_api_error
+ Api_errors.network_already_connected
+ ~args:[Ref.string_of host; Ref.string_of transport_PIF]
+ (fun () -> Xapi_tunnel.create ~__context ~transport_PIF ~network)
+
+let test_create_on_bond_slave () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let transport_PIF =
+ let members = mknlist 2 (create_physical_pif ~__context ~host) in
+ let _ = create_bond_pif ~__context ~host ~members () in
+ List.hd members
+ in
+ let network = make_network ~__context ~bridge:"xapi0" () in
+ assert_raises_api_error
+ Api_errors.cannot_add_tunnel_to_bond_slave
+ ~args:[Ref.string_of transport_PIF]
+ (fun () -> Xapi_tunnel.create ~__context ~transport_PIF ~network)
+
+let test_create_on_tunnel_access () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let transport_PIF = create_physical_pif ~__context ~host () in
+ let access_PIF = create_tunnel_pif ~__context ~host ~pif:transport_PIF () in
+ let network = make_network ~__context ~bridge:"xapi1" () in
+ assert_raises_api_error
+ Api_errors.is_tunnel_access_pif
+ ~args:[Ref.string_of access_PIF]
+ (fun () -> Xapi_tunnel.create ~__context ~transport_PIF:access_PIF ~network)
+
+let test_create_on_sriov_logical () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ let network = make_network ~__context ~bridge:"xapi01" () in
+ assert_raises_api_error
+ Api_errors.cannot_add_tunnel_to_sriov_logical
+ ~args:[Ref.string_of sriov_logical_PIF]
+ (fun () -> Xapi_tunnel.create ~__context ~transport_PIF:sriov_logical_PIF ~network)
+
+let test_create_on_vlan_on_sriov_logical () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ let transport_PIF = create_vlan_pif ~__context ~host ~pif:sriov_logical_PIF ~vlan:1L () in
+ let network = make_network ~__context ~bridge:"xapi01" () in
+ assert_raises_api_error
+ Api_errors.cannot_add_tunnel_to_vlan_on_sriov_logical
+ ~args:[Ref.string_of transport_PIF]
+ (fun () -> Xapi_tunnel.create ~__context ~transport_PIF ~network)
+
+let test_create_tunnel_into_sriov_network () =
+ let __context = make_test_database () in
+ let sriov_network =
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ Db.PIF.get_network ~__context ~self:sriov_logical_PIF
+ in
+ let pif =
+ let host = make_host ~__context () in
+ create_physical_pif ~__context ~host ()
+ in
+ assert_raises_api_error
+ Api_errors.network_incompatible_with_tunnel
+ ~args:[Ref.string_of sriov_network]
+ (fun () ->
+ Xapi_tunnel.create ~__context ~transport_PIF:pif ~network:sriov_network)
+
+let test_create_tunnel_into_sriov_vlan_network () =
+ let __context = make_test_database () in
+ let sriov_vlan_network =
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ let vlan_pif = create_vlan_pif ~__context ~host ~vlan:1L ~pif:sriov_logical_PIF () in
+ Db.PIF.get_network ~__context ~self:vlan_pif
+ in
+ let pif =
+ let host = make_host ~__context () in
+ create_physical_pif ~__context ~host ()
+ in
+ assert_raises_api_error
+ Api_errors.network_incompatible_with_tunnel
+ ~args:[Ref.string_of sriov_vlan_network]
+ (fun () ->
+ Xapi_tunnel.create ~__context ~transport_PIF:pif ~network:sriov_vlan_network)
+
+let test =
+ "test_tunnel" >:::
+ [
+ "test_create_internal" >:: test_create_internal;
+ "test_create_on_unmanaged_pif" >:: test_create_on_unmanaged_pif;
+ "test_create_network_already_connected" >:: test_create_network_already_connected;
+ "test_create_on_bond_slave" >:: test_create_on_bond_slave;
+ "test_create_on_tunnel_access" >:: test_create_on_tunnel_access;
+ "test_create_on_sriov_logical" >:: test_create_on_sriov_logical;
+ "test_create_on_vlan_on_sriov_logical" >:: test_create_on_vlan_on_sriov_logical;
+ "test_create_tunnel_into_sriov_network" >:: test_create_tunnel_into_sriov_network;
+ "test_create_tunnel_into_sriov_vlan_network" >:: test_create_tunnel_into_sriov_vlan_network;
+ ]
diff --git a/ocaml/tests/test_vlan.ml b/ocaml/tests/test_vlan.ml
index 45d18f19ef6..7640b13af9b 100644
--- a/ocaml/tests/test_vlan.ml
+++ b/ocaml/tests/test_vlan.ml
@@ -72,31 +72,51 @@ let test_create_network_already_connected () =
~args:[Ref.string_of host; Ref.string_of tagged_PIF]
(fun () -> Xapi_vlan.create ~__context ~tagged_PIF ~tag ~network:network)
-let test_create_pif_not_a_bond_slave () =
+let test_create_pif_is_bond_slave () =
let __context = make_test_database () in
- let dummy_bond = Ref.make () in
let tag = 3201L in
let host = make_host ~__context () in
- let network = make_network ~__context () in
+ let tagged_PIF =
+ let members = mknlist 2 (create_physical_pif ~__context ~host) in
+ let _ = create_bond_pif ~__context ~host ~members () in
+ List.hd members
+ in
let vlan_network = make_network ~__context ~bridge:"xapi0" () in
- let tagged_PIF = make_pif ~__context ~network ~host ~bond_slave_of:dummy_bond () in
- Db.PIF.set_bond_slave_of ~__context ~self:tagged_PIF ~value:dummy_bond;
assert_raises_api_error
Api_errors.cannot_add_vlan_to_bond_slave
~args:[Ref.string_of tagged_PIF]
(fun () -> Xapi_vlan.create ~__context ~tagged_PIF ~tag ~network:vlan_network)
-let test_create_pif_not_vlan_slave () =
+let test_create_pif_is_vlan_master () =
let __context = make_test_database () in
- let tag = 3201L in
let host = make_host ~__context () in
- let network = make_network ~__context () in
- let vlan_network = make_network ~__context ~bridge:"xapi0" () in
- let tagged_PIF = make_pif ~__context ~network ~host ~vLAN:0L () in
+ let vlan_network2 = make_network ~__context ~bridge:"xapi02" () in
+ let untagged_PIF =
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ create_vlan_pif ~__context ~host ~vlan:1L ~pif:physical_PIF ()
+ in
assert_raises_api_error
Api_errors.pif_is_vlan
- ~args:[Ref.string_of tagged_PIF]
- (fun () -> Xapi_vlan.create ~__context ~tagged_PIF ~tag ~network:vlan_network)
+ ~args:[Ref.string_of untagged_PIF]
+ (fun () ->
+ let tag = 3201L in
+ Xapi_vlan.create ~__context ~tagged_PIF:untagged_PIF ~tag ~network:vlan_network2)
+
+let test_create_pif_is_vlan_master_on_sriov () =
+ let __context = make_test_database () in
+ let host = make_host ~__context () in
+ let vlan_network2 = make_network ~__context ~bridge:"xapi02" () in
+ let untagged_PIF =
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ create_vlan_pif ~__context ~host ~vlan:1L ~pif:sriov_logical_PIF ()
+ in
+ assert_raises_api_error
+ Api_errors.pif_is_vlan
+ ~args:[Ref.string_of untagged_PIF]
+ (fun () ->
+ let tag = 3201L in
+ Xapi_vlan.create ~__context ~tagged_PIF:untagged_PIF ~tag ~network:vlan_network2)
let test_create_invalid_tag () =
let __context = make_test_database () in
@@ -131,15 +151,15 @@ let test_create_vlan_already_exists () =
~args:[device]
(fun () -> Xapi_vlan.create ~__context ~tagged_PIF ~tag ~network:new_vlan_network)
-let test_create_pif_has_tunnel_access () =
+let test_create_pif_is_tunnel_access () =
let __context = make_test_database () in
let tag = 3201L in
let host = make_host ~__context () in
- let network = make_network ~__context () in
- let tunnel_network = make_network ~__context ~bridge:"xapi0" () in
let vlan_network = make_network ~__context ~bridge:"xapi1" () in
- let transport_PIF = make_pif ~__context ~network ~host () in
- let _, tagged_PIF = Xapi_tunnel.create_internal ~__context ~transport_PIF ~network:tunnel_network ~host in
+ let tagged_PIF =
+ let transport_PIF = create_physical_pif ~__context ~host () in
+ create_tunnel_pif ~__context ~host ~pif:transport_PIF ()
+ in
assert_raises_api_error
Api_errors.is_tunnel_access_pif
~args:[Ref.string_of tagged_PIF]
@@ -162,16 +182,85 @@ let test_gc_vlan () =
Db_gc_util.gc_PIFs ~__context;
Alcotest.(check bool) "not valid ref" false (Db.is_valid_ref __context vlan)
+let test_create_sriov_vlan_into_non_sriov_vlan_network () =
+ let __context = make_test_database () in
+ let vlan_network =
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let vlan_pif = create_vlan_pif ~__context ~host ~vlan:1L ~pif:physical_PIF () in
+ Db.PIF.get_network ~__context ~self:vlan_pif
+ in
+ let tagged_PIF =
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ create_sriov_pif ~__context ~pif:physical_PIF ()
+ in
+ assert_raises_api_error
+ Api_errors.network_incompatible_with_vlan_on_sriov
+ ~args:[Ref.string_of vlan_network]
+ (fun () ->
+ let tag = 3201L in
+ Xapi_vlan.create ~__context ~tagged_PIF ~tag ~network:vlan_network)
+
+let test_create_non_sriov_vlan_into_sriov_vlan_network () =
+ let __context = make_test_database () in
+ let vlan_network =
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ let vlan_pif = create_vlan_pif ~__context ~host ~vlan:1L ~pif:sriov_logical_PIF () in
+ Db.PIF.get_network ~__context ~self:vlan_pif
+ in
+ let tagged_PIF =
+ let host = make_host ~__context () in
+ create_physical_pif ~__context ~host ()
+ in
+ assert_raises_api_error
+ Api_errors.network_incompatible_with_vlan_on_bridge
+ ~args:[Ref.string_of vlan_network]
+ (fun () ->
+ let tag = 3201L in
+ Xapi_vlan.create ~__context ~tagged_PIF ~tag ~network:vlan_network)
+
+let test_create_sriov_vlan_into_sriov_vlan_network_with_different_type_pci_device () =
+ let __context = make_test_database () in
+ let vlan_network =
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let pci = make_pci ~__context ~vendor_id:"101" ~device_id:"2" () in
+ Db.PIF.set_PCI ~__context ~self:physical_PIF ~value:pci;
+ let sriov_logical_PIF = create_sriov_pif ~__context ~pif:physical_PIF () in
+ let vlan_pif = create_vlan_pif ~__context ~host ~vlan:1L ~pif:sriov_logical_PIF () in
+ Db.PIF.get_network ~__context ~self:vlan_pif
+ in
+ let tagged_PIF =
+ let host = make_host ~__context () in
+ let physical_PIF = create_physical_pif ~__context ~host () in
+ let pci = make_pci ~__context ~vendor_id:"101" ~device_id:"3" () in
+ Db.PIF.set_PCI ~__context ~self:physical_PIF ~value:pci;
+ create_sriov_pif ~__context ~pif:physical_PIF ()
+ in
+ assert_raises_api_error
+ Api_errors.network_has_incompatible_vlan_on_sriov_pifs
+ ~args:[Ref.string_of tagged_PIF; Ref.string_of vlan_network]
+ (fun () ->
+ let tag = 3201L in
+ Xapi_vlan.create ~__context ~tagged_PIF ~tag ~network:vlan_network)
+
let test =
[
"test_pool_introduce", `Quick, test_pool_introduce;
"test_create_internal", `Quick, test_create_internal;
- "test_create_unmanged_pif", `Quick, test_create_unmanaged_pif;
+ "test_create_unmanaged_pif", `Quick, test_create_unmanaged_pif;
"test_create_network_already_connected", `Quick, test_create_network_already_connected;
- "test_create_pif_not_a_bond_slave", `Quick, test_create_pif_not_a_bond_slave;
- "test_create_pif_not_vlan_slave", `Quick, test_create_pif_not_vlan_slave;
+ "test_create_pif_is_bond_slave", `Quick, test_create_pif_is_bond_slave;
+ "test_create_pif_is_vlan_master", `Quick, test_create_pif_is_vlan_master;
"test_create_invalid_tag", `Quick, test_create_invalid_tag;
"test_create_vlan_already_exists", `Quick, test_create_vlan_already_exists;
- "test_create_pif_has_tunnel_access", `Quick, test_create_pif_has_tunnel_access;
- "test_gc_vlan", `Quick, test_gc_vlan
+ "test_create_pif_is_tunnel_access", `Quick, test_create_pif_is_tunnel_access;
+ "test_create_pif_is_vlan_master_on_sriov", `Quick, test_create_pif_is_vlan_master_on_sriov;
+ "test_gc_vlan", `Quick, test_gc_vlan;
+ "test_create_sriov_vlan_into_non_sriov_vlan_network", `Quick, test_create_sriov_vlan_into_non_sriov_vlan_network;
+ "test_create_non_sriov_vlan_into_sriov_vlan_network", `Quick, test_create_non_sriov_vlan_into_sriov_vlan_network;
+ "test_create_sriov_vlan_into_sriov_vlan_network_with_different_type_pci_device", `Quick, test_create_sriov_vlan_into_sriov_vlan_network_with_different_type_pci_device;
]
diff --git a/ocaml/tests/test_vm_helpers.ml b/ocaml/tests/test_vm_helpers.ml
index 28cdf5adb08..6dcb7cfdc13 100644
--- a/ocaml/tests/test_vm_helpers.ml
+++ b/ocaml/tests/test_vm_helpers.ml
@@ -98,20 +98,22 @@ let assert_list_is_set l =
let assert_host_group_coherent g =
match g with
- | [] -> assert_failure "Empty host group"
+ | [] -> ()
| (h, c) :: _ ->
assert_list_is_set (List.map fst g);
assert_bool "Score not same for all hosts in group"
(List.for_all (fun x -> snd x = c) g)
let assert_host_groups_equal g g' =
- let extract_host_strings g =
- let hosts = List.map fst g in
- List.sort String.compare (List.map Ref.string_of hosts)
- in
- assert_equal (extract_host_strings g) (extract_host_strings g');
- let score_of g = snd (List.hd g) in
- assert_equal (score_of g) (score_of g')
+ if g' <> [] then begin
+ let extract_host_strings g =
+ let hosts = List.map fst g in
+ List.sort String.compare (List.map Ref.string_of hosts)
+ in
+ assert_equal (extract_host_strings g) (extract_host_strings g');
+ let score_of g = snd (List.hd g) in
+ assert_equal (score_of g) (score_of g')
+ end
let rec assert_equivalent expected_grouping actual_grouping =
match (expected_grouping, actual_grouping) with
@@ -209,6 +211,203 @@ let test_group_hosts_df () =
| _ -> failwith "Test-failure: Unexpected number of pgpus in test setup"
)
+let on_pool_of_intel_i350 (f : Context.t -> API.ref_host -> API.ref_host -> API.ref_host -> 'a) =
+ (* Note: f c h h' h'' applied to hosts with the same number of Intel I350 as 's
+ Due to one host at most have one pif in a network, for h'', the remaining vfs for each pif doesn't matter.
+ What really matters is on same sriov network,on different host h' and h'' pif's remaining vfs.
+ * +------------+ +----------------+ +--------------+
+ * | | | +----+ +----+ | |+----+ +----+|
+ * | | | |I350| | K1 | | ||I350| |I350||
+ * | | | +----+ +----+ | |+----+ +----+|
+ * +------------+ +----------------+ +--------------+
+ * h h' h''
+ *)
+ let __context = make_test_database () in
+ let h = List.hd (Db.Host.get_all ~__context) in
+ (* Make two more hosts *)
+ let h' = make_host ~__context () in
+ let h'' = make_host ~__context () in
+ let sriov_network1 = make_network ~__context ~name_description:"sriov1" ~bridge:"" () in
+ let sriov_network2 = make_network ~__context ~name_description:"sriov2" ~bridge:"" () in
+ let make_sriov_on (host,network) =
+ let local_network = make_network ~__context ~name_description:"local_network" () in
+ let pf = make_pci ~__context ~host ~functions:1L ~driver_name:"igb" () in
+ let physical_PIF = make_pif ~__context ~host ~network:local_network () in
+ Db.PIF.set_PCI ~__context ~self:physical_PIF ~value:pf;
+ let logical_pif = create_sriov_pif ~__context ~pif:physical_PIF ~network () in
+ Db.PIF.set_currently_attached ~__context ~self:logical_pif ~value:true;
+ make_vfs_on_pf ~__context ~pf ~num:8L
+ in
+ List.iter make_sriov_on [(h',sriov_network1); (h'',sriov_network1); (h'',sriov_network2)];
+ (* make one k1 on h' *)
+ let gPU_group = make_gpu_group ~__context () in
+ let _ = make_pgpu ~__context ~host:h' ~gPU_group default_k1 in
+ f __context h h' h''
+
+let make_vm_with_vif ~__context ~network =
+ let vm = make_vm ~__context () in
+ let _ = make_vif ~__context ~vM:vm ~network:network () in
+ vm
+
+let make_allocated_vfs ~__context ~vm ~pci ~num =
+ let rec allocate_vf num =
+ if num > 0L then begin
+ let _ = Pciops.reserve_free_virtual_function ~__context vm pci in
+ allocate_vf (Int64.sub num 1L);
+ end
+ in
+ allocate_vf num
+
+(* --- Xapi_network_sriov_helpers.is_sriov_network --- *)
+let test_is_sriov_network_succeeds () =
+ on_pool_of_intel_i350 (fun __context _ h' _ ->
+ let local_logical_PIFs = Db.PIF.get_records_where ~__context ~expr:( And (
+ Eq (Field "host", Literal (Ref.string_of h')),
+ Eq (Field "physical", Literal "false")
+ ))
+ in
+ let network = (List.map (fun (rf, _ ) -> Db.PIF.get_network ~__context ~self:rf ) local_logical_PIFs) |> List.hd in
+ OUnit.assert_equal true (Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network) )
+
+(*--- Xapi_vm_helpers.assert_netsriov_available ---*)
+let test_netsriov_available_succeeds () =
+ on_pool_of_intel_i350 (fun __context _ h' _ ->
+ let sriov_networks = List.find_all (fun network -> Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network) (Db.Network.get_all ~__context) in
+ let network_on_h = List.find (fun network ->
+ let pifs = Db.Network.get_PIFs ~__context ~self:network in
+ List.exists (fun pif -> h' = Db.PIF.get_host ~__context ~self:pif) pifs
+ ) sriov_networks in
+ let vm = make_vm_with_vif ~__context ~network:network_on_h in
+ assert_netsriov_available ~__context ~self:vm ~host:h')
+
+(* If a host without a SR-IOV network was chosen,then the assert_can_see_networks will raise `vm_requires_net` before `assert_netsriov_available` *)
+let test_netsriov_available_fails_no_netsriov () =
+ on_pool_of_intel_i350 (fun __context h _ _ ->
+ let sriov_network = List.find (fun network -> Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network) (Db.Network.get_all ~__context) in
+ let vm = make_vm_with_vif ~__context ~network:sriov_network in
+ assert_raises_api_error Api_errors.vm_requires_net (fun () ->
+ assert_can_see_networks ~__context ~self:vm ~host:h))
+
+let test_netsriov_available_fails_no_capacity () =
+ on_pool_of_intel_i350 (fun __context _ h' _ ->
+ let sriov_networks = List.find_all (fun network -> Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network) (Db.Network.get_all ~__context) in
+ let network_on_h = List.find (fun network ->
+ let pifs = Db.Network.get_PIFs ~__context ~self:network in
+ List.exists (fun pif -> h' = Db.PIF.get_host ~__context ~self:pif) pifs
+ ) sriov_networks in
+ let vm = make_vm_with_vif ~__context ~network:network_on_h in
+ match Xapi_network_sriov_helpers.get_local_underlying_pif ~__context ~network:network_on_h ~host:h' with
+ | None -> failwith "Test-failure: Cannot get underlying pif from sr-iov network"
+ | Some pif ->
+ let pci = Db.PIF.get_PCI ~__context ~self:pif in
+ make_allocated_vfs ~__context ~vm ~pci ~num:8L;
+ assert_raises_api_error Api_errors.network_sriov_insufficient_capacity (fun () ->
+ assert_netsriov_available ~__context ~self:vm ~host:h')
+ )
+
+let assert_grouping_of_sriov ~__context ~network ~expection_groups =
+ let host_lists = Xapi_network_sriov_helpers.group_hosts_by_best_sriov ~__context ~network in
+ try assert_equivalent expection_groups host_lists
+ with e ->
+ let item_to_string (h, c) = Printf.sprintf "(%s, %Ld)" (Ref.string_of h) c in
+ let group_to_string g = Printf.sprintf "[ %s ]"
+ (String.concat "; " (List.map item_to_string g)) in
+ let groups_to_string gs = Printf.sprintf "[ %s ]"
+ (String.concat "; " (List.map group_to_string gs)) in
+ let diff_string = Printf.sprintf "Expected: %s\nActual: %s\n"
+ (groups_to_string expection_groups) (groups_to_string host_lists) in
+ assert_failure (diff_string ^ Printexc.to_string e)
+
+let test_group_hosts_netsriov () =
+ on_pool_of_intel_i350 ( fun __context h h' h'' ->
+ let sriov_networks = List.find_all
+ (fun network -> Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network)
+ (Db.Network.get_all ~__context)
+ |> List.sort (fun a b -> compare (List.length (Db.Network.get_PIFs ~__context ~self:a))
+ (List.length (Db.Network.get_PIFs ~__context ~self:b)) )
+ in
+ match sriov_networks with
+ (* we create 2 sriov networks,one include h and h'' and the other only has h'' *)
+ | (n1 :: n2 :: _ ) ->
+ (* n1 only have sriov on h'' *)
+ assert_grouping_of_sriov ~__context ~network:n1 ~expection_groups:[ [(h'',8L)] ];
+ (* n2 has sriovs on h' and h'' *)
+ assert_grouping_of_sriov ~__context ~network:n2 ~expection_groups:[ [(h',8L);(h'',8L)] ]
+ | _ -> failwith "Test-failure: Unexpected number of sriov network in test" )
+
+let test_group_hosts_netsriov_unattached () =
+ on_pool_of_intel_i350 ( fun __context h h' h'' ->
+ let sriov_networks = List.find_all
+ (fun network -> Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network)
+ (Db.Network.get_all ~__context)
+ |> List.sort (fun a b -> compare (List.length (Db.Network.get_PIFs ~__context ~self:a))
+ (List.length (Db.Network.get_PIFs ~__context ~self:b)) )
+ in
+ match sriov_networks with
+ | (n1 :: n2 :: _ ) ->
+ (* n1 only have sriov on h'' *)
+ let pif = List.hd (Db.Network.get_PIFs ~__context ~self:n1) in
+ Db.PIF.set_currently_attached ~__context ~self:pif ~value:false;
+ assert_grouping_of_sriov ~__context ~network:n1 ~expection_groups:[ [(h'',0L)] ];
+ let pif = List.find (fun self -> h'' = Db.PIF.get_host ~__context ~self )
+ (Db.Network.get_PIFs ~__context ~self:n2)
+ in
+ Db.PIF.set_currently_attached ~__context ~self:pif ~value:false;
+ assert_grouping_of_sriov ~__context ~network:n2 ~expection_groups:[ [(h',8L)];[(h'',0L)] ];
+ | _ -> failwith "Test-failure: Unexpected number of sriov network in test" )
+
+let test_group_hosts_netsriov_with_allocated () =
+ on_pool_of_intel_i350 ( fun __context h h' h'' ->
+ let sriov_networks = List.find_all
+ (fun network -> Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network)
+ (Db.Network.get_all ~__context)
+ |> List.sort (fun a b -> compare (List.length (Db.Network.get_PIFs ~__context ~self:a))
+ (List.length (Db.Network.get_PIFs ~__context ~self:b)) )
+ in
+ match sriov_networks with
+ (* we create 2 sriov networks,one include h and h'' and the other only has h'' *)
+ | ( _ :: n2 :: _ ) ->
+ (* n2 has sriovs on h' and h'' *)
+ let network_on_h = List.find (fun network ->
+ let pifs = Db.Network.get_PIFs ~__context ~self:network in
+ List.exists (fun pif -> h' = Db.PIF.get_host ~__context ~self:pif) pifs
+ ) sriov_networks in
+ let vm = make_vm_with_vif ~__context ~network:network_on_h in
+ begin match Xapi_network_sriov_helpers.get_local_underlying_pif ~__context ~network:network_on_h ~host:h' with
+ | None -> failwith "Test-failure: Cannot get underlying pif from sr-iov network"
+ | Some pif ->
+ let pci = Db.PIF.get_PCI ~__context ~self:pif in
+ make_allocated_vfs ~__context ~vm ~pci ~num:2L;
+ assert_grouping_of_sriov ~__context ~network:n2 ~expection_groups:[ [(h'',8L)]; [(h',6L)] ]
+ end
+ | _ -> failwith "Test-failure: Unexpected number of sriov network in test" )
+
+let test_get_group_key_vgpu () =
+ on_pool_of_intel_i350 ( fun __context _ h' _ ->
+ let group = List.hd (Db.GPU_group.get_all ~__context) in
+ let vm = make_vm_with_vgpu_in_group ~__context k100 group in
+ match Xapi_vm_helpers.get_group_key ~__context ~vm with
+ | `VGPU _ -> ()
+ | _ -> failwith "Test-failure: Unexpected Group Key in test" )
+
+let test_get_group_key_netsriov () =
+ on_pool_of_intel_i350 ( fun __context _ h' _ ->
+ let sriov_network = List.find (fun network -> Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network) (Db.Network.get_all ~__context) in
+ let vm = make_vm_with_vif ~__context ~network:sriov_network in
+ match Xapi_vm_helpers.get_group_key ~__context ~vm with
+ | `Netsriov _ -> ()
+ | _ -> failwith "Test-failure: Unexpected Group Key in test" )
+
+let test_get_group_key_vgpu_and_netsriov () =
+ on_pool_of_intel_i350 ( fun __context _ h' _ ->
+ let group = List.hd (Db.GPU_group.get_all ~__context) in
+ let vm = make_vm_with_vgpu_in_group ~__context k100 group in
+ let sriov_network = List.find (fun network -> Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network) (Db.Network.get_all ~__context) in
+ let _ = make_vif ~__context ~vM:vm ~network:sriov_network () in
+ match Xapi_vm_helpers.get_group_key ~__context ~vm with
+ | `VGPU _ -> ()
+ | _ -> failwith "Test-failure: Unexpected Group Key in test" )
+
let test =
"test_vm_helpers" >:::
[
@@ -219,4 +418,18 @@ let test =
"test_group_hosts_bf" >:: test_group_hosts_bf;
"test_group_hosts_df" >:: test_group_hosts_df;
+
+ "test_is_sriov_network_succeeds" >:: test_is_sriov_network_succeeds;
+ "test_netsriov_available_succeeds" >:: test_netsriov_available_succeeds;
+ "test_netsriov_available_fails_no_netsriov" >:: test_netsriov_available_fails_no_netsriov;
+ "test_netsriov_available_fails_no_capacity" >:: test_netsriov_available_fails_no_capacity;
+
+ "test_group_hosts_netsriov" >:: test_group_hosts_netsriov;
+ "test_group_hosts_netsriov_unattached" >:: test_group_hosts_netsriov_unattached;
+ "test_group_hosts_netsriov_with_allocated" >:: test_group_hosts_netsriov_with_allocated;
+
+ "test_get_group_key_vgpu" >:: test_get_group_key_vgpu;
+ "test_get_group_key_netsriov" >:: test_get_group_key_netsriov;
+ "test_get_group_key_vgpu_and_netsriov" >:: test_get_group_key_vgpu_and_netsriov;
+
]
diff --git a/ocaml/tests/test_vm_migrate.ml b/ocaml/tests/test_vm_migrate.ml
index b11ffa2c30e..717b999639b 100644
--- a/ocaml/tests/test_vm_migrate.ml
+++ b/ocaml/tests/test_vm_migrate.ml
@@ -12,57 +12,60 @@
* GNU Lesser General Public License for more details.
*)
-open OUnit
-open Test_common
-
let mac1 = "00:00:00:00:00:01"
let mac2 = "00:00:00:00:00:02"
+let check_network_map =
+ Alcotest.(check (slist
+ (pair
+ (Alcotest_comparators.ref ())
+ (Alcotest_comparators.ref ()))
+ compare))
+
let test_infer_vif_map_empty () =
- let __context = make_test_database () in
- assert_equal
- (Xapi_vm_migrate.infer_vif_map ~__context [] [])
+ let __context = Test_common.make_test_database () in
+ check_network_map "Asserted by test_infer_vif_map_empty"
[]
+ (Xapi_vm_migrate.infer_vif_map ~__context [] [])
let test_infer_vif_map () =
- let __context = make_test_database () in
- let vm_vif1 = make_vif ~__context ~mAC:mac1 () in
- let vm_vif2 = make_vif ~__context ~mAC:mac2 () in
- let snap_vif1 = make_vif ~__context ~mAC:mac1 () in
- let snap_vif2 = make_vif ~__context ~mAC:mac2 () in
+ let __context = Test_common.make_test_database () in
+ let vm_vif1 = Test_common.make_vif ~__context ~mAC:mac1 () in
+ let vm_vif2 = Test_common.make_vif ~__context ~mAC:mac2 () in
+ let snap_vif1 = Test_common.make_vif ~__context ~mAC:mac1 () in
+ let snap_vif2 = Test_common.make_vif ~__context ~mAC:mac2 () in
(* In reality this network won't be in the local database, but for our
* purposes it is a meaningless UUID so it's OK for it to be in the local
* database. *)
- let network1 = make_network ~__context () in
- (* Check that a map with a single VIF -> network pair is unchanged. *)
- assert_equal
+ let network1 = Test_common.make_network ~__context () in
+ check_network_map
+ "test_infer_vif_map: check that a map with a single VIF -> network pair is unchanged"
(Xapi_vm_migrate.infer_vif_map ~__context [vm_vif1] [vm_vif1, network1])
[vm_vif1, network1];
- (* Check that a missing VIF is caught. *)
- assert_raises
+ Alcotest.check_raises
+ "test_infer_vif_map: check that a missing VIF is caught"
Api_errors.(Server_error (vif_not_in_map, [Ref.string_of vm_vif2]))
- (fun () ->
- Xapi_vm_migrate.infer_vif_map ~__context
+ (fun () -> ignore
+ (Xapi_vm_migrate.infer_vif_map ~__context
[vm_vif1; vm_vif2]
- [vm_vif1, network1]);
- (* Check that a snapshot VIF is mapped implicitly. *)
+ [vm_vif1, network1]));
let inferred_map =
Xapi_vm_migrate.infer_vif_map ~__context
[vm_vif1; snap_vif1]
[vm_vif1, network1]
in
- assert_equal (List.assoc snap_vif1 inferred_map) network1;
- (* Check that an orphaned, unmapped snapshot VIF is caught. *)
- assert_raises
+ Alcotest.(check (Alcotest_comparators.ref ()))
+ "test_infer_vif_map: check that a snapshot VIF is mapped implicitly"
+ (List.assoc snap_vif1 inferred_map) network1;
+ Alcotest.check_raises
+ "Check that an orphaned, unmapped snapshot VIF is caught."
Api_errors.(Server_error (vif_not_in_map, [Ref.string_of snap_vif2]))
- (fun () ->
- Xapi_vm_migrate.infer_vif_map ~__context
+ (fun () -> ignore
+ (Xapi_vm_migrate.infer_vif_map ~__context
[vm_vif1; snap_vif1; snap_vif2]
- [vm_vif1, network1])
+ [vm_vif1, network1]))
let test =
- "test_vm_migrate" >:::
- [
- "test_infer_vif_map_empty" >:: test_infer_vif_map_empty;
- "test_infer_vif_map" >:: test_infer_vif_map;
+ [ "test_infer_vif_map_empty", `Quick, test_infer_vif_map_empty
+ ; "test_infer_vif_map", `Quick, test_infer_vif_map
]
diff --git a/ocaml/xapi-consts/api_errors.ml b/ocaml/xapi-consts/api_errors.ml
index 0c55345cc4c..c7641e1df7a 100644
--- a/ocaml/xapi-consts/api_errors.ml
+++ b/ocaml/xapi-consts/api_errors.ml
@@ -95,6 +95,17 @@ let device_attach_timeout = "DEVICE_ATTACH_TIMEOUT"
let device_detach_timeout = "DEVICE_DETACH_TIMEOUT"
let device_detach_rejected = "DEVICE_DETACH_REJECTED"
+let network_sriov_insufficient_capacity = "NETWORK_SRIOV_INSUFFICIENT_CAPACITY"
+let network_sriov_already_enabled = "NETWORK_SRIOV_ALREADY_ENABLED"
+let network_sriov_enable_failed = "NETWORK_SRIOV_ENABLE_FAILED"
+let network_sriov_disable_failed = "NETWORK_SRIOV_DISABLE_FAILED"
+let network_incompatible_with_sriov = "NETWORK_INCOMPATIBLE_WITH_SRIOV"
+let network_incompatible_with_vlan_on_bridge = "NETWORK_INCOMPATIBLE_WITH_VLAN_ON_BRIDGE"
+let network_incompatible_with_vlan_on_sriov = "NETWORK_INCOMPATIBLE_WITH_VLAN_ON_SRIOV"
+let network_incompatible_with_bond = "NETWORK_INCOMPATIBLE_WITH_BOND"
+let network_incompatible_with_tunnel = "NETWORK_INCOMPATIBLE_WITH_TUNNEL"
+let network_has_incompatible_sriov_pifs = "NETWORK_HAS_INCOMPATIBLE_SRIOV_PIFS"
+let network_has_incompatible_vlan_on_sriov_pifs = "NETWORK_HAS_INCOMPATIBLE_VLAN_ON_SRIOV_PIFS"
let operation_not_allowed = "OPERATION_NOT_ALLOWED"
let operation_blocked = "OPERATION_BLOCKED"
let network_already_connected = "NETWORK_ALREADY_CONNECTED"
@@ -103,7 +114,9 @@ let network_incompatible_purposes = "NETWORK_INCOMPATIBLE_PURPOSES"
let cannot_destroy_system_network = "CANNOT_DESTROY_SYSTEM_NETWORK"
let pif_is_physical = "PIF_IS_PHYSICAL"
+let pif_is_not_physical = "PIF_IS_NOT_PHYSICAL"
let pif_is_vlan = "PIF_IS_VLAN"
+let pif_is_sriov_logical = "PIF_IS_SRIOV_LOGICAL"
let pif_vlan_exists = "PIF_VLAN_EXISTS"
let pif_vlan_still_exists = "PIF_VLAN_STILL_EXISTS"
let vlan_in_use = "VLAN_IN_USE"
@@ -120,10 +133,15 @@ let pif_not_present = "PIF_NOT_PRESENT"
let pif_does_not_allow_unplug = "PIF_DOES_NOT_ALLOW_UNPLUG"
let pif_has_fcoe_sr_in_use = "PIF_HAS_FCOE_SR_IN_USE"
let pif_unmanaged = "PIF_UNMANAGED"
+let pif_is_not_sriov_capable = "PIF_IS_NOT_SRIOV_CAPABLE"
+let pif_sriov_still_exists = "PIF_SRIOV_STILL_EXISTS"
let cannot_plug_bond_slave = "CANNOT_PLUG_BOND_SLAVE"
let cannot_add_vlan_to_bond_slave = "CANNOT_ADD_VLAN_TO_BOND_SLAVE"
let cannot_add_tunnel_to_bond_slave = "CANNOT_ADD_TUNNEL_TO_BOND_SLAVE"
+let cannot_add_tunnel_to_sriov_logical = "CANNOT_ADD_TUNNEL_TO_SRIOV_LOGICAL"
+let cannot_add_tunnel_to_vlan_on_sriov_logical = "CANNOT_ADD_TUNNEL_TO_VLAN_ON_SRIOV_LOGICAL"
let cannot_change_pif_properties = "CANNOT_CHANGE_PIF_PROPERTIES"
+let cannot_forget_sriov_logical = "CANNOT_FORGET_SRIOV_LOGICAL"
let incompatible_pif_properties = "INCOMPATIBLE_PIF_PROPERTIES"
let slave_requires_management_iface = "SLAVE_REQUIRES_MANAGEMENT_INTERFACE"
let vif_in_use = "VIF_IN_USE"
@@ -185,6 +203,7 @@ let host_cannot_attach_network = "HOST_CANNOT_ATTACH_NETWORK"
let vm_no_suspend_sr = "VM_NO_SUSPEND_SR"
let vm_no_crashdump_sr = "VM_NO_CRASHDUMP_SR"
let vm_migrate_failed = "VM_MIGRATE_FAILED"
+let vm_migrate_contact_remote_service_failed = "VM_MIGRATE_CONTACT_REMOTE_SERVICE_FAILED"
let vm_missing_pv_drivers = "VM_MISSING_PV_DRIVERS"
let vm_failed_shutdown_ack = "VM_FAILED_SHUTDOWN_ACKNOWLEDGMENT"
let vm_old_pv_drivers = "VM_OLD_PV_DRIVERS"
@@ -326,6 +345,7 @@ let pool_joining_host_management_vlan_does_not_match = "POOL_JOINING_HOST_MANAGE
let pool_joining_host_has_non_management_vlans = "POOL_JOINING_HOST_HAS_NON_MANAGEMENT_VLANS"
let pool_joining_host_has_bonds = "POOL_JOINING_HOST_HAS_BONDS"
let pool_joining_host_has_tunnels = "POOL_JOINING_HOST_HAS_TUNNELS"
+let pool_joining_host_has_network_sriovs = "POOL_JOINING_HOST_HAS_NETWORK_SRIOVS"
(*workload balancing*)
let wlb_not_initialized = "WLB_NOT_INITIALIZED"
diff --git a/ocaml/xapi-types/features.ml b/ocaml/xapi-types/features.ml
index d1082913231..0d2eaf7235b 100644
--- a/ocaml/xapi-types/features.ml
+++ b/ocaml/xapi-types/features.ml
@@ -60,6 +60,7 @@ type feature =
| Pool_size
| CBT
| USB_passthrough
+ | Network_sriov
| Corosync
[@@deriving rpc]
@@ -110,6 +111,7 @@ let keys_of_features =
Pool_size, ("restrict_pool_size", Negative, "Pool_size");
CBT, ("restrict_cbt", Negative, "CBT");
USB_passthrough, ("restrict_usb_passthrough", Negative, "USB_passthrough");
+ Network_sriov, ("restrict_network_sriov", Negative, "Network_sriov");
Corosync, ("restrict_corosync", Negative, "Corosync");
]
diff --git a/ocaml/xapi-types/features.mli b/ocaml/xapi-types/features.mli
index 493c4162f9a..5c7a9687a56 100644
--- a/ocaml/xapi-types/features.mli
+++ b/ocaml/xapi-types/features.mli
@@ -60,6 +60,7 @@ type feature =
| Pool_size (** Enable use of Pooling for more than 3 Hosts *)
| CBT (** Enable the use of CBT *)
| USB_passthrough (** Enable the use of USB passthrough. *)
+ | Network_sriov (** Enable the use of Network SRIOV. *)
| Corosync (** Enable the use of corosync. *)
(** Convert RPC into {!feature}s *)
diff --git a/ocaml/xapi/agility.ml b/ocaml/xapi/agility.ml
index def3c9e4192..ab30e0f78cd 100644
--- a/ocaml/xapi/agility.ml
+++ b/ocaml/xapi/agility.ml
@@ -37,12 +37,20 @@ let is_sr_properly_shared ~__context ~self =
(* Only returns true if the network is shared properly: all (enabled) hosts in the pool must have a PIF on
* the network, and none of these PIFs may be bond slaves. This ensures that a VM with a VIF on this
- * network can run on (and be migrated to) any (enabled) host in the pool. *)
-let is_network_properly_shared ~__context ~self =
- let pifs = Db.Network.get_PIFs ~__context ~self in
- let non_slave_pifs = List.filter (fun pif ->
- not (Db.is_valid_ref __context (Db.PIF.get_bond_slave_of ~__context ~self:pif))) pifs in
- let hosts_with_pif = List.setify (List.map (fun pif -> Db.PIF.get_host ~__context ~self:pif) non_slave_pifs) in
+ * network can run on (and be migrated to) any (enabled) host in the pool.
+ * sriov network should have all pifs attached or can be plugged without a reboot.*)
+ let is_network_properly_shared ~__context ~self =
+ let pifs_rc = Db.PIF.get_records_where ~__context ~expr:(Eq (Field "network",Literal (Ref.string_of self))) in
+ let non_slave_and_down_sriov_pifs = List.filter (fun (_ ,pif_rec) ->
+ not (Db.is_valid_ref __context pif_rec.API.pIF_bond_slave_of) &&
+ (match Xapi_pif_helpers.get_pif_topo ~__context ~pif_rec with
+ | Network_sriov_logical sriov :: _
+ | VLAN_untagged _ :: Network_sriov_logical sriov :: _ ->
+ Xapi_network_sriov_helpers.can_be_up_without_reboot ~__context sriov
+ | _ -> true)
+ ) pifs_rc
+ in
+ let hosts_with_pif = List.setify (List.map (fun (_ ,pif_rec) -> pif_rec.API.pIF_host) non_slave_and_down_sriov_pifs) in
let all_hosts = Db.Host.get_all ~__context in
let enabled_hosts = List.filter (fun host -> Db.Host.get_enabled ~__context ~self:host) all_hosts in
let properly_shared = List.subset enabled_hosts hosts_with_pif in
diff --git a/ocaml/xapi/api_server.ml b/ocaml/xapi/api_server.ml
index 6d4f23512fa..3c2097adafd 100644
--- a/ocaml/xapi/api_server.ml
+++ b/ocaml/xapi/api_server.ml
@@ -95,6 +95,7 @@ module Actions = struct
module PUSB = Xapi_pusb
module USB_group = Xapi_usb_group
module VUSB = Xapi_vusb
+ module Network_sriov = Xapi_network_sriov
module Cluster = Xapi_cluster
module Cluster_host = Xapi_cluster_host
end
@@ -187,23 +188,15 @@ let callback is_json req bio _ =
let response_str =
if rpc.Rpc.name = "system.listMethods"
then
- let inner = Xmlrpc.to_a
- ~empty:Bigbuffer.make
- ~append:(fun buf s -> Bigbuffer.append_substring buf s 0 (String.length s))
- response.Rpc.contents in
- let s = Printf.sprintf "%s" (Bigbuffer.to_string inner) in
- let buf = Bigbuffer.make () in
- Bigbuffer.append_string buf s;
- buf
+ let inner = Xmlrpc.to_string response.Rpc.contents in
+ Printf.sprintf "%s" inner
else
- Xmlrpc.a_of_response
- ~empty:Bigbuffer.make
- ~append:(fun buf s -> Bigbuffer.append_substring buf s 0 (String.length s))
- response in
+ Xmlrpc.string_of_response response
+ in
Http_svr.response_fct req ~hdrs:[ Http.Hdr.content_type, "text/xml";
"Access-Control-Allow-Origin", "*";
- "Access-Control-Allow-Headers", "X-Requested-With"] fd (Bigbuffer.length response_str)
- (fun fd -> Bigbuffer.to_fct response_str (fun s -> ignore(Unixext.really_write_string fd s)))
+ "Access-Control-Allow-Headers", "X-Requested-With"] fd (Int64.of_int @@ String.length response_str)
+ (fun fd -> Unixext.really_write_string fd response_str |> ignore)
with
| (Api_errors.Server_error (err, params)) ->
Http_svr.response_str req ~hdrs:[ Http.Hdr.content_type, "text/xml" ] fd
@@ -219,14 +212,13 @@ let jsoncallback req bio _ =
let body = Http_svr.read_body ~limit:Db_globs.http_limit_max_rpc_size req bio in
try
let json_rpc_version, id, rpc = Jsonrpc.version_id_and_call_of_string body in
- let response = Jsonrpc.a_of_response ~id ~version:json_rpc_version
- ~empty:Bigbuffer.make
- ~append:(fun buf s -> Bigbuffer.append_substring buf s 0 (String.length s))
+ let response = Jsonrpc.string_of_response ~id ~version:json_rpc_version
(callback1 ~json_rpc_version true req fd (Some body) rpc) in
Http_svr.response_fct req ~hdrs:[ Http.Hdr.content_type, "application/json";
"Access-Control-Allow-Origin", "*";
- "Access-Control-Allow-Headers", "X-Requested-With"] fd (Bigbuffer.length response)
- (fun fd -> Bigbuffer.to_fct response (fun s -> ignore(Unixext.really_write_string fd s)))
+ "Access-Control-Allow-Headers", "X-Requested-With"] fd
+ (Int64.of_int @@ String.length response)
+ (fun fd -> Unixext.really_write_string fd response |> ignore)
with
| (Api_errors.Server_error (err, params)) ->
Http_svr.response_str req ~hdrs:[ Http.Hdr.content_type, "application/json" ] fd
diff --git a/ocaml/xapi/cli_frontend.ml b/ocaml/xapi/cli_frontend.ml
index 31b77309955..ebc0f66d25e 100644
--- a/ocaml/xapi/cli_frontend.ml
+++ b/ocaml/xapi/cli_frontend.ml
@@ -1585,6 +1585,24 @@ let rec cmdtable_data : (string*cmd_spec) list =
flags=[];
};
+ "network-sriov-create",
+ {
+ reqd=["pif-uuid";"network-uuid"];
+ optn=[];
+ help="Create a new network-sriov on a PIF.";
+ implementation=No_fd Cli_operations.Network_sriov.create;
+ flags=[];
+ };
+
+ "network-sriov-destroy",
+ {
+ reqd=["uuid"];
+ optn=[];
+ help="Destroy a network-sriov.";
+ implementation=No_fd Cli_operations.Network_sriov.destroy;
+ flags=[];
+ };
+
"pif-unplug",
{
reqd=["uuid"];
diff --git a/ocaml/xapi/cli_operations.ml b/ocaml/xapi/cli_operations.ml
index 3aff5c2895f..226af8e0c7c 100644
--- a/ocaml/xapi/cli_operations.ml
+++ b/ocaml/xapi/cli_operations.ml
@@ -844,6 +844,7 @@ let gen_cmds rpc session_id =
; Client.PUSB.(mk get_all get_all_records_where get_by_uuid pusb_record "pusb" [] ["uuid"; "path"; "product-id"; "product-desc"; "vendor-id"; "vendor-desc"; "serial"; "version";"description"] rpc session_id)
; Client.USB_group.(mk get_all get_all_records_where get_by_uuid usb_group_record "usb-group" [] ["uuid";"name-label";"name-description"] rpc session_id)
; Client.VUSB.(mk get_all get_all_records_where get_by_uuid vusb_record "vusb" [] ["uuid";"vm-uuid"; "usb-group-uuid"] rpc session_id)
+ ; Client.Network_sriov.(mk get_all get_all_records_where get_by_uuid network_sriov_record "network-sriov" [] ["uuid"; "physical-pif"; "logical-pif"; "requires-reboot"; "configuration-mode"] rpc session_id)
; Client.Cluster.(mk get_all get_all_records_where get_by_uuid cluster_record "cluster" [] ["uuid";"cluster_hosts";"network";"cluster_token";"cluster_stack";"allowed_operations";"current_operations";"pool_auto_join";"cluster_config";"other_config"] rpc session_id)
; Client.Cluster_host.(mk get_all get_all_records_where get_by_uuid cluster_host_record "cluster-host" [] ["uuid";"cluster";"host";"enabled";"allowed_operations";"current_operations";"other_config"] rpc session_id)
]
@@ -3618,7 +3619,7 @@ let vm_import fd printer rpc session_id params =
| `success ->
if stream_ok then
let result = Client.Task.get_result rpc session_id importtask in
- let vmrefs = API.Legacy.From.ref_VM_set "" (Xml.parse_string result) in
+ let vmrefs = result |> Xmlrpc.of_string |> API.ref_VM_set_of_rpc in
let uuids = List.map (fun vm -> Client.VM.get_uuid rpc session_id vm) vmrefs in
marshal fd (Command (Print (String.concat "," uuids)))
else
@@ -3670,7 +3671,7 @@ let vm_import fd printer rpc session_id params =
Some (Client.Task.get_by_uuid rpc session_id (List.assoc "task-uuid" params))
else None (* track_http_operation will create one for us *) in
let result = track_http_operation ?use_existing_task:importtask fd rpc session_id make_command "VM import" in
- let vmrefs = API.Legacy.From.ref_VM_set "" (Xml.parse_string result) in
+ let vmrefs = result |> Xmlrpc.of_string |> API.ref_VM_set_of_rpc in
let uuids = List.map (fun vm -> Client.VM.get_uuid rpc session_id vm) vmrefs in
let uuids = if uuids = [] && dry_run then ["xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx"] else uuids in
marshal fd (Command (Print (String.concat "," uuids)))
@@ -4022,6 +4023,19 @@ let tunnel_destroy printer rpc session_id params =
let tunnel = Client.Tunnel.get_by_uuid rpc session_id uuid in
Client.Tunnel.destroy rpc session_id tunnel
+module Network_sriov = struct
+ let create printer rpc session_id params =
+ let pif = Client.PIF.get_by_uuid rpc session_id (List.assoc "pif-uuid" params) in
+ let network = Client.Network.get_by_uuid rpc session_id (List.assoc "network-uuid" params) in
+ let sriov = Client.Network_sriov.create rpc session_id pif network in
+ let uuid = Client.Network_sriov.get_uuid rpc session_id sriov in
+ printer (Cli_printer.PList [uuid])
+
+ let destroy printer rpc session_id params =
+ let sriov = Client.Network_sriov.get_by_uuid rpc session_id (List.assoc "uuid" params) in
+ ignore(Client.Network_sriov.destroy rpc session_id sriov)
+end
+
let pif_reconfigure_ip printer rpc session_id params =
let read_optional_case_insensitive key =
let lower_case_params = List.map (fun (k,v)->(String.lowercase_ascii k,v)) params in
@@ -4459,7 +4473,7 @@ let update_upload fd printer rpc session_id params =
HttpPut (filename, uri)
in
let result = track_http_operation fd rpc session_id make_command "host patch upload" in
- let vdi_ref = API.Legacy.From.ref_VDI "" (Xml.parse_string result) in
+ let vdi_ref = result |> Xmlrpc.of_string |> API.ref_VDI_of_rpc in
let update_ref =
try Client.Pool_update.introduce rpc session_id vdi_ref
with e ->
diff --git a/ocaml/xapi/db_gc_util.ml b/ocaml/xapi/db_gc_util.ml
index 6d99e8c7356..465e292d960 100644
--- a/ocaml/xapi/db_gc_util.ml
+++ b/ocaml/xapi/db_gc_util.ml
@@ -62,11 +62,12 @@ let gc_PIFs ~__context =
gc_connector ~__context Db.PIF.get_all Db.PIF.get_record (fun x->valid_ref __context x.pIF_host) (fun x->valid_ref __context x.pIF_network)
(fun ~__context ~self ->
(* We need to destroy the PIF, it's metrics and any VLAN/bond records that this PIF was a master of. *)
- (* bonds/tunnels_to_gc is actually a list which is either empty (not part of a bond/tunnel)
+ (* bonds/tunnels/sriovs_to_gc is actually a list which is either empty (not part of a bond/tunnel/sriov)
* or containing exactly one reference.. *)
let bonds_to_gc = Db.PIF.get_bond_master_of ~__context ~self in
let vlan_to_gc = Db.PIF.get_VLAN_master_of ~__context ~self in
let tunnels_to_gc = Db.PIF.get_tunnel_access_PIF_of ~__context ~self in
+ let sriovs_to_gc = Db.PIF.get_sriov_logical_PIF_of ~__context ~self in
(* Only destroy PIF_metrics of physical or bond PIFs *)
if vlan_to_gc = Ref.null && tunnels_to_gc = [] then begin
let metrics = Db.PIF.get_metrics ~__context ~self in
@@ -74,6 +75,7 @@ let gc_PIFs ~__context =
end;
(try Db.VLAN.destroy ~__context ~self:vlan_to_gc with _ -> ());
List.iter (fun tunnel -> (try Db.Tunnel.destroy ~__context ~self:tunnel with _ -> ())) tunnels_to_gc;
+ List.iter (fun sriov -> (try Db.Network_sriov.destroy ~__context ~self:sriov with _ -> ())) sriovs_to_gc;
List.iter (fun bond -> (try Db.Bond.destroy ~__context ~self:bond with _ -> ())) bonds_to_gc;
Db.PIF.destroy ~__context ~self)
diff --git a/ocaml/xapi/dbsync_slave.ml b/ocaml/xapi/dbsync_slave.ml
index 01a2502da0d..ce6ac4e7144 100644
--- a/ocaml/xapi/dbsync_slave.ml
+++ b/ocaml/xapi/dbsync_slave.ml
@@ -302,6 +302,10 @@ let update_env __context sync_keys =
update_physical_networks ~__context;
*)
+ switched_sync Xapi_globs.sync_pci_devices (fun () ->
+ Xapi_pci.update_pcis ~__context;
+ );
+
switched_sync Xapi_globs.sync_pif_params (fun () ->
debug "resynchronising PIF params";
resynchronise_pif_params ~__context;
@@ -340,10 +344,6 @@ let update_env __context sync_keys =
Create_misc.create_chipset_info ~__context;
);
- switched_sync Xapi_globs.sync_pci_devices (fun () ->
- Xapi_pci.update_pcis ~__context;
- );
-
switched_sync Xapi_globs.sync_gpus (fun () ->
Xapi_pgpu.update_gpus ~__context;
);
diff --git a/ocaml/xapi/export.ml b/ocaml/xapi/export.ml
index 50f6fbaebd7..91ba6a0de18 100644
--- a/ocaml/xapi/export.ml
+++ b/ocaml/xapi/export.ml
@@ -186,7 +186,7 @@ let make_host table __context self =
API.host_resident_VMs = List.filter ((<>) Ref.null) (List.map (fun vm -> lookup table (Ref.string_of vm)) host.API.host_resident_VMs) } in
{ cls = Datamodel_common._host;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.host_t host }
+ snapshot = API.rpc_of_host_t host }
(** Convert a VM reference to an obj *)
let make_vm ?(with_snapshot_metadata=false) ~preserve_power_state table __context self =
@@ -223,14 +223,14 @@ let make_vm ?(with_snapshot_metadata=false) ~preserve_power_state table __contex
API.vM_blobs = [];} in
{ cls = Datamodel_common._vm;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.vM_t vm }
+ snapshot = API.rpc_of_vM_t vm }
(** Convert a guest-metrics reference to an obj *)
let make_gm table __context self =
let gm = Db.VM_guest_metrics.get_record ~__context ~self in
{ cls = Datamodel_common._vm_guest_metrics;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.vM_guest_metrics_t gm }
+ snapshot = API.rpc_of_vM_guest_metrics_t gm }
(** Convert a VIF reference to an obj *)
let make_vif table ~preserve_power_state __context self =
@@ -245,7 +245,7 @@ let make_vif table ~preserve_power_state __context self =
} in
{ cls = Datamodel_common._vif;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.vIF_t vif }
+ snapshot = API.rpc_of_vIF_t vif }
(** Convert a Network reference to an obj *)
let make_network table __context self =
@@ -258,7 +258,7 @@ let make_network table __context self =
} in
{ cls = Datamodel_common._network;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.network_t net }
+ snapshot = API.rpc_of_network_t net }
(** Convert a VBD reference to an obj *)
let make_vbd table ~preserve_power_state __context self =
@@ -273,7 +273,7 @@ let make_vbd table ~preserve_power_state __context self =
} in
{ cls = Datamodel_common._vbd;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.vBD_t vbd }
+ snapshot = API.rpc_of_vBD_t vbd }
(** Convert a VDI reference to an obj *)
let make_vdi table __context self =
@@ -287,7 +287,7 @@ let make_vdi table __context self =
} in
{ cls = Datamodel_common._vdi;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.vDI_t vdi }
+ snapshot = API.rpc_of_vDI_t vdi }
(** Convert a SR reference to an obj *)
let make_sr table __context self =
@@ -300,7 +300,7 @@ let make_sr table __context self =
} in
{ cls = Datamodel_common._sr;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.sR_t sr;
+ snapshot = API.rpc_of_sR_t sr;
}
(** Convert a VGPU_type reference to an obj *)
@@ -309,7 +309,7 @@ let make_vgpu_type table __context self =
{
cls = Datamodel_common._vgpu_type;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.vGPU_type_t vgpu_type
+ snapshot = API.rpc_of_vGPU_type_t vgpu_type
}
(** Convert a VGPU reference to an obj *)
@@ -324,7 +324,7 @@ let make_vgpu table ~preserve_power_state __context self =
{
cls = Datamodel_common._vgpu;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.vGPU_t vgpu
+ snapshot = API.rpc_of_vGPU_t vgpu
}
(** Convert a GPU_group reference to an obj *)
@@ -337,7 +337,7 @@ let make_gpu_group table __context self =
{
cls = Datamodel_common._gpu_group;
id = Ref.string_of (lookup table (Ref.string_of self));
- snapshot = API.Legacy.To.gPU_group_t group
+ snapshot = API.rpc_of_gPU_group_t group
}
let make_pvs_proxies table __context self =
@@ -352,7 +352,7 @@ let make_pvs_proxies table __context self =
} in
{ cls = Datamodel_common._pvs_proxy
; id = Ref.string_of (lookup' self)
- ; snapshot = API.Legacy.To.pVS_proxy_t proxy
+ ; snapshot = API.rpc_of_pVS_proxy_t proxy
}
let make_pvs_sites table __context self =
@@ -368,7 +368,7 @@ let make_pvs_sites table __context self =
} in
{ cls = Datamodel_common._pvs_site
; id = Ref.string_of (lookup' self)
- ; snapshot = API.Legacy.To.pVS_site_t site
+ ; snapshot = API.rpc_of_pVS_site_t site
}
@@ -414,7 +414,8 @@ let vm_metadata ~with_snapshot_metadata ~preserve_power_state ~include_vhd_paren
let objects = make_all ~with_snapshot_metadata ~preserve_power_state table __context in
let header = { version = this_version __context;
objects = objects } in
- let ova_xml = Xml.to_bigbuffer (xmlrpc_of_header header) in
+ let ova_xml = Xmlrpc.to_string (rpc_of_header header)
+ in
table, ova_xml
let string_of_vm ~__context vm =
@@ -438,8 +439,8 @@ let export_metadata ~__context ~with_snapshot_metadata ~preserve_power_state ~in
(string_of_bool preserve_power_state) end;
let _, ova_xml = vm_metadata ~with_snapshot_metadata ~preserve_power_state ~include_vhd_parents ~__context ~vms in
- let hdr = Tar_unix.Header.make Xva.xml_filename (Bigbuffer.length ova_xml) in
- Tar_unix.write_block hdr (fun s -> Bigbuffer.to_fct ova_xml (fun frag -> Unixext.really_write_string s frag)) s;
+ let hdr = Tar_unix.Header.make Xva.xml_filename (Int64.of_int @@ String.length ova_xml) in
+ Tar_unix.write_block hdr (fun s -> Unixext.really_write_string s ova_xml) s;
Tar_unix.write_end s
let export refresh_session __context rpc session_id s vm_ref preserve_power_state =
@@ -451,8 +452,8 @@ let export refresh_session __context rpc session_id s vm_ref preserve_power_stat
debug "Outputting ova.xml";
- let hdr = Tar_unix.Header.make Xva.xml_filename (Bigbuffer.length ova_xml) in
- Tar_unix.write_block hdr (fun s -> Bigbuffer.to_fct ova_xml (fun frag -> Unixext.really_write_string s frag)) s;
+ let hdr = Tar_unix.Header.make Xva.xml_filename (Int64.of_int @@ String.length ova_xml) in
+ Tar_unix.write_block hdr (fun s -> Unixext.really_write_string s ova_xml) s;
(* Only stream the disks that are in the table AND which are not CDROMs (ie whose VBD.type <> CD
and whose SR.content_type <> "iso" *)
diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml
index 7a2d3e87dd9..046ea4e8040 100644
--- a/ocaml/xapi/helpers.ml
+++ b/ocaml/xapi/helpers.ml
@@ -42,6 +42,9 @@ let log_exn_continue msg f x = try f x with e -> debug "Ignoring exception: %s w
let choose_network_name_for_pif device =
Printf.sprintf "Pool-wide network associated with %s" device
+let choose_network_name_for_sriov device =
+ Printf.sprintf "SR-IOV network associated with %s" device
+
(** Once the server functor has been instantiated, set this reference to the appropriate
"fake_rpc" (loopback non-HTTP) rpc function. This is used by the CLI, which passes in
the HTTP request headers it has already received together with its active file descriptor. *)
@@ -1141,8 +1144,9 @@ let timebox ~timeout ~otherwise f =
with e ->
result := fun () -> raise e);
Unix.close fd_out) () in
- let _ = Thread.wait_timed_read fd_in timeout in
+ let finished = Thread.wait_timed_read fd_in timeout in
Unix.close fd_in;
+ if not finished then ignore_exn (fun () -> Unix.close fd_out);
!result ()
(**************************************************************************************)
diff --git a/ocaml/xapi/import.ml b/ocaml/xapi/import.ml
index e31e987ceb0..f00b4b1e904 100644
--- a/ocaml/xapi/import.ml
+++ b/ocaml/xapi/import.ml
@@ -125,26 +125,27 @@ let choose_one = function
| x :: _ -> Some x
| [] -> None
+
(* Return the list of non-CDROM VDIs ie those which will be streamed-in *)
let non_cdrom_vdis (x: header) =
let all_vbds = List.filter (fun x -> x.cls = Datamodel_common._vbd) x.objects in
- let all_vbds = List.map (fun x -> API.Legacy.From.vBD_t "" x.snapshot) all_vbds in
+ let all_vbds = List.map (fun x -> API.vBD_t_of_rpc x.snapshot) all_vbds in
let all_disk_vbds = List.filter (fun x -> x.API.vBD_type <> `CD) all_vbds in
let all_disk_vdis = List.map (fun x -> Ref.string_of x.API.vBD_VDI) all_disk_vbds in
(* Remove all those whose SR has content-type = "iso" *)
let all_disk_vdis = List.filter (fun vdi ->
- let vdir = API.Legacy.From.vDI_t "" (find_in_export vdi x.objects) in
- let sr = API.Legacy.From.sR_t "" (find_in_export (Ref.string_of vdir.API.vDI_SR) x.objects) in
+ let vdir = API.vDI_t_of_rpc (find_in_export vdi x.objects) in
+ let sr = API.sR_t_of_rpc (find_in_export (Ref.string_of vdir.API.vDI_SR) x.objects) in
sr.API.sR_content_type <> "iso") all_disk_vdis in
let all_vdis = List.filter (fun x -> x.cls = Datamodel_common._vdi) x.objects in
List.filter (fun x -> false
|| (List.mem x.id all_disk_vdis)
- || (API.Legacy.From.vDI_t "" x.snapshot).API.vDI_type = `suspend) all_vdis
+ || ( API.vDI_t_of_rpc x.snapshot).API.vDI_type = `suspend) all_vdis
let get_vm_record snapshot =
- let vm_record = API.Legacy.From.vM_t "" snapshot in
+ let vm_record = API.vM_t_of_rpc snapshot in
(* Ensure that the domain_type is set correctly *)
if vm_record.API.vM_domain_type = `unspecified then
{vm_record with API.vM_domain_type =
@@ -299,7 +300,7 @@ module Host : HandlerTools = struct
| Found_no_host
let precheck __context config rpc session_id state x =
- let host_record = API.Legacy.From.host_t "" x.snapshot in
+ let host_record = API.host_t_of_rpc x.snapshot in
try Found_host (Db.Host.get_by_uuid __context host_record.API.host_uuid)
with _ -> Found_no_host
@@ -584,7 +585,7 @@ module GuestMetrics : HandlerTools = struct
state.table <- (x.cls, x.id, Ref.string_of dummy_gm) :: state.table
let handle __context config rpc session_id state x precheck_result =
- let gm_record = API.Legacy.From.vM_guest_metrics_t "" x.snapshot in
+ let gm_record = API.vM_guest_metrics_t_of_rpc x.snapshot in
let gm = Ref.make () in
Db.VM_guest_metrics.create ~__context
~ref:gm
@@ -616,7 +617,7 @@ module SR : HandlerTools = struct
| SR_not_needed
let precheck __context config rpc session_id state x =
- let sr_record = API.Legacy.From.sR_t "" x.snapshot in
+ let sr_record = API.sR_t_of_rpc x.snapshot in
match config.import_type with
| Metadata_import _ -> begin
(* Look up the existing SR record *)
@@ -665,9 +666,9 @@ module VDI : HandlerTools = struct
| Create of API.vDI_t
let precheck __context config rpc session_id state x =
- let vdi_record = API.Legacy.From.vDI_t "" x.snapshot in
+ let vdi_record = API.vDI_t_of_rpc x.snapshot in
- let original_sr = API.Legacy.From.sR_t "" (find_in_export (Ref.string_of vdi_record.API.vDI_SR) state.export) in
+ let original_sr = API.sR_t_of_rpc (find_in_export (Ref.string_of vdi_record.API.vDI_SR) state.export) in
if original_sr.API.sR_content_type = "iso" then begin
(* Best effort: locate a VDI in any shared ISO SR with a matching VDI.location *)
let iso_srs = List.filter (fun self -> Client.SR.get_content_type rpc session_id self = "iso"
@@ -800,7 +801,7 @@ module VDI : HandlerTools = struct
handle_dry_run __context config rpc session_id state x precheck_result
| Found_disk vdi ->
handle_dry_run __context config rpc session_id state x precheck_result;
- let other_config_record = (API.Legacy.From.vDI_t "" x.snapshot).API.vDI_other_config in
+ let other_config_record = ( API.vDI_t_of_rpc x.snapshot).API.vDI_other_config in
List.iter (fun key ->
Db.VDI.remove_from_other_config ~__context ~self:vdi ~key;
try Db.VDI.add_to_other_config ~__context ~self:vdi ~key ~value:(List.assoc key other_config_record) with Not_found -> ()
@@ -829,7 +830,7 @@ module Net : HandlerTools = struct
| Create of API.network_t
let precheck __context config rpc session_id state x =
- let net_record = API.Legacy.From.network_t "" x.snapshot in
+ let net_record = API.network_t_of_rpc x.snapshot in
let possibilities = Client.Network.get_by_name_label rpc session_id net_record.API.network_name_label in
match possibilities with
| [] ->
@@ -881,7 +882,7 @@ module GPUGroup : HandlerTools = struct
| Create of API.gPU_group_t
let precheck __context config rpc session_id state x =
- let gpu_group_record = API.Legacy.From.gPU_group_t "" x.snapshot in
+ let gpu_group_record = API.gPU_group_t_of_rpc x.snapshot in
let groups = Client.GPU_group.get_all_records rpc session_id in
try
let group, _ =
@@ -951,7 +952,7 @@ module VBD : HandlerTools = struct
| Create of API.vBD_t
let precheck __context config rpc session_id state x =
- let vbd_record = API.Legacy.From.vBD_t "" x.snapshot in
+ let vbd_record = API.vBD_t_of_rpc x.snapshot in
let get_vbd () = Client.VBD.get_by_uuid rpc session_id vbd_record.API.vBD_uuid in
let vbd_exists () = try ignore (get_vbd ()); true with _ -> false in
@@ -1040,7 +1041,7 @@ module VIF : HandlerTools = struct
| Create of API.vIF_t
let precheck __context config rpc session_id state x =
- let vif_record = API.Legacy.From.vIF_t "" x.snapshot in
+ let vif_record = API.vIF_t_of_rpc x.snapshot in
let get_vif () = Client.VIF.get_by_uuid rpc session_id vif_record.API.vIF_uuid in
let vif_exists () = try ignore (get_vif ()); true with _ -> false in
@@ -1135,7 +1136,7 @@ module VGPUType : HandlerTools = struct
| Create of API.vGPU_type_t
let precheck __context config rpc session_id state x =
- let vgpu_type_record = API.Legacy.From.vGPU_type_t "" x.snapshot in
+ let vgpu_type_record = API.vGPU_type_t_of_rpc x.snapshot in
(* First look up VGPU types using the identifier string. *)
let compatible_types =
@@ -1213,7 +1214,7 @@ module VGPU : HandlerTools = struct
| Create of API.vGPU_t
let precheck __context config rpc session_id state x =
- let vgpu_record = API.Legacy.From.vGPU_t "" x.snapshot in
+ let vgpu_record = API.vGPU_t_of_rpc x.snapshot in
let get_vgpu () = Client.VGPU.get_by_uuid rpc session_id vgpu_record.API.vGPU_uuid in
let vgpu_exists () = try ignore (get_vgpu ()); true with _ -> false in
@@ -1306,11 +1307,11 @@ module PVS_Proxy : HandlerTools = struct
* in the [precheck_t] value.
*)
let precheck __context config rpc session_id state obj =
- let proxy = API.Legacy.From.pVS_proxy_t "" obj.snapshot in
+ let proxy = API.pVS_proxy_t_of_rpc obj.snapshot in
let site =
proxy.API.pVS_proxy_site
|> fun ref -> find_in_export (Ref.string_of ref) state.export
- |> API.Legacy.From.pVS_site_t "" in
+ |> API.pVS_site_t_of_rpc in
let pvs_uuid = site.API.pVS_site_PVS_uuid in
match find_pvs_site __context config rpc session_id pvs_uuid with
| None -> Drop
@@ -1446,9 +1447,7 @@ let handle_all __context config rpc session_id (xs: obj list) =
(** Read the next file in the archive as xml *)
let read_xml hdr fd =
- let xml_string = Bigbuffer.make () in
- really_read_bigbuffer fd xml_string hdr.Tar_unix.Header.file_size;
- Xml.parse_bigbuffer xml_string
+ Unixext.really_read_string fd (Int64.to_int hdr.Tar_unix.Header.file_size)
let assert_filename_is hdr =
let expected = Xva.xml_filename in
@@ -1611,7 +1610,7 @@ let metadata_handler (req: Request.t) s _ =
(* Skip trailing two zero blocks *)
Tar_unix.Archive.skip s (Tar_unix.Header.length * 2);
- let header = header_of_xmlrpc metadata in
+ let header = metadata |> Xmlrpc.of_string |> header_of_rpc in
assert_compatible ~__context header.version;
if full_restore then assert_can_restore_backup ~__context rpc session_id header;
@@ -1649,13 +1648,14 @@ let stream_import __context rpc session_id s content_length refresh_session conf
with_open_archive s ?length:content_length
(fun metadata s ->
debug "Got XML";
- let old_zurich_or_geneva = try ignore(Xva.of_xml metadata); true with _ -> false in
+ let metadata' = Xml.parse_string metadata in
+ let old_zurich_or_geneva = try ignore(Xva.of_xml metadata'); true with _ -> false in
let vmrefs =
if old_zurich_or_geneva
- then Import_xva.from_xml refresh_session s __context rpc session_id sr metadata
+ then Import_xva.from_xml refresh_session s __context rpc session_id sr metadata'
else begin
debug "importing new style VM";
- let header = header_of_xmlrpc metadata in
+ let header = metadata |> Xmlrpc.of_string |> header_of_rpc in
assert_compatible ~__context header.version;
if config.full_restore then assert_can_restore_backup ~__context rpc session_id header;
@@ -1676,7 +1676,7 @@ let stream_import __context rpc session_id s content_length refresh_session conf
(* some CDROMs might be in as disks, don't stream them either *)
let all_vdis = List.filter (fun x -> exists (Ref.of_string x.id) table) all_vdis in
let vdis = List.map (fun x ->
- let vdir = API.Legacy.From.vDI_t "" (find_in_export x.id state.export) in
+ let vdir = API.vDI_t_of_rpc (find_in_export x.id state.export) in
x.id, lookup (Ref.of_string x.id) table, vdir.API.vDI_virtual_size) all_vdis in
List.iter (fun (extid, intid, size) -> debug "Expecting to import VDI %s into %s (size=%Ld)" extid (Ref.string_of intid) size) vdis;
let checksum_table = Stream_vdi.recv_all refresh_session s __context rpc session_id header.version config.force vdis in
@@ -1691,7 +1691,7 @@ let stream_import __context rpc session_id s content_length refresh_session conf
(* against the table here. Nb. Rio GA-Miami B2 exports get their checksums checked twice! *)
if header.version.export_vsn < 2 then begin
let xml = Tar_unix.Archive.with_next_file s (fun s hdr -> read_xml hdr s) in
- let expected_checksums = checksum_table_of_xmlrpc xml in
+ let expected_checksums = xml |> Xmlrpc.of_string |> checksum_table_of_rpc in
if not(compare_checksums checksum_table expected_checksums) then begin
error "Some data checksums were incorrect: VM may be corrupt";
if not(config.force)
diff --git a/ocaml/xapi/importexport.ml b/ocaml/xapi/importexport.ml
index 1ff21c27791..1e9157b753e 100644
--- a/ocaml/xapi/importexport.ml
+++ b/ocaml/xapi/importexport.ml
@@ -16,52 +16,73 @@
*)
(** Represents a database record (the reference gets converted to a small string) *)
-type obj = { cls: string; id: string; snapshot: XMLRPC.xmlrpc }
+type obj = {
+ cls: string [@key "class"];
+ id: string;
+ snapshot: Rpc.t
+} [@@deriving rpc]
-(** Version information attached to each export and checked on import *)
-type version =
- { hostname: string;
- date: string;
- product_version: string;
- product_brand: string;
- build_number: string;
- xapi_vsn_major: int;
- xapi_vsn_minor: int;
- export_vsn: int; (* 0 if missing, indicates eg whether to expect sha1sums in the stream *)
- }
+let string_of_obj x = x.cls ^ " " ^ x.id
-(** An exported VM has a header record: *)
-type header =
- { version: version;
- objects: obj list }
+(** Version information attached to each export and checked on import *)
+type version = {
+ hostname: string;
+ date: string;
+ product_version: string;
+ product_brand: string;
+ build_number: string;
+ xapi_vsn_major: int;
+ xapi_vsn_minor: int;
+ export_vsn: int; (* 0 if missing, indicates eg whether to expect sha1sums in the stream *)
+}
-exception Version_mismatch of string
+let rpc_of_version x =
+ let open Xapi_globs in
+ Rpc.Dict(
+ [ _hostname, Rpc.String(x.hostname)
+ ; _date, Rpc.String(x.date)
+ ; _product_version, Rpc.String(x.product_version)
+ ; _product_brand, Rpc.String(x.product_brand)
+ ; _build_number, Rpc.String(x.build_number)
+ ; _xapi_major, Rpc.Int(Int64.of_int Xapi_globs.version_major)
+ ; _xapi_minor, Rpc.Int(Int64.of_int Xapi_globs.version_minor)
+ ; _export_vsn, Rpc.Int(Int64.of_int Xapi_globs.export_vsn)
+ ])
-module D=Debug.Make(struct let name="importexport" end)
-open D
+exception Failure of string
let find kvpairs where x =
if not(List.mem_assoc x kvpairs)
then raise (Failure (Printf.sprintf "Failed to find key '%s' in %s" x where))
else List.assoc x kvpairs
-let string_of_obj x = x.cls ^ " " ^ x.id
+[@@@warning "-8"]
+let version_of_rpc = function
+ | Rpc.Dict(map) ->
+ let find = find map "version data" in
+ let open Xapi_globs in
+ { hostname = Rpc.string_of_rpc (find _hostname)
+ ; date = Rpc.string_of_rpc (find _date)
+ ; product_version = Rpc.string_of_rpc (find _product_version)
+ ; product_brand = Rpc.string_of_rpc (find _product_brand)
+ ; build_number = Rpc.string_of_rpc (find _build_number)
+ ; xapi_vsn_major = Rpc.int_of_rpc (find _xapi_major)
+ ; xapi_vsn_minor = Rpc.int_of_rpc (find _xapi_minor)
+ ; export_vsn = try Rpc.int_of_rpc (find _export_vsn) with _ -> 0
+ }
+ | rpc -> raise (Failure(Printf.sprintf "version_of_rpc: malformed RPC %s" (Rpc.to_string rpc)))
+[@@@warning "+8"]
-let _class = "class"
-let _id = "id"
-let _snapshot = "snapshot"
+(** An exported VM has a header record: *)
+type header = {
+ version: version;
+ objects: obj list
+} [@@deriving rpc]
-let xmlrpc_of_obj x = XMLRPC.To.structure
- [ _class, XMLRPC.To.string x.cls;
- _id, XMLRPC.To.string x.id;
- _snapshot, x.snapshot ]
+exception Version_mismatch of string
-let obj_of_xmlrpc x =
- let kvpairs = XMLRPC.From.structure x in
- let find = find kvpairs "object data" in
- { cls = XMLRPC.From.string (find _class);
- id = XMLRPC.From.string (find _id);
- snapshot = find _snapshot }
+module D=Debug.Make(struct let name="importexport" end)
+open D
(** Return a version struct corresponding to this host *)
let this_version __context =
@@ -89,52 +110,13 @@ let assert_compatible ~__context other_version =
if this_version.xapi_vsn_major<>other_version.xapi_vsn_major || this_version.xapi_vsn_minor 0;
- }
-
-let _version = "version"
-let _objects = "objects"
-
-let xmlrpc_of_header x =
- XMLRPC.To.structure
- [ _version, xmlrpc_of_version x.version;
- _objects, XMLRPC.To.array (List.map xmlrpc_of_obj x.objects);
- ]
-
-let header_of_xmlrpc x =
- let kvpairs = XMLRPC.From.structure x in
- let find = find kvpairs "contents data" in
- { version = version_of_xmlrpc (find _version);
- objects = XMLRPC.From.array obj_of_xmlrpc (find _objects);
- }
let vm_has_field ~(x: obj) ~name =
- let structure = XMLRPC.From.structure x.snapshot in
- List.mem_assoc name structure
+ match x.snapshot with
+ | Rpc.Dict(map) -> List.mem_assoc name map
+ | rpc -> raise (
+ Failure(Printf.sprintf "vm_has_field: invalid object %s" (Xmlrpc.to_string rpc))
+ )
(* This function returns true when the VM record was created pre-ballooning. *)
let vm_exported_pre_dmc (x: obj) =
@@ -147,8 +129,7 @@ open Client
(** HTTP header type used for streaming binary data *)
let content_type = Http.Hdr.content_type ^ ": application/octet-stream"
-let xmlrpc_of_checksum_table table = API.Legacy.To.string_to_string_map table
-let checksum_table_of_xmlrpc xml = API.Legacy.From.string_to_string_map "" xml
+let checksum_table_of_rpc = API.string_to_string_map_of_rpc
let compare_checksums a b =
let success = ref true in
@@ -299,7 +280,12 @@ let remote_metadata_export_import ~__context ~rpc ~session_id ~remote_address ~r
| `success -> begin
debug "Remote metadata import succeeded";
let result = Client.Task.get_result rpc session_id remote_task in
- API.Legacy.From.ref_VM_set "" (Xml.parse_string result)
+ try
+ result
+ |> Xmlrpc.of_string
+ |> API.ref_VM_set_of_rpc
+ with
+ parse_error -> raise Api_errors.(Server_error (field_type_error, [Printexc.to_string parse_error]))
end
)
(fun () -> Client.Task.destroy rpc session_id remote_task )
diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml
index 280eb757139..60f0923ee31 100644
--- a/ocaml/xapi/message_forwarding.ml
+++ b/ocaml/xapi/message_forwarding.ml
@@ -336,6 +336,12 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
Ref.string_of bond
with _ -> "invalid"
+ let network_sriov_uuid ~__context sriov =
+ try if Pool_role.is_master () then
+ Db.Network_sriov.get_uuid __context sriov
+ else
+ Ref.string_of sriov
+ with _ -> "invalid"
let pif_uuid ~__context pif =
try if Pool_role.is_master () then
@@ -834,6 +840,15 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
~value:Ref.null)
(Db.VM.get_VGPUs ~__context ~self:vm)
+ let clear_reserved_netsriov_vfs_on ~__context ~vm =
+ Db.VM.get_VIFs ~__context ~self:vm
+ |> List.iter (fun vif ->
+ let vf = Db.VIF.get_reserved_pci ~__context ~self:vif in
+ Db.VIF.set_reserved_pci ~__context ~self:vif ~value:Ref.null;
+ if Db.is_valid_ref __context vf
+ then Db.PCI.set_scheduled_to_be_attached_to ~__context ~self:vf ~value:Ref.null
+ )
+
(* Notes on memory checking/reservation logic:
When computing the hosts free memory we consider all VMs resident_on (ie running
and consuming resources NOW) and scheduled_to_be_resident_on (ie those which are
@@ -860,8 +875,10 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
try
Vgpuops.create_vgpus ~__context host (vm, snapshot)
(Helpers.will_have_qemu ~__context ~self:vm);
+ Xapi_network_sriov_helpers.reserve_sriov_vfs ~__context ~host ~vm
with e ->
clear_scheduled_to_be_resident_on ~__context ~vm;
+ clear_reserved_netsriov_vfs_on ~__context ~vm;
raise e
(* For start/start_on/resume/resume_on/migrate *)
@@ -1683,7 +1700,7 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
info "VM.migrate_send: VM = '%s'" (vm_uuid ~__context vm);
let local_fn = Local.VM.migrate_send ~vm ~dest ~live ~vdi_map ~vif_map ~vgpu_map ~options in
let forwarder =
- if Xapi_vm_lifecycle.is_live ~__context ~self:vm then
+ if Xapi_vm_lifecycle_helpers.is_live ~__context ~self:vm then
let host = List.assoc Xapi_vm_migrate._host dest |> Ref.of_string in
if Db.is_valid_ref __context host then
(* Intra-pool: reserve resources on the destination host, then
@@ -3575,7 +3592,7 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
VM.with_vm_operation ~__context ~self:vm ~doc:"VDI.pool_migrate" ~op:`migrate_send
(fun () ->
let snapshot, host =
- if Xapi_vm_lifecycle.is_live ~__context ~self:vm then
+ if Xapi_vm_lifecycle_helpers.is_live ~__context ~self:vm then
(Db.VM.get_record ~__context ~self:vm,
Db.VM.get_resident_on ~__context ~self:vm)
else
@@ -4253,6 +4270,25 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
Local.VUSB.destroy ~__context ~self
end
+ module Network_sriov = struct
+ let create ~__context ~pif ~network =
+ info "Network_sriov.create : pif = '%s' , network = '%s' " (pif_uuid ~__context pif) (network_uuid ~__context network);
+ let local_fn = Local.Network_sriov.create ~pif ~network in
+ let host = Db.PIF.get_host ~__context ~self:pif in
+ do_op_on ~__context ~local_fn ~host (fun session_id rpc -> Client.Network_sriov.create rpc session_id pif network)
+
+ let destroy ~__context ~self =
+ info "Network_sriov.destroy : network_sriov = '%s'" (network_sriov_uuid ~__context self);
+ let local_fn = Local.Network_sriov.destroy ~self in
+ let physical_pif = Db.Network_sriov.get_physical_PIF ~__context ~self in
+ let host = Db.PIF.get_host ~__context ~self:physical_pif in
+ do_op_on ~__context ~local_fn ~host (fun session_id rpc -> Client.Network_sriov.destroy rpc session_id self)
+
+ let get_remaining_capacity ~__context ~self =
+ info "Network_sriov.get_remaining_capacity : network_sriov = '%s'" (network_sriov_uuid ~__context self);
+ Local.Network_sriov.get_remaining_capacity ~__context ~self
+ end
+
module Cluster = struct
let create ~__context ~network ~cluster_stack ~pool_auto_join ~token_timeout ~token_timeout_coefficient =
info "Cluster.create";
diff --git a/ocaml/xapi/nm.ml b/ocaml/xapi/nm.ml
index 1fa34c7f7bf..ceca85a2b0c 100644
--- a/ocaml/xapi/nm.ml
+++ b/ocaml/xapi/nm.ml
@@ -217,35 +217,6 @@ let destroy_vlan ~__context vlan =
in
[bridge, false]
-let get_bond pif_rc =
- match pif_rc.API.pIF_bond_master_of with
- | [] -> None
- | bond :: _ ->
- Some bond
-
-let get_vlan pif_rc =
- if pif_rc.API.pIF_VLAN_master_of = Ref.null then
- None
- else
- Some pif_rc.API.pIF_VLAN_master_of
-
-let get_tunnel pif_rc =
- if pif_rc.API.pIF_tunnel_access_PIF_of = [] then
- None
- else
- Some (List.hd pif_rc.API.pIF_tunnel_access_PIF_of)
-
-let get_pif_type pif_rc =
- match get_vlan pif_rc with
- | Some vlan -> `vlan_pif vlan
- | None ->
- match get_bond pif_rc with
- | Some bond -> `bond_pif bond
- | None ->
- match get_tunnel pif_rc with
- | Some tunnel -> `tunnel_pif tunnel
- | None -> `phy_pif
-
let linux_pif_config pif_type pif_rc properties mtu persistent =
(* If we are using linux bridge rather than OVS, then we need to
* configure the "pif" that represents the vlan or bond.
@@ -264,13 +235,14 @@ let rec create_bridges ~__context pif_rc net_rc =
let other_config = determine_other_config ~__context pif_rc net_rc in
let persistent = is_dom0_interface pif_rc in
let igmp_snooping = Some (Db.Pool.get_igmp_snooping_enabled ~__context ~self:(Helpers.get_pool ~__context)) in
+ let open Xapi_pif_helpers in
match get_pif_type pif_rc with
- | `tunnel_pif _ ->
+ | Tunnel_access _ ->
[],
[net_rc.API.network_bridge, {default_bridge with bridge_mac=(Some pif_rc.API.pIF_MAC);
igmp_snooping; other_config; persistent_b=persistent}],
[]
- | `vlan_pif vlan ->
+ | VLAN_untagged vlan ->
let original_pif_rc = pif_rc in
let slave = Db.VLAN.get_tagged_PIF ~__context ~self:vlan in
let pif_rc = Db.PIF.get_record ~__context ~self:slave in
@@ -283,14 +255,14 @@ let rec create_bridges ~__context pif_rc net_rc =
cleanup,
create_vlan ~__context vlan persistent @ bridge_config,
interface_config
- | `bond_pif bond ->
+ | Bond_master bond ->
let cleanup, bridge_config, interface_config = create_bond ~__context bond mtu persistent in
let interface_config = (* Add configuration for the bond pif itself *)
linux_pif_config `bond_pif pif_rc pif_rc.API.pIF_properties mtu persistent
:: interface_config
in
cleanup, bridge_config, interface_config
- | `phy_pif ->
+ | Physical _ ->
let cleanup =
if pif_rc.API.pIF_bond_slave_of <> Ref.null then
destroy_bond ~__context ~force:true pif_rc.API.pIF_bond_slave_of
@@ -304,12 +276,15 @@ let rec create_bridges ~__context pif_rc net_rc =
[net_rc.API.network_bridge, {default_bridge with ports; bridge_mac=(Some pif_rc.API.pIF_MAC);
igmp_snooping; other_config; persistent_b=persistent}],
[pif_rc.API.pIF_device, {default_interface with mtu; ethtool_settings; ethtool_offload; persistent_i=persistent}]
+ | Network_sriov_logical _ ->
+ raise Api_errors.(Server_error (internal_error, ["Should not create bridge for SRIOV logical PIF"]))
let rec destroy_bridges ~__context ~force pif_rc bridge =
+ let open Xapi_pif_helpers in
match get_pif_type pif_rc with
- | `tunnel_pif _ ->
+ | Tunnel_access _ ->
[bridge, false]
- | `vlan_pif vlan ->
+ | VLAN_untagged vlan ->
let cleanup = destroy_vlan ~__context vlan in
let slave = Db.VLAN.get_tagged_PIF ~__context ~self:vlan in
let rc = Db.PIF.get_record ~__context ~self:slave in
@@ -318,10 +293,12 @@ let rec destroy_bridges ~__context ~force pif_rc bridge =
(destroy_bridges ~__context ~force rc bridge) @ cleanup
else
cleanup
- | `bond_pif bond ->
+ | Bond_master bond ->
destroy_bond ~__context ~force bond
- | `phy_pif ->
+ | Physical _ ->
[bridge, false]
+ | Network_sriov_logical _ ->
+ raise Api_errors.(Server_error (internal_error, ["Should not destroy bridge for SRIOV logical PIF"]))
let determine_static_routes net_rc =
if List.mem_assoc "static-routes" net_rc.API.network_other_config then
@@ -334,171 +311,185 @@ let determine_static_routes net_rc =
let bring_pif_up ~__context ?(management_interface=false) (pif: API.ref_PIF) =
with_local_lock (fun () ->
- let dbg = Context.string_of_task __context in
let rc = Db.PIF.get_record ~__context ~self:pif in
- let net_rc = Db.Network.get_record ~__context ~self:rc.API.pIF_network in
- let bridge = net_rc.API.network_bridge in
-
- (* Call networkd even if currently_attached is false, just to update its state *)
- debug "Making sure that PIF %s is up" rc.API.pIF_uuid;
-
- let old_ip = try Net.Interface.get_ipv4_addr dbg bridge with _ -> [] in
-
- (* If the PIF is a bond master, the bond slaves will now go down *)
- (* Interface-reconfigure in bridge mode requires us to set currently_attached to false here *)
- begin match rc.API.pIF_bond_master_of with
- | [] -> ()
- | bond :: _ ->
- let slaves = Db.Bond.get_slaves ~__context ~self:bond in
- List.iter (fun self -> Db.PIF.set_currently_attached ~__context ~self ~value:false) slaves
- end;
-
- Network.transform_networkd_exn pif (fun () ->
- let persistent = is_dom0_interface rc in
- let gateway_if, dns_if = Helpers.determine_gateway_and_dns_ifs ~__context
- ?management_interface:(if management_interface then Some pif else None) () in
- Opt.iter (fun (_, name) -> Net.set_gateway_interface dbg name) gateway_if;
- Opt.iter (fun (_, name) -> Net.set_dns_interface dbg name) dns_if;
-
- (* Setup network infrastructure *)
- let cleanup, bridge_config, interface_config = create_bridges ~__context rc net_rc in
- List.iter (fun (name, force) -> Net.Bridge.destroy dbg force name) cleanup;
- Net.Bridge.make_config dbg false bridge_config;
- Net.Interface.make_config dbg false interface_config;
-
- (* Configure IPv4 parameters and DNS *)
- let ipv4_conf, ipv4_gateway, dns =
- match rc.API.pIF_ip_configuration_mode with
- | `None -> None4, None, ([], [])
- | `DHCP -> DHCP4, None, ([], [])
- | `Static ->
- let conf = (Static4 [
- Unix.inet_addr_of_string rc.API.pIF_IP,
- netmask_to_prefixlen rc.API.pIF_netmask]) in
- let gateway =
- if rc.API.pIF_gateway <> "" then
- Some (Unix.inet_addr_of_string rc.API.pIF_gateway)
- else
- None in
- let dns =
- if rc.API.pIF_DNS <> "" then begin
- let nameservers = List.map Unix.inet_addr_of_string (String.split ',' rc.API.pIF_DNS) in
- let domains =
- if List.mem_assoc "domain" rc.API.pIF_other_config then
- let domains = List.assoc "domain" rc.API.pIF_other_config in
- try
- String.split ',' domains
- with _ ->
- warn "Invalid DNS search domains: %s" domains;
+ let open Xapi_pif_helpers in
+ match get_pif_topo ~__context ~pif_rec:rc with
+ | Network_sriov_logical _ :: _ ->
+ Xapi_network_sriov_helpers.sriov_bring_up ~__context ~self:pif
+ | VLAN_untagged _ :: Network_sriov_logical sriov :: _ ->
+ let sriov_logical_pif = Db.Network_sriov.get_logical_PIF ~__context ~self:sriov in
+ let currently_attached = Db.PIF.get_currently_attached ~__context ~self:sriov_logical_pif in
+ Db.PIF.set_currently_attached ~__context ~self:pif ~value:currently_attached
+ | _ ->
+ let dbg = Context.string_of_task __context in
+ let net_rc = Db.Network.get_record ~__context ~self:rc.API.pIF_network in
+ let bridge = net_rc.API.network_bridge in
+
+ (* Call networkd even if currently_attached is false, just to update its state *)
+ debug "Making sure that PIF %s is up" rc.API.pIF_uuid;
+
+ let old_ip = try Net.Interface.get_ipv4_addr dbg bridge with _ -> [] in
+
+ (* If the PIF is a bond master, the bond slaves will now go down *)
+ (* Interface-reconfigure in bridge mode requires us to set currently_attached to false here *)
+ begin match rc.API.pIF_bond_master_of with
+ | [] -> ()
+ | bond :: _ ->
+ let slaves = Db.Bond.get_slaves ~__context ~self:bond in
+ List.iter (fun self -> Db.PIF.set_currently_attached ~__context ~self ~value:false) slaves
+ end;
+
+ Network.transform_networkd_exn pif (fun () ->
+ let persistent = is_dom0_interface rc in
+ let gateway_if, dns_if = Helpers.determine_gateway_and_dns_ifs ~__context
+ ?management_interface:(if management_interface then Some pif else None) () in
+ Opt.iter (fun (_, name) -> Net.set_gateway_interface dbg name) gateway_if;
+ Opt.iter (fun (_, name) -> Net.set_dns_interface dbg name) dns_if;
+
+ (* Setup network infrastructure *)
+ let cleanup, bridge_config, interface_config = create_bridges ~__context rc net_rc in
+ List.iter (fun (name, force) -> Net.Bridge.destroy dbg force name) cleanup;
+ Net.Bridge.make_config dbg false bridge_config;
+ Net.Interface.make_config dbg false interface_config;
+
+ (* Configure IPv4 parameters and DNS *)
+ let ipv4_conf, ipv4_gateway, dns =
+ match rc.API.pIF_ip_configuration_mode with
+ | `None -> None4, None, ([], [])
+ | `DHCP -> DHCP4, None, ([], [])
+ | `Static ->
+ let conf = (Static4 [
+ Unix.inet_addr_of_string rc.API.pIF_IP,
+ netmask_to_prefixlen rc.API.pIF_netmask]) in
+ let gateway =
+ if rc.API.pIF_gateway <> "" then
+ Some (Unix.inet_addr_of_string rc.API.pIF_gateway)
+ else
+ None in
+ let dns =
+ if rc.API.pIF_DNS <> "" then begin
+ let nameservers = List.map Unix.inet_addr_of_string (String.split ',' rc.API.pIF_DNS) in
+ let domains =
+ if List.mem_assoc "domain" rc.API.pIF_other_config then
+ let domains = List.assoc "domain" rc.API.pIF_other_config in
+ try
+ String.split ',' domains
+ with _ ->
+ warn "Invalid DNS search domains: %s" domains;
+ []
+ else
[]
- else
- []
- in
- nameservers, domains
- end else
- [], []
- in
- conf, gateway, dns
- in
- let ipv4_routes = determine_static_routes net_rc in
-
- (* Configure IPv6 parameters *)
- let ipv6_conf, ipv6_gateway =
- match rc.API.pIF_ipv6_configuration_mode with
- | `None -> Linklocal6, None
- | `DHCP -> DHCP6, None
- | `Autoconf -> Autoconf6, None
- | `Static ->
- let addresses = List.filter_map (fun addr_and_prefixlen ->
- try
- let n = String.index addr_and_prefixlen '/' in
- let addr = Unix.inet_addr_of_string (String.sub addr_and_prefixlen 0 n) in
- let prefixlen = int_of_string (String.sub_to_end addr_and_prefixlen (n + 1)) in
- Some (addr, prefixlen)
- with _ -> None
- ) rc.API.pIF_IPv6 in
- let conf = Static6 addresses in
- let gateway =
- if rc.API.pIF_ipv6_gateway <> "" then
- Some (Unix.inet_addr_of_string rc.API.pIF_ipv6_gateway)
- else
- None in
- conf, gateway
- in
-
- let mtu = determine_mtu rc net_rc in
- let (ethtool_settings, ethtool_offload) =
- determine_ethtool_settings rc.API.pIF_properties net_rc.API.network_other_config in
- let interface_config = [bridge, {ipv4_conf; ipv4_gateway; ipv6_conf; ipv6_gateway;
- ipv4_routes; dns; ethtool_settings; ethtool_offload; mtu; persistent_i=persistent}] in
- Net.Interface.make_config dbg false interface_config
- );
-
- let new_ip = try Net.Interface.get_ipv4_addr dbg bridge with _ -> [] in
- if new_ip <> old_ip then begin
- warn "An IP address of dom0 was changed";
- warn "About to kill idle client stunnels";
- (* The master_connection would otherwise try to take a broken stunnel from the cache *)
- Stunnel_cache.flush ();
- warn "About to forcibly reset the master connection";
- Master_connection.force_connection_reset ()
- end;
-
- if rc.API.pIF_currently_attached = false || management_interface then begin
- if management_interface then begin
- warn "About to kill active client stunnels";
- let stunnels =
- let all = Locking_helpers.Thread_state.get_all_acquired_resources () in
- debug "There are %d allocated resources" (List.length all);
- List.filter (function Locking_helpers.Process("stunnel", _) -> true | _ -> false) all in
- debug "Of which %d are stunnels" (List.length stunnels);
- List.iter Locking_helpers.kill_resource stunnels;
+ in
+ nameservers, domains
+ end else
+ [], []
+ in
+ conf, gateway, dns
+ in
+ let ipv4_routes = determine_static_routes net_rc in
+
+ (* Configure IPv6 parameters *)
+ let ipv6_conf, ipv6_gateway =
+ match rc.API.pIF_ipv6_configuration_mode with
+ | `None -> Linklocal6, None
+ | `DHCP -> DHCP6, None
+ | `Autoconf -> Autoconf6, None
+ | `Static ->
+ let addresses = List.filter_map (fun addr_and_prefixlen ->
+ try
+ let n = String.index addr_and_prefixlen '/' in
+ let addr = Unix.inet_addr_of_string (String.sub addr_and_prefixlen 0 n) in
+ let prefixlen = int_of_string (String.sub_to_end addr_and_prefixlen (n + 1)) in
+ Some (addr, prefixlen)
+ with _ -> None
+ ) rc.API.pIF_IPv6 in
+ let conf = Static6 addresses in
+ let gateway =
+ if rc.API.pIF_ipv6_gateway <> "" then
+ Some (Unix.inet_addr_of_string rc.API.pIF_ipv6_gateway)
+ else
+ None in
+ conf, gateway
+ in
+
+ let mtu = determine_mtu rc net_rc in
+ let (ethtool_settings, ethtool_offload) =
+ determine_ethtool_settings rc.API.pIF_properties net_rc.API.network_other_config in
+ let interface_config = [bridge, {ipv4_conf; ipv4_gateway; ipv6_conf; ipv6_gateway;
+ ipv4_routes; dns; ethtool_settings; ethtool_offload; mtu; persistent_i=persistent}] in
+ Net.Interface.make_config dbg false interface_config
+ );
+
+ let new_ip = try Net.Interface.get_ipv4_addr dbg bridge with _ -> [] in
+ if new_ip <> old_ip then begin
+ warn "An IP address of dom0 was changed";
+ warn "About to kill idle client stunnels";
+ (* The master_connection would otherwise try to take a broken stunnel from the cache *)
+ Stunnel_cache.flush ();
+ warn "About to forcibly reset the master connection";
+ Master_connection.force_connection_reset ()
end;
- Db.PIF.set_currently_attached ~__context ~self:pif ~value:true;
+ if rc.API.pIF_currently_attached = false || management_interface then begin
+ if management_interface then begin
+ warn "About to kill active client stunnels";
+ let stunnels =
+ let all = Locking_helpers.Thread_state.get_all_acquired_resources () in
+ debug "There are %d allocated resources" (List.length all);
+ List.filter (function Locking_helpers.Process("stunnel", _) -> true | _ -> false) all in
+ debug "Of which %d are stunnels" (List.length stunnels);
+ List.iter Locking_helpers.kill_resource stunnels;
+ end;
+
+ Db.PIF.set_currently_attached ~__context ~self:pif ~value:true;
+
+ (* If the PIF is a bond slave, the bond master will now be down *)
+ begin match rc.API.pIF_bond_slave_of with
+ | bond when bond = Ref.null -> ()
+ | bond ->
+ let master = Db.Bond.get_master ~__context ~self:bond in
+ Db.PIF.set_currently_attached ~__context ~self:master ~value:false
+ end;
+ Xapi_mgmt_iface.on_dom0_networking_change ~__context
+ end;
- (* If the PIF is a bond slave, the bond master will now be down *)
- begin match rc.API.pIF_bond_slave_of with
- | bond when bond = Ref.null -> ()
- | bond ->
- let master = Db.Bond.get_master ~__context ~self:bond in
- Db.PIF.set_currently_attached ~__context ~self:master ~value:false
+ (* sync MTU *)
+ begin
+ try
+ let mtu = Int64.of_int (Net.Interface.get_mtu dbg bridge) in
+ if mtu <> rc.API.pIF_MTU then
+ Db.PIF.set_MTU ~__context ~self:pif ~value:mtu
+ with _ ->
+ warn "could not update MTU field on PIF %s" rc.API.pIF_uuid
end;
- Xapi_mgmt_iface.on_dom0_networking_change ~__context
- end;
-
- (* sync MTU *)
- begin
- try
- let mtu = Int64.of_int (Net.Interface.get_mtu dbg bridge) in
- if mtu <> rc.API.pIF_MTU then
- Db.PIF.set_MTU ~__context ~self:pif ~value:mtu
- with _ ->
- warn "could not update MTU field on PIF %s" rc.API.pIF_uuid
- end;
-
- (* sync igmp_snooping_enabled *)
- if rc.API.pIF_VLAN = -1L then begin
- let igmp_snooping = Db.Pool.get_igmp_snooping_enabled ~__context ~self:(Helpers.get_pool ~__context) in
- let igmp_snooping' = if igmp_snooping then `enabled else `disabled in
- if igmp_snooping' <> rc.API.pIF_igmp_snooping_status then
- Db.PIF.set_igmp_snooping_status ~__context ~self:pif ~value:igmp_snooping'
- end
- )
+
+ (* sync igmp_snooping_enabled *)
+ if rc.API.pIF_VLAN = -1L then begin
+ let igmp_snooping = Db.Pool.get_igmp_snooping_enabled ~__context ~self:(Helpers.get_pool ~__context) in
+ let igmp_snooping' = if igmp_snooping then `enabled else `disabled in
+ if igmp_snooping' <> rc.API.pIF_igmp_snooping_status then
+ Db.PIF.set_igmp_snooping_status ~__context ~self:pif ~value:igmp_snooping'
+ end
+ )
let bring_pif_down ~__context ?(force=false) (pif: API.ref_PIF) =
with_local_lock (fun () ->
- Network.transform_networkd_exn pif (fun () ->
- let dbg = Context.string_of_task __context in
- let rc = Db.PIF.get_record ~__context ~self:pif in
- debug "Making sure that PIF %s down" rc.API.pIF_uuid;
-
- let bridge = Db.Network.get_bridge ~__context ~self:rc.API.pIF_network in
- let cleanup = destroy_bridges ~__context ~force rc bridge in
- List.iter (fun (name, force) -> Net.Bridge.destroy dbg force name) cleanup;
- Net.Interface.set_persistent dbg bridge false;
-
- Db.PIF.set_currently_attached ~__context ~self:pif ~value:false
- )
+ let rc = Db.PIF.get_record ~__context ~self:pif in
+ let open Xapi_pif_helpers in
+ match get_pif_topo ~__context ~pif_rec:rc with
+ | Network_sriov_logical _ :: _ ->
+ Xapi_network_sriov_helpers.sriov_bring_down ~__context ~self:pif
+ | VLAN_untagged _ :: Network_sriov_logical _ :: _ ->
+ Db.PIF.set_currently_attached ~__context ~self:pif ~value:false
+ | _ ->
+ Network.transform_networkd_exn pif (fun () ->
+ let dbg = Context.string_of_task __context in
+ debug "Making sure that PIF %s down" rc.API.pIF_uuid;
+
+ let bridge = Db.Network.get_bridge ~__context ~self:rc.API.pIF_network in
+ let cleanup = destroy_bridges ~__context ~force rc bridge in
+ List.iter (fun (name, force) -> Net.Bridge.destroy dbg force name) cleanup;
+ Net.Interface.set_persistent dbg bridge false;
+ Db.PIF.set_currently_attached ~__context ~self:pif ~value:false
+ )
)
-
diff --git a/ocaml/xapi/record_util.ml b/ocaml/xapi/record_util.ml
index 0ddbb85cf7e..a06bccd999a 100644
--- a/ocaml/xapi/record_util.ml
+++ b/ocaml/xapi/record_util.ml
@@ -527,6 +527,11 @@ let vusb_operation_to_string = function
| `plug -> "plug"
| `unplug -> "unplug"
+let network_sriov_configuration_mode_to_string = function
+ | `sysfs -> "sysfs"
+ | `modprobe -> "modprobe"
+ | `unknown -> "unknown"
+
(* string_to_string_map_to_string *)
let s2sm_to_string sep x =
String.concat sep (List.map (fun (a,b) -> a^": "^b) x)
diff --git a/ocaml/xapi/records.ml b/ocaml/xapi/records.ml
index 23676784dde..ef36c887aa6 100644
--- a/ocaml/xapi/records.ml
+++ b/ocaml/xapi/records.ml
@@ -213,6 +213,23 @@ let message_record rpc session_id message =
]
}
+let network_sriov_record rpc session_id network_sriov =
+ let _ref = ref network_sriov in
+ let empty_record = ToGet (fun () -> Client.Network_sriov.get_record rpc session_id !_ref) in
+ let record = ref empty_record in
+ let x () = lzy_get record 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.network_sriov_uuid) ();
+ make_field ~name:"physical-PIF" ~get:(fun () -> get_uuid_from_ref (x ()).API.network_sriov_physical_PIF) ();
+ make_field ~name:"logical-PIF" ~get:(fun () -> get_uuid_from_ref (x ()).API.network_sriov_logical_PIF) ();
+ make_field ~name:"requires-reboot" ~get:(fun () -> string_of_bool (x ()).API.network_sriov_requires_reboot) ();
+ make_field ~name:"remaining-capacity" ~get:(fun () -> try Int64.to_string (Client.Network_sriov.get_remaining_capacity rpc session_id network_sriov) with _ -> "") ~expensive:true ();
+ ]}
let pif_record rpc session_id pif =
let _ref = ref pif in
@@ -238,6 +255,8 @@ let pif_record rpc session_id pif =
make_field ~name:"VLAN" ~get:(fun () -> (Int64.to_string (x ()).API.pIF_VLAN)) ();
make_field ~name:"bond-master-of" ~get:(fun () -> String.concat "; " (List.map (fun pif -> get_uuid_from_ref pif) (x ()).API.pIF_bond_master_of)) ();
make_field ~name:"bond-slave-of" ~get:(fun () -> get_uuid_from_ref (x ()).API.pIF_bond_slave_of) ();
+ make_field ~name:"sriov-physical-PIF-of" ~get:(fun () -> String.concat ";" (List.map get_uuid_from_ref (x ()).API.pIF_sriov_physical_PIF_of)) ();
+ make_field ~name:"sriov-logical-PIF-of" ~get:(fun () -> String.concat ";" (List.map get_uuid_from_ref (x ()).API.pIF_sriov_logical_PIF_of)) ();
make_field ~name:"tunnel-access-PIF-of" ~get:(fun () -> String.concat "; " (List.map (fun pif -> get_uuid_from_ref pif) (x ()).API.pIF_tunnel_access_PIF_of)) ();
make_field ~name:"tunnel-transport-PIF-of" ~get:(fun () -> String.concat "; " (List.map (fun pif -> get_uuid_from_ref pif) (x ()).API.pIF_tunnel_transport_PIF_of)) ();
make_field ~name:"management" ~get:(fun () -> string_of_bool ((x ()).API.pIF_management)) ();
diff --git a/ocaml/xapi/sync_networking.ml b/ocaml/xapi/sync_networking.ml
index 80e9e0f0548..baccdd7b956 100644
--- a/ocaml/xapi/sync_networking.ml
+++ b/ocaml/xapi/sync_networking.ml
@@ -161,3 +161,50 @@ let copy_tunnels_from_master ~__context () =
let host = !Xapi_globs.localhost_ref in
Helpers.call_api_functions ~__context (fun rpc session_id -> Client.Host.sync_tunnels ~rpc ~session_id ~host)
+(** Copy network-sriovs from master *)
+let copy_network_sriovs_from_master ~__context () =
+ let me = !Xapi_globs.localhost_ref in
+ let master = Helpers.get_master ~__context in
+ let master_sriov_pifs = Db.PIF.get_records_where ~__context ~expr:(And (
+ Eq (Field "host", Literal (Ref.string_of master)),
+ Not (Eq (Field "sriov_logical_PIF_of", Literal "()"))
+ )) in
+ let my_sriov_pifs = Db.PIF.get_records_where ~__context ~expr:(And (
+ Eq (Field "host", Literal (Ref.string_of me)),
+ Not (Eq (Field "sriov_logical_PIF_of", Literal "()"))
+ )) in
+ let my_physical_pifs = Db.PIF.get_records_where ~__context ~expr:(And (
+ Eq (Field "host", Literal (Ref.string_of me)),
+ Eq (Field "physical", Literal "true")
+ )) in
+
+ debug "Resynchronising network-sriovs";
+ let maybe_create_sriov_for_me (master_pif_ref, master_pif_rec) =
+ let sriov_network = master_pif_rec.API.pIF_network in
+ let existing_pif = List.filter (fun (_, slave_pif_rec) ->
+ slave_pif_rec.API.pIF_network = sriov_network
+ ) my_sriov_pifs in
+ if existing_pif = [] then begin
+ let device = master_pif_rec.API.pIF_device in
+ let pifs = List.filter (fun (_, pif_rec) -> pif_rec.API.pIF_device = device) my_physical_pifs in
+ match pifs with
+ | [] ->
+ info "Cannot sync network sriov because cannot find PIF whose device name is %s" device
+ | (pif_ref, pif_rec) :: _ ->
+ begin
+ try
+ Xapi_network_sriov.create ~__context ~pif:pif_ref ~network:sriov_network |> ignore
+ with
+ | Api_errors.Server_error (err, _) when err = Api_errors.network_has_incompatible_sriov_pifs ->
+ warn "Cannot sync network sriov on slave because PCI device of %s is different from the PIF of master in the same position" pif_rec.API.pIF_uuid
+ | Api_errors.Server_error (err, _) when err = Api_errors.network_sriov_already_enabled ->
+ warn "Cannot sync network sriov on slave because PIF %s on slave has enabled sriov in another network" pif_rec.API.pIF_uuid
+ | Api_errors.Server_error (err, _) when err = Api_errors.pif_is_not_sriov_capable ->
+ warn "Cannot sync network sriov on slave because PIF %s on slave is not sriov capable" pif_rec.API.pIF_uuid
+ | exn ->
+ error "Error occurs when syncing network sriov for PIF %s: %s" pif_rec.API.pIF_uuid (Printexc.to_string exn)
+ end
+ end
+ in
+ List.iter (Helpers.log_exn_continue "resynchronising network sriov on slave"
+ maybe_create_sriov_for_me) master_sriov_pifs
diff --git a/ocaml/xapi/sync_networking.mli b/ocaml/xapi/sync_networking.mli
index 27b3e8a38c5..1fb559ede0b 100644
--- a/ocaml/xapi/sync_networking.mli
+++ b/ocaml/xapi/sync_networking.mli
@@ -19,3 +19,4 @@ val fix_bonds : __context:Context.t -> unit -> unit
val copy_bonds_from_master : __context:Context.t -> unit -> unit
val copy_vlans_from_master : __context:Context.t -> unit -> unit
val copy_tunnels_from_master : __context:Context.t -> unit -> unit
+val copy_network_sriovs_from_master : __context:Context.t -> unit -> unit
diff --git a/ocaml/xapi/vm_evacuation.ml b/ocaml/xapi/vm_evacuation.ml
index 6cd62498f95..b1754db6711 100644
--- a/ocaml/xapi/vm_evacuation.ml
+++ b/ocaml/xapi/vm_evacuation.ml
@@ -92,7 +92,7 @@ let ensure_no_vms ~__context ~rpc ~session_id ~evacuate_timeout =
(* We can unplug the PBD if a VM is suspended or halted, but not if
* it is running or paused, i.e. "live" *)
vms
- |> List.filter (fun self -> Xapi_vm_lifecycle.is_live ~__context ~self)
+ |> List.filter (fun self -> Xapi_vm_lifecycle_helpers.is_live ~__context ~self)
|> hard_shutdown
in
diff --git a/ocaml/xapi/xapi.ml b/ocaml/xapi/xapi.ml
index 71f4fbaa9e5..d44fcf162bc 100644
--- a/ocaml/xapi/xapi.ml
+++ b/ocaml/xapi/xapi.ml
@@ -909,7 +909,7 @@ let server_init() =
"creating networks", [ Startup.OnlyMaster ], Create_networks.create_networks_localhost;
(* CA-22417: bring up all non-bond slaves so that the SM backends can use storage NIC IP addresses (if the routing
table happens to be right) *)
- "Best-effort bring up of physical NICs", [ Startup.NoExnRaising ], Xapi_pif.start_of_day_best_effort_bring_up;
+ "Best-effort bring up of physical and sriov NICs", [ Startup.NoExnRaising ], Xapi_pif.start_of_day_best_effort_bring_up;
"Create any necessary cluster_host objects", [ Startup.NoExnRaising ], (fun () -> Xapi_cluster_host.create_as_necessary __context (Helpers.get_localhost ~__context));
"updating the vswitch controller", [], (fun () -> Helpers.update_vswitch_controller ~__context ~host:(Helpers.get_localhost ~__context));
"initialising storage", [ Startup.NoExnRaising ],
@@ -920,6 +920,7 @@ let server_init() =
"watching networks for NBD-related changes", [Startup.OnThread], Network_event_loop.watch_networks_for_nbd_changes;
(* CA-175353: moving VIFs between networks requires VMs to be resynced *)
"Synchronising bonds on slave with master", [Startup.OnlySlave; Startup.NoExnRaising], Sync_networking.copy_bonds_from_master ~__context;
+ "Synchronising network sriovs on slave with master", [Startup.OnlySlave; Startup.NoExnRaising], Sync_networking.copy_network_sriovs_from_master ~__context;
"Synchronising VLANs on slave with master", [Startup.OnlySlave; Startup.NoExnRaising], Sync_networking.copy_vlans_from_master ~__context;
"Synchronising tunnels on slave with master", [Startup.OnlySlave; Startup.NoExnRaising], Sync_networking.copy_tunnels_from_master ~__context;
diff --git a/ocaml/xapi/xapi_bond.ml b/ocaml/xapi/xapi_bond.ml
index 549d06c3a98..2a3247e93c4 100644
--- a/ocaml/xapi/xapi_bond.ml
+++ b/ocaml/xapi/xapi_bond.ml
@@ -261,6 +261,7 @@ let create ~__context ~network ~members ~mAC ~mode ~properties =
Xapi_network.assert_network_is_managed ~__context ~self:network;
let host = Db.PIF.get_host ~__context ~self:(List.hd members) in
Xapi_pif.assert_no_other_local_pifs ~__context ~host ~network;
+ Xapi_network_helpers.assert_network_compatible_with_bond ~__context ~network;
(* Validate MAC parameter; note an empty string is OK here, since that means 'inherit MAC from
* primary slave PIF' (see below) *)
@@ -334,19 +335,11 @@ let create ~__context ~network ~members ~mAC ~mode ~properties =
(* 7. Members must have the same PIF properties *)
(* 8. Only the primary PIF should have a non-None IP configuration *)
List.iter (fun self ->
- let bond = Db.PIF.get_bond_slave_of ~__context ~self in
- let bonded = try ignore(Db.Bond.get_uuid ~__context ~self:bond); true with _ -> false in
- if bonded
- then raise (Api_errors.Server_error (Api_errors.pif_already_bonded, [ Ref.string_of self ]));
- if Db.PIF.get_VLAN ~__context ~self <> -1L
- then raise (Api_errors.Server_error (Api_errors.pif_vlan_exists, [ Db.PIF.get_device_name ~__context ~self] ));
- if Db.PIF.get_tunnel_access_PIF_of ~__context ~self <> []
- then raise (Api_errors.Server_error (Api_errors.is_tunnel_access_pif, [Ref.string_of self]));
+ Xapi_pif_helpers.assert_pif_is_managed ~__context ~self;
+ Xapi_pif_helpers.bond_is_allowed_on_pif ~__context ~self;
let pool = Helpers.get_pool ~__context in
if Db.Pool.get_ha_enabled ~__context ~self:pool && Db.PIF.get_management ~__context ~self
then raise (Api_errors.Server_error(Api_errors.ha_cannot_change_bond_status_of_mgmt_iface, []));
- if Db.PIF.get_managed ~__context ~self <> true
- then raise (Api_errors.Server_error (Api_errors.pif_unmanaged, [Ref.string_of self]));
) members;
let hosts = List.map (fun self -> Db.PIF.get_host ~__context ~self) members in
if List.length (List.setify hosts) <> 1
@@ -376,7 +369,7 @@ let create ~__context ~network ~members ~mAC ~mode ~properties =
~ip_configuration_mode:`None ~iP:"" ~netmask:"" ~gateway:"" ~dNS:"" ~bond_slave_of:Ref.null
~vLAN_master_of:Ref.null ~management:false ~other_config:[] ~disallow_unplug:false
~ipv6_configuration_mode:`None ~iPv6:[""] ~ipv6_gateway:"" ~primary_address_type:`IPv4 ~managed:true
- ~properties:pif_properties ~capabilities:[];
+ ~properties:pif_properties ~capabilities:[] ~pCI:Ref.null;
Db.Bond.create ~__context ~ref:bond ~uuid:(Uuid.to_string (Uuid.make_uuid ())) ~master:master ~other_config:[]
~primary_slave ~mode ~properties ~links_up:0L;
diff --git a/ocaml/xapi/xapi_fist.ml b/ocaml/xapi/xapi_fist.ml
index 0d7d871b585..2f210f2d042 100644
--- a/ocaml/xapi/xapi_fist.ml
+++ b/ocaml/xapi/xapi_fist.ml
@@ -60,9 +60,6 @@ let simulate_restart_failure () = fistpoint "simulate_restart_failure"
(** Throw an error in the failed VM restart logic when trying to compute a plan (it should fall back to best-effort) *)
let simulate_planner_failure () = fistpoint "simulate_planner_failure"
-(** Skip the check to prevent chaining of VLANs *)
-let allow_vlan_on_vlan () = fistpoint "allow_vlan_on_vlan"
-
(** Skip the check to prevent untagged VLAN PIFs being forgotten (block added in CA-24056; conflicts with repro advice in CA-23042) *)
let allow_forget_of_vlan_pif () = fistpoint "allow_forget_of_vlan_pif"
diff --git a/ocaml/xapi/xapi_guest_agent.ml b/ocaml/xapi/xapi_guest_agent.ml
index 223033dcf0e..cb2f864abb0 100644
--- a/ocaml/xapi/xapi_guest_agent.ml
+++ b/ocaml/xapi/xapi_guest_agent.ml
@@ -77,8 +77,11 @@ let extend base str = Printf.sprintf "%s/%s" base str
* will be generated. I.E.
* attr/eth0/ip -> 0/ip; 0/ipv4/0
* attr/vif/0/ipv4/0 -> 0/ip; 0/ipv4/0
+ *
+ * Add support for SR-IOV VF, so there are two kinds of vif_type, either to be
+ * `vif` or `net-sriov-vf`
* *)
-let networks path (list: string -> string list) =
+let networks path vif_type (list: string -> string list) =
(* Find all ipv6 addresses under a path. *)
let find_ipv6 path prefix = List.map
(fun str -> (extend (extend path str) "addr", extend prefix str))
@@ -157,7 +160,7 @@ let networks path (list: string -> string list) =
let ip_vers = List.filter (fun a -> a = "ipv4" || a = "ipv6") (list vif_path) in
List.fold_left (extract_ip_ver vif_id) [] ip_vers
in
- match find_vifs (extend path "vif") with
+ match find_vifs (extend path vif_type) with
| [] ->
path
|> find_eths
@@ -219,7 +222,10 @@ let get_initial_guest_metrics (lookup: string -> string option) (list: string ->
let pv_drivers_version = to_map pv_drivers_version
and os_version = to_map os_version
and device_id = to_map device_id
- and networks = to_map (networks "attr" list)
+ and networks = to_map (List.concat [
+ networks "attr" "vif" list
+ ; networks "xenserver/attr" "net-sriov-vf" list
+ ])
and other = List.append (to_map (other all_control)) ts
and memory = to_map memory
and last_updated = Unix.gettimeofday () in
diff --git a/ocaml/xapi/xapi_ha_vm_failover.ml b/ocaml/xapi/xapi_ha_vm_failover.ml
index 1ec763113b2..b2f1badbb0a 100644
--- a/ocaml/xapi/xapi_ha_vm_failover.ml
+++ b/ocaml/xapi/xapi_ha_vm_failover.ml
@@ -488,7 +488,7 @@ let restart_auto_run_vms ~__context live_set n =
debug "Setting all VMs running or paused to Halted";
(* ensure all vms resident_on this host running or paused have their powerstates reset *)
List.iter (fun vm ->
- if Xapi_vm_lifecycle.is_live ~__context ~self:vm then
+ if Xapi_vm_lifecycle_helpers.is_live ~__context ~self:vm then
Xapi_vm_lifecycle.force_state_reset ~__context ~self:vm ~value:`Halted)
!reset_vms;
(* host_post_declare_dead may take a long time if the SR is locked *)
diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml
index 597eee3d15f..7e276fc49bb 100644
--- a/ocaml/xapi/xapi_host.ml
+++ b/ocaml/xapi/xapi_host.ml
@@ -1573,30 +1573,30 @@ let sync_vlans ~__context ~host =
Not (Eq (Field "VLAN_master_of", Literal (Ref.string_of Ref.null)))
)) in
- let get_network_of_pif_underneath_vlan vlan_pif =
- let vlan = Db.PIF.get_VLAN_master_of ~__context ~self:vlan_pif in
- let pif_underneath_vlan = Db.VLAN.get_tagged_PIF ~__context ~self:vlan in
- Db.PIF.get_network ~__context ~self:pif_underneath_vlan
+ let get_network_of_pif_underneath_vlan vlan_pif_rec =
+ match Xapi_pif_helpers.get_pif_topo ~__context ~pif_rec:vlan_pif_rec with
+ | VLAN_untagged vlan :: _ ->
+ let pif_underneath_vlan = Db.VLAN.get_tagged_PIF ~__context ~self:vlan in
+ Db.PIF.get_network ~__context ~self:pif_underneath_vlan
+ | _ -> raise Api_errors.(Server_error(internal_error, [Printf.sprintf "Cannot find vlan from a vlan master PIF:%s" vlan_pif_rec.API.pIF_uuid]))
in
-
let maybe_create_vlan (master_pif_ref, master_pif_rec) =
(* Check to see if the slave has any existing pif(s) that for the specified device, network, vlan... *)
+ (* On the master, we find the pif, p, that underlies the VLAN
+ * (e.g. "eth0" underlies "eth0.25") and then find the network that p's on: *)
+ let network_of_pif_underneath_vlan_on_master = get_network_of_pif_underneath_vlan master_pif_rec in
let existing_pif = List.filter (fun (slave_pif_ref, slave_pif_record) ->
(* Is slave VLAN PIF that we're considering (slave_pif_ref) the one that corresponds
* to the master_pif we're considering (master_pif_ref)? *)
true
&& slave_pif_record.API.pIF_network = master_pif_rec.API.pIF_network
&& slave_pif_record.API.pIF_VLAN = master_pif_rec.API.pIF_VLAN
- && ((get_network_of_pif_underneath_vlan slave_pif_ref) =
- (get_network_of_pif_underneath_vlan master_pif_ref))
+ && (get_network_of_pif_underneath_vlan slave_pif_record = network_of_pif_underneath_vlan_on_master)
) slave_vlan_pifs in
(* if I don't have any such pif(s) then make one: *)
- if List.length existing_pif = 0
+ if existing_pif = []
then
begin
- (* On the master, we find the pif, p, that underlies the VLAN
- * (e.g. "eth0" underlies "eth0.25") and then find the network that p's on: *)
- let network_of_pif_underneath_vlan_on_master = get_network_of_pif_underneath_vlan master_pif_ref in
let pifs = Db.PIF.get_records_where ~__context ~expr:(And (
Eq (Field "host", Literal (Ref.string_of host)),
Eq (Field "network", Literal (Ref.string_of network_of_pif_underneath_vlan_on_master))
@@ -1632,27 +1632,27 @@ let sync_tunnels ~__context ~host =
Not (Eq (Field "tunnel_access_PIF_of", Literal "()"))
)) in
- let get_network_of_transport_pif access_pif =
- match Db.PIF.get_tunnel_access_PIF_of ~__context ~self:access_pif with
- | [tunnel] ->
+ let get_network_of_transport_pif access_pif_rec =
+ match Xapi_pif_helpers.get_pif_topo ~__context ~pif_rec:access_pif_rec with
+ | Tunnel_access tunnel :: _ ->
let transport_pif = Db.Tunnel.get_transport_PIF ~__context ~self:tunnel in
Db.PIF.get_network ~__context ~self:transport_pif
- | _ -> failwith (Printf.sprintf "PIF %s has no tunnel_access_PIF_of" (Ref.string_of access_pif))
+ | _ -> raise Api_errors.(Server_error(internal_error, [Printf.sprintf "PIF %s has no tunnel_access_PIF_of" access_pif_rec.API.pIF_uuid]))
in
let maybe_create_tunnel_for_me (master_pif_ref, master_pif_rec) =
(* check to see if I have any existing pif(s) that for the specified device, network, vlan... *)
let existing_pif = List.filter (fun (_, slave_pif_record) ->
(* Is the slave's tunnel access PIF that we're considering (slave_pif_ref)
- * the one that corresponds to the master's tunnel access PIF we're considering (master_pif_ref)? *)
+ * the one that corresponds to the master's tunnel access PIF we're considering (master_pif_ref)? *)
slave_pif_record.API.pIF_network = master_pif_rec.API.pIF_network
) slave_tunnel_pifs in
(* If the slave doesn't have any such PIF then make one: *)
- if List.length existing_pif = 0
+ if existing_pif = []
then
begin
(* On the master, we find the network the tunnel transport PIF is on *)
- let network_of_transport_pif_on_master = get_network_of_transport_pif master_pif_ref in
+ let network_of_transport_pif_on_master = get_network_of_transport_pif master_pif_rec in
let pifs = Db.PIF.get_records_where ~__context ~expr:(And (
Eq (Field "host", Literal (Ref.string_of host)),
Eq (Field "network", Literal (Ref.string_of network_of_transport_pif_on_master))
@@ -1679,8 +1679,12 @@ let sync_pif_currently_attached ~__context ~host ~bridges =
let networks = Db.Network.get_all_records ~__context in
let pifs = Db.PIF.get_records_where ~__context ~expr:(
Eq (Field "host", Literal (Ref.string_of host))
- ) in
-
+ ) |> List.filter (fun (_, pif_rec) ->
+ match Xapi_pif_helpers.get_pif_topo ~__context ~pif_rec with
+ | VLAN_untagged _ :: Network_sriov_logical _ :: _
+ | Network_sriov_logical _ :: _ -> false
+ | _ -> true)
+ in
let network_to_bridge = List.map (fun (net, net_r) -> net, net_r.API.network_bridge) networks in
(* PIF -> bridge option: None means "dangling PIF" *)
diff --git a/ocaml/xapi/xapi_host_helpers.ml b/ocaml/xapi/xapi_host_helpers.ml
index 5c688db2ec9..91f7b1f26c3 100644
--- a/ocaml/xapi/xapi_host_helpers.ml
+++ b/ocaml/xapi/xapi_host_helpers.ml
@@ -224,6 +224,7 @@ let consider_enabling_host_nolock ~__context =
if !Xapi_globs.on_system_boot then begin
debug "Host.enabled: system has just restarted: setting localhost to enabled";
Db.Host.set_enabled ~__context ~self:localhost ~value:true;
+ update_allowed_operations ~__context ~self:localhost;
Localdb.put Constants.host_disabled_until_reboot "false";
(* Start processing pending VM powercycle events *)
Local_work_queue.start_vm_lifecycle_queue ();
@@ -233,6 +234,7 @@ let consider_enabling_host_nolock ~__context =
end else begin
debug "Host.enabled: system not just rebooted && host_disabled_until_reboot not set: setting localhost to enabled";
Db.Host.set_enabled ~__context ~self:localhost ~value:true;
+ update_allowed_operations ~__context ~self:localhost;
(* Start processing pending VM powercycle events *)
Local_work_queue.start_vm_lifecycle_queue ();
end
diff --git a/ocaml/xapi/xapi_network_attach_helpers.ml b/ocaml/xapi/xapi_network_attach_helpers.ml
index 261f8da2399..a6e9f5bee6f 100644
--- a/ocaml/xapi/xapi_network_attach_helpers.ml
+++ b/ocaml/xapi/xapi_network_attach_helpers.ml
@@ -46,7 +46,7 @@ let assert_network_has_no_vifs_in_use_on_me ~__context ~host ~network =
let vm = Db.VIF.get_VM ~__context ~self in
let resident_on = Db.VM.get_resident_on ~__context ~self:vm in
if resident_on=host then
- if Xapi_vm_lifecycle.is_live ~__context ~self:vm then
+ if Xapi_vm_lifecycle_helpers.is_live ~__context ~self:vm then
raise (Api_errors.Server_error(Api_errors.vif_in_use, [ Ref.string_of network; Ref.string_of self ]))
end)
vifs
diff --git a/ocaml/xapi/xapi_network_helpers.ml b/ocaml/xapi/xapi_network_helpers.ml
new file mode 100644
index 00000000000..473789933a5
--- /dev/null
+++ b/ocaml/xapi/xapi_network_helpers.ml
@@ -0,0 +1,72 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+open API
+module D=Debug.Make(struct let name="xapi" end)
+open D
+open Xapi_pif_helpers
+
+let is_sriov_based_network ~__context ~network =
+ match Db.Network.get_PIFs ~__context ~self:network with
+ | [] -> false
+ | existing_pif :: _ ->
+ let existing_pif_rec = Db.PIF.get_record ~__context ~self:existing_pif in
+ match get_pif_topo ~__context ~pif_rec:existing_pif_rec with
+ | VLAN_untagged _ :: Network_sriov_logical _ :: _
+ | Network_sriov_logical _ :: _ -> true
+ | _ -> false
+
+let assert_network_compatible_with_tunnel ~__context ~network =
+ if is_sriov_based_network ~__context ~network then
+ raise Api_errors.(Server_error (network_incompatible_with_tunnel, [Ref.string_of network]))
+
+let assert_network_compatible_with_bond ~__context ~network =
+ if is_sriov_based_network ~__context ~network then
+ raise Api_errors.(Server_error (network_incompatible_with_bond, [Ref.string_of network]))
+
+let assert_network_compatible_with_vlan_on_bridge ~__context ~network =
+ if is_sriov_based_network ~__context ~network then
+ raise Api_errors.(Server_error (network_incompatible_with_vlan_on_bridge, [Ref.string_of network]))
+
+let assert_network_compatible_with_vlan_on_sriov ~__context ~network ~sriov ~tagged_PIF =
+ match Db.Network.get_PIFs ~__context ~self:network with
+ | [] -> ()
+ | existing_pif :: _ ->
+ let existing_pif_rec = Db.PIF.get_record ~__context ~self:existing_pif in
+ match get_pif_topo ~__context ~pif_rec:existing_pif_rec with
+ | VLAN_untagged _ :: Network_sriov_logical existing_sriov :: _ ->
+ let existing_phy_pif = Db.Network_sriov.get_physical_PIF ~__context ~self:existing_sriov in
+ let candidate_phy_pif = Db.Network_sriov.get_physical_PIF ~__context ~self:sriov in
+ if not (is_device_underneath_same_type ~__context existing_phy_pif candidate_phy_pif) then
+ raise Api_errors.(Server_error (network_has_incompatible_vlan_on_sriov_pifs, [Ref.string_of tagged_PIF; Ref.string_of network]))
+ | _ ->
+ raise Api_errors.(Server_error (network_incompatible_with_vlan_on_sriov, [Ref.string_of network]))
+
+let assert_vlan_network_compatible_with_pif ~__context ~network ~tagged_PIF ~pif_topo =
+ match pif_topo with
+ | Network_sriov_logical sriov :: _ ->
+ assert_network_compatible_with_vlan_on_sriov ~__context ~network ~sriov ~tagged_PIF
+ | _ ->
+ assert_network_compatible_with_vlan_on_bridge ~__context ~network
+
+(* SRIOV PIF can only join the network which is empty or all of the existing PIFs of it are SRIOV PIFS and all of them has identical PCI devices. *)
+let assert_network_compatible_with_sriov ~__context ~pif ~network =
+ match Db.Network.get_PIFs ~__context ~self:network with
+ | [] -> ()
+ | logical_pif :: _ ->
+ match Db.PIF.get_sriov_logical_PIF_of ~__context ~self:logical_pif with
+ | [] -> raise Api_errors.(Server_error (network_incompatible_with_sriov, [Ref.string_of network]))
+ | sriov :: _ ->
+ let existing_pif = Db.Network_sriov.get_physical_PIF ~__context ~self:sriov in
+ if not (is_device_underneath_same_type ~__context pif existing_pif) then
+ raise Api_errors.(Server_error (network_has_incompatible_sriov_pifs, [Ref.string_of pif; Ref.string_of network]))
diff --git a/ocaml/xapi/xapi_network_sriov.ml b/ocaml/xapi/xapi_network_sriov.ml
new file mode 100644
index 00000000000..9d1357f85a2
--- /dev/null
+++ b/ocaml/xapi/xapi_network_sriov.ml
@@ -0,0 +1,65 @@
+(*
+ * Copyright (C) 2017 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+module D = Debug.Make(struct let name="xapi_network_sriov" end)
+open D
+
+(** Dummy MAC used by the SRIOV **)
+let network_sriov_mac = "fe:ff:ff:ff:ff:ff"
+
+let create_internal ~__context ~physical_PIF ~physical_rec ~network =
+ let sriov = Ref.make () in
+ let sriov_uuid = Uuid.to_string (Uuid.make_uuid ()) in
+ let logical_PIF = Ref.make () in
+ let mTU = physical_rec.API.pIF_MTU in
+ let metrics = physical_rec.API.pIF_metrics in
+ let device = physical_rec.API.pIF_device in
+ let host = physical_rec.API.pIF_host in
+ Db.PIF.create ~__context ~ref:logical_PIF ~uuid:(Uuid.to_string (Uuid.make_uuid ()))
+ ~device ~device_name:device ~network ~host ~mAC:network_sriov_mac ~mTU ~vLAN:(-1L) ~metrics
+ ~physical:false ~currently_attached:false ~igmp_snooping_status:`unknown
+ ~ip_configuration_mode:`None ~iP:"" ~netmask:"" ~gateway:"" ~dNS:"" ~bond_slave_of:Ref.null
+ ~vLAN_master_of:Ref.null ~management:false ~other_config:[] ~disallow_unplug:false
+ ~ipv6_configuration_mode:`None ~iPv6:[] ~ipv6_gateway:"" ~primary_address_type:`IPv4 ~managed:true
+ ~properties:[] ~capabilities:[] ~pCI:Ref.null;
+ info "network-sriov create uuid=%s" sriov_uuid;
+ Db.Network_sriov.create ~__context ~ref:sriov ~uuid:sriov_uuid ~physical_PIF ~logical_PIF ~requires_reboot:false ~configuration_mode:`unknown;
+ sriov, logical_PIF
+
+let create ~__context ~pif ~network =
+ Pool_features.assert_enabled ~__context ~f:Features.Network_sriov;
+ Xapi_network.assert_network_is_managed ~__context ~self:network;
+ Xapi_pif_helpers.assert_pif_is_managed ~__context ~self:pif;
+ let pif_rec = Db.PIF.get_record ~__context ~self:pif in
+ Xapi_pif_helpers.sriov_is_allowed_on_pif ~__context ~physical_PIF:pif ~pif_rec;
+ let host = Db.PIF.get_host ~__context ~self:pif in
+ Xapi_pif.assert_no_other_local_pifs ~__context ~host ~network;
+ Xapi_network_helpers.assert_network_compatible_with_sriov ~__context ~pif ~network;
+
+ info "Start creating logical PIF and network-sriov object";
+ let sriov, logical_PIF = create_internal ~__context ~physical_PIF:pif ~physical_rec:pif_rec ~network in
+ Xapi_pif.plug ~__context ~self:logical_PIF;
+ sriov
+
+let destroy ~__context ~self =
+ let logical_PIF = Db.Network_sriov.get_logical_PIF ~__context ~self in
+ Xapi_pif_helpers.assert_not_vlan_slave ~__context ~self:logical_PIF;
+ Xapi_pif.unplug ~__context ~self:logical_PIF;
+ Db.PIF.destroy ~__context ~self:logical_PIF;
+ let sriov_uuid = Db.Network_sriov.get_uuid ~__context ~self in
+ info "network-sriov destroy uuid=%s" sriov_uuid;
+ Db.Network_sriov.destroy ~__context ~self
+
+let get_remaining_capacity ~__context ~self =
+ Xapi_network_sriov_helpers.get_remaining_capacity_on_sriov ~__context ~self
diff --git a/ocaml/xapi/xapi_network_sriov.mli b/ocaml/xapi/xapi_network_sriov.mli
new file mode 100644
index 00000000000..d5b84a3b11a
--- /dev/null
+++ b/ocaml/xapi/xapi_network_sriov.mli
@@ -0,0 +1,34 @@
+(*
+ * Copyright (C) 2017 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+(** Create a network-sriov object on the specific PIF and network, it will internally create a logical PIF to connect the network-sriov and network. Topo: physical PIF - network-sriov - logical PIF - network *)
+val create :
+ __context:Context.t ->
+ pif:[ `PIF ] Ref.t ->
+ network:[ `network ] Ref.t ->
+ [ `network_sriov ] Ref.t
+
+val create_internal :
+ __context:Context.t ->
+ physical_PIF:[ `PIF ] Ref.t ->
+ physical_rec:API.pIF_t ->
+ network:[ `network ] Ref.t ->
+ ([ `network_sriov ] Ref.t * [ `PIF ] Ref.t)
+
+(** Destroy a network-sriov object, and it will automatically destroy the logical PIF that bonded with it. *)
+val destroy : __context:Context.t -> self:[ `network_sriov ] Ref.t -> unit
+
+(** Get the available VF numbers of a SR-IOV object **)
+val get_remaining_capacity : __context:Context.t -> self:[ `network_sriov ] Ref.t -> int64
+
diff --git a/ocaml/xapi/xapi_network_sriov_helpers.ml b/ocaml/xapi/xapi_network_sriov_helpers.ml
new file mode 100644
index 00000000000..2dc47714930
--- /dev/null
+++ b/ocaml/xapi/xapi_network_sriov_helpers.ml
@@ -0,0 +1,217 @@
+(*
+ * Copyright (C) 2017 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+open Network
+open Db_filter_types
+open Xapi_stdext_std
+module D = Debug.Make(struct let name="xapi_network_sriov" end)
+open D
+
+let get_sriov_of ~__context ~sriov_logical_pif =
+ match Db.PIF.get_sriov_logical_PIF_of ~__context ~self:sriov_logical_pif with
+ | v :: _ -> v
+ | [] -> raise Api_errors.(Server_error (internal_error, [Printf.sprintf "Cannot find sriov object in sriov logical PIF %s" (Ref.string_of sriov_logical_pif)]))
+
+let sriov_bring_up ~__context ~self =
+ let update_sriov_with_result result =
+ let open Net.Sriov in
+ let mode, require_reboot = match result with
+ | Sysfs_successful -> `sysfs, false
+ | Modprobe_successful -> `modprobe, false
+ | Modprobe_successful_requires_reboot -> `modprobe, true
+ in
+ let sriov = get_sriov_of ~__context ~sriov_logical_pif:self in
+ let physical_pif = Db.Network_sriov.get_physical_PIF ~__context ~self:sriov in
+ info "Enable network sriov on PIF %s successful, mode: %s need_reboot: %b" (Ref.string_of physical_pif) (Record_util.network_sriov_configuration_mode_to_string mode) require_reboot;
+ Db.Network_sriov.set_configuration_mode ~__context ~self:sriov ~value:mode;
+ Db.Network_sriov.set_requires_reboot ~__context ~self:sriov ~value:require_reboot;
+ Db.PIF.set_currently_attached ~__context ~self ~value:(not require_reboot)
+ in
+ let device = Db.PIF.get_device ~__context ~self in
+ begin
+ let dbg = Context.string_of_task __context in
+ match Net.Sriov.enable dbg device with
+ | Ok result -> update_sriov_with_result result
+ | Error error ->
+ Db.PIF.set_currently_attached ~__context ~self ~value:false;
+ raise Api_errors.(Server_error (network_sriov_enable_failed, [Ref.string_of self; error]))
+ end;
+ Xapi_pci.update_pcis ~__context
+
+let require_operation_on_pci_device ~__context ~sriov ~self =
+ let is_sriov_enabled ~pif_rec =
+ match pif_rec.API.pIF_sriov_logical_PIF_of with
+ | [] -> false
+ | sriov :: _ ->
+ pif_rec.API.pIF_currently_attached || Db.Network_sriov.get_requires_reboot ~__context ~self:sriov
+ in
+ let pif_rec = Db.PIF.get_record ~__context ~self in
+ if is_sriov_enabled ~pif_rec then begin
+ match Db.Network_sriov.get_configuration_mode ~__context ~self:sriov with
+ | `sysfs -> true
+ | `unknown -> false
+ | `modprobe ->
+ let host = Db.PIF.get_host ~__context ~self in
+ let physical_pif = Db.Network_sriov.get_physical_PIF ~__context ~self:sriov in
+ let pci = Db.PIF.get_PCI ~__context ~self:physical_pif in
+ let driver_name = Db.PCI.get_driver_name ~__context ~self:pci in
+ (* Filter the network SR-IOV logical PIF on local host which *)
+ (* 1. has same driver name with me *)
+ (* 2. PIF.currently_attached = `true` or Network_sriov.requires_reboot = `true`. Aka the PIF that enabled SR-IOV or will enable SR-IOV after reboot *)
+ (* If the final list just contains me, should call networkd to disable SR-IOV for the device. *)
+ Db.PIF.get_records_where ~__context ~expr:(And (
+ Eq (Field "host", Literal (Ref.string_of host)),
+ Not (Eq (Field "sriov_logical_PIF_of", Literal "()"))
+ ))
+ |> List.filter (fun (_, pif_rec) ->
+ let sriov = match pif_rec.API.pIF_sriov_logical_PIF_of with
+ | v :: _ -> v
+ | [] -> raise Api_errors.(Server_error (internal_error, [Printf.sprintf "Cannot find sriov object in sriov logical PIF %s" pif_rec.API.pIF_uuid]))
+ in
+ let physical_pif = Db.Network_sriov.get_physical_PIF ~__context ~self:sriov in
+ let pci = Db.PIF.get_PCI ~__context ~self:physical_pif in
+ Db.PCI.get_driver_name ~__context ~self:pci = driver_name
+ )
+ |> List.filter (fun (_, pif_rec) ->
+ is_sriov_enabled ~pif_rec
+ )
+ |> List.map (fun (pif_ref, _) -> pif_ref)
+ |> (=) [self]
+ end
+ else false
+
+let sriov_bring_down ~__context ~self =
+ let sriov = get_sriov_of ~__context ~sriov_logical_pif:self in
+ let physical_pif = Db.Network_sriov.get_physical_PIF ~__context ~self:sriov in
+ if require_operation_on_pci_device ~__context ~sriov ~self then begin
+ debug "Disable network sriov on pci device. PIF: %s" (Ref.string_of self);
+ let dbg = Context.string_of_task __context in
+ let device = Db.PIF.get_device ~__context ~self in
+ match Net.Sriov.disable dbg device with
+ | Ok -> ()
+ | Error error ->
+ raise Api_errors.(Server_error (network_sriov_disable_failed, [Ref.string_of self; error]))
+ end;
+ info "Disable network sriov on PIF %s successful" (Ref.string_of physical_pif);
+ Db.PIF.set_currently_attached ~__context ~self ~value:false;
+ Db.Network_sriov.set_requires_reboot ~__context ~self:sriov ~value:false;
+ Xapi_pci.update_pcis ~__context
+
+let get_remaining_capacity_on_sriov ~__context ~self =
+ let physical_PIF = Db.Network_sriov.get_physical_PIF ~__context ~self in
+ let pci = Db.PIF.get_PCI ~__context ~self:physical_PIF in
+ Xapi_pci.get_idle_vf_nums ~__context ~self:pci
+
+(*Returns physical PIF underlying the given PIF, return None if the given PIF is not (a VLAN on) a SR-IOV logical PIF *)
+let get_underlying_pif ~__context ~pif =
+ let pif_rec = Db.PIF.get_record ~__context ~self:pif in
+ match Xapi_pif_helpers.get_pif_topo ~__context ~pif_rec with
+ | Network_sriov_logical sriov :: _
+ | VLAN_untagged _ :: Network_sriov_logical sriov :: _ ->
+ Some (Db.Network_sriov.get_physical_PIF ~__context ~self:sriov)
+ | _ -> None
+
+(* Only 2 type pif of sr-iov can be quickly up without a reboot:
+ 1. sysfs mode
+ 2. modprobe with currently_attached or unattached but has remaining-capacity(it means unplug sr-iov pif but before reboot host)
+ Used in
+ * Group host by best sriov
+ * Check the network is properly shared *)
+let can_be_up_without_reboot ~__context sriov =
+ match Db.Network_sriov.get_configuration_mode ~__context ~self:sriov with
+ | `sysfs -> true
+ | `unknown -> false
+ | `modprobe ->
+ let pif = Db.Network_sriov.get_logical_PIF ~__context ~self:sriov in
+ Db.PIF.get_currently_attached ~__context ~self:pif || get_remaining_capacity_on_sriov ~__context ~self:sriov > 0L
+
+(* Just take one pif from the network and check if it has an underlying_pif, if so it's a SR-IOV network.
+Note, get_underlying_pif only matches a (VLAN on) SR-IOV type of PIF. *)
+let is_sriov_network ~__context ~self =
+ match Db.Network.get_PIFs ~__context ~self with
+ | [] -> false
+ | pif :: _ ->
+ get_underlying_pif ~__context ~pif <> None
+
+let get_sriov_networks_from_vm ~__context ~vm =
+ let networks = Db.VM.get_VIFs ~__context ~self:vm |> List.map (fun vif -> Db.VIF.get_network ~__context ~self:vif ) in
+ List.filter (fun network -> is_sriov_network ~__context ~self:network) networks
+
+(* Get localhost underlying pif with for the sr-iov network *)
+let get_local_underlying_pif ~__context ~network ~host =
+ match Xapi_network_attach_helpers.get_local_pifs ~__context ~network ~host with
+ | [] -> None
+ | pif :: _ -> get_underlying_pif ~__context ~pif
+
+(* Get remaining capacity for localhost on the given network, return None if no underlying_pif found or capacity = 0L *)
+let get_remaining_capacity_on_host ~__context ~host ~network =
+ let local_pifs = Xapi_network_attach_helpers.get_local_pifs ~__context ~network ~host in
+ match local_pifs with
+ | [] -> raise Api_errors.(Server_error (internal_error, ["Cannot get local pif on network"]))
+ | local_pif :: _ ->
+ match get_underlying_pif ~__context ~pif:local_pif with
+ | Some underlying_pif ->
+ let pci = Db.PIF.get_PCI ~__context ~self:underlying_pif in
+ Xapi_pci.get_idle_vf_nums ~__context ~self:pci
+ | None -> raise Api_errors.(Server_error (internal_error, ["Cannot get underlying pif on sriov network"]))
+
+(* Partition hosts by attached and unattached pifs, the network input is a SR-IOV type.
+ 1.For attached pifs, check the free capacity > 0
+ 2.For unattached pifs,check the sriov on pif can be attached without reboot when vm start
+ 3.Group host by free capacity,finally returns the host list list like [ [(host0,num0);(host1,num0)];[(host2;num1);(host3,num1)]... ]
+ 4.Since before plug the unattached_pif, vf capacity on pif is unknown,so used vf_num = 0L
+ 5.If unattached_hosts not empty then add at the end of host lists.
+ *)
+let group_hosts_by_best_sriov ~__context ~network =
+ let pifs = Db.Network.get_PIFs ~__context ~self:network in
+ let attached_hosts, unattached_hosts = List.fold_left (fun (l1, l2) pif ->
+ let pif_rec = Db.PIF.get_record ~__context ~self:pif in
+ let host = pif_rec.API.pIF_host in
+ if pif_rec.API.pIF_currently_attached then begin
+ let num = get_remaining_capacity_on_host ~__context ~host ~network in
+ if num = 0L then (l1,l2) else ((host, num) :: l1, l2)
+ end else begin
+ let sriov =
+ match Xapi_pif_helpers.get_pif_topo ~__context ~pif_rec with
+ | Network_sriov_logical sriov :: _
+ | VLAN_untagged _ :: Network_sriov_logical sriov :: _ -> sriov
+ | _ -> raise Api_errors.(Server_error (internal_error, [Printf.sprintf "Cannot find sriov object in PIF %s" (Ref.string_of pif)]))
+ in
+ if can_be_up_without_reboot ~__context sriov then (l1, (host, 0L) :: l2)
+ else (l1, l2)
+ end
+ ) ([], []) pifs
+ in
+ let host_lists =
+ Helpers.group_by `descending (fun ( _ , num ) -> num) (Listext.List.setify attached_hosts)
+ |> List.map (fun hl -> List.map (fun ( (h, num), _ ) -> h, num) hl)
+ in
+ if unattached_hosts <> [] then
+ host_lists @ [unattached_hosts]
+ else host_lists
+
+(* If exn happens during vifs reservation ,reserved vfs will be cleared. Nothing will be done while cannot get underlying pif *)
+let reserve_sriov_vfs ~__context ~host ~vm =
+ let vifs = Db.VM.get_VIFs ~__context ~self:vm in
+ List.iter (fun vif ->
+ let network = Db.VIF.get_network ~__context ~self:vif in
+ match get_local_underlying_pif ~__context ~network ~host with
+ | None -> ()
+ | Some pif ->
+ let pci = Db.PIF.get_PCI ~__context ~self:pif in
+ begin match Pciops.reserve_free_virtual_function ~__context vm pci with
+ | Some vf -> Db.VIF.set_reserved_pci ~__context ~self:vif ~value:vf
+ | None -> raise Api_errors.(Server_error (internal_error, ["No free virtual function found"]))
+ end
+ ) vifs
diff --git a/ocaml/xapi/xapi_pci.ml b/ocaml/xapi/xapi_pci.ml
index 36a444d95e2..e9efcfb23ee 100644
--- a/ocaml/xapi/xapi_pci.ml
+++ b/ocaml/xapi/xapi_pci.ml
@@ -53,14 +53,14 @@ let create ~__context ~class_id ~class_name ~vendor_id ~vendor_name ~device_id
~device_name ~host ~pci_id ~functions ~physical_function
~dependencies ~other_config
~subsystem_vendor_id ~subsystem_vendor_name
- ~subsystem_device_id ~subsystem_device_name =
+ ~subsystem_device_id ~driver_name ~subsystem_device_name =
let p = Ref.make () in
let uuid = Uuid.to_string (Uuid.make_uuid ()) in
Db.PCI.create ~__context ~ref:p ~uuid ~class_id ~class_name ~vendor_id ~vendor_name ~device_id
~device_name ~host ~pci_id ~functions ~physical_function
~dependencies:[] ~other_config:[]
~subsystem_vendor_id ~subsystem_vendor_name
- ~subsystem_device_id ~subsystem_device_name
+ ~subsystem_device_id ~driver_name ~subsystem_device_name
~scheduled_to_be_attached_to:Ref.null;
debug "PCI %s, %s, %s created" pci_id vendor_name device_name;
p
@@ -76,6 +76,45 @@ let get_local_pcis_and_records ~__context =
let get_local_pci_refs ~__context =
get_local ~__context Db.PCI.get_refs_where
+(** Update pf and vf settings *)
+(* For virtual function record, set field `physical_function` to its PF PCI record *)
+(* For physical function record, set field `functions` to 1 plus number of its virtual functions *)
+let update_pf_vf_relations ~__context ~pcis =
+ let pci_path x = Printf.sprintf "/sys/bus/pci/devices/%s/physfn" x
+ in
+ let get_phyfn_path pci_rec =
+ let path = pci_path pci_rec.Db_actions.pCI_pci_id in
+ try
+ (*if can't read link from the path,then it's a physical function*)
+ Some (Filename.basename (Unix.readlink path))
+ with _ -> None
+ in
+ let set_phyfn (vf_ref, vf_rec, phyfn_path) pfs =
+ match phyfn_path with
+ | Some phyfn_path ->
+ begin
+ try
+ let pf, _, _ = List.find (fun (_, pf_rec, _) -> phyfn_path = pf_rec.Db_actions.pCI_pci_id) pfs in
+ if vf_rec.Db_actions.pCI_physical_function <> pf then Db.PCI.set_physical_function ~__context ~self:vf_ref ~value:pf
+ with Not_found ->
+ error "Failed to find physical function of vf %s" vf_rec.Db_actions.pCI_uuid
+ end
+ | None -> ()
+ in
+ let pfs, vfs = pcis
+ |> List.map (fun (pci_ref, pci_rec) -> pci_ref, pci_rec, get_phyfn_path pci_rec)
+ |> List.partition (fun (_, _, phyfn_path) -> phyfn_path = None) in
+ (* set physical function for vfs *)
+ List.iter (fun vf -> set_phyfn vf pfs) vfs
+
+let get_idle_vf_nums ~__context ~self =
+ let vfs = Db.PCI.get_virtual_functions ~__context ~self in
+ let not_attached pci =
+ Db.PCI.get_attached_VMs ~__context ~self:pci = [] &&
+ Db.PCI.get_scheduled_to_be_attached_to ~__context ~self:pci = Ref.null
+ in
+ List.filter not_attached vfs |> List.length |> Int64.of_int
+
let update_pcis ~__context =
let host = Helpers.get_localhost ~__context in
let existing = List.filter_map
@@ -93,6 +132,10 @@ let update_pcis ~__context =
| None -> "", ""
| Some property -> id_of_int property.id, property.name
in
+ let string_of_pci_driver_name = function
+ | None -> ""
+ | Some name -> name
+ in
let rec update_or_create cur = function
| [] -> cur
| pci :: remaining_pcis ->
@@ -102,6 +145,7 @@ let update_pcis ~__context =
strings_of_pci_property pci.subsystem_vendor in
let (subsystem_device_id, subsystem_device_name) =
strings_of_pci_property pci.subsystem_device in
+ let driver_name = string_of_pci_driver_name pci.driver_name in
let (rf, rc) = List.find (fun (rf, rc) ->
rc.Db_actions.pCI_pci_id = pci.address &&
rc.Db_actions.pCI_vendor_id = id_of_int pci.vendor.id &&
@@ -121,6 +165,9 @@ let update_pcis ~__context =
(* sync the subsystem device name. *)
if rc.Db_actions.pCI_subsystem_device_name <> subsystem_device_name
then Db.PCI.set_subsystem_device_name ~__context ~self:rf ~value:subsystem_device_name;
+ (* sync the driver name. *)
+ if rc.Db_actions.pCI_driver_name <> driver_name
+ then Db.PCI.set_driver_name ~__context ~self:rf ~value:driver_name;
(* sync the class information. *)
if rc.Db_actions.pCI_class_id <> id_of_int pci.pci_class.id
then Db.PCI.set_class_id ~__context ~self:rf ~value:(id_of_int pci.pci_class.id);
@@ -136,6 +183,7 @@ let update_pcis ~__context =
strings_of_pci_property pci.subsystem_vendor in
let subsystem_device_id, subsystem_device_name =
strings_of_pci_property pci.subsystem_device in
+ let driver_name = string_of_pci_driver_name pci.driver_name in
let self = create ~__context
~class_id:(id_of_int pci.pci_class.id)
~class_name:pci.pci_class.name
@@ -145,7 +193,7 @@ let update_pcis ~__context =
~device_name:pci.device.name ~host ~pci_id:pci.address
~functions:1L ~physical_function:Ref.null ~dependencies:[] ~other_config:[]
~subsystem_vendor_id ~subsystem_vendor_name
- ~subsystem_device_id ~subsystem_device_name in
+ ~subsystem_device_id ~subsystem_device_name ~driver_name in
self, Db.PCI.get_record_internal ~__context ~self
in
update_or_create ((obj, pci) :: cur) remaining_pcis
@@ -179,7 +227,8 @@ let update_pcis ~__context =
let current = List.map (fun ((pref, prec), _) -> pref, prec) current in
let obsolete = List.set_difference existing current in
- List.iter (fun (self, _) -> Db.PCI.destroy ~__context ~self) obsolete
+ List.iter (fun (self, _) -> Db.PCI.destroy ~__context ~self) obsolete;
+ update_pf_vf_relations ~__context ~pcis:current
let with_vga_arbiter ~readonly f =
Unixext.with_file
diff --git a/ocaml/xapi/xapi_pci.mli b/ocaml/xapi/xapi_pci.mli
index 773b051200c..f2f775c739e 100644
--- a/ocaml/xapi/xapi_pci.mli
+++ b/ocaml/xapi/xapi_pci.mli
@@ -36,6 +36,9 @@ val string_of_pci : __context:Context.t -> self:API.ref_PCI -> string
(** A list of (ref, record) pairs for the PCI DB objects of the local host *)
val get_local_pcis_and_records : __context:Context.t -> (API.ref_PCI * Db_actions.pCI_t) list
+(** Get the numbers of VFs that have not been attached to a host *)
+val get_idle_vf_nums : __context:Context.t -> self:API.ref_PCI -> int64
+
(** A list of refs for the PCI DB objects of the local host *)
val get_local_pci_refs : __context:Context.t -> API.ref_PCI list
diff --git a/ocaml/xapi/xapi_pci_helpers.ml b/ocaml/xapi/xapi_pci_helpers.ml
index e3267c66ac2..de1538bfb23 100644
--- a/ocaml/xapi/xapi_pci_helpers.ml
+++ b/ocaml/xapi/xapi_pci_helpers.ml
@@ -28,8 +28,19 @@ type pci = {
subsystem_vendor: pci_property option;
subsystem_device: pci_property option;
related: string list;
+ driver_name: string option;
}
+let get_driver_name address =
+ try
+ let driver_path = Unix.readlink (Printf.sprintf "/sys/bus/pci/devices/%s/driver" address) in
+ match Astring.String.cut ~sep:"/" ~rev:true driver_path with
+ | Some (prefix, suffix) -> Some suffix
+ | None -> None
+ with e ->
+ debug "get_driver_name: for %s failed with %s" address (Printexc.to_string e);
+ None
+
let get_host_pcis () =
let default ~msg v =
match v with
@@ -52,6 +63,8 @@ let get_host_pcis () =
; name = lookup_device_name access d.vendor_id d.device_id
|> default ~msg:"device name" }
in
+ let address = address_of_dev d in
+ let driver_name = get_driver_name address in
let (subsystem_vendor, subsystem_device) = match d.subsystem_id with
| None -> None, None
| Some (sv_id, sd_id) ->
@@ -72,9 +85,9 @@ let get_host_pcis () =
let slot x = (x.domain, x.bus, x.dev) in
slot d' = slot d && d' <> d
) devs in
- { address = address_of_dev d;
+ { address;
vendor; device; subsystem_vendor; subsystem_device; pci_class;
- related = List.map address_of_dev related_devs;
+ related = List.map address_of_dev related_devs; driver_name;
}
) devs
)
diff --git a/ocaml/xapi/xapi_pgpu.ml b/ocaml/xapi/xapi_pgpu.ml
index 3b6bd491a0c..8182bcb9b05 100644
--- a/ocaml/xapi/xapi_pgpu.ml
+++ b/ocaml/xapi/xapi_pgpu.ml
@@ -100,52 +100,11 @@ let sync_pci_hidden ~__context ~pgpu ~pci =
| `enabled | `disable_on_reboot -> false
end
-(* If this PCI device is by AMD and if (ON THE HOST RUNNING THIS CODE) it has
- * a valid-looking phys_fn symlink in its entry under /sys/bus/pci/...
- * then:
- * assume it is a Virtual Function (we should already have checked it is a display device)
- * set the physical_function field in its DB object to point to its PF PCI object
- * return true meaning it is a VF (even if we couldn't find a PF PCI object for it)
- * else return false *)
-(* This is not in the .mli *)
-let mxgpu_set_phys_fn_ref ~__context pci_ref pci_rec =
- Xapi_pci.int_of_id (pci_rec.Db_actions.pCI_vendor_id) = Xapi_vgpu_type.Vendor_amd.vendor_id &&
- pci_rec.Db_actions.pCI_virtual_functions = [] && (* i.e. we don't already know it is a phys fn *)
- (* A better name for pci_id would be pci_address. *)
- let pci_addr = pci_rec.Db_actions.pCI_pci_id in
- (* E.g. path = "/sys/bus/pci/devices/0000:88:00.0/" *)
- let path = Printf.sprintf "/sys/bus/pci/devices/%s/physfn" pci_addr in
- try (
- (* No problem if there's no such symlink: we'll handle the exception. *)
- let physfn_addr = Filename.basename(Unix.readlink path) in
- (* Expect physfn_addr to look like "0000:8c:01.0" from link-target "../0000:8c:01.0" *)
- (* If it does then look up Db ref with that pci_id (i.e. address), and create a link in DB *)
- if Pciops.is_bdf_format physfn_addr then (
- let host = Helpers.get_localhost ~__context in
- let expr = Db_filter_types.(And (Eq (Field "pci_id", Literal physfn_addr),
- Eq (Field "host", Literal (Ref.string_of host)))) in
- ( match Db.PCI.get_refs_where ~__context ~expr with (* Expect exactly one *)
- | [pf_ref] ->
- Db.PCI.set_physical_function ~__context ~self:pci_ref ~value:pf_ref;
- Db.PCI.set_dependencies ~__context ~self:pci_ref ~value:[]
- | [] -> error "Found no pci with address %s but physfn-link of %s points to it!" physfn_addr pci_addr
- | _ -> error "Found more than one pci with same address! %s" physfn_addr
- );
- true (* It was a Virtual Function PCI device so we don't want a pgpu for it. *)
- ) else false
- ) (* Unix_error from blind attempt to read symlink that might not exist *)
- with Unix.Unix_error _ -> false
-
-(* This has the important side-effect of updating the physical_function field
- * of the PCI object in the database iff the PCI device turns out to be a VF
- * of an AMD MxGPU on the local host (in which case we return false).
- * Returns true iff pci_ref seems to represent a PHYSICAL gpu (not a VF) on the
- * LOCAL host. *)
let is_local_pgpu ~__context (pci_ref, pci_rec) =
let localhost = Helpers.get_localhost ~__context in
pci_rec.Db_actions.pCI_host = localhost
&& Xapi_pci.(is_class_of_kind Display_controller (int_of_id (pci_rec.Db_actions.pCI_class_id)))
- && not (mxgpu_set_phys_fn_ref ~__context pci_ref pci_rec) (* Ignore PCIs discovered to be Virtual Functions. *)
+ && pci_rec.Db_actions.pCI_physical_function = Ref.null
(* Makes DB match reality for pgpus on local host *)
let update_gpus ~__context =
@@ -153,9 +112,8 @@ let update_gpus ~__context =
let system_display_device = Xapi_pci.get_system_display_device () in
let existing_pgpus = List.filter (fun (rf, rc) -> rc.API.pGPU_host = host) (Db.PGPU.get_all_records ~__context) in
let pcis =
- (* Important side-effects in is_local_pgpu *)
- List.filter (is_local_pgpu ~__context)
- (Xapi_pci.get_local_pcis_and_records ~__context)
+ Xapi_pci.get_local_pcis_and_records ~__context
+ |> List.filter (is_local_pgpu ~__context)
|> List.map (function pci_ref, _ -> pci_ref) in
let is_host_display_enabled =
match Db.Host.get_display ~__context ~self:host with
@@ -404,9 +362,3 @@ let mxgpu_vf_setup ~__context =
(* Update the gpus even if the module was present already, in case it was
* already loaded before xapi was (re)started. *)
Xapi_pci.update_pcis ~__context;
- (* Potential optimisation: make update_pcis return a value telling whether
- * it changed anything, and stop here if it did not. *)
- List.iter
- (* Important side-effects in is_local_pgpu *)
- (fun pci_ref -> ignore (is_local_pgpu ~__context pci_ref))
- (Xapi_pci.get_local_pcis_and_records ~__context)
diff --git a/ocaml/xapi/xapi_pif.ml b/ocaml/xapi/xapi_pif.ml
index 06b81baf919..5fb414ce265 100644
--- a/ocaml/xapi/xapi_pif.ml
+++ b/ocaml/xapi/xapi_pif.ml
@@ -23,14 +23,23 @@ open Listext
open Pervasiveext
open Xstringext
open Threadext
-
open Network
+let get_device_pci ~__context ~host ~device =
+ let dbg = Context.string_of_task __context in
+ let pci_bus_path = Net.Interface.get_pci_bus_path dbg device in
+ let expr = Db_filter_types.(And (Eq (Field "pci_id", Literal (pci_bus_path)),
+ Eq (Field "host", Literal (Ref.string_of host)))) in
+ match Db.PCI.get_refs_where ~__context ~expr with
+ | pci :: _ -> pci
+ | _ -> Ref.null
+
let refresh_internal ~__context ~self =
let device = Db.PIF.get_device ~__context ~self in
let network = Db.PIF.get_network ~__context ~self in
let bridge = Db.Network.get_bridge ~__context ~self:network in
let dbg = Context.string_of_task __context in
+ let host = Db.PIF.get_host ~__context ~self in
(* Update the specified PIF field in the database, if
* and only if a corresponding value can be read from
@@ -58,6 +67,12 @@ let refresh_internal ~__context ~self =
(fun () -> Net.Interface.get_mac dbg device)
(id);
+ maybe_update_database "PCI"
+ (Db.PIF.get_PCI)
+ (Db.PIF.set_PCI)
+ (fun () -> get_device_pci ~__context ~host ~device)
+ (Ref.string_of);
+
maybe_update_database "MTU"
(Db.PIF.get_MTU)
(Db.PIF.set_MTU)
@@ -145,22 +160,7 @@ let assert_not_in_bond ~__context ~self =
let assert_no_vlans ~__context ~self =
(* Disallow if this is a base interface of any existing VLAN *)
- let vlans = Db.PIF.get_VLAN_slave_of ~__context ~self in
- debug "PIF %s assert_no_vlans = [ %s ]"
- (Db.PIF.get_uuid ~__context ~self)
- (String.concat "; " (List.map Ref.string_of vlans));
- if vlans <> []
- then begin
- debug "PIF has associated VLANs: [ %s ]"
- (String.concat
- ("; ")
- (List.map
- (fun self -> Db.VLAN.get_uuid ~__context ~self)
- (vlans)));
- raise (Api_errors.Server_error
- (Api_errors.pif_vlan_still_exists,
- [ Ref.string_of self ]))
- end;
+ Xapi_pif_helpers.assert_not_vlan_slave ~__context ~self;
(* Disallow if this is a derived interface of a VLAN *)
if
Db.PIF.get_VLAN ~__context ~self <> (-1L)
@@ -198,10 +198,6 @@ let assert_not_management_pif ~__context ~self =
if Db.PIF.get_management ~__context ~self then
raise (Api_errors.Server_error (Api_errors.pif_is_management_iface, [ Ref.string_of self ]))
-let assert_pif_is_managed ~__context ~self =
- if Db.PIF.get_managed ~__context ~self <> true then
- raise (Api_errors.Server_error (Api_errors.pif_unmanaged, [Ref.string_of self]))
-
let assert_not_slave_management_pif ~__context ~self =
if true
&& Pool_role.is_slave ()
@@ -225,6 +221,16 @@ let assert_no_protection_enabled ~__context ~self =
(Api_errors.redo_log_is_enabled, []))
end
+let assert_no_sriov ~__context ~self =
+ let pif_rec = Db.PIF.get_record ~__context ~self in
+ let topo = Xapi_pif_helpers.get_pif_topo ~__context ~pif_rec in
+ match topo, pif_rec.API.pIF_sriov_physical_PIF_of with
+ | Network_sriov_logical _ :: _, _ ->
+ raise Api_errors.(Server_error (cannot_forget_sriov_logical, [ Ref.string_of self ]))
+ | Physical _ :: _, _ :: _ ->
+ raise Api_errors.(Server_error (pif_sriov_still_exists, [ Ref.string_of self ]))
+ | _ -> ()
+
let abort_if_network_attached_to_protected_vms ~__context ~self =
(* Abort a PIF.unplug if the Network
* has VIFs connected to protected VMs *)
@@ -374,7 +380,7 @@ let pool_introduce
~ip_configuration_mode ~iP ~netmask ~gateway ~dNS
~bond_slave_of:Ref.null ~vLAN_master_of ~management
~other_config ~disallow_unplug ~ipv6_configuration_mode
- ~iPv6 ~ipv6_gateway ~primary_address_type ~managed ~properties ~capabilities:[] in
+ ~iPv6 ~ipv6_gateway ~primary_address_type ~managed ~properties ~capabilities:[] ~pCI:Ref.null in
pif_ref
let db_introduce = pool_introduce
@@ -400,6 +406,7 @@ let introduce_internal
in
let dbg = Context.string_of_task __context in
let capabilities = Net.Interface.get_capabilities dbg device in
+ let pci = get_device_pci ~__context ~host ~device in
let pif = Ref.make () in
debug
@@ -414,7 +421,7 @@ let introduce_internal
~dNS:"" ~bond_slave_of:Ref.null ~vLAN_master_of ~management:false
~other_config:[] ~disallow_unplug ~ipv6_configuration_mode:`None
~iPv6:[] ~ipv6_gateway:"" ~primary_address_type:`IPv4 ~managed
- ~properties:default_properties ~capabilities:capabilities in
+ ~properties:default_properties ~capabilities:capabilities ~pCI:pci in
(* If I'm a pool slave and this pif represents my management
* interface then leave it alone: if the interface goes down
@@ -532,6 +539,7 @@ let forget ~__context ~self =
assert_no_tunnels ~__context ~self;
assert_not_slave_management_pif ~__context ~self;
assert_no_protection_enabled ~__context ~self;
+ assert_no_sriov ~__context ~self;
let host = Db.PIF.get_host ~__context ~self in
let t = make_tables ~__context ~host in
@@ -621,7 +629,7 @@ let destroy ~__context ~self =
Client.Client.VLAN.destroy rpc session_id vlan)
let reconfigure_ipv6 ~__context ~self ~mode ~iPv6 ~gateway ~dNS =
- assert_pif_is_managed ~__context ~self;
+ Xapi_pif_helpers.assert_pif_is_managed ~__context ~self;
assert_no_protection_enabled ~__context ~self;
if gateway <> "" then
@@ -670,7 +678,7 @@ let reconfigure_ipv6 ~__context ~self ~mode ~iPv6 ~gateway ~dNS =
end
let reconfigure_ip ~__context ~self ~mode ~iP ~netmask ~gateway ~dNS =
- assert_pif_is_managed ~__context ~self;
+ Xapi_pif_helpers.assert_pif_is_managed ~__context ~self;
assert_no_protection_enabled ~__context ~self;
if mode = `Static then begin
@@ -768,10 +776,18 @@ let set_property ~__context ~self ~name ~value =
) (self :: vlan_pifs)
let rec unplug ~__context ~self =
- assert_pif_is_managed ~__context ~self;
+ let unplug_vlan_on_sriov ~__context ~self =
+ Db.PIF.get_VLAN_slave_of ~__context ~self
+ |> List.iter (fun vlan ->
+ let untagged_pif = Db.VLAN.get_untagged_PIF ~__context ~self:vlan in
+ unplug ~__context ~self:untagged_pif
+ )
+ in
+ Xapi_pif_helpers.assert_pif_is_managed ~__context ~self;
assert_no_protection_enabled ~__context ~self;
assert_not_management_pif ~__context ~self;
- let host = Db.PIF.get_host ~__context ~self in
+ let pif_rec = Db.PIF.get_record ~__context ~self in
+ let host = pif_rec.API.pIF_host in
if Db.Host.get_enabled ~__context ~self:host
then abort_if_network_attached_to_protected_vms ~__context ~self;
@@ -781,84 +797,128 @@ let rec unplug ~__context ~self =
if Db.PIF.get_capabilities ~__context ~self |> List.mem "fcoe" then
assert_fcoe_not_in_use ~__context self;
- let tunnel = Db.PIF.get_tunnel_transport_PIF_of ~__context ~self in
- if tunnel <> []
- then begin
- debug "PIF is tunnel transport PIF... also bringing down access PIF";
- let tunnel = List.hd tunnel in
- let access_PIF = Db.Tunnel.get_access_PIF ~__context ~self:tunnel in
- unplug ~__context ~self:access_PIF
+ List.iter (fun tunnel ->
+ debug "PIF is tunnel transport PIF... also bringing down access PIF";
+ let access_PIF = Db.Tunnel.get_access_PIF ~__context ~self:tunnel in
+ unplug ~__context ~self:access_PIF
+ ) pif_rec.API.pIF_tunnel_transport_PIF_of;
+
+ (* Only exclusive PIF types can be put into following pattern match *)
+ begin match Xapi_pif_helpers.get_pif_topo ~__context ~pif_rec with
+ | Bond_master bond :: _ ->
+ List.iter (fun slave ->
+ if Db.PIF.get_sriov_physical_PIF_of ~__context ~self:slave <> [] then begin
+ debug "PIF is bond master, one of its slaves is a network SRIOV physical PIF, \
+ also bringing down the slave as network SRIOV physical PIF";
+ unplug ~__context ~self:slave
+ end
+ ) (Db.Bond.get_slaves ~__context ~self:bond)
+ | Network_sriov_logical _ :: _ ->
+ debug "PIF is network SRIOV logical PIF, also bringing down vlan on top of it";
+ unplug_vlan_on_sriov ~__context ~self
+ | Physical pif_rec :: _ ->
+ List.iter (fun sriov ->
+ (* If this PIF is also a bond slave, it will be checked later to make sure that
+ * this bond slave will not be brought down here *)
+ debug "PIF is network SRIOV physical PIF, also bringing down SRIOV logical PIF";
+ let pif = Db.Network_sriov.get_logical_PIF ~__context ~self:sriov in
+ unplug ~__context ~self:pif
+ ) pif_rec.API.pIF_sriov_physical_PIF_of
+ | _ -> ()
end;
- Nm.bring_pif_down ~__context self
+
+ (* Don't bring down bond slave, as it will be handled with bond master *)
+ if pif_rec.API.pIF_bond_slave_of = Ref.null then
+ Nm.bring_pif_down ~__context self
let rec plug ~__context ~self =
- assert_pif_is_managed ~__context ~self;
- let tunnel = Db.PIF.get_tunnel_access_PIF_of ~__context ~self in
- if tunnel <> []
- then begin
- let tunnel = List.hd tunnel in
- let transport_PIF =
- Db.Tunnel.get_transport_PIF ~__context ~self:tunnel in
- if Db.PIF.get_ip_configuration_mode
- ~__context ~self:transport_PIF = `None
- then raise (Api_errors.Server_error
- (Api_errors.transport_pif_not_configured,
- [Ref.string_of transport_PIF]))
- else begin
- debug "PIF is tunnel access PIF... also bringing up transport PIF";
- plug ~__context ~self:transport_PIF
- end
- end;
- if Db.PIF.get_bond_slave_of ~__context ~self <> Ref.null then
- raise (Api_errors.Server_error (Api_errors.cannot_plug_bond_slave, [Ref.string_of self]));
- Nm.bring_pif_up ~__context ~management_interface:false self
+ Xapi_pif_helpers.assert_pif_is_managed ~__context ~self;
+ let pif_rec = Db.PIF.get_record ~__context ~self in
+ let () = match Xapi_pif_helpers.get_pif_type pif_rec with
+ | Tunnel_access tunnel ->
+ let transport_PIF = Db.Tunnel.get_transport_PIF ~__context ~self:tunnel in
+ if Db.PIF.get_ip_configuration_mode ~__context ~self:transport_PIF = `None
+ then raise Api_errors.(Server_error
+ (transport_pif_not_configured,
+ [Ref.string_of transport_PIF]))
+ else begin
+ debug "PIF is tunnel access PIF... also bringing up transport PIF";
+ plug ~__context ~self:transport_PIF
+ end
+ | VLAN_untagged vlan ->
+ let tagged_pif = Db.VLAN.get_tagged_PIF ~__context ~self:vlan in
+ if Db.PIF.get_sriov_logical_PIF_of ~__context ~self:tagged_pif <> [] then begin
+ debug "PIF is VLAN master on top of SRIOV logical PIF, also bringing up SRIOV logical PIF";
+ plug ~__context ~self:tagged_pif
+ end
+ | Network_sriov_logical sriov ->
+ let phy_pif = Db.Network_sriov.get_physical_PIF ~__context ~self:sriov in
+ debug "PIF is SRIOV logical PIF, also bringing up SRIOV physical PIF";
+ plug ~__context ~self:phy_pif
+ | Physical pif_rec ->
+ let bond = pif_rec.API.pIF_bond_slave_of in
+ if bond <> Ref.null then begin
+ if pif_rec.API.pIF_sriov_physical_PIF_of <> [] then begin
+ (* It's a bond slave and SR-IOV physical *)
+ let bond_master_pif = Db.Bond.get_master ~__context ~self:bond in
+ debug "PIF is SRIOV physical PIF and bond slave, also bringing up bond master PIF";
+ plug ~__context ~self:bond_master_pif
+ (* It will be checked later to make sure that bond slave will not be brought up *)
+ end
+ else raise Api_errors.(Server_error (cannot_plug_bond_slave, [Ref.string_of self]))
+ end else ()
+ | _ -> ()
+ in
+ (* Don't bring up bond slave, as it has been up with bond master *)
+ if pif_rec.API.pIF_bond_slave_of = Ref.null then
+ Nm.bring_pif_up ~__context ~management_interface:false self
let calculate_pifs_required_at_start_of_day ~__context =
let localhost = Helpers.get_localhost ~__context in
(* Select all PIFs on the host that are not bond slaves, and are physical, or bond master, or
* have IP configuration. The latter means that any VLAN or tunnel PIFs without IP address
* are excluded. *)
- Db.PIF.get_records_where ~__context
- ~expr:(
- And (
- Eq (Field "managed", Literal "true"),
+ let pifs = Db.PIF.get_records_where ~__context
+ ~expr:(
And (
+ Eq (Field "managed", Literal "true"),
And (
- Eq (Field "host", Literal (Ref.string_of localhost)),
- Eq (Field "bond_slave_of", Literal (Ref.string_of Ref.null))
- ),
- Or (Or (
- Not (Eq (Field "bond_master_of", Literal "()")),
- Eq (Field "physical", Literal "true")),
- Not (Eq (Field "ip_configuration_mode", Literal "None"))
- )
+ And (
+ Eq (Field "host", Literal (Ref.string_of localhost)),
+ Eq (Field "bond_slave_of", Literal (Ref.string_of Ref.null))
+ ),
+ Or (Or (
+ Not (Eq (Field "bond_master_of", Literal "()")),
+ Eq (Field "physical", Literal "true")),
+ Not (Eq (Field "ip_configuration_mode", Literal "None"))
+ )
+ )
)
- )
- )
+ ) in
+ let sriov_pifs = Db.PIF.get_records_where ~__context ~expr:(And (
+ Eq (Field "host", Literal (Ref.string_of localhost)),
+ Not (Eq (Field "sriov_logical_PIF_of", Literal "()") )
+ )) in
+ pifs @ sriov_pifs
let start_of_day_best_effort_bring_up () =
- begin
- Server_helpers.exec_with_new_task
- "Bringing up managed physical PIFs"
- (fun __context ->
- let dbg = Context.string_of_task __context in
- debug
- "Configured network backend: %s"
- (Network_interface.string_of_kind (Net.Bridge.get_kind dbg ()));
- (* Clear the state of the network daemon, before refreshing it by plugging
- * the most important PIFs (see above). *)
- Net.clear_state ();
- List.iter
- (fun (pif, pifr) ->
- Helpers.log_exn_continue
- (Printf.sprintf
- "error trying to bring up pif: %s"
- pifr.API.pIF_uuid)
- (fun pif ->
- debug
- "Best effort attempt to bring up PIF: %s"
- pifr.API.pIF_uuid;
- plug ~__context ~self:pif)
- (pif))
- (calculate_pifs_required_at_start_of_day ~__context))
- end
+ Server_helpers.exec_with_new_task
+ "Bringing up managed physical and sriov PIFs"
+ (fun __context ->
+ let dbg = Context.string_of_task __context in
+ debug
+ "Configured network backend: %s"
+ (Network_interface.string_of_kind (Net.Bridge.get_kind dbg ()));
+ (* Clear the state of the network daemon, before refreshing it by plugging
+ * the most important PIFs (see above). *)
+ Net.clear_state ();
+ List.iter
+ (fun (pif, pifr) ->
+ Helpers.log_exn_continue
+ (Printf.sprintf "error trying to bring up pif: %s" pifr.API.pIF_uuid)
+ (fun pif ->
+ debug "Best effort attempt to bring up PIF: %s" pifr.API.pIF_uuid;
+ plug ~__context ~self:pif)
+ (pif))
+ (calculate_pifs_required_at_start_of_day ~__context))
+
diff --git a/ocaml/xapi/xapi_pif_helpers.ml b/ocaml/xapi/xapi_pif_helpers.ml
new file mode 100644
index 00000000000..5bc56fea599
--- /dev/null
+++ b/ocaml/xapi/xapi_pif_helpers.ml
@@ -0,0 +1,182 @@
+(*
+ * Copyright (C) Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+open API
+module D=Debug.Make(struct let name="xapi" end)
+open D
+
+(* Any given PIF should belongs only one of the following types *)
+type pif_type_t =
+ | Tunnel_access of ref_tunnel
+ | VLAN_untagged of ref_VLAN
+ | Network_sriov_logical of ref_network_sriov
+ | Bond_master of ref_Bond
+ | Physical of pIF_t
+
+let pif_type_to_string = function
+ | Tunnel_access _ -> "Tunnel_access"
+ | VLAN_untagged _ -> "VLAN_untagged"
+ | Network_sriov_logical _ -> "Network_sriov_logical"
+ | Bond_master _ -> "Bond_master"
+ | Physical _ -> "Physical"
+
+let is_tunnel_access_pif pif_rec =
+ match pif_rec.API.pIF_tunnel_access_PIF_of with
+ | tunnel :: _ -> Some (Tunnel_access tunnel)
+ | _ -> None
+
+let is_vlan_master_pif pif_rec =
+ let vlan = pif_rec.API.pIF_VLAN_master_of in
+ if vlan = Ref.null then None else Some (VLAN_untagged vlan)
+
+let is_sriov_logical_pif pif_rec =
+ match pif_rec.API.pIF_sriov_logical_PIF_of with
+ | sriov :: _ -> Some (Network_sriov_logical sriov)
+ | _ -> None
+
+let is_bond_master_pif pif_rec =
+ match pif_rec.API.pIF_bond_master_of with
+ | bond :: _ -> Some (Bond_master bond)
+ | _ -> None
+
+let is_physical_pif pif_rec =
+ if pif_rec.API.pIF_physical then Some (Physical pif_rec) else None
+
+let (>>=) (ret, pif_rec) f =
+ match ret, pif_rec with
+ | Some _ as v, _ -> v, pif_rec
+ | None, _ -> f pif_rec, pif_rec
+
+let get_pif_type pif_rec =
+ match (None, pif_rec)
+ >>= is_tunnel_access_pif
+ >>= is_vlan_master_pif
+ >>= is_sriov_logical_pif
+ >>= is_bond_master_pif
+ >>= is_physical_pif
+ with
+ | Some v, _ -> v
+ | None, _ -> raise Api_errors.(Server_error (internal_error, [Printf.sprintf "Cannot calculate PIF type of %s" pif_rec.API.pIF_uuid]))
+
+(** This function aims to get a list of types of the PIFs underneath the given PIF *)
+(* The root PIF underneath should be Physical or Bond_master *)
+let get_pif_topo ~__context ~pif_rec =
+ let rec get_pif_type_till_root ret pif_rec =
+ let pif_t = get_pif_type pif_rec in
+ match pif_t with
+ | Tunnel_access tunnel ->
+ let tunnel_rec = Db.Tunnel.get_record ~__context ~self:tunnel in
+ let pif_ref = tunnel_rec.API.tunnel_transport_PIF in
+ let pif_rec = Db.PIF.get_record ~__context ~self:pif_ref in
+ get_pif_type_till_root (pif_t :: ret) pif_rec
+ | VLAN_untagged vlan ->
+ let vlan_rec = Db.VLAN.get_record ~__context ~self:vlan in
+ let pif_ref = vlan_rec.API.vLAN_tagged_PIF in
+ let pif_rec = Db.PIF.get_record ~__context ~self:pif_ref in
+ get_pif_type_till_root (pif_t :: ret) pif_rec
+ | Network_sriov_logical sriov ->
+ let sriov_rec = Db.Network_sriov.get_record ~__context ~self:sriov in
+ let pif_ref = sriov_rec.API.network_sriov_physical_PIF in
+ let pif_rec = Db.PIF.get_record ~__context ~self:pif_ref in
+ get_pif_type_till_root (pif_t :: ret) pif_rec
+ | Bond_master _
+ | Physical _ ->
+ pif_t :: ret
+ in
+ let pif_t_list = get_pif_type_till_root [] pif_rec in
+ let pif_t_list = List.rev pif_t_list in
+ debug "PIF type of %s is: %s" pif_rec.API.pIF_uuid (String.concat " " (List.map pif_type_to_string pif_t_list));
+ pif_t_list
+
+let vlan_is_allowed_on_pif ~__context ~tagged_PIF ~pif_rec ~pif_topo ~tag =
+ match pif_topo with
+ | Physical pif_rec :: _ when pif_rec.API.pIF_bond_slave_of <> Ref.null ->
+ (* Disallow creating on bond slave *)
+ (* Here we rely on the implementation to guarantee that `Physical` is a terminating case *)
+ raise Api_errors.(Server_error (cannot_add_vlan_to_bond_slave, [Ref.string_of tagged_PIF]))
+ | VLAN_untagged _ :: _ ->
+ raise Api_errors.(Server_error (pif_is_vlan, [Ref.string_of tagged_PIF]))
+ | Tunnel_access _ :: _ ->
+ raise Api_errors.(Server_error (is_tunnel_access_pif, [Ref.string_of tagged_PIF]))
+ | _ -> ()
+
+let tunnel_is_allowed_on_pif ~__context ~transport_PIF =
+ let pif_rec = Db.PIF.get_record ~__context ~self:transport_PIF in
+ match get_pif_topo ~__context ~pif_rec with
+ | Physical pif_rec :: _ when pif_rec.API.pIF_bond_slave_of <> Ref.null ->
+ (* Disallow creating on bond slave *)
+ (* Here we rely on the implementation to guarantee that `Physical` is a terminating case *)
+ raise Api_errors.(Server_error (cannot_add_tunnel_to_bond_slave, [Ref.string_of transport_PIF]))
+ | Tunnel_access _ :: _ ->
+ raise Api_errors.(Server_error (is_tunnel_access_pif, [Ref.string_of transport_PIF]));
+ | Network_sriov_logical _ :: _ ->
+ raise Api_errors.(Server_error (cannot_add_tunnel_to_sriov_logical, [Ref.string_of transport_PIF]))
+ | VLAN_untagged _ :: Network_sriov_logical _ :: _ ->
+ raise Api_errors.(Server_error (cannot_add_tunnel_to_vlan_on_sriov_logical, [Ref.string_of transport_PIF]))
+ | _ -> ()
+
+let bond_is_allowed_on_pif ~__context ~self =
+ let pif_rec = Db.PIF.get_record ~__context ~self in
+ match get_pif_topo ~__context ~pif_rec with
+ | Physical pif_rec :: _ when pif_rec.API.pIF_bond_slave_of <> Ref.null ->
+ (* Disallow creating on bond slave *)
+ (* Here we rely on the implementation to guarantee that `Physical` is a terminating case *)
+ let bond = pif_rec.API.pIF_bond_slave_of in
+ let bonded = try ignore(Db.Bond.get_uuid ~__context ~self:bond); true with _ -> false in
+ if bonded
+ then raise Api_errors.(Server_error (pif_already_bonded, [ Ref.string_of self ]))
+ | VLAN_untagged _ :: _ ->
+ raise Api_errors.(Server_error (pif_vlan_exists, [Db.PIF.get_device_name ~__context ~self]))
+ | Tunnel_access _ :: _ ->
+ raise Api_errors.(Server_error (is_tunnel_access_pif, [Ref.string_of self]))
+ | Network_sriov_logical _ :: _ ->
+ raise Api_errors.(Server_error (pif_is_sriov_logical, [Ref.string_of self]))
+ | _ -> ()
+
+let sriov_is_allowed_on_pif ~__context ~physical_PIF ~pif_rec =
+ let _ = match get_pif_type pif_rec with
+ | Physical _ -> ()
+ | _ ->
+ raise Api_errors.(Server_error (pif_is_not_physical, [Ref.string_of physical_PIF]))
+ in
+ if pif_rec.API.pIF_sriov_physical_PIF_of <> [] then
+ raise Api_errors.(Server_error (network_sriov_already_enabled, [Ref.string_of physical_PIF]));
+ if not (List.mem "sriov" pif_rec.API.pIF_capabilities) then
+ raise Api_errors.(Server_error (pif_is_not_sriov_capable, [Ref.string_of physical_PIF]))
+
+let assert_pif_is_managed ~__context ~self =
+ if Db.PIF.get_managed ~__context ~self <> true then
+ raise Api_errors.(Server_error (pif_unmanaged, [Ref.string_of self]))
+
+let assert_not_vlan_slave ~__context ~self =
+ let vlans = Db.PIF.get_VLAN_slave_of ~__context ~self in
+ debug "PIF %s assert_no_vlans = [ %s ]"
+ (Db.PIF.get_uuid ~__context ~self)
+ (String.concat "; " (List.map Ref.string_of vlans));
+ if vlans <> []
+ then begin
+ List.map (fun self -> Db.VLAN.get_uuid ~__context ~self) vlans
+ |> String.concat "; "
+ |> debug "PIF has associated VLANs: [ %s ]";
+ raise Api_errors.(Server_error
+ (pif_vlan_still_exists,
+ [ Ref.string_of self ]))
+ end
+
+let is_device_underneath_same_type ~__context pif1 pif2 =
+ let get_device_info pif =
+ let pci = Db.PIF.get_PCI ~__context ~self:pif in
+ let pci_rec = Db.PCI.get_record_internal ~__context ~self:pci in
+ pci_rec.Db_actions.pCI_vendor_id, pci_rec.Db_actions.pCI_device_id
+ in
+ (get_device_info pif1) = (get_device_info pif2)
diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml
index 6f4ece5dfb7..5682b0bfa56 100644
--- a/ocaml/xapi/xapi_pool.ml
+++ b/ocaml/xapi/xapi_pool.ml
@@ -244,6 +244,13 @@ let pre_join_checks ~__context ~rpc ~session_id ~force =
raise (Api_errors.Server_error(Api_errors.pool_joining_host_has_tunnels, []))
end in
+ (* Allow pool-join if host does not have any network-sriovs*)
+ let assert_no_network_sriovs_on_me () =
+ if Db.Network_sriov.get_all ~__context <> [] then begin
+ error "The current host has network SR-IOV enabled: it cannot join a new pool";
+ raise (Api_errors.Server_error(Api_errors.pool_joining_host_has_network_sriovs, []))
+ end in
+
(* Allow pool-join if host does not have any non-management VLANs *)
let assert_no_non_management_vlans_on_me () =
List.iter (fun self ->
@@ -452,6 +459,7 @@ let pre_join_checks ~__context ~rpc ~session_id ~force =
assert_no_shared_srs_on_me ();
assert_no_bonds_on_me ();
assert_no_tunnels_on_me ();
+ assert_no_network_sriovs_on_me ();
assert_no_non_management_vlans_on_me ();
assert_management_vlan_are_same ();
assert_external_auth_matches ();
diff --git a/ocaml/xapi/xapi_tunnel.ml b/ocaml/xapi/xapi_tunnel.ml
index 56ea5af1a73..c493a109de2 100644
--- a/ocaml/xapi/xapi_tunnel.ml
+++ b/ocaml/xapi/xapi_tunnel.ml
@@ -41,20 +41,20 @@ let create_internal ~__context ~transport_PIF ~network ~host =
~device ~device_name ~network ~host ~mAC ~mTU:(-1L) ~vLAN:(-1L) ~metrics
~physical:false ~currently_attached:false ~igmp_snooping_status:`unknown
~ip_configuration_mode:`None ~iP:"" ~netmask:"" ~gateway:"" ~dNS:"" ~bond_slave_of:Ref.null
- ~vLAN_master_of:Ref.null ~management:false ~other_config:[] ~disallow_unplug:false ~ipv6_configuration_mode:`None
- ~iPv6:[""] ~ipv6_gateway:"" ~primary_address_type:`IPv4 ~managed:true ~properties:[] ~capabilities:[];
+ ~vLAN_master_of:Ref.null
+ ~management:false ~other_config:[] ~disallow_unplug:false ~ipv6_configuration_mode:`None
+ ~iPv6:[""] ~ipv6_gateway:"" ~primary_address_type:`IPv4 ~managed:true ~properties:[] ~capabilities:[] ~pCI:Ref.null;
Db.Tunnel.create ~__context ~ref:tunnel ~uuid:(Uuid.to_string (Uuid.make_uuid ()))
~access_PIF ~transport_PIF ~status:["active", "false"] ~other_config:[];
tunnel, access_PIF
let create ~__context ~transport_PIF ~network =
Xapi_network.assert_network_is_managed ~__context ~self:network;
- if Db.PIF.get_managed ~__context ~self:transport_PIF <> true then
- raise (Api_errors.Server_error (Api_errors.pif_unmanaged, [Ref.string_of transport_PIF]));
- if Db.PIF.get_bond_slave_of ~__context ~self:transport_PIF <> Ref.null then
- raise (Api_errors.Server_error (Api_errors.cannot_add_tunnel_to_bond_slave, [Ref.string_of transport_PIF]));
let host = Db.PIF.get_host ~__context ~self:transport_PIF in
Xapi_pif.assert_no_other_local_pifs ~__context ~host ~network;
+ Xapi_pif_helpers.assert_pif_is_managed ~__context ~self:transport_PIF;
+ Xapi_pif_helpers.tunnel_is_allowed_on_pif ~__context ~transport_PIF;
+ Xapi_network_helpers.assert_network_compatible_with_tunnel ~__context ~network;
let hosts = Db.Host.get_all ~__context in
List.iter
(fun h ->
@@ -62,8 +62,6 @@ let create ~__context ~transport_PIF ~network =
if not (List.mem_assoc "network_backend" v && List.assoc "network_backend" v = "openvswitch") then
raise (Api_errors.Server_error (Api_errors.openvswitch_not_active, []));
) hosts;
- if Db.PIF.get_tunnel_access_PIF_of ~__context ~self:transport_PIF <> [] then
- raise (Api_errors.Server_error (Api_errors.is_tunnel_access_pif, [Ref.string_of transport_PIF]));
let tunnel, access_PIF = create_internal ~__context ~transport_PIF ~network ~host in
Xapi_pif.plug ~__context ~self:access_PIF;
tunnel
diff --git a/ocaml/xapi/xapi_vif_helpers.ml b/ocaml/xapi/xapi_vif_helpers.ml
index 7c7a689a33b..82d611e5d8e 100644
--- a/ocaml/xapi/xapi_vif_helpers.ml
+++ b/ocaml/xapi/xapi_vif_helpers.ml
@@ -34,7 +34,8 @@ let valid_operations ~__context record _ref' : table =
* one operation at a time
* a halted VM can have the VIF attached
* a running VM can do plug/unplug depending on whether the device is already
- currently-attached and whether the VM has PV drivers *)
+ currently-attached and whether the VM has PV drivers
+ * Network SR-IOV VIF plug/unplug not allowed when VM is running *)
let table : table = Hashtbl.create 10 in
List.iter (fun x -> Hashtbl.replace table x None) all_ops;
let set_errors (code: string) (params: string list) (ops: API.vif_operations_set) =
@@ -54,6 +55,11 @@ let valid_operations ~__context record _ref' : table =
[ "VIF"; _ref; vif_operation_to_string concurrent_op ] all_ops;
end;
+ (* SR-IOV VIF do not support hotplug/unplug *)
+ let network = record.Db_actions.vIF_network in
+ if Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network then
+ set_errors Api_errors.operation_not_allowed ["Network SR-IOV VIF plug/unplug not allowed"] [ `plug; `unplug ];
+
(* VM must be online to support plug/unplug *)
let power_state = Db.VM.get_power_state ~__context ~self:vm in
let plugged = record.Db_actions.vIF_currently_attached || record.Db_actions.vIF_reserved in
@@ -184,6 +190,9 @@ let create ~__context ~device ~network ~vM
~ipv6_configuration_mode ~ipv6_addresses ~ipv6_gateway : API.ref_VIF =
let () = debug "VIF.create running" in
+ if Xapi_network_sriov_helpers.is_sriov_network ~__context ~self:network then
+ Pool_features.assert_enabled ~__context ~f:Features.Network_sriov;
+
if locking_mode = `locked || ipv4_allowed <> [] || ipv6_allowed <> [] then
assert_locking_licensed ~__context;
@@ -240,8 +249,8 @@ let create ~__context ~device ~network ~vM
~runtime_properties:[] ~other_config
~metrics ~locking_mode
~ipv4_allowed ~ipv6_allowed
- ~ipv4_configuration_mode ~ipv4_addresses ~ipv4_gateway
- ~ipv6_configuration_mode ~ipv6_addresses ~ipv6_gateway in ()
+ ~ipv4_configuration_mode ~ipv4_addresses ~ipv4_gateway
+ ~ipv6_configuration_mode ~ipv6_addresses ~ipv6_gateway ~reserved_pci:Ref.null in ()
);
update_allowed_operations ~__context ~self:ref;
debug "VIF ref='%s' created (VM = '%s'; MAC address = '%s')" (Ref.string_of ref) (Ref.string_of vM) mAC;
diff --git a/ocaml/xapi/xapi_vlan.ml b/ocaml/xapi/xapi_vlan.ml
index 49ea5cd95f0..61b05704215 100644
--- a/ocaml/xapi/xapi_vlan.ml
+++ b/ocaml/xapi/xapi_vlan.ml
@@ -35,43 +35,34 @@ let create_internal ~__context ~host ~tagged_PIF ~tag ~network ~device =
~device ~device_name:device ~network ~host ~mAC:vlan_mac ~mTU ~vLAN:tag ~metrics
~physical:false ~currently_attached:false ~igmp_snooping_status:`unknown
~ip_configuration_mode:`None ~iP:"" ~netmask:"" ~gateway:"" ~dNS:"" ~bond_slave_of:Ref.null
- ~vLAN_master_of:vlan ~management:false ~other_config:[] ~disallow_unplug:false
+ ~vLAN_master_of:vlan ~management:false
+ ~other_config:[] ~disallow_unplug:false
~ipv6_configuration_mode:`None ~iPv6:[""] ~ipv6_gateway:"" ~primary_address_type:`IPv4 ~managed:true
- ~properties:[] ~capabilities:[];
+ ~properties:[] ~capabilities:[] ~pCI:Ref.null;
let () = Db.VLAN.create ~__context ~ref:vlan ~uuid:vlan_uuid ~tagged_PIF ~untagged_PIF ~tag ~other_config:[] in
vlan, untagged_PIF
let create ~__context ~tagged_PIF ~tag ~network =
Xapi_network.assert_network_is_managed ~__context ~self:network;
- if Db.PIF.get_managed ~__context ~self:tagged_PIF <> true then
- raise (Api_errors.Server_error (Api_errors.pif_unmanaged, [Ref.string_of tagged_PIF]));
-
let host = Db.PIF.get_host ~__context ~self:tagged_PIF in
Xapi_pif.assert_no_other_local_pifs ~__context ~host ~network;
-
- if Db.PIF.get_bond_slave_of ~__context ~self:tagged_PIF <> Ref.null then
- raise (Api_errors.Server_error (Api_errors.cannot_add_vlan_to_bond_slave, [Ref.string_of tagged_PIF]));
-
- (* Check that the tagged PIF is not a VLAN itself - CA-25160. This check can be skipped using the allow_vlan_on_vlan FIST point. *)
- let origtag = Db.PIF.get_VLAN ~__context ~self:tagged_PIF in
- if origtag >= 0L && not (Xapi_fist.allow_vlan_on_vlan()) then
- raise (Api_errors.Server_error (Api_errors.pif_is_vlan, [Ref.string_of tagged_PIF]));
-
+ Xapi_pif_helpers.assert_pif_is_managed ~__context ~self:tagged_PIF;
+ let pif_rec = Db.PIF.get_record ~__context ~self:tagged_PIF in
+ let pif_topo = Xapi_pif_helpers.get_pif_topo ~__context ~pif_rec in
+ Xapi_pif_helpers.vlan_is_allowed_on_pif ~__context ~tagged_PIF ~pif_rec ~pif_topo ~tag;
+ Xapi_network_helpers.assert_vlan_network_compatible_with_pif ~__context ~network ~tagged_PIF ~pif_topo;
(* Check the VLAN tag is sensible; 4095 is reserved for implementation use (802.1Q) *)
if tag<0L || tag>4094L then
raise (Api_errors.Server_error (Api_errors.vlan_tag_invalid, [Int64.to_string tag]));
- let device = Db.PIF.get_device ~__context ~self:tagged_PIF in
+ let device = pif_rec.API.pIF_device in
let vlans = Db.VLAN.get_records_where ~__context
~expr:(Db_filter_types.And (Db_filter_types.Eq (Db_filter_types.Field "tagged_PIF", Db_filter_types.Literal (Ref.string_of tagged_PIF)),
Db_filter_types.Eq (Db_filter_types.Field "tag", Db_filter_types.Literal (Int64.to_string tag)))) in
if vlans <> [] then
raise (Api_errors.Server_error (Api_errors.pif_vlan_exists, [device]));
- if Db.PIF.get_tunnel_access_PIF_of ~__context ~self:tagged_PIF <> [] then
- raise (Api_errors.Server_error (Api_errors.is_tunnel_access_pif, [Ref.string_of tagged_PIF]));
-
(* Check the VLAN is not in use by the kernel *)
let open Network in
if Net.Interface.has_vlan (Context.string_of_task __context) device (Int64.to_int tag) then
diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml
index f9b348f5db7..a0329f6112b 100644
--- a/ocaml/xapi/xapi_vm.ml
+++ b/ocaml/xapi/xapi_vm.ml
@@ -252,6 +252,10 @@ let start ~__context ~vm ~start_paused ~force =
if vusbs <> [] then
Vm_platform.check_restricted_device_model ~__context vmr.API.vM_platform;
+ let sriov_networks = Xapi_network_sriov_helpers.get_sriov_networks_from_vm __context vm in
+ if sriov_networks <> [] then
+ Pool_features.assert_enabled ~__context ~f:Features.Network_sriov;
+
if not force then
assert_memory_constraints ~__context ~vm vmr.API.vM_platform;
@@ -374,7 +378,7 @@ let power_state_reset ~__context ~vm =
end;
(* Perform sanity checks if VM is Running or Paused since we don't want to
lose track of running domains. *)
- if Xapi_vm_lifecycle.is_live ~__context ~self:vm then begin
+ if Xapi_vm_lifecycle_helpers.is_live ~__context ~self:vm then begin
debug "VM.power_state_reset vm=%s power state is either running or paused: performing sanity checks" (Ref.string_of vm);
let localhost = Helpers.get_localhost ~__context in
let resident = Db.VM.get_resident_on ~__context ~self:vm in
diff --git a/ocaml/xapi/xapi_vm_clone.ml b/ocaml/xapi/xapi_vm_clone.ml
index a1ed87655f4..609c3ae8901 100644
--- a/ocaml/xapi/xapi_vm_clone.ml
+++ b/ocaml/xapi/xapi_vm_clone.ml
@@ -100,9 +100,12 @@ let wait_for_subtask ?progress_minmax ~__context task =
let wait_for_clone ?progress_minmax ~__context task =
let result = wait_for_subtask ?progress_minmax ~__context task in
- let result = Xml.parse_string result in
- let vdiref = API.Legacy.From.ref_VDI "" result in
- vdiref
+ try
+ result
+ |> Xmlrpc.of_string
+ |> API.ref_VDI_of_rpc
+ with
+ parse_error -> raise Api_errors.(Server_error (field_type_error, [Printexc.to_string parse_error]))
(* Clone code is parameterised over this so it can be shared with copy *)
type disk_op_t =
diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml
index b57c0de403b..c2260254f55 100644
--- a/ocaml/xapi/xapi_vm_helpers.ml
+++ b/ocaml/xapi/xapi_vm_helpers.ml
@@ -409,6 +409,26 @@ let assert_usbs_available ~__context ~self ~host =
]))
)
+(* Get SR-IOV Vifs by return a list of [(network1,(required_num1,PCI1));(network2,(required_num2,PCI2))....]
+ Raise exn immediately when found Idle VF nums < required_num *)
+let assert_netsriov_available ~__context ~self ~host =
+ let sriov_networks = List.fold_left (fun acc vif ->
+ let network = Db.VIF.get_network ~__context ~self:vif in
+ try
+ let required, pif = List.assoc network acc in
+ (network,(required + 1,pif)) :: (List.remove_assoc network acc)
+ with Not_found ->
+ match Xapi_network_sriov_helpers.get_local_underlying_pif ~__context ~network ~host with
+ | Some pif -> (network,(1,pif)) :: acc
+ | None -> acc
+ ) [] (Db.VM.get_VIFs ~__context ~self)
+ in
+ List.iter (fun (network, (required,pif)) ->
+ let pci = Db.PIF.get_PCI ~__context ~self:pif in
+ if (Xapi_pci.get_idle_vf_nums ~__context ~self:pci) < (Int64.of_int required) then
+ raise (Api_errors.Server_error(Api_errors.network_sriov_insufficient_capacity, [Ref.string_of network]))
+ ) sriov_networks
+
let assert_host_supports_hvm ~__context ~self ~host =
(* For now we say that a host supports HVM if any of *)
(* the capability strings contains the substring "hvm". *)
@@ -489,6 +509,7 @@ let assert_can_boot_here ~__context ~self ~host ~snapshot ?(do_sr_check=true) ?(
assert_host_has_iommu ~__context ~host;
assert_gpus_available ~__context ~self ~host;
assert_usbs_available ~__context ~self ~host;
+ assert_netsriov_available ~__context ~self ~host;
begin match Helpers.domain_type ~__context ~self with
| `hvm | `pv_in_pvh ->
assert_host_supports_hvm ~__context ~self ~host
@@ -648,42 +669,77 @@ let group_hosts_by_best_pgpu_in_group ~__context gpu_group vgpu_type =
snd (List.hd (List.hd (group_by_capacity viable_resident_pgpus)))
) viable_hosts
-(** Selects a single host from the set of all hosts on which the given [vm]
- can boot. Raises [Api_errors.no_hosts_available] if no such host exists. *)
-let choose_host_for_vm_no_wlb ~__context ~vm ~snapshot =
+let vm_has_vgpu ~__context ~vm =
+ match Db.VM.get_VGPUs ~__context ~self:vm with
+ | [] -> None
+ | vgpu :: _ -> Some (`VGPU vgpu)
+
+let vm_has_sriov ~__context ~vm =
+ match Xapi_network_sriov_helpers.get_sriov_networks_from_vm ~__context ~vm with
+ | [] -> None
+ | network :: _ -> Some (`Netsriov network)
+
+let (>>=) opt f =
+ match opt with
+ | Some _ as v -> v
+ | None -> f
+
+let get_group_key ~__context ~vm =
+ match None
+ >>= (vm_has_vgpu __context vm)
+ >>= (vm_has_sriov __context vm) with
+ | Some x -> x
+ | None -> `Other
+
+let group_hosts_by_best_pgpu ~__context vgpu =
+ let vgpu_type = Db.VGPU.get_type ~__context ~self:vgpu in
+ let gpu_group = Db.VGPU.get_GPU_group ~__context ~self:vgpu in
+ match
+ Xapi_gpu_group.get_remaining_capacity_internal ~__context
+ ~self:gpu_group ~vgpu_type
+ with
+ | Either.Left e -> raise e
+ | Either.Right _ -> ();
+ group_hosts_by_best_pgpu_in_group ~__context gpu_group vgpu_type
+ |> List.map (fun g -> List.map (fun (h,_)-> h) g)
+
+(* Selects a single host from the set of all hosts on which the given [vm] can boot.
+ Raises [Api_errors.no_hosts_available] if no such host exists.
+ 1.Take Vgpu or Network SR-IOV as a group_key for group all hosts into host list list
+ 2.helper function's order determine the priority of resources,now vgpu has higher priority than Network SR-IOV
+ 3.If no key found in VM,then host_lists will be [all_hosts] *)
+let choose_host_for_vm_no_wlb ~__context ~vm ~snapshot =
let validate_host = vm_can_run_on_host ~__context ~vm ~snapshot ~do_memory_check:true in
let all_hosts = Db.Host.get_all ~__context in
+ let group_key = get_group_key ~__context ~vm in
+ let host_lists =
+ match group_key with
+ | `Other -> [all_hosts]
+ | `VGPU vgpu -> group_hosts_by_best_pgpu ~__context vgpu
+ | `Netsriov network ->
+ let host_group = Xapi_network_sriov_helpers.group_hosts_by_best_sriov ~__context ~network
+ |> List.map (fun g -> List.map (fun (h,_)-> h) g)
+ in
+ if host_group <> [] then host_group
+ else raise (Api_errors.Server_error(Api_errors.network_sriov_insufficient_capacity, [Ref.string_of network]))
+ in
+ let rec select_host_from = function
+ | [] -> raise (Api_errors.Server_error (Api_errors.no_hosts_available, []))
+ | (hosts :: less_optimal_groups_of_hosts) ->
+ debug "Attempting to start VM (%s) on one of equally optimal hosts [ %s ]"
+ (Ref.string_of vm) (String.concat ";" (List.map Ref.string_of hosts));
+ try Xapi_vm_placement.select_host __context vm validate_host hosts
+ with _ ->
+ info "Failed to start VM (%s) on any of [ %s ]"
+ (Ref.string_of vm) (String.concat ";" (List.map Ref.string_of hosts));
+ select_host_from less_optimal_groups_of_hosts
+ in
try
- match Db.VM.get_VGPUs ~__context ~self:vm with
- | [] -> Xapi_vm_placement.select_host __context vm validate_host all_hosts
- | vgpu :: _ -> (* just considering first vgpu *)
- let vgpu_type = Db.VGPU.get_type ~__context ~self:vgpu in
- let gpu_group = Db.VGPU.get_GPU_group ~__context ~self:vgpu in
- match
- Xapi_gpu_group.get_remaining_capacity_internal ~__context
- ~self:gpu_group ~vgpu_type
- with
- | Either.Left e -> raise e
- | Either.Right _ -> ();
- let host_lists =
- group_hosts_by_best_pgpu_in_group ~__context gpu_group vgpu_type in
- let rec select_host_from = function
- | [] -> raise (Api_errors.Server_error (Api_errors.no_hosts_available, []))
- | (hosts :: less_optimal_groups_of_hosts) ->
- let hosts = List.map (fun (h, c) -> h) hosts in
- debug "Attempting to start VM (%s) on one of equally optimal hosts [ %s ]"
- (Ref.string_of vm) (String.concat ";" (List.map Ref.string_of hosts));
- try Xapi_vm_placement.select_host __context vm validate_host hosts
- with _ ->
- info "Failed to start VM (%s) on any of [ %s ]"
- (Ref.string_of vm) (String.concat ";" (List.map Ref.string_of hosts));
- select_host_from less_optimal_groups_of_hosts
- in
- select_host_from host_lists
+ select_host_from host_lists
with Api_errors.Server_error(x,[]) when x=Api_errors.no_hosts_available ->
debug "No hosts guaranteed to satisfy VM constraints. Trying again ignoring memory checks";
let validate_host = vm_can_run_on_host ~__context ~vm ~snapshot ~do_memory_check:false in
- Xapi_vm_placement.select_host __context vm validate_host all_hosts
+ List.flatten host_lists |> Xapi_vm_placement.select_host __context vm validate_host
(* choose_host_for_vm will use WLB as long as it is enabled and there *)
(* is no pool.other_config["wlb_choose_host_disable"] = "true". *)
diff --git a/ocaml/xapi/xapi_vm_lifecycle.ml b/ocaml/xapi/xapi_vm_lifecycle.ml
index 22d98a00c6f..77351c4f40c 100644
--- a/ocaml/xapi/xapi_vm_lifecycle.ml
+++ b/ocaml/xapi/xapi_vm_lifecycle.ml
@@ -243,14 +243,7 @@ let check_pci ~op ~ref_str =
| `suspend | `checkpoint | `pool_migrate | `migrate_send -> Some (Api_errors.vm_has_pci_attached, [ref_str])
| _ -> None
-let check_vgpu ~__context ~op ~ref_str ~vgpus =
- let vgpu_migration_enabled () =
- let pool = Helpers.get_pool ~__context in
- let restrictions = Db.Pool.get_restrictions ~__context ~self:pool in
- try
- List.assoc "restrict_vgpu_migration" restrictions = "false"
- with Not_found -> false
- in
+let check_vgpu ~__context ~op ~ref_str ~vgpus ~power_state =
let is_migratable vgpu =
try
(* Prevent VMs with VGPU from being migrated from pre-Jura to Jura and later hosts during RPU *)
@@ -279,13 +272,13 @@ let check_vgpu ~__context ~op ~ref_str ~vgpus =
| _ -> false
in
match op with
+ | `migrate_send
+ when power_state = `Halted -> None
| `pool_migrate | `migrate_send
- when vgpu_migration_enabled ()
- && List.for_all is_migratable vgpus
+ when List.for_all is_migratable vgpus
&& List.for_all is_suspendable vgpus -> None
| `suspend
- when vgpu_migration_enabled ()
- && List.for_all is_suspendable vgpus -> None
+ when List.for_all is_suspendable vgpus -> None
| `pool_migrate | `migrate_send | `suspend | `checkpoint ->
Some (Api_errors.vm_has_vgpu, [ref_str])
| _ -> None
@@ -507,7 +500,7 @@ let check_operation_error ~__context ~ref =
(* The VM has a VGPU, check if the operation is allowed*)
let current_error = check current_error (fun () ->
if vmr.Db_actions.vM_VGPUs <> []
- then check_vgpu ~__context ~op ~ref_str ~vgpus:vmr.Db_actions.vM_VGPUs
+ then check_vgpu ~__context ~op ~ref_str ~vgpus:vmr.Db_actions.vM_VGPUs ~power_state
else None) in
(* The VM has a VUSB, check if the operation is allowed*)
@@ -589,9 +582,10 @@ let update_allowed_operations ~__context ~self =
if Db.is_valid_ref __context appliance then
Xapi_vm_appliance_lifecycle.update_allowed_operations ~__context ~self:appliance
-(** Called on new VMs (clones, imports) and on server start to manually refresh
+(** 1. Called on new VMs (clones, imports) and on server start to manually refresh
the power state, allowed_operations field etc. Current-operations won't be
- cleaned *)
+ cleaned
+ 2. Called on update VM when the power state changes *)
let force_state_reset_keep_current_operations ~__context ~self ~value:state =
if state = `Halted then begin
(* mark all devices as disconnected *)
@@ -605,6 +599,7 @@ let force_state_reset_keep_current_operations ~__context ~self ~value:state =
(fun vif ->
Db.VIF.set_currently_attached ~__context ~self:vif ~value:false;
Db.VIF.set_reserved ~__context ~self:vif ~value:false;
+ Db.VIF.set_reserved_pci ~__context ~self:vif ~value:Ref.null;
Xapi_vif_helpers.clear_current_operations ~__context ~self:vif;
Opt.iter
(fun p -> Pvs_proxy_control.clear_proxy_state ~__context vif p)
@@ -685,11 +680,6 @@ let cancel_tasks ~__context ~self ~all_tasks_in_db ~task_ids =
let set = (fun value -> Db.VM.set_current_operations ~__context ~self ~value) in
Helpers.cancel_tasks ~__context ~ops ~all_tasks_in_db ~task_ids ~set
-(** VM is considered as "live" when it's either Running or Paused, i.e. with a live domain *)
-let is_live ~__context ~self =
- let power_state = Db.VM.get_power_state ~__context ~self in
- power_state = `Running || power_state = `Paused
-
(** Assert that VM is in a certain set of states before starting an operation *)
let assert_initial_power_state_in ~__context ~self ~allowed =
let actual = Db.VM.get_power_state ~__context ~self in
diff --git a/ocaml/xapi/xapi_vm_lifecycle_helpers.ml b/ocaml/xapi/xapi_vm_lifecycle_helpers.ml
new file mode 100755
index 00000000000..c6e25903953
--- /dev/null
+++ b/ocaml/xapi/xapi_vm_lifecycle_helpers.ml
@@ -0,0 +1,21 @@
+(*
+ * Copyright (C) 2017 Citrix Systems Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+ module D = Debug.Make(struct let name="xapi" end)
+ open D
+
+ (** VM is considered as "live" when it's either Running or Paused, i.e. with a live domain *)
+let is_live ~__context ~self =
+ let power_state = Db.VM.get_power_state ~__context ~self in
+ power_state = `Running || power_state = `Paused
\ No newline at end of file
diff --git a/ocaml/xapi/xapi_vm_migrate.ml b/ocaml/xapi/xapi_vm_migrate.ml
index 11cfbab112c..f5fff63401b 100644
--- a/ocaml/xapi/xapi_vm_migrate.ml
+++ b/ocaml/xapi/xapi_vm_migrate.ml
@@ -1278,8 +1278,10 @@ let assert_can_migrate_sender ~__context ~vm ~dest ~live ~vdi_map ~vif_map ~vgpu
| `intra_pool -> None
| `cross_pool -> Some (remote.rpc, remote.session)
in
- Xapi_pgpu_helpers.assert_destination_has_pgpu_compatible_with_vm ~__context
- ~vm ~vgpu_map ~host:remote.dest_host ?remote:remote_for_migration_type ()
+ (* We only need to check compatibility for "live" vGPUs *)
+ if Db.VM.get_power_state ~__context ~self:vm <> `Halted then
+ Xapi_pgpu_helpers.assert_destination_has_pgpu_compatible_with_vm ~__context
+ ~vm ~vgpu_map ~host:remote.dest_host ?remote:remote_for_migration_type ()
let migrate_send ~__context ~vm ~dest ~live ~vdi_map ~vif_map ~options ~vgpu_map =
with_migrate (fun () ->
diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml
index 1c90fd471ea..08d286fec27 100644
--- a/ocaml/xapi/xapi_xenops.ml
+++ b/ocaml/xapi/xapi_xenops.ml
@@ -123,13 +123,36 @@ let vdi_of_disk ~__context x = match String.split ~limit:2 '/' x with
None
let backend_of_network net =
- if List.mem_assoc "backend_vm" net.API.network_other_config then begin
+ try
let backend_vm = List.assoc "backend_vm" net.API.network_other_config in
debug "Using VM %s as backend for VIF on network %s" backend_vm net.API.network_uuid;
Network.Remote (backend_vm, net.API.network_bridge)
- end else
+ with Not_found ->
Network.Local net.API.network_bridge (* PR-1255 *)
+let backend_of_vif ~__context ~vif =
+ let vif_record = Db.VIF.get_record_internal ~__context ~self:vif in
+ let net = Db.Network.get_record ~__context ~self:vif_record.Db_actions.vIF_network in
+ let host = Helpers.get_localhost ~__context in
+ let pifs = Xapi_network_attach_helpers.get_local_pifs ~__context
+ ~network:vif_record.Db_actions.vIF_network ~host
+ in
+ match pifs with
+ | [] -> backend_of_network net
+ | pif :: _ ->
+ let pif_rec = Db.PIF.get_record ~__context ~self:pif in
+ let l = Xapi_pif_helpers.get_pif_topo ~__context ~pif_rec in
+ if List.exists (function Xapi_pif_helpers.Network_sriov_logical _ -> true | _ -> false) l then
+ begin
+ if vif_record.Db_actions.vIF_reserved_pci <> Ref.null then
+ let (domain, bus, dev, fn) =
+ Pciops.pcidev_of_pci ~__context vif_record.Db_actions.vIF_reserved_pci in
+ Network.Sriov {domain; bus; dev; fn}
+ else raise (Api_errors.(Server_error (internal_error,
+ [Printf.sprintf "No reserved_pci for network SR-IOV vif %s" (Ref.string_of vif)])))
+ end
+ else backend_of_network net
+
let find f map default feature =
try
let v = List.assoc feature map in
@@ -294,7 +317,6 @@ let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu =
vncterm_ip = None (*None PR-1255*);
}
in
-
match Helpers.(check_domain_type vm.API.vM_domain_type, boot_method_of_vm ~__context ~vm) with
| `hvm, Helpers.Hvmloader options -> HVM (make_hvmloader_boot_record options)
| `pv, Helpers.Direct options -> PV (make_direct_boot_record options)
@@ -303,6 +325,15 @@ let builder_of_vm ~__context (vmref, vm) timeoffset pci_passthrough vgpu =
| `pv_in_pvh, Helpers.Indirect options -> PVinPVH (make_indirect_boot_record options)
| _ -> raise Api_errors.(Server_error (internal_error, ["invalid boot configuration"]))
+let list_net_sriov_vf_pcis ~__context ~vm =
+ vm.API.vM_VIFs
+ |> List.filter (fun self -> Db.VIF.get_currently_attached ~__context ~self)
+ |> List.filter_map (fun vif ->
+ match backend_of_vif ~__context ~vif with
+ | Network.Sriov {domain; bus; dev; fn} -> Some (domain, bus, dev, fn)
+ | _ -> None
+ )
+
module MD = struct
(** Convert between xapi DB records and xenopsd records *)
@@ -468,11 +499,11 @@ module MD = struct
| `locked, _ -> Vif.Locked { Vif.ipv4 = vif.API.vIF_ipv4_allowed; ipv6 = vif.API.vIF_ipv6_allowed }
| `unlocked, _ -> Vif.Unlocked
| `disabled, _ -> Vif.Disabled in
+ let host = Helpers.get_localhost ~__context in
+ let pifs = Xapi_network_attach_helpers.get_local_pifs ~__context ~network:vif.API.vIF_network ~host in
let carrier =
if !Xapi_globs.pass_through_pif_carrier then
(* We need to reflect the carrier of the local PIF on the network (if any) *)
- let host = Helpers.get_localhost ~__context in
- let pifs = Xapi_network_attach_helpers.get_local_pifs ~__context ~network:vif.API.vIF_network ~host in
match pifs with
| [] -> true (* Internal network; consider as "always up" *)
| pif :: _ ->
@@ -509,6 +540,12 @@ module MD = struct
(of_pvs_proxy ~__context vif)
(Pvs_proxy_control.find_proxy_for_vif ~__context ~vif:vif_ref)
in
+ let vlan = match pifs with
+ | [] -> None
+ | pif :: _ ->
+ let vlan = Db.PIF.get_VLAN ~__context ~self:pif in
+ if vlan < 0L then None else Some vlan
+ in
let open Vif in {
id = (vm.API.vM_uuid, vif.API.vIF_device);
position = int_of_string vif.API.vIF_device;
@@ -516,13 +553,14 @@ module MD = struct
carrier = carrier;
mtu = mtu;
rate = rate;
- backend = backend_of_network net;
+ backend = backend_of_vif ~__context ~vif:vif_ref;
other_config = vif.API.vIF_other_config;
locking_mode = locking_mode;
extra_private_keys;
ipv4_configuration = ipv4_configuration;
ipv6_configuration = ipv6_configuration;
pvs_proxy;
+ vlan = vlan;
}
let pcis_of_vm ~__context (vmref, vm) =
@@ -534,7 +572,9 @@ module MD = struct
let unmanaged = List.flatten (List.map (fun (_, dev) -> dev) (Pciops.sort_pcidevs other_pcidevs)) in
- let devs = devs @ unmanaged in
+ let net_sriov_pcidevs = list_net_sriov_vf_pcis ~__context ~vm in
+
+ let devs = devs @ net_sriov_pcidevs @ unmanaged in
let open Pci in
List.map
@@ -1798,26 +1838,30 @@ let update_vif ~__context id =
(try Client.VIF.remove dbg id with e -> debug "VIF.remove failed: %s" (Printexc.to_string e))
end;
- if state.plugged then begin
- (* sync MTU *)
- (try
- match state.device with
- | None -> failwith (Printf.sprintf "could not determine device id for VIF %s.%s" (fst id) (snd id))
- | Some device ->
- let dbg = Context.string_of_task __context in
- let mtu = Net.Interface.get_mtu dbg device in
- Db.VIF.set_MTU ~__context ~self:vif ~value:(Int64.of_int mtu)
- with _ ->
- debug "could not update MTU field on VIF %s.%s" (fst id) (snd id));
-
- (* Clear monitor cache for associated PIF if pass_through_pif_carrier is set *)
- if !Xapi_globs.pass_through_pif_carrier then
- let host = Helpers.get_localhost ~__context in
- let pifs = Xapi_network_attach_helpers.get_local_pifs ~__context ~network:vifr.API.vIF_network ~host in
- List.iter (fun pif ->
- let pif_name = Db.PIF.get_device ~__context ~self:pif in
- Monitor_dbcalls_cache.clear_cache_for_pif ~pif_name
- ) pifs
+ begin match backend_of_vif ~__context ~vif with
+ | Network.Sriov _ -> ()
+ | Network.Local _ | Network.Remote _ ->
+ if state.plugged then begin
+ (* sync MTU *)
+ (try
+ match state.device with
+ | None -> failwith (Printf.sprintf "could not determine device id for VIF %s.%s" (fst id) (snd id))
+ | Some device ->
+ let dbg = Context.string_of_task __context in
+ let mtu = Net.Interface.get_mtu dbg device in
+ Db.VIF.set_MTU ~__context ~self:vif ~value:(Int64.of_int mtu)
+ with _ ->
+ debug "could not update MTU field on VIF %s.%s" (fst id) (snd id));
+
+ (* Clear monitor cache for associated PIF if pass_through_pif_carrier is set *)
+ if !Xapi_globs.pass_through_pif_carrier then
+ let host = Helpers.get_localhost ~__context in
+ let pifs = Xapi_network_attach_helpers.get_local_pifs ~__context ~network:vifr.API.vIF_network ~host in
+ List.iter (fun pif ->
+ let pif_name = Db.PIF.get_device ~__context ~self:pif in
+ Monitor_dbcalls_cache.clear_cache_for_pif ~pif_name
+ ) pifs
+ end
end;
(match Pvs_proxy_control.find_proxy_for_vif ~__context ~vif with
| None -> ()
@@ -2428,7 +2472,7 @@ let transform_xenops_exn ~__context ~vm queue_name f =
let vms' = List.map (fun uuid -> Db.VM.get_by_uuid ~__context ~uuid |> Ref.string_of) vms in
reraise Api_errors.vms_failed_to_cooperate vms'
| IO_error -> reraise Api_errors.vdi_io_error ["I/O error saving VM suspend image"]
- | Failed_to_contact_remote_service x -> internal "failed to contact: %s" x
+ | Failed_to_contact_remote_service x -> reraise Api_errors.vm_migrate_contact_remote_service_failed []
| Hook_failed(script, reason, stdout, i) -> reraise Api_errors.xapi_hook_failed [ script; reason; stdout; i ]
| Not_enough_memory needed -> internal "there was not enough memory (needed %Ld bytes)" needed
| Cancelled id ->
@@ -3116,17 +3160,21 @@ let vif_move ~__context ~self network =
assert_resident_on ~__context ~self:vm;
let vif = md_of_vif ~__context ~self in
info "xenops: VIF.move %s.%s" (fst vif.Vif.id) (snd vif.Vif.id);
- let network = Db.Network.get_record ~__context ~self:network in
- let backend = backend_of_network network in
- let dbg = Context.string_of_task __context in
- let module Client = (val make_client queue_name : XENOPS) in
- (* Nb., at this point, the database shows the vif on the new network *)
- Xapi_network.attach_for_vif ~__context ~vif:self ();
- Client.VIF.move dbg vif.Vif.id backend |> sync_with_task __context queue_name;
- Events_from_xenopsd.wait queue_name dbg (fst vif.Vif.id) ();
- if not (Db.VIF.get_currently_attached ~__context ~self) then
- raise Api_errors.(Server_error(internal_error, [
- Printf.sprintf "vif_move: Unable to plug moved VIF %s" (Ref.string_of self)]))
+ let backend = backend_of_vif ~__context ~vif:self in
+ match backend with
+ | Network.Sriov _ -> raise Api_errors.(Server_error(internal_error, [
+ Printf.sprintf "vif_move: Unable to move a network SR-IOV backed VIF %s"
+ (Ref.string_of self)]))
+ | _ ->
+ let dbg = Context.string_of_task __context in
+ let module Client = (val make_client queue_name : XENOPS) in
+ (* Nb., at this point, the database shows the vif on the new network *)
+ Xapi_network.attach_for_vif ~__context ~vif:self ();
+ Client.VIF.move dbg vif.Vif.id backend |> sync_with_task __context queue_name;
+ Events_from_xenopsd.wait queue_name dbg (fst vif.Vif.id) ();
+ if not (Db.VIF.get_currently_attached ~__context ~self) then
+ raise Api_errors.(Server_error(internal_error, [
+ Printf.sprintf "vif_move: Unable to plug moved VIF %s" (Ref.string_of self)]))
)
let vif_set_ipv4_configuration ~__context ~self =
diff --git a/ocaml/xe-cli/bash-completion b/ocaml/xe-cli/bash-completion
index 6ac0f910980..ed0f071f73e 100644
--- a/ocaml/xe-cli/bash-completion
+++ b/ocaml/xe-cli/bash-completion
@@ -105,7 +105,16 @@ _xe()
pvs-cache-storage-*)
# Chop off at the third '-' and append 'list'
cmd="$(echo ${OLDSTYLE_WORDS[1]} | cut -d- -f1-3)-list";;
- host-cpu-*|host-crashdump-*|gpu-group-*|vgpu-type-*|pvs-server-*|pvs-proxy-*|pvs-site-*|sdn-controller-*|cluster-host-*)
+ host-cpu-*|\
+ host-crashdump-*|\
+ gpu-group-*|\
+ vgpu-type-*|\
+ pvs-server-*|\
+ pvs-proxy-*|\
+ pvs-site-*|\
+ sdn-controller-*|\
+ network-sriov-*|\
+ cluster-host-*)
# Chop off at the second '-' and append 'list'
cmd="$(echo ${OLDSTYLE_WORDS[1]} | cut -d- -f1-2)-list";;
*)
diff --git a/xapi-database.opam b/xapi-database.opam
index 1cace10be25..39f6d7902c3 100644
--- a/xapi-database.opam
+++ b/xapi-database.opam
@@ -13,7 +13,6 @@ depends: [
"ppx_sexp_conv"
"xapi-libs-transitional"
"xapi-idl"
- "xapi-stdext-bigbuffer"
"xapi-stdext-encodings"
"xapi-stdext-monadic"
"xapi-stdext-pervasives"