feature: bring back action runners

bin/build.ml

@@ -1,14 +1,13 @@
 open Import
 
-let run_build_system_impl ?restart_started_at ~run_id ~request () =
+let run_build_system_impl ?restart_started_at ~request () =
   Dune_engine.Build_system.run_action_builder
     ?restart_started_at
-    ~run_id
     (let open Action_builder.O in
      Action_builder.of_memo (Util.setup ()) >>= request)
 ;;
 
-let run_build_system ~run_id ~request = run_build_system_impl ~run_id ~request ()
+let run_build_system ~request = run_build_system_impl ~request ()
 
 let poll_handling_rpc_build_requests build_loop ~(common : Common.t) =
   let open Fiber.O in
@@ -21,7 +20,7 @@ let poll_handling_rpc_build_requests build_loop ~(common : Common.t) =
     build_loop
     ~get_build_request:
       (let+ { kind; outcome } = Dune_rpc_impl.Server.pending_action rpc in
-       ( (fun ~run_id ~restart_started_at ->
+       ( (fun ~restart_started_at ->
            let request setup =
              let root = Common.root common in
              match kind with
@@ -32,7 +31,7 @@ let poll_handling_rpc_build_requests build_loop ~(common : Common.t) =
                  ~to_cwd:root.to_cwd
                  ~test_paths
            in
-           run_build_system_impl ?restart_started_at ~run_id ~request ())
+           run_build_system_impl ?restart_started_at ~request ())
        , outcome ))
 ;;
 
@@ -44,8 +43,8 @@ let run_build_command_poll_eager ~(common : Common.t) ~config ~request : unit =
           is responsible for building targets named in RPC build requests. *)
     Dune_engine.Build_loop.run (fun build_loop ->
       let+ () =
-        Dune_engine.Build_loop.poll build_loop (fun ~run_id ~restart_started_at ->
-          run_build_system_impl ?restart_started_at ~run_id ~request ())
+        Dune_engine.Build_loop.poll build_loop (fun ~restart_started_at ->
+          run_build_system_impl ?restart_started_at ~request ())
       and+ () = poll_handling_rpc_build_requests build_loop ~common in
       ()))
 ;;
@@ -61,7 +60,7 @@ let run_build_command_poll_passive ~common ~config ~request:_ : unit =
 let run_build_command_once ~(common : Common.t) ~config ~request =
   let open Fiber.O in
   let once () =
-    run_build_system ~run_id:Dune_engine.Run_id.Batch ~request
+    run_build_system ~request
     >>| function
     | Error `Already_reported -> raise Dune_util.Report_error.Already_reported
     | Ok () -> ()

bin/build.mli

@@ -1,8 +1,7 @@
 open Import
 
 val run_build_system
-  :  run_id:Dune_engine.Run_id.t
-  -> request:(Dune_rules.Main.build_system -> unit Action_builder.t)
+  :  request:(Dune_rules.Main.build_system -> unit Action_builder.t)
   -> (unit, [ `Already_reported ]) result Fiber.t
 
 val build : unit Cmd.t

bin/common.ml

@@ -60,6 +60,7 @@ end
 
 let default_build_dir = "_build"
 let trace_file_name = "trace.csexp"
+let action_runner_name = Action_runner_name.of_string "action-runner"
 
 let find_default_trace_file () =
   let trace_file = Filename.concat default_build_dir trace_file_name in
@@ -625,6 +626,8 @@ module Builder = struct
     ; allow_builds : bool
     ; default_root_is_cwd : bool
     ; target_exec : string option
+    ; action_runner : bool
+    ; sandbox_actions : bool
     }
 
   let set_no_build t no_build = { t with no_build }
@@ -952,6 +955,25 @@ module Builder = struct
         & info
             [ "stop-on-first-error" ]
             ~doc:(Some "Stop the build as soon as an error is encountered."))
+    and+ sandbox_actions =
+      Arg.(
+        value
+        & flag
+        & info
+            [ "sandbox-actions" ]
+            ~docs
+            ~doc:
+              (Some
+                 "Run spawned build processes in an external dune action runner wrapped \
+                  with bubblewrap."))
+    and+ action_runner =
+      Arg.(
+        value
+        & flag
+        & info
+            [ "action-runner" ]
+            ~docs
+            ~doc:(Some "Run spawned build processes in an external dune action runner."))
     in
     { no_build
     ; debug_dep_path
@@ -996,6 +1018,8 @@ module Builder = struct
     ; allow_builds = true
     ; default_root_is_cwd = false
     ; target_exec
+    ; action_runner
+    ; sandbox_actions
     }
   ;;
 
@@ -1035,6 +1059,8 @@ module Builder = struct
         ; allow_builds
         ; default_root_is_cwd
         ; target_exec
+        ; action_runner
+        ; sandbox_actions
         }
     =
     No_build.equal t.no_build no_build
@@ -1074,6 +1100,8 @@ module Builder = struct
     && Bool.equal t.allow_builds allow_builds
     && Bool.equal t.default_root_is_cwd default_root_is_cwd
     && Option.equal String.equal t.target_exec target_exec
+    && Bool.equal t.action_runner action_runner
+    && Bool.equal t.sandbox_actions sandbox_actions
   ;;
 end
 
@@ -1082,13 +1110,16 @@ type t =
   ; root : Workspace_root.t
   ; rpc :
       [ `Allow of Dune_lang.Dep_conf.t Dune_rpc_impl.Server.t Lazy.t | `Forbid_builds ]
+  ; action_runner : Dune_engine.Action_runner.t option
   }
 
 let capture_outputs t = t.builder.capture_outputs
 let root t = t.root
 let watch t = t.builder.watch
 let x t = t.builder.workspace_config.x
 let file_watcher t = t.builder.file_watcher
+let sandbox_actions t = t.builder.sandbox_actions
+let action_runner t = t.action_runner
 let prefix_target t s = t.root.reach_from_root_prefix ^ s
 
 let rpc t =
@@ -1176,7 +1207,7 @@ let build (root : Workspace_root.t) (builder : Builder.t) =
            Dune_rpc_impl.Server.create ~registry ~root:root.dir builder.watch))
     else `Forbid_builds
   in
-  { builder; root; rpc }
+  { builder; root; rpc; action_runner = None }
 ;;
 
 let maybe_init_cache (cache_config : Dune_cache.Config.t) =
@@ -1283,7 +1314,47 @@ let init_with_root ~(root : Workspace_root.t) (builder : Builder.t) =
       , Dyn.string (Path.to_string (Lazy.force Dune_cache.Layout.build_cache_dir)) )
     ];
   Dune_cache.Shared.config := maybe_init_cache cache_config;
-  Dune_rules.Main.init ~sandboxing_preference:config.sandboxing_preference ();
+  let action_runner =
+    match
+      c.builder.allow_builds, c.builder.action_runner || c.builder.sandbox_actions
+    with
+    | false, _ -> None
+    | true, false -> None
+    | true, true ->
+      let server =
+        match rpc c with
+        | `Allow server -> Dune_rpc_impl.Server.action_runner server
+        | `Forbid_builds ->
+          Code_error.raise "action runners require the dune RPC server" []
+      in
+      Some (Dune_engine.Action_runner.create server ~name:action_runner_name)
+  in
+  let c = { c with action_runner } in
+  (match action_runner with
+   | None -> ()
+   | Some runner ->
+     Dune_engine.Process.Runner.set (fun ~build request ->
+       let { Dune_engine.Process.Build.run_id; cancellation } = build in
+       let on_cancel () = Dune_engine.Action_runner.cancel_build runner ~run_id in
+       Some
+         (let open Fiber.O in
+          let* result, outcome =
+            Fiber.Cancel.with_handler
+              cancellation
+              (fun () ->
+                 Fiber.collect_errors (fun () ->
+                   Dune_engine.Action_runner.exec_process runner ~build request))
+              ~on_cancel
+          in
+          match outcome, result with
+          | Cancelled (), _ ->
+            raise (Memo.Non_reproducible Dune_scheduler.Scheduler.Run.Build_cancelled)
+          | Not_cancelled, Ok result -> Fiber.return result
+          | Not_cancelled, Error exns -> Fiber.reraise_all exns)));
+  Dune_rules.Main.init
+    ~sandbox_actions:c.builder.sandbox_actions
+    ~sandboxing_preference:config.sandboxing_preference
+    ();
   Only_packages.Clflags.set c.builder.only_packages;
   Report_error.print_memo_stacks := c.builder.debug_dep_path;
   Dune_engine.Clflags.report_errors_config := c.builder.report_errors_config;

bin/common.mli

@@ -18,6 +18,8 @@ val rpc
 val watch_exclusions : t -> string list
 val watch : t -> Dune_rpc_impl.Watch_mode_config.t
 val file_watcher : t -> Dune_scheduler.Scheduler.Run.file_watcher
+val sandbox_actions : t -> bool
+val action_runner : t -> Dune_engine.Action_runner.t option
 val prefix_target : t -> string -> string
 val find_default_trace_file : unit -> string
 

bin/describe/aliases_targets.ml

@@ -106,8 +106,7 @@ let ls_term (fetch_results : Path.Build.t -> string list Action_builder.t) =
   Scheduler_setup.go_with_rpc_server ~common ~config
   @@ fun () ->
   let open Fiber.O in
-  Build.run_build_system ~run_id:Dune_engine.Run_id.Batch ~request
-  >>| fun (_ : (unit, [ `Already_reported ]) result) -> ()
+  Build.run_build_system ~request >>| fun (_ : (unit, [ `Already_reported ]) result) -> ()
 ;;
 
 module Aliases_cmd = struct

bin/describe/describe_pp.ml

@@ -32,7 +32,7 @@ let execute_pp_action ~sctx file pp_file dump_file =
   let context = Dune_rules.Expander.context expander in
   let build_dir = Context_name.build_dir context in
   let* input =
-    let* action, _observing_facts =
+    let* (action, can_run_in_action_runner), _observing_facts =
       let* loc, action =
         let+ dialect, ml_kind = dialect_and_ml_kind file in
         match Dialect.print_ast dialect ml_kind with
@@ -54,7 +54,7 @@ let execute_pp_action ~sctx file pp_file dump_file =
             ~deps:[]
             ~what:"describe pp"
         in
-        Action.with_outputs_to dump_file build.action
+        Action.with_outputs_to dump_file build.action, build.can_run_in_action_runner
       in
       Action_builder.evaluate_and_collect_facts build
     in
@@ -74,6 +74,7 @@ let execute_pp_action ~sctx file pp_file dump_file =
     ; env
     ; rule_loc = Loc.none
     ; execution_parameters
+    ; can_run_in_action_runner
     ; action
     }
   in

bin/exec.ml

@@ -304,10 +304,10 @@ let exec_building_directly ~common ~config ~context ~prog ~args ~no_rebuild =
     let on_exit = Console.printf "Program exited with code [%d]" in
     Dune_engine.Build_loop.run (fun build_loop ->
       Dune_engine.Build_loop.poll build_loop
-      @@ fun ~run_id ~restart_started_at ->
+      @@ fun ~restart_started_at ->
       let* () = Fiber.return () in
       Console.maybe_clear_screen ~details_hum:[];
-      Dune_engine.Build_system.run ?restart_started_at ~run_id
+      Dune_engine.Build_system.run ?restart_started_at
       @@ step ~prog ~args ~common ~no_rebuild ~context ~on_exit)
   | No ->
     Scheduler_setup.go_with_rpc_server ~common ~config

bin/fmt.ml

@@ -35,7 +35,7 @@ let run_fmt_command ~common ~config ~preview builder =
       Alias.in_dir ~name:Dune_rules.Alias.fmt ~recursive:true ~contexts:setup.contexts dir
       |> Alias.request
     in
-    Build.run_build_system ~run_id:Dune_engine.Run_id.Batch ~request
+    Build.run_build_system ~request
     >>| function
     | Ok () -> ()
     | Error `Already_reported -> raise Dune_util.Report_error.Already_reported

bin/internal.ml

@@ -228,6 +228,7 @@ let group =
     (Cmd.info "internal")
     [ Internal_dump.command
     ; Internal_digest_db.command
+    ; Internal_action_runner.group
     ; latest_lang_version
     ; bootstrap_info
     ; Sexp_pp.command

bin/internal_action_runner.ml

@@ -0,0 +1,41 @@
+open Import
+
+let start =
+  let+ builder = Common.Builder.term_no_trace_no_pkg
+  and+ name =
+    Arg.(required & pos 0 (some string) None (Arg.info [] ~docv:"NAME" ~doc:None))
+  and+ generation =
+    Arg.(required & pos 1 (some int) None (Arg.info [] ~docv:"GENERATION" ~doc:None))
+  and+ where =
+    Arg.(required & pos 2 (some string) None (Arg.info [] ~docv:"WHERE" ~doc:None))
+  and+ trace_fd =
+    Arg.(value & opt (some string) None (Arg.info [ "trace-fd" ] ~docv:"FD" ~doc:None))
+  in
+  let builder = Common.Builder.forbid_builds builder in
+  let common, config = Common.init builder in
+  let name = Action_runner_name.parse_string_exn (Loc.none, name) in
+  Option.iter trace_fd ~f:(fun fd ->
+    if Sys.win32 then Code_error.raise "trace fd handoff is not supported on Windows" [];
+    Dune_trace.set_global_inherited_fd
+      ~common_args:[ "action_runner", Sexp.Atom (Action_runner_name.to_string name) ]
+      (Fd.unsafe_of_int (Int.of_string_exn fd)));
+  let where =
+    match
+      Dune_rpc.Conv.of_sexp
+        Dune_rpc.Where.sexp
+        ~version:Dune_rpc.Version.latest
+        (Sexp.Atom where)
+    with
+    | Ok where -> where
+    | Error err ->
+      User_error.raise
+        [ Pp.textf "invalid action runner RPC address %S" where
+        ; Pp.text (Dyn.to_string (Dune_rpc.Conv.dyn_of_error err))
+        ]
+  in
+  Scheduler_setup.go_without_rpc_server ~common ~config (fun () ->
+    Dune_engine.Action_runner.Worker.start ~name ~generation ~where)
+;;
+
+let start = Cmd.v (Cmd.info "start") start
+let group = Cmd.group (Cmd.info "action-runner") [ start ]

bin/internal_action_runner.mli

@@ -0,0 +1,3 @@
+open Import
+
+val group : unit Cmd.t