Merge pull request #2398 from djs55/ca-181545

CA-181545: Query the message switch to find which of the whitelisted …

Author: Jon Ludlam

ocaml/xapi/storage_access.ml

@@ -898,6 +898,9 @@ let external_rpc queue_name uri =
 				uri
 				call
 
+(* Internal exception, never escapes the module *)
+exception Message_switch_failure
+
 (** Synchronise the SM table with the SMAPIv1 plugins on the disk and the SMAPIv2
     plugins mentioned in the configuration file whitelist. *)
 let on_xapi_start ~__context =
@@ -929,6 +932,38 @@ let on_xapi_start ~__context =
 			Xapi_sm.update_from_query_result ~__context (List.assoc ty existing) query_result
 		) (List.intersect smapiv1_drivers (List.map fst existing));
 	let smapiv2_drivers = List.set_difference to_keep smapiv1_drivers in
+	(* Query the message switch to detect running SMAPIv2 plugins. *)
+	let running_smapiv2_drivers =
+		if !Xcp_client.use_switch then begin
+			try
+				let open Message_switch in
+				let open Protocol_unix in
+				let (>>|) result f =
+					match Client.error_to_msg result with
+					| `Error (`Msg x) ->
+						error "Error %s while querying message switch queues" x;
+						raise Message_switch_failure
+					| `Ok x -> f x
+				in
+				Client.connect ~switch:!Xcp_client.switch_path ()
+				>>| fun t ->
+				Client.list ~t ~prefix:!Storage_interface.queue_name ~filter:`Alive ()
+				>>| fun running_smapiv2_driver_queues ->
+				List.filter
+					(fun driver ->
+						List.exists
+							(Xstringext.String.endswith driver)
+							running_smapiv2_driver_queues)
+					smapiv2_drivers
+			with
+			| Message_switch_failure -> [] (* no more logging *)
+			| e ->
+				error "Unexpected error querying the message switch: %s" (Printexc.to_string e);
+				Debug.log_backtrace e (Backtrace.get e);
+				[]
+		end
+		else smapiv2_drivers
+	in
 	(* Create all missing SMAPIv2 plugins *)
 	let query ty =
 		let queue_name = !Storage_interface.queue_name ^ "." ^ ty in
@@ -940,12 +975,12 @@ let on_xapi_start ~__context =
 	List.iter
 		(fun ty ->
 			Xapi_sm.create_from_query_result ~__context (query ty)
-		) (List.set_difference smapiv2_drivers (List.map fst existing));
+		) (List.set_difference running_smapiv2_drivers (List.map fst existing));
 	(* Update all existing SMAPIv2 plugins *)
 	List.iter
 		(fun ty ->
 			Xapi_sm.update_from_query_result ~__context (List.assoc ty existing) (query ty)
-		) (List.intersect smapiv2_drivers (List.map fst existing))
+		) (List.intersect running_smapiv2_drivers (List.map fst existing))
 
 let bind ~__context ~pbd =
     (* Start the VM if necessary, record its uuid *)