Skip to content

Commit

Permalink
Eager watch mode for exec
Browse files Browse the repository at this point in the history 
Signed-off-by: Stephen Sherratt <stephen@sherra.tt>
  • Loading branch information
@gridbugs
gridbugs committed Dec 1, 2022
1 parent 1e835d9 commit 46bbcd1
Show file tree
Hide file tree
Showing 7 changed files with 341 additions and 88 deletions.
2 changes: 2 additions & 0 deletions CHANGES.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,8 @@ Unreleased
- Fix missing dependencies when detecting the kind of C compiler we're using
(#6610, fixes #6415, @emillon)

- Implement eager watch mode for `dune exec` (#6507, fixes #2934, @gridbugs)

3.6.0 (2022-11-14)
------------------

Expand Down
3 changes: 2 additions & 1 deletion bin/dune
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,8 @@
csexp
csexp_rpc
dune_rpc_impl
dune_rpc_private)
dune_rpc_private
spawn)
(bootstrap_info bootstrap-info))

; Installing the dune binary depends on the kind of build:
Expand Down
285 changes: 202 additions & 83 deletions bin/exec.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,108 @@ let man =

let info = Cmd.info "exec" ~doc ~man

module Command_to_exec = struct
(* A command to execute, which knows how to (re)build the program and then
run it with some arguments in an enivorment *)

type t =
{ get_path_and_build_if_necessary :
unit -> (Path.t, [ `Already_reported ]) result Fiber.t
; args : string list
; env : Env.t
}

(* Helper function to spawn a new process running a command in an
environment, returning the new process' pid *)
let spawn_process path ~args ~env =
let path = Path.to_string path in
let env = Env.to_unix env |> Spawn.Env.of_list in
let argv = path :: args in
let pid = Spawn.spawn ~prog:path ~env ~argv () in
Pid.of_int pid

(* Run the command, first (re)building the program which the command is
invoking *)
let build_and_run_in_child_process
{ get_path_and_build_if_necessary; args; env } =
let open Fiber.O in
(* Take the lock before building and release it afterwards so `dune build`
can be run in between rebuilds. The timeout allows multiple instances of
`dune exec -w ...` to be run simultaneously. *)
Dune_util.Global_lock.lock_exn ~timeout:(Some 1.0);
let+ result_path = get_path_and_build_if_necessary () in
Dune_util.Global_lock.unlock ();
Result.map result_path ~f:(spawn_process ~args ~env)
end

module Watch = struct
(* When running `dune exec` in watch mode, this will keep track of the pid of
the process created to run the program in the previous iteration so that
it can be killed (for long running programs, e.g. servers) and restarted
when its source is changed. *)

type state = { currently_running_pid : Pid.t option ref }

let init_state () = { currently_running_pid = ref None }

(* Send sigkill to a process and wait for it to stop. On Windows the only
supported (emulated) signal is sigkill. *)
let kill_process_windows pid =
let pid_int = Pid.to_int pid in
Unix.kill pid_int Sys.sigkill;
let _stopped_pid, _process_status = Unix.waitpid [] pid_int in
()

(* Send sigterm to a process, and wait 1s for the process to stop. If it's
still running after 1s, send sigkill. *)
let kill_process_unix pid =
let pid_int = Pid.to_int pid in
Unix.kill pid_int Sys.sigterm;
let period = 0.1 in
(* Periodically check if the process is still running ([wait]-ing with [WNOHANG]) after sending sigterm, and send sigkill if its still running after a timeout *)
let rec poll remaining_time =
if remaining_time <= 0.0 then (
Unix.kill pid_int Sys.sigkill;
let _stopped_pid, _process_status = Unix.waitpid [] pid_int in
())
else (
Unix.sleepf period;
let stopped_pid, _process_status =
Unix.waitpid [ Unix.WNOHANG ] pid_int
in
if Int.equal stopped_pid 0 then
(* the process is still running *)
poll (remaining_time -. period)
else ())
in
poll 1.0

(* Helper function to kill a process and block the calling thread until the
killed process stops. The pid of the killed process will be reaped. *)
let kill_process pid =
if Sys.win32 then kill_process_windows pid else kill_process_unix pid

let kill_currently_running_process { currently_running_pid } =
match !currently_running_pid with
| None -> ()
| Some pid ->
currently_running_pid := None;
kill_process pid

(* Kills the currently running process, then runs the given command after
(re)building the program which it will invoke *)
let run state ~command_to_exec =
let open Fiber.O in
let* () = Fiber.return () in
kill_currently_running_process state;
Command_to_exec.build_and_run_in_child_process command_to_exec
>>| Result.map ~f:(fun pid -> state.currently_running_pid := Some pid)

let loop ~command_to_exec =
let state = init_state () in
Scheduler.Run.poll (run state ~command_to_exec)
end

let term =
let+ common = Common.term
and+ context =
Expand All @@ -44,92 +146,109 @@ let term =
& info [ "no-build" ] ~doc:"don't rebuild target before executing")
and+ args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) in
let config = Common.init common in
let prog, argv, env =
Scheduler.go ~common ~config (fun () ->
let open Fiber.O in
let* setup = Import.Main.setup () in
let* setup = Memo.run setup in
let sctx = Import.Main.find_scontext_exn setup ~name:context in
let context = Dune_rules.Super_context.context sctx in
let dir =
Path.Build.relative context.build_dir (Common.prefix_target common "")
in
let build_prog p =
let open Memo.O in
if no_rebuild then
if Path.exists p then Memo.return p
else
User_error.raise
[ Pp.textf
"Program %S isn't built yet. You need to build it first or \
remove the --no-build option."
prog
]
(* This will prevent status line printing from interfering with the output of
the running program. *)
Console.Backend.set Console.Backend.dumb;
Scheduler.go_with_rpc_server_and_console_status_reporting ~common ~config
(fun () ->
let open Fiber.O in
let* setup = Import.Main.setup () in
let* setup = Memo.run setup in
let sctx = Import.Main.find_scontext_exn setup ~name:context in
let context = Dune_rules.Super_context.context sctx in
let dir =
Path.Build.relative context.build_dir (Common.prefix_target common "")
in
let build_prog p =
let open Memo.O in
if no_rebuild then
if Path.exists p then Memo.return p
else
let+ () = Build_system.build_file p in
p
in
let not_found () =
let open Memo.O in
let+ hints =
(* Good candidates for the "./x.exe" instead of "x.exe" error are
executables present in the current directory. Note: we do not
check directory targets here; even if they do indeed include a
matching executable, they would be located in a subdirectory of
[dir], so it's unclear if that's what the user wanted. *)
let+ candidates =
Build_system.files_of ~dir:(Path.build dir)
>>| Path.Set.to_list
>>| List.filter ~f:(fun p -> Path.extension p = ".exe")
>>| List.map ~f:(fun p -> "./" ^ Path.basename p)
in
User_message.did_you_mean prog ~candidates
User_error.raise
[ Pp.textf
"Program %S isn't built yet. You need to build it first or \
remove the --no-build option."
prog
]
else
let+ () = Build_system.build_file p in
p
in
let not_found () =
let open Memo.O in
let+ hints =
(* Good candidates for the "./x.exe" instead of "x.exe" error are
executables present in the current directory. Note: we do not
check directory targets here; even if they do indeed include a
matching executable, they would be located in a subdirectory of
[dir], so it's unclear if that's what the user wanted. *)
let+ candidates =
Build_system.files_of ~dir:(Path.build dir)
>>| Path.Set.to_list
>>| List.filter ~f:(fun p -> Path.extension p = ".exe")
>>| List.map ~f:(fun p -> "./" ^ Path.basename p)
in
User_error.raise ~hints [ Pp.textf "Program %S not found!" prog ]
User_message.did_you_mean prog ~candidates
in
let* prog =
let open Memo.O in
Build_system.run_exn (fun () ->
match Filename.analyze_program_name prog with
| In_path -> (
Super_context.resolve_program sctx ~dir ~loc:None prog
>>= function
| Error (_ : Action.Prog.Not_found.t) -> not_found ()
| Ok prog -> build_prog prog)
| Relative_to_current_dir -> (
let path =
Path.relative_to_source_in_build_or_external ~dir prog
in
(Build_system.file_exists path >>= function
| true -> Memo.return (Some path)
| false -> (
if not (Filename.check_suffix prog ".exe") then
Memo.return None
else
let path = Path.extend_basename path ~suffix:".exe" in
Build_system.file_exists path >>= function
| true -> Memo.return (Some path)
| false -> Memo.return None))
>>= function
| Some path -> build_prog path
| None -> not_found ())
| Absolute -> (
match
let prog = Path.of_string prog in
if Path.exists prog then Some prog
else if not Sys.win32 then None
else
let prog = Path.extend_basename prog ~suffix:Bin.exe in
Option.some_if (Path.exists prog) prog
with
| Some prog -> Memo.return prog
| None -> not_found ()))
User_error.raise ~hints [ Pp.textf "Program %S not found!" prog ]
in
let get_path_and_build_if_necessary () =
let open Memo.O in
match Filename.analyze_program_name prog with
| In_path -> (
Super_context.resolve_program sctx ~dir ~loc:None prog >>= function
| Error (_ : Action.Prog.Not_found.t) -> not_found ()
| Ok prog -> build_prog prog)
| Relative_to_current_dir -> (
let path = Path.relative_to_source_in_build_or_external ~dir prog in
(Build_system.file_exists path >>= function
| true -> Memo.return (Some path)
| false -> (
if not (Filename.check_suffix prog ".exe") then Memo.return None
else
let path = Path.extend_basename path ~suffix:".exe" in
Build_system.file_exists path >>= function
| true -> Memo.return (Some path)
| false -> Memo.return None))
>>= function
| Some path -> build_prog path
| None -> not_found ())
| Absolute -> (
match
let prog = Path.of_string prog in
if Path.exists prog then Some prog
else if not Sys.win32 then None
else
let prog = Path.extend_basename prog ~suffix:Bin.exe in
Option.some_if (Path.exists prog) prog
with
| Some prog -> Memo.return prog
| None -> not_found ())
in
let env = Super_context.context_env sctx in
match Common.watch common with
| Yes Passive ->
User_error.raise
[ Pp.textf "passive watch mode is unsupported by exec" ]
| Yes Eager ->
let command_to_exec =
{ Command_to_exec.get_path_and_build_if_necessary =
(fun () -> Build_system.run get_path_and_build_if_necessary)
; args
; env
}
in
let prog = Path.to_string prog in
let argv = prog :: args in
let env = Super_context.context_env sctx in
Fiber.return (prog, argv, env))
in
restore_cwd_and_execve common prog argv env
let+ () = Watch.loop ~command_to_exec in
`In_watch_mode_so_should_loop_forever_and_never_get_here
| No ->
let+ path = Build_system.run_exn get_path_and_build_if_necessary in
`Execve_thunk
(fun () ->
let prog = Path.to_string path in
let argv = prog :: args in
restore_cwd_and_execve common prog argv env))
|> function
| `In_watch_mode_so_should_loop_forever_and_never_get_here -> ()
| `Execve_thunk thunk -> thunk ()

let command = Cmd.v info term
14 changes: 10 additions & 4 deletions src/dune_engine/scheduler.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -944,7 +944,9 @@ let wait_for_process t pid =
Fiber.Ivar.read ivar)
in
match outcome with
| Cancelled () -> cancelled ()
| Cancelled () ->
print_endline "cancelled";
cancelled ()
| Not_cancelled -> res

let got_signal signal =
Expand Down Expand Up @@ -1382,11 +1384,15 @@ let wait_for_process_with_timeout t pid ~timeout ~is_process_group_leader =
(fun () ->
let+ res = Alarm_clock.await sleep in
if res = `Finished && Process_watcher.is_running t.process_watcher pid
then
if is_process_group_leader then kill_process_group pid Sys.sigkill
else Unix.kill (Pid.to_int pid) Sys.sigkill)
then print_endline "bbbbbb";
if is_process_group_leader then kill_process_group pid Sys.sigkill
else (
Unix.kill (Pid.to_int pid) Sys.sigkill;
print_endline "cccccc"))
(fun () ->
print_endline "dddddd";
let+ res = wait_for_process t pid in
print_endline "aaaaaa";
Alarm_clock.cancel (Lazy.force t.alarm_clock) sleep;
res))

Expand Down
Loading

0 comments on commit 46bbcd1

Please sign in to comment.