CP-51693: extend XMLRPC feature flag to other functions making RPC calls in XAPI (#6979)

There were a few more places that used XMLRPC that were missed the first
time.
In particular intra-pool communication and XAPI<->xenopsd communication.

The feature flag will eventually be enabled (on `feature/perf-edvint`
first), but the feature flagged code can be merged to master directly.

Author: edwintorok

ocaml/xapi/helpers.ml

@@ -427,20 +427,22 @@ module TraceHelper = struct
     Tracing_propagator.Propagator.Http.inject_into trace_context
 end
 
+let choose_rpc () =
+  let open Xmlrpc_client in
+  if !Xapi_globs.use_xmlrpc then
+    (XMLRPC_protocol.rpc, "/")
+  else
+    (JSONRPC_protocol.rpc, "/jsonrpc")
+
 (* Note that both this and `make_timeboxed_rpc` are almost always
  * partially applied, returning a function of type 'Rpc.request -> Rpc.response'.
  * The body is therefore not evaluated until the RPC call is actually being
  * made. *)
-let make_rpc ~__context rpc : Rpc.response =
-  let subtask_of = Ref.string_of (Context.get_task_id __context) in
+let make_rpc' ~subtask_of ?task_id ~__context rpc : Rpc.response =
+  let subtask_of = Ref.string_of subtask_of in
   let open Xmlrpc_client in
   let tracing = Context.set_client_span __context in
-  let dorpc, path =
-    if !Xapi_globs.use_xmlrpc then
-      (XMLRPC_protocol.rpc, "/")
-    else
-      (JSONRPC_protocol.rpc, "/jsonrpc")
-  in
+  let dorpc, path = choose_rpc () in
   let http = xmlrpc ~subtask_of ~version:"1.1" path in
   let http = TraceHelper.inject_span_into_req tracing http in
   let transport =
@@ -449,25 +451,27 @@ let make_rpc ~__context rpc : Rpc.response =
     else
       SSL
         ( SSL.make ~use_stunnel_cache:true ~verify_cert:(Stunnel_client.pool ())
+            ?task_id:(Option.map Ref.string_of task_id)
             ()
         , Pool_role.get_master_address ()
         , !Constants.https_port
         )
   in
   dorpc ~srcstr:"xapi" ~dststr:"xapi" ~transport ~http rpc
 
+(* erase optional labeled arguments for partial applications to work *)
+let make_rpc ~__context rpc =
+  make_rpc' ~subtask_of:(Context.get_task_id __context) ~__context rpc
+
 let make_timeboxed_rpc ~__context timeout rpc : Rpc.response =
-  let subtask_of = Ref.string_of (Context.get_task_id __context) in
+  let subtask_of = Context.get_task_id __context in
   Server_helpers.exec_with_new_task "timeboxed_rpc"
     ~subtask_of:(Context.get_task_id __context) (fun __context ->
       (* Note we need a new task here because the 'resources' (including stunnel pid) are
        * associated with the task. To avoid conflating the stunnel with any real resources
        * the task has acquired we make a new one specifically for the stunnel pid *)
-      let open Xmlrpc_client in
-      let tracing = Context.set_client_span __context in
-      let http = xmlrpc ~subtask_of ~version:"1.1" "/" in
-      let http = TraceHelper.inject_span_into_req tracing http in
       let task_id = Context.get_task_id __context in
+
       let cancel () =
         let resources =
           Locking_helpers.Thread_state.get_acquired_resources_by_task task_id
@@ -477,20 +481,9 @@ let make_timeboxed_rpc ~__context timeout rpc : Rpc.response =
       let module Scheduler = Xapi_stdext_threads_scheduler.Scheduler in
       Scheduler.add_to_queue (Ref.string_of task_id) Scheduler.OneShot timeout
         cancel ;
-      let transport =
-        if Pool_role.is_master () then
-          Unix Xapi_globs.unix_domain_socket
-        else
-          SSL
-            ( SSL.make ~verify_cert:(Stunnel_client.pool ())
-                ~use_stunnel_cache:true ~task_id:(Ref.string_of task_id) ()
-            , Pool_role.get_master_address ()
-            , !Constants.https_port
-            )
-      in
-      let result =
-        XMLRPC_protocol.rpc ~srcstr:"xapi" ~dststr:"xapi" ~transport ~http rpc
-      in
+
+      let result = make_rpc' ~subtask_of ~task_id ~__context rpc in
+
       Scheduler.remove_from_queue (Ref.string_of task_id) ;
       result
   )
@@ -525,6 +518,10 @@ let make_remote_rpc_of_url ~verify_cert ~srcstr ~dststr (url, pool_secret) call
         http
   in
   let transport = transport_of_url ~verify_cert url in
+  (* we should determine the protocol based on Content-type, not the URL,
+     but since we currently only use the URL to determine the protocol:
+     keep this as XMLRPC for now, because we don't have JSONRPC duplicates for
+     all handlers *)
   XMLRPC_protocol.rpc ~transport ~srcstr ~dststr ~http call
 
 (* This one uses rpc-light *)
@@ -535,9 +532,10 @@ let make_remote_rpc ?(verify_cert = Stunnel_client.pool ()) ~__context
     SSL (SSL.make ~verify_cert (), remote_address, !Constants.https_port)
   in
   let tracing = Context.tracing_of __context in
-  let http = xmlrpc ~version:"1.0" "/" in
+  let dorpc, path = choose_rpc () in
+  let http = xmlrpc ~version:"1.0" path in
   let http = TraceHelper.inject_span_into_req tracing http in
-  XMLRPC_protocol.rpc ~srcstr:"xapi" ~dststr:"remote_xapi" ~transport ~http xml
+  dorpc ~srcstr:"xapi" ~dststr:"remote_xapi" ~transport ~http xml
 
 (* Helper type for an object which may or may not be in the local database. *)
 type 'a api_object =
@@ -611,10 +609,9 @@ let call_emergency_mode_functions hostname f =
       , !Constants.https_port
       )
   in
-  let http = xmlrpc ~version:"1.0" "/" in
-  let rpc =
-    XMLRPC_protocol.rpc ~srcstr:"xapi" ~dststr:"xapi" ~transport ~http
-  in
+  let dorpc, path = choose_rpc () in
+  let http = xmlrpc ~version:"1.0" path in
+  let rpc = dorpc ~srcstr:"xapi" ~dststr:"xapi" ~transport ~http in
   let session_id =
     Client.Client.Session.slave_local_login ~rpc
       ~psecret:(Xapi_globs.pool_secret ())

ocaml/xapi/message_forwarding.ml

@@ -59,11 +59,12 @@ let remote_rpc_no_retry _context hostname (task_opt : API.ref_task option) xml =
       )
   in
   let tracing = Context.set_client_span _context in
+  let dorpc, path = Helpers.choose_rpc () in
   let http =
-    xmlrpc ?task_id:(Option.map Ref.string_of task_opt) ~version:"1.0" "/"
+    xmlrpc ?task_id:(Option.map Ref.string_of task_opt) ~version:"1.0" path
     |> Helpers.TraceHelper.inject_span_into_req tracing
   in
-  XMLRPC_protocol.rpc ~srcstr:"xapi" ~dststr:"dst_xapi" ~transport ~http xml
+  dorpc ~srcstr:"xapi" ~dststr:"dst_xapi" ~transport ~http xml
 
 (* Use HTTP 1.1, use the stunnel cache and pre-verify the connection *)
 let remote_rpc_retry _context hostname (task_opt : API.ref_task option) xml =
@@ -78,11 +79,12 @@ let remote_rpc_retry _context hostname (task_opt : API.ref_task option) xml =
       )
   in
   let tracing = Context.set_client_span _context in
+  let dorpc, path = Helpers.choose_rpc () in
   let http =
-    xmlrpc ?task_id:(Option.map Ref.string_of task_opt) ~version:"1.1" "/"
+    xmlrpc ?task_id:(Option.map Ref.string_of task_opt) ~version:"1.1" path
     |> Helpers.TraceHelper.inject_span_into_req tracing
   in
-  XMLRPC_protocol.rpc ~srcstr:"xapi" ~dststr:"dst_xapi" ~transport ~http xml
+  dorpc ~srcstr:"xapi" ~dststr:"dst_xapi" ~transport ~http xml
 
 let call_slave_with_session remote_rpc_fn __context host
     (task_opt : API.ref_task option) f =

ocaml/xapi/rpc_retry.ml

@@ -34,12 +34,13 @@ functor
   struct
     let transport = Unix Meta.server_path
 
-    let simple_rpc =
-      XMLRPC_protocol.rpc ~srcstr:Meta.client_name ~dststr:Meta.server_name
-        ~transport
-        ~http:(xmlrpc ~version:"1.0" "/")
+    let simple_rpc () =
+      let dorpc, path = Helpers.choose_rpc () in
+      dorpc ~srcstr:Meta.client_name ~dststr:Meta.server_name ~transport
+        ~http:(xmlrpc ~version:"1.0" path)
 
     let rpc call =
+      let simple_rpc = simple_rpc () in
       let rec aux ~retrying =
         let response' =
           try

ocaml/xapi/xapi_http.ml

@@ -29,7 +29,7 @@ let validate_session __context session_id realm =
 (* Talk to the master over the network. NB we deliberately use the network rather than
    the unix domain socket because we don't want to accidentally bypass the authentication *)
 let inet_rpc xml =
-  let version = "1.1" and path = "/" in
+  let version = "1.1" in
   let http = 80 and https = !Constants.https_port in
   (* Bypass SSL for localhost, this works even if the management interface
      is disabled. *)
@@ -44,8 +44,9 @@ let inet_rpc xml =
         , https
         )
   in
+  let dorpc, path = Helpers.choose_rpc () in
   let http = xmlrpc ~version path in
-  XMLRPC_protocol.rpc ~srcstr:"xapi" ~dststr:"xapi" ~transport ~http xml
+  dorpc ~srcstr:"xapi" ~dststr:"xapi" ~transport ~http xml
 
 open Client
 open Http

ocaml/xapi/xapi_pool.ml

@@ -3591,11 +3591,12 @@ let perform ~local_fn ~__context ~host ~remote_fn =
     in
     let task_id = Option.map Ref.string_of task_opt in
     let tracing = Context.set_client_span __context in
-    let http = xmlrpc ?task_id ~version:"1.0" "/" in
+    let dorpc, path = Helpers.choose_rpc () in
+    let http = xmlrpc ?task_id ~version:"1.0" path in
     let http = Helpers.TraceHelper.inject_span_into_req tracing http in
     let port = !Constants.https_port in
     let transport = SSL (SSL.make ~verify_cert ?task_id (), hostname, port) in
-    XMLRPC_protocol.rpc ~srcstr:"xapi" ~dststr:"dst_xapi" ~transport ~http xml
+    dorpc ~srcstr:"xapi" ~dststr:"dst_xapi" ~transport ~http xml
   in
   let open Message_forwarding in
   do_op_on_common ~local_fn ~__context ~host ~remote_fn