diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index 1175b6aa03..31ffc71172 100644 --- a/ocaml/xapi/helpers.ml +++ b/ocaml/xapi/helpers.ml @@ -402,6 +402,11 @@ module TraceHelper = struct Tracing_propagator.Propagator.Http.inject_into trace_context end +(** Once the server functor has been instantiated, xapi sets this reference to the appropriate + "fake_rpc" (loopback non-HTTP) rpc function. + This way, internally the coordinator can short-circuit API calls without having to go over the network. *) +let rpc_fun : (Http.Request.t -> Rpc.call -> Rpc.response) option ref = ref None + (* 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 @@ -418,18 +423,22 @@ let make_rpc ~__context rpc : Rpc.response = in let http = xmlrpc ~subtask_of ~version:"1.1" path in let http = TraceHelper.inject_span_into_req tracing http in - let transport = - if Pool_role.is_master () then - Unix Xapi_globs.unix_domain_socket - else - SSL - ( SSL.make ~use_stunnel_cache:true ~verify_cert:(Stunnel_client.pool ()) - () - , Pool_role.get_master_address () - , !Constants.https_port - ) - in - dorpc ~srcstr:"xapi" ~dststr:"xapi" ~transport ~http rpc + match !rpc_fun with + | Some rpcfun when Pool_role.is_master () -> + rpcfun http rpc + | _ -> + let transport = + if Pool_role.is_master () then + Unix Xapi_globs.unix_domain_socket + else + SSL + ( SSL.make ~use_stunnel_cache:true + ~verify_cert:(Stunnel_client.pool ()) () + , Pool_role.get_master_address () + , !Constants.https_port + ) + in + dorpc ~srcstr:"xapi" ~dststr:"xapi" ~transport ~http rpc let make_timeboxed_rpc ~__context timeout rpc : Rpc.response = let subtask_of = Ref.string_of (Context.get_task_id __context) in diff --git a/ocaml/xapi/xapi.ml b/ocaml/xapi/xapi.ml index dc1a1e7e04..726944eacf 100644 --- a/ocaml/xapi/xapi.ml +++ b/ocaml/xapi/xapi.ml @@ -159,11 +159,18 @@ let random_setup () = finally (fun () -> really_input chan s 0 n) (fun () -> close_in chan) ; Random.full_init (Array.init n (fun i -> Char.code (Bytes.get s i))) +let dummy_fd, dummy_fd2 = Unix.pipe () + +let () = Unix.close dummy_fd + +let fake_rpc2 req rpc = Api_server.Server.dispatch_call req dummy_fd2 rpc + let register_callback_fns () = let fake_rpc req sock xml : Rpc.response = Api_server.callback1 false req sock xml in Xapi_cli.rpc_fun := Some fake_rpc ; + Helpers.rpc_fun := Some fake_rpc2 ; Message_forwarding.register_callback_fns () let noevents = ref false