From 4d3e411b34d255093df73b5a98370e6176961bb5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 15 Nov 2024 11:49:44 +0000 Subject: [PATCH 1/2] CP-52708: make file descriptor argument optional in Server.dispatch_call MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This will enable short-circuiting internal API calls. When the FD is missing mark the call as Internal. Signed-off-by: Edwin Török --- ocaml/idl/ocaml_backend/gen_server.ml | 2 +- ocaml/tests/test_client.ml | 2 +- ocaml/xapi/api_server.ml | 2 +- ocaml/xapi/context.ml | 13 ++++++------- ocaml/xapi/context.mli | 2 +- ocaml/xapi/server.mli | 2 +- ocaml/xapi/server_helpers.mli | 2 +- 7 files changed, 12 insertions(+), 13 deletions(-) diff --git a/ocaml/idl/ocaml_backend/gen_server.ml b/ocaml/idl/ocaml_backend/gen_server.ml index 31e2bbe16f2..c4f5dd2a69c 100644 --- a/ocaml/idl/ocaml_backend/gen_server.ml +++ b/ocaml/idl/ocaml_backend/gen_server.ml @@ -470,7 +470,7 @@ let gen_module api : O.Module.t = ~params: [ O.Anon (Some "http_req", "Http.Request.t") - ; O.Anon (Some "fd", "Unix.file_descr") + ; O.Anon (Some "fd", "Unix.file_descr option") ; O.Anon (Some "call", "Rpc.call") ] ~ty:"response" diff --git a/ocaml/tests/test_client.ml b/ocaml/tests/test_client.ml index 55096a5c48a..620ce7d370e 100644 --- a/ocaml/tests/test_client.ml +++ b/ocaml/tests/test_client.ml @@ -10,7 +10,7 @@ work in unit tests. *) let make_client_params ~__context = let req = Xmlrpc_client.xmlrpc ~version:"1.1" "/" in - let rpc = Api_server.Server.dispatch_call req Unix.stdout in + let rpc = Api_server.Server.dispatch_call req None in let session_id = let session_id = Ref.make_secret () in let now = Xapi_stdext_date.Date.now () in diff --git a/ocaml/xapi/api_server.ml b/ocaml/xapi/api_server.ml index e6864bd80e1..3cbfd8b1f25 100644 --- a/ocaml/xapi/api_server.ml +++ b/ocaml/xapi/api_server.ml @@ -33,7 +33,7 @@ let callback1 ?(json_rpc_version = Jsonrpc.V1) is_json req fd call = else let response = let@ req = Helper.with_tracing ~name:"Server.dispatch_call" req in - Server.dispatch_call req fd call + Server.dispatch_call req (Some fd) call in let translated = if diff --git a/ocaml/xapi/context.ml b/ocaml/xapi/context.ml index 5f357e110af..fcc48d235f2 100644 --- a/ocaml/xapi/context.ml +++ b/ocaml/xapi/context.ml @@ -460,29 +460,28 @@ let get_http_other_config http_req = let of_http_req ?session_id ?(internal_async_subtask = false) ~generate_task_for ~supports_async ~label ~http_req ~fd () = let http_other_config = get_http_other_config http_req in + let origin = + match fd with None -> Internal | Some fd -> Http (http_req, fd) + in let new_task_context () = let subtask_of = Option.map Ref.of_string http_req.Http.Request.subtask_of in make ?session_id ?subtask_of ~http_other_config ~task_in_database:true - ~origin:(Http (http_req, fd)) - label + ~origin label in if internal_async_subtask then new_task_context () else match http_req.Http.Request.task with | Some task_id -> - from_forwarded_task ?session_id ~http_other_config - ~origin:(Http (http_req, fd)) + from_forwarded_task ?session_id ~http_other_config ~origin (Ref.of_string task_id) | None -> if generate_task_for && supports_async then new_task_context () else - make ?session_id ~http_other_config - ~origin:(Http (http_req, fd)) - label + make ?session_id ~http_other_config ~origin label let set_test_rpc context rpc = context.test_rpc <- Some rpc diff --git a/ocaml/xapi/context.mli b/ocaml/xapi/context.mli index 34e51afd2ee..fb6aa041c44 100644 --- a/ocaml/xapi/context.mli +++ b/ocaml/xapi/context.mli @@ -49,7 +49,7 @@ val of_http_req : -> supports_async:bool -> label:string -> http_req:Http.Request.t - -> fd:Unix.file_descr + -> fd:Unix.file_descr option -> unit -> t diff --git a/ocaml/xapi/server.mli b/ocaml/xapi/server.mli index 2f093e9adb6..a1de8fbfaab 100644 --- a/ocaml/xapi/server.mli +++ b/ocaml/xapi/server.mli @@ -3,5 +3,5 @@ module Make : functor (_ : Custom_actions.CUSTOM_ACTIONS) -> sig val dispatch_call : - Http.Request.t -> Unix.file_descr -> Rpc.call -> Rpc.response + Http.Request.t -> Unix.file_descr option -> Rpc.call -> Rpc.response end diff --git a/ocaml/xapi/server_helpers.mli b/ocaml/xapi/server_helpers.mli index 6651402acaa..9155469e26b 100644 --- a/ocaml/xapi/server_helpers.mli +++ b/ocaml/xapi/server_helpers.mli @@ -61,7 +61,7 @@ val do_dispatch : -> string -> (__context:Context.t -> 'a) -> ('a -> Rpc.t) - -> Unix.file_descr + -> Unix.file_descr option -> Http.Request.t -> string -> [< `Async | `InternalAsync | `Sync > `Sync `InternalAsync] From 4d275d69b7e05a57b0f1da8b16ad9ea6d1ede310 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Edwin=20T=C3=B6r=C3=B6k?= Date: Fri, 15 Nov 2024 11:49:44 +0000 Subject: [PATCH 2/2] CP-52708: Avoid making Unix read/write calls for internal API calls: forward the API call directly like we do with the CLI for calls to the coordinator when we are the coordinator MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Edwin Török --- ocaml/xapi/helpers.ml | 33 +++++++++++++++++++++------------ ocaml/xapi/xapi.ml | 3 +++ 2 files changed, 24 insertions(+), 12 deletions(-) diff --git a/ocaml/xapi/helpers.ml b/ocaml/xapi/helpers.ml index 3802d78e0b6..adf264c68a7 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 2834cd15b3c..c0fcf6389a2 100644 --- a/ocaml/xapi/xapi.ml +++ b/ocaml/xapi/xapi.ml @@ -159,11 +159,14 @@ 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 fake_rpc2 req rpc = Api_server.Server.dispatch_call req None 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