From d40c5aa88bac5b036ecaeb34562900bf58e5c35e Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Sat, 3 Aug 2024 18:12:00 +0100 Subject: [PATCH] refactor: remove action runners from public dune Action runners in this dune are a rather old version that it is very much out of date with the state of the actual feature and has many bugs and limitations that need a lot of upstreaming to fix. In its current state, it does not provide any value to users of public dune. If we ever want to upstream this feature, it will be easier to just do it from scratch anyway instead of resolving the conflicts against some old version. This is due to the fact that the action runner API with the engine is rather small and well defined. Once we introduce a better abstraction for action execution (as we are indeed planning), it will be probably be even simpler to upstream action runners. All in all, we gain nothing on either team by keeping this dead weight around. Signed-off-by: Rudi Grinberg --- bin/common.ml | 24 +- bin/common.mli | 9 - boot/libs.ml | 2 +- src/dune_engine/action_runner.ml | 398 --------------------------- src/dune_engine/action_runner.mli | 49 ---- src/dune_engine/build_config.ml | 6 - src/dune_engine/build_config_intf.ml | 6 +- src/dune_engine/build_system.ml | 14 +- src/dune_engine/dune | 1 - src/dune_engine/dune_engine.ml | 1 - src/dune_rpc_impl/server.ml | 36 +-- src/dune_rpc_impl/server.mli | 2 - src/dune_rules/main.ml | 4 - src/dune_rules/main.mli | 4 +- 14 files changed, 15 insertions(+), 541 deletions(-) delete mode 100644 src/dune_engine/action_runner.ml delete mode 100644 src/dune_engine/action_runner.mli diff --git a/bin/common.ml b/bin/common.ml index 49811f2977a..e0515ed5738 100644 --- a/bin/common.ml +++ b/bin/common.ml @@ -553,14 +553,6 @@ let cache_debug_flags_term : Cache_debug_flags.t Term.t = value initial ;; -module Action_runner = struct - type t = - | No - | Yes of - (Dune_lang.Dep_conf.t Dune_rpc_impl.Server.t - -> (Dune_engine.Action_exec.input -> Dune_engine.Action_runner.t option) Staged.t) -end - module Builder = struct type t = { debug_dep_path : bool @@ -602,14 +594,12 @@ module Builder = struct ; stats_trace_extended : bool ; allow_builds : bool ; default_root_is_cwd : bool - ; action_runner : Action_runner.t ; log_file : Dune_util.Log.File.t } let set_root t root = { t with root = Some root } let forbid_builds t = { t with allow_builds = false; no_print_directory = true } let set_default_root_is_cwd t x = { t with default_root_is_cwd = x } - let set_action_runner t x = { t with action_runner = x } let set_log_file t x = { t with log_file = x } let disable_log_file t = { t with log_file = No_log_file } let set_promote t v = { t with promote = Some v } @@ -1029,7 +1019,6 @@ module Builder = struct ; stats_trace_extended ; allow_builds = true ; default_root_is_cwd = false - ; action_runner = No ; log_file = Default } ;; @@ -1160,7 +1149,6 @@ let build (builder : Builder.t) = | Yes Passive -> Some 1.0 | _ -> None in - let action_runner = Dune_engine.Action_runner.Rpc_server.create () in Dune_rpc_impl.Server.create ~lock_timeout ~registry @@ -1168,8 +1156,7 @@ let build (builder : Builder.t) = ~handle:Dune_rules_rpc.register ~watch_mode_config:builder.watch ~parse_build:Dune_rules_rpc.parse_build - stats - action_runner)) + stats)) else `Forbid_builds in if builder.print_metrics then Dune_metrics.enable (); @@ -1226,16 +1213,7 @@ let init (builder : Builder.t) = "Shared cache location: %s" (Path.to_string Dune_cache_storage.Layout.root_dir) ]; - let action_runner = - match builder.action_runner with - | No -> None - | Yes f -> - (match rpc c with - | `Forbid_builds -> Code_error.raise "action runners require building" [] - | `Allow server -> Some (Staged.unstage @@ f server)) - in Dune_rules.Main.init - ?action_runner ~stats:c.stats ~sandboxing_preference:config.sandboxing_preference ~cache_config diff --git a/bin/common.mli b/bin/common.mli index 113de7ca515..3ee8ca1546f 100644 --- a/bin/common.mli +++ b/bin/common.mli @@ -24,14 +24,6 @@ val watch : t -> Dune_rpc_impl.Watch_mode_config.t val file_watcher : t -> Dune_engine.Scheduler.Run.file_watcher val prefix_target : t -> string -> string -module Action_runner : sig - type t = - | No - | Yes of - (Dune_lang.Dep_conf.t Dune_rpc_impl.Server.t - -> (Dune_engine.Action_exec.input -> Dune_engine.Action_runner.t option) Staged.t) -end - (** [Builder] describes how to initialize Dune. *) module Builder : sig type t @@ -39,7 +31,6 @@ module Builder : sig val set_root : t -> string -> t val forbid_builds : t -> t val set_default_root_is_cwd : t -> bool -> t - val set_action_runner : t -> Action_runner.t -> t val set_log_file : t -> Dune_util.Log.File.t -> t val disable_log_file : t -> t val set_promote : t -> Dune_engine.Clflags.Promote.t -> t diff --git a/boot/libs.ml b/boot/libs.ml index 2d60cb5a5f2..926558a23b5 100644 --- a/boot/libs.ml +++ b/boot/libs.ml @@ -40,7 +40,6 @@ let local_libraries = ; ("src/dune_output_truncation", Some "Dune_output_truncation", false, None) ; ("src/csexp_rpc", Some "Csexp_rpc", false, None) - ; ("src/dune_rpc_server", Some "Dune_rpc_server", false, None) ; ("src/dune_rpc_client", Some "Dune_rpc_client", false, None) ; ("src/dune_thread_pool", Some "Dune_thread_pool", false, None) ; ("otherlibs/ocamlc-loc/src", Some "Ocamlc_loc", false, None) @@ -91,6 +90,7 @@ let local_libraries = ; ("src/upgrader", Some "Dune_upgrader", false, None) ; ("src/dune_pkg_outdated", Some "Dune_pkg_outdated", false, None) ; ("vendor/cmdliner/src", None, false, None) + ; ("src/dune_rpc_server", Some "Dune_rpc_server", false, None) ; ("src/dune_rpc_impl", Some "Dune_rpc_impl", false, None) ; ("src/dune_rules_rpc", Some "Dune_rules_rpc", false, None) ] diff --git a/src/dune_engine/action_runner.ml b/src/dune_engine/action_runner.ml deleted file mode 100644 index 795d95ac713..00000000000 --- a/src/dune_engine/action_runner.ml +++ /dev/null @@ -1,398 +0,0 @@ -open Import -open Fiber.O -module Dune_rpc = Dune_rpc_private - -module Decl : sig - val exec : (Action_exec.input, Action_exec.Exec_result.t) Dune_rpc.Decl.request - val ready : (string, unit) Dune_rpc.Decl.request - val cancel_build : (unit, unit) Dune_rpc.Decl.request -end = struct - module Conv = Dune_rpc_private.Conv - module Decl = Dune_rpc_private.Decl - - (* CR-someday dkalinichenko: this is an ugly implementation detail; consider - moving this code to its own file. *) - module Marshallable_error = struct - (* We convert [Action_exec.Exec_result.Error.t] into this representation - since [Annots.t] cannot be marshalled (as it contains a [Univ_map.t]). - - This needs to be updated each time we add a new [Annots.t], otherwise - we will silently drop those annotations when using action runners. *) - type t = - | User_with_annots of - { message : User_message.t (* Should not have any fields in [Annots.t]. *) - ; has_embedded_location : bool - ; needs_stack_trace : bool - ; compound_user_error : Compound_user_error.t list option - (* Compound user errors do not contain annotations, so it's fine to - marshal them as is. *) - ; diff_promotion : Diff_promotion.Annot.t option - ; with_directory : string option - } - | Code of Code_error.t - | Sys of string - | Unix of Unix.error * string * string - | Nonreproducible_build_cancelled - - let to_ (t : t) : Action_exec.Exec_result.Error.t = - match t with - | User_with_annots - { message - ; has_embedded_location - ; needs_stack_trace - ; compound_user_error - ; diff_promotion - ; with_directory - } -> - let annots = User_message.Annots.empty in - let annots = - match has_embedded_location with - | true -> - User_message.Annots.set annots User_message.Annots.has_embedded_location () - | false -> annots - in - let annots = - match needs_stack_trace with - | true -> - User_message.Annots.set annots User_message.Annots.needs_stack_trace () - | false -> annots - in - let annots = - match compound_user_error with - | Some annot -> User_message.Annots.set annots Compound_user_error.annot annot - | None -> annots - in - let annots = - match diff_promotion with - | Some annot -> User_message.Annots.set annots Diff_promotion.Annot.annot annot - | None -> annots - in - User - { loc = message.loc - ; paragraphs = message.paragraphs - ; hints = message.hints - ; annots - ; context = None - ; dir = with_directory - } - | Code err -> Code err - | Sys err -> Sys err - | Unix (err, call, args) -> Unix (err, call, args) - | Nonreproducible_build_cancelled -> Nonreproducible_build_cancelled - ;; - - let from (t : Action_exec.Exec_result.Error.t) : t = - match t with - | User message -> - let annots = message.annots in - let message = { message with annots = User_message.Annots.empty } in - let has_embedded_location = - match - User_message.Annots.find annots User_message.Annots.has_embedded_location - with - | Some () -> true - | None -> false - in - let needs_stack_trace = - match User_message.Annots.find annots User_message.Annots.needs_stack_trace with - | Some () -> true - | None -> false - in - let compound_user_error = - User_message.Annots.find annots Compound_user_error.annot - in - let diff_promotion = User_message.Annots.find annots Diff_promotion.Annot.annot in - let with_directory = message.dir in - User_with_annots - { message - ; has_embedded_location - ; needs_stack_trace - ; compound_user_error - ; diff_promotion - ; with_directory - } - | Code err -> Code err - | Sys err -> Sys err - | Unix (err, call, args) -> Unix (err, call, args) - | Nonreproducible_build_cancelled -> Nonreproducible_build_cancelled - ;; - end - - module Exec = struct - let marshal () = - let to_ data = Marshal.from_string data 0 in - let from action = Marshal.to_string action [] in - Conv.iso Conv.string to_ from - ;; - - let marshal_result () = - let to_ = Result.map_error ~f:(List.map ~f:Marshallable_error.to_) in - let from = Result.map_error ~f:(List.map ~f:Marshallable_error.from) in - Conv.iso (marshal ()) to_ from - ;; - - let decl = - let v1 = - Decl.Request.make_current_gen - ~req:(marshal ()) - ~resp:(marshal_result ()) - ~version:1 - in - Decl.Request.make ~method_:"action/exec" ~generations:[ v1 ] - ;; - end - - module Ready = struct - let decl = - let v1 = - Decl.Request.make_current_gen ~req:Conv.string ~resp:Conv.unit ~version:1 - in - Decl.Request.make ~method_:"action/ready" ~generations:[ v1 ] - ;; - end - - module Cancel_build = struct - let decl = - let v1 = Decl.Request.make_current_gen ~req:Conv.unit ~resp:Conv.unit ~version:1 in - Decl.Request.make ~method_:"action/cancel-build" ~generations:[ v1 ] - ;; - end - - let exec = Exec.decl - let ready = Ready.decl - let cancel_build = Cancel_build.decl -end - -module Client = Dune_rpc_client.Client - -type session = Session : _ Dune_rpc_server.Session.t -> session - -type initialized = - { session : session - ; id : (module Stdune.Id.S) - } - -type status = - | Awaiting_initialization of unit Fiber.Ivar.t - | Initialized of initialized - | Closed - -let dyn_of_status = - let open Dyn in - function - | Awaiting_initialization _ -> variant "Awaiting_initialization" [] - | Initialized _ -> variant "Initialized" [] - | Closed -> variant "Closed" [] -;; - -module Id = Stdune.Id.Make () - -type t = - { name : string - ; id : Id.t - ; mutable status : status - } - -let name t = t.name - -let send_request ~info ~request ~payload t = - let* { session; id = (module Id) } = - match t.status with - | Closed -> - Code_error.raise "action runner disconnected" [ "name", Dyn.string t.name ] - | Initialized s -> Fiber.return s - | Awaiting_initialization ready -> - let+ () = Fiber.Ivar.read ready in - (match t.status with - | Closed -> - Code_error.raise - "action runner disconnected before initialization" - [ "name", Dyn.string t.name ] - | Initialized s -> s - | Awaiting_initialization _ -> - (* we just finished initializing *) - assert false) - in - let (Session session) = session in - let id = Dune_rpc.Id.make @@ Csexp.Atom (Int.to_string @@ Id.to_int @@ Id.gen ()) in - if !Log.verbose then Log.info info; - Dune_rpc_server.Session.request - session - (Dune_rpc.Decl.Request.witness request) - id - payload -;; - -let exec_action (t : t) (action : Action_exec.input) = - send_request - ~info: - [ Pp.textf - "dispatching action at %s to %s" - (Path.to_string_maybe_quoted action.root) - t.name - ] - ~request:Decl.exec - ~payload:action - t -;; - -let cancel_build (t : t) = - send_request - ~info:[ Pp.textf "cancelling all builds at %s" t.name ] - ~request:Decl.cancel_build - ~payload:() - t -;; - -let _to_dyn { name; id; status } = - let open Dyn in - record [ "name", string name; "id", Id.to_dyn id; "status", dyn_of_status status ] -;; - -module Rpc_server = struct - type nonrec t = - { workers : (string, t) Table.t - ; pool : Fiber.Pool.t - } - - let create () = - { workers = Table.create (module String) 16; pool = Fiber.Pool.create () } - ;; - - let all_runners t = Table.values t.workers - let run t = Fiber.Pool.run t.pool - let stop t = Fiber.Pool.close t.pool - - let close worker = - match worker.status with - | Closed -> () - | _ -> worker.status <- Closed - ;; - - let register t worker = - match Table.add t.workers worker.name worker with - | Ok () -> () - | Error _ -> - User_error.raise [ Pp.textf "Cannot register %s as it already exists" worker.name ] - ;; - - let implement_handler t (handler : _ Dune_rpc_server.Handler.t) = - Dune_rpc_server.Handler.declare_request handler Decl.exec; - Dune_rpc_server.Handler.declare_request handler Decl.cancel_build; - Dune_rpc_server.Handler.implement_request handler Decl.ready - @@ fun session name -> - let socket_name = Dune_rpc_server.Session.name session in - if not (name = socket_name) - then ( - let error = - Dune_rpc.Response.Error.create - ~payload: - (Sexp.record - [ "name", Csexp.Atom name; "socket_name", Csexp.Atom socket_name ]) - ~kind:Invalid_request - ~message:"action runner connected to the wrong socket" - () - in - raise (Dune_rpc.Response.Error.E error)); - match Table.find t.workers name with - | None -> - let error = - Dune_rpc.Response.Error.create - ~kind:Invalid_request - ~message:"unexpected action runner" - () - in - raise (Dune_rpc.Response.Error.E error) - | Some worker -> - (match worker.status with - | Closed -> - let error = - Dune_rpc.Response.Error.create - ~kind:Invalid_request - ~message:"disconnected earlier" - () - in - raise (Dune_rpc.Response.Error.E error) - | Initialized _ -> - let error = - Dune_rpc.Response.Error.create - ~kind:Invalid_request - ~message:"already signalled readiness to the server" - () - in - raise (Dune_rpc.Response.Error.E error) - | Awaiting_initialization ivar -> - let initialized = - { session = Session session; id = (module Stdune.Id.Make ()) } - in - worker.status <- Initialized initialized; - if !Log.verbose then Log.info [ Pp.textf "action runner %s connected" name ]; - let* () = - Fiber.Pool.task t.pool ~f:(fun () -> - let+ () = Dune_rpc_server.Session.closed session in - close worker) - in - Fiber.Ivar.fill ivar ()) - ;; -end - -let create server ~name = - let init = Fiber.Ivar.create () in - let t = { name; id = Id.gen (); status = Awaiting_initialization init } in - Rpc_server.register server t; - t -;; - -module Worker = struct - let exec_action = - let build_deps _ = Code_error.raise "no dynamic actions yet" [] in - fun (action : Action_exec.input) -> - Log.info - [ Pp.text "action runner executing action:" - ; Action.for_shell action.action |> Action_to_sh.pp - ]; - Action_exec.exec ~build_deps action - ;; - - let cancel_build = Scheduler.cancel_current_build - - let start ~name ~where = - let* connection = Client.Connection.connect_exn where in - let private_menu : Client.proc list = - [ Request Decl.ready - ; Handle_request (Decl.exec, exec_action) - ; Handle_request (Decl.cancel_build, cancel_build) - ] - in - let id = Dune_rpc.Id.make (Sexp.Atom name) in - Dune_rpc.Initialize.Request.create ~id - |> Client.client ~private_menu connection ~f:(fun client -> - let* request = - Client.Versioned.prepare_request - client - (Dune_rpc_private.Decl.Request.witness Decl.ready) - in - match request with - | Error v -> - User_error.raise - [ Pp.textf - "Server does not agree on the menu. Are you running the same dune binary \ - for the worker?" - ; Pp.text (Dune_rpc.Version_error.message v) - ] - | Ok request -> - let* response = Client.request client request name in - (match response with - | Ok () -> - if !Log.verbose - then Log.info [ Pp.textf "action runner %s successfully connected" name ]; - Client.disconnected client - | Error e -> - User_error.raise - [ Pp.textf - "Failed to signal readiness to the server %S" - (Dune_rpc.Where.to_string where) - ; Pp.text @@ Dune_rpc.Response.Error.message e - ])) - ;; -end diff --git a/src/dune_engine/action_runner.mli b/src/dune_engine/action_runner.mli deleted file mode 100644 index 80489006dd6..00000000000 --- a/src/dune_engine/action_runner.mli +++ /dev/null @@ -1,49 +0,0 @@ -(** Action runners are instances capabale of executing dune actions outside of - the build engine's process. *) - -type t - -module Rpc_server : sig - (** The component of the RPC server required to orchestrate the runners. It's - responsible for handing off sessions to action runners once they connect. *) - type runner := t - - type t - - val create : unit -> t - - (** [implement_handler handler] adds the functions needed to manage connected - workers to the rpc server. This only needs to be called by the RPC server *) - val implement_handler : t -> 'a Dune_rpc_server.Handler.t -> unit - - (** [run t] is to be run by the rpc server *) - val run : t -> unit Fiber.t - - (** [stop t] is to be run by the rpc server *) - val stop : t -> unit Fiber.t - - val all_runners : t -> runner list -end - -val create : Rpc_server.t -> name:string -> t -val name : t -> string - -(* CR-soon dkalinichenko: return [Exn_with_backtrace.t list] in the error case - after rgrinberg patches exception marshalling upstream. *) - -(** [exec_action worker action] dispatches [action] to [worker] *) -val exec_action : t -> Action_exec.input -> Action_exec.Exec_result.t Fiber.t - -(** [cancel_build] cancels all actions being executed by [worker] *) -val cancel_build : t -> unit Fiber.t - -module Worker : sig - (** A worker is a runner of action *) - - (** [start ~name ~where] start a runner named [name] connected to server - [where]. The server is allowed to dispatch actions to this worker once the - worker initializes itself. - - This function returns when the connection to the server terminates. *) - val start : name:string -> where:Dune_rpc_private.Where.t -> unit Fiber.t -end diff --git a/src/dune_engine/build_config.ml b/src/dune_engine/build_config.ml index 5e4ed6d1db9..584f7d6df41 100644 --- a/src/dune_engine/build_config.ml +++ b/src/dune_engine/build_config.ml @@ -77,8 +77,6 @@ type t = ; implicit_default_alias : Path.Build.t -> unit Action_builder.t option Memo.t ; execution_parameters : dir:Path.Build.t -> Execution_parameters.t Memo.t ; source_tree : (module Source_tree) - ; action_runner : Action_exec.input -> Action_runner.t option - ; action_runners : unit -> Action_runner.t list ; shared_cache : (module Dune_cache.Shared.S) ; write_error_summary : Build_system_error.Set.t -> unit Fiber.t } @@ -87,8 +85,6 @@ let t : t Fdecl.t = Fdecl.create Dyn.opaque let get () = Fdecl.get t let set - ~action_runner - ~action_runners ~stats ~contexts ~promote_source @@ -128,8 +124,6 @@ let set ; implicit_default_alias ; execution_parameters ; source_tree - ; action_runner - ; action_runners ; shared_cache ; write_error_summary } diff --git a/src/dune_engine/build_config_intf.ml b/src/dune_engine/build_config_intf.ml index cc91f72eada..84b0faffd63 100644 --- a/src/dune_engine/build_config_intf.ml +++ b/src/dune_engine/build_config_intf.ml @@ -119,9 +119,7 @@ module type Build_config = sig (** Initialise the build system. This must be called before running the build system and only once. *) val set - : action_runner:(Action_exec.input -> Action_runner.t option) - -> action_runners:(unit -> Action_runner.t list) - -> stats:Dune_stats.t option + : stats:Dune_stats.t option -> contexts:(Build_context.t * Context_type.t) list Memo.Lazy.t -> promote_source: (chmod:(int -> int) @@ -156,8 +154,6 @@ module type Build_config = sig ; implicit_default_alias : Path.Build.t -> unit Action_builder.t option Memo.t ; execution_parameters : dir:Path.Build.t -> Execution_parameters.t Memo.t ; source_tree : (module Source_tree) - ; action_runner : Action_exec.input -> Action_runner.t option - ; action_runners : unit -> Action_runner.t list ; shared_cache : (module Dune_cache.Shared.S) ; write_error_summary : Build_system_error.Set.t -> unit Fiber.t } diff --git a/src/dune_engine/build_system.ml b/src/dune_engine/build_system.ml index 28986dceba9..5fa83350947 100644 --- a/src/dune_engine/build_system.ml +++ b/src/dune_engine/build_system.ml @@ -420,11 +420,8 @@ end = struct ; action } in - match (Build_config.get ()).action_runner input with - | None -> - let build_deps deps = Memo.run (build_deps deps) in - Action_exec.exec input ~build_deps - | Some runner -> Action_runner.exec_action runner input + let build_deps deps = Memo.run (build_deps deps) in + Action_exec.exec input ~build_deps in let* action_exec_result = Action_exec.Exec_result.ok_exn action_exec_result in let* () = @@ -1106,12 +1103,7 @@ let report_early_exn exn = let+ () = State.add_errors errors and+ () = match !Clflags.stop_on_first_error with - | true -> - let* () = - (Build_config.get ()).action_runners () - |> Fiber.parallel_iter ~f:Action_runner.cancel_build - in - Scheduler.cancel_current_build () + | true -> Scheduler.cancel_current_build () | false -> Fiber.return () in (match !Clflags.report_errors_config with diff --git a/src/dune_engine/dune b/src/dune_engine/dune index 82ef2ed07d8..a1cdfb66a1a 100644 --- a/src/dune_engine/dune +++ b/src/dune_engine/dune @@ -26,7 +26,6 @@ dune_output_truncation csexp_rpc dune_rpc_private - dune_rpc_server dune_rpc_client dune_thread_pool spawn diff --git a/src/dune_engine/dune_engine.ml b/src/dune_engine/dune_engine.ml index f34a0b6a41c..e2516ac166c 100644 --- a/src/dune_engine/dune_engine.ml +++ b/src/dune_engine/dune_engine.ml @@ -37,7 +37,6 @@ module Reflection = Reflection module No_io = No_io module Rpc = Rpc module Dune_rpc_client = Dune_rpc_client -module Action_runner = Action_runner module Action_exec = Action_exec module Running_jobs = Running_jobs module Rule_cache = Rule_cache diff --git a/src/dune_rpc_impl/server.ml b/src/dune_rpc_impl/server.ml index bd6fe2ef229..a3387699251 100644 --- a/src/dune_rpc_impl/server.ml +++ b/src/dune_rpc_impl/server.ml @@ -15,7 +15,6 @@ end include struct open Dune_engine - module Action_runner = Action_runner module Build_config = Build_config module Diff_promotion = Diff_promotion end @@ -38,7 +37,6 @@ module Run = struct type t = { handler : Dune_rpc_server.t - ; action_runner : Action_runner.Rpc_server.t ; pool : Fiber.Pool.t ; root : string ; where : Dune_rpc.Where.t @@ -204,16 +202,13 @@ let ready (t : _ t) = ;; let stop (t : _ t) = - Fiber.fork_and_join_unit - (fun () -> Action_runner.Rpc_server.stop t.config.action_runner) - (fun () -> - let* server = Fiber.Ivar.peek t.config.server_ivar in - match server with - | None -> Fiber.return () - | Some server -> Csexp_rpc.Server.stop server) + let* server = Fiber.Ivar.peek t.config.server_ivar in + match server with + | None -> Fiber.return () + | Some server -> Csexp_rpc.Server.stop server ;; -let handler (t : _ t Fdecl.t) action_runner_server handle : 'a Dune_rpc_server.Handler.t = +let handler (t : _ t Fdecl.t) handle : 'a Dune_rpc_server.Handler.t = let on_init session (_ : Initialize.Request.t) = let t = Fdecl.get t in let client = () in @@ -406,24 +401,14 @@ let handler (t : _ t Fdecl.t) action_runner_server handle : 'a Dune_rpc_server.H let f _ () = Fiber.return Path.Build.(to_string root) in Handler.implement_request rpc Procedures.Public.build_dir f in - Dune_engine.Action_runner.Rpc_server.implement_handler action_runner_server rpc; handle rpc; rpc ;; -let create - ~lock_timeout - ~registry - ~root - ~watch_mode_config - ~handle - stats - action_runner - ~parse_build - = +let create ~lock_timeout ~registry ~root ~watch_mode_config ~handle stats ~parse_build = let t = Fdecl.create Dyn.opaque in let pending_build_jobs = Job_queue.create () in - let handler = Dune_rpc_server.make (handler t action_runner handle) in + let handler = Dune_rpc_server.make (handler t handle) in let pool = Fiber.Pool.create () in let where = Where.default () in Global_lock.lock_exn ~timeout:lock_timeout; @@ -455,7 +440,6 @@ let create ; stats ; server ; registry - ; action_runner ; server_ivar = Fiber.Ivar.create () } in @@ -473,13 +457,9 @@ let create let run t = let* () = Fiber.return () in - Fiber.fork_and_join_unit - (fun () -> Run.run t.config) - (fun () -> Dune_engine.Action_runner.Rpc_server.run t.config.action_runner) + Run.run t.config ;; -let action_runner t = t.config.action_runner - let pending_build_action t = Job_queue.read t.pending_build_jobs |> Fiber.map ~f:(fun (targets, ivar) -> Build (targets, ivar)) diff --git a/src/dune_rpc_impl/server.mli b/src/dune_rpc_impl/server.mli index 784d9ccd02d..07abc19db57 100644 --- a/src/dune_rpc_impl/server.mli +++ b/src/dune_rpc_impl/server.mli @@ -8,7 +8,6 @@ val create -> handle:(unit Dune_rpc_server.Handler.t -> unit) (** register additional requests or notifications *) -> Dune_stats.t option - -> Dune_engine.Action_runner.Rpc_server.t -> parse_build:(string -> 'a) -> 'a t @@ -22,4 +21,3 @@ val stop : _ t -> unit Fiber.t val ready : _ t -> unit Fiber.t val run : _ t -> unit Fiber.t -val action_runner : _ t -> Dune_engine.Action_runner.Rpc_server.t diff --git a/src/dune_rules/main.ml b/src/dune_rules/main.ml index 1f5cb1d08e6..5d83235ea35 100644 --- a/src/dune_rules/main.ml +++ b/src/dune_rules/main.ml @@ -46,8 +46,6 @@ let execution_parameters = ;; let init - ?(action_runner = fun _ -> None) - ?(action_runners = fun _ -> []) ~stats ~sandboxing_preference ~cache_config @@ -97,8 +95,6 @@ let init ~execution_parameters ~source_tree:(module Source_tree) ~shared_cache:(module Shared_cache) - ~action_runner - ~action_runners ~write_error_summary:(fun _ -> Fiber.return ()) ;; diff --git a/src/dune_rules/main.mli b/src/dune_rules/main.mli index fd911044307..d12d2166236 100644 --- a/src/dune_rules/main.mli +++ b/src/dune_rules/main.mli @@ -2,9 +2,7 @@ open Import (** Tie the knot between [Dune_engine] and [Dune_rules]. *) val init - : ?action_runner:(Dune_engine.Action_exec.input -> Dune_engine.Action_runner.t option) - -> ?action_runners:(unit -> Dune_engine.Action_runner.t list) - -> stats:Dune_stats.t option + : stats:Dune_stats.t option -> sandboxing_preference:Sandbox_mode.t list -> cache_config:Dune_cache.Config.t -> cache_debug_flags:Dune_engine.Cache_debug_flags.t