fix(sched): kill running actions when meowc is interrupted

Ctrl-C killed meowc and left every compiler it had spawned running, still
holding CPU and still about to write into the build directory. There were no
signal handlers at all.

SIGINT and SIGTERM now cancel the same way a build failure does, and the run
returns cleanly so the cache is still written and the exit status is 130. A
second signal falls through to the default handler, so an unresponsive child
cannot trap the user.

Signalling a single pid was not enough: a compiler driver spawns its own
children, and those were reparented to init and survived. Each action is now
placed in its own process group with setsid, and cancellation signals the group,
which also makes the existing failure path reach grandchildren. Unix.wait is
retried on EINTR so a signal arriving mid-wait is not fatal.

bin/meowc.ml

@@ -205,7 +205,7 @@ let execute p ~names =
         end)
       order;
     Printf.printf "\n  %s\n" (Style.dim (Printf.sprintf "%d actions, nothing run" !n));
-    (b, { Sched.built = 0; cached = 0; failed = 0; aborted = 0 })
+    (b, { Sched.built = 0; cached = 0; failed = 0; aborted = 0; interrupted = false })
   end
   else begin
     let cache = Cache.load (Filename.concat p.tc.builddir ".meowc-cache") in
@@ -223,7 +223,10 @@ let execute p ~names =
 let summarise (r : Sched.result) elapsed =
   if not fl.quiet && not fl.dry then begin
     let text =
-      if r.failed > 0 then
+      if r.interrupted then
+        Style.yellow "interrupted"
+        ^ (if r.aborted > 0 then Style.dim (Printf.sprintf ", %d cancelled" r.aborted) else "")
+      else if r.failed > 0 then
         Style.red (Style.plural r.failed "action" ^ " failed")
         ^ (if r.aborted > 0 then Style.dim (Printf.sprintf ", %d cancelled" r.aborted) else "")
       else if r.built = 0 then Style.dim "nothing to do"
@@ -233,6 +236,7 @@ let summarise (r : Sched.result) elapsed =
       (if r.built + r.failed + r.aborted = 0 then "" else "\n")
       (Style.pad 48 text) (Style.dim (duration elapsed))
   end;
+  if r.interrupted then exit 130;
   if r.failed > 0 then exit 1
 
 let cmd_build names =

lib/sched.ml

@@ -1,4 +1,4 @@
-type result = { built : int; cached : int; failed : int; aborted : int }
+type result = { built : int; cached : int; failed : int; aborted : int; interrupted : bool }
 
 type state = Blocked | Ready | Running | Done | Failed
 
@@ -34,7 +34,8 @@ let run g ~selected ~jobs ~cache ~verbose ~keep_going ~on_start ~on_done =
   let running = Hashtbl.create 8 in
   let cancelled = Hashtbl.create 8 in
   let built = ref 0 and cached = ref 0 and failed = ref 0 and aborted_count = ref 0 in
-  let stopping () = !failed > 0 && not keep_going in
+  let interrupted = ref false in
+  let stopping () = !interrupted || (!failed > 0 && not keep_going) in
   let release i =
     List.iter
       (fun j ->
@@ -53,13 +54,25 @@ let run g ~selected ~jobs ~cache ~verbose ~keep_going ~on_start ~on_done =
     let tmp = Filename.temp_file "meowc" ".log" in
     let fd = Unix.openfile tmp [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
     let nul = Exec.devnull () in
+    flush stdout;
     let pid =
-      match Unix.create_process v.cmd.(0) v.cmd nul fd fd with
+      match Unix.fork () with
+      | 0 ->
+          (try ignore (Unix.setsid ()) with Unix.Unix_error _ -> ());
+          (try
+             Unix.dup2 nul Unix.stdin;
+             Unix.dup2 fd Unix.stdout;
+             Unix.dup2 fd Unix.stderr;
+             Unix.close fd;
+             Unix.close nul;
+             Unix.execvp v.cmd.(0) v.cmd
+           with _ -> ());
+          Unix._exit 127
       | pid -> pid
       | exception Unix.Unix_error (e, _, _) ->
           Unix.close fd;
           Unix.close nul;
-          Diag.error "cannot run %s: %s" v.cmd.(0) (Unix.error_message e)
+          Diag.error "cannot fork for %s: %s" v.cmd.(0) (Unix.error_message e)
     in
     Unix.close fd;
     Unix.close nul;
@@ -71,7 +84,7 @@ let run g ~selected ~jobs ~cache ~verbose ~keep_going ~on_start ~on_done =
     Hashtbl.iter
       (fun pid _ ->
         Hashtbl.replace cancelled pid ();
-        try Unix.kill pid Sys.sigterm with Unix.Unix_error _ -> ())
+        try Unix.kill (-pid) Sys.sigterm with Unix.Unix_error _ -> ())
       running
   in
   let discard (v : Graph.node) =
@@ -80,8 +93,16 @@ let run g ~selected ~jobs ~cache ~verbose ~keep_going ~on_start ~on_done =
     List.iter (fun o -> try Sys.remove o with Sys_error _ -> ()) v.outs;
     skip v.id
   in
+  let rec wait_child () =
+    match Unix.wait () with
+    | r -> Some r
+    | exception Unix.Unix_error (Unix.EINTR, _, _) -> wait_child ()
+    | exception Unix.Unix_error (Unix.ECHILD, _, _) -> None
+  in
   let reap () =
-    let pid, status = Unix.wait () in
+    match wait_child () with
+    | None -> Hashtbl.reset running
+    | Some (pid, status) -> (
     match Hashtbl.find_opt running pid with
     | None -> ()
     | Some (v, tmp) ->
@@ -111,7 +132,23 @@ let run g ~selected ~jobs ~cache ~verbose ~keep_going ~on_start ~on_done =
           on_done ~ok ~log v;
           if verbose then print_endline ("      " ^ Style.dim (Exec.show v.cmd));
           if not keep_going then cancel_running ()
-        end
+        end)
+  in
+  let take_signals () =
+    let handle _ =
+      if not !interrupted then begin
+        interrupted := true;
+        Sys.set_signal Sys.sigint Sys.Signal_default;
+        Sys.set_signal Sys.sigterm Sys.Signal_default;
+        cancel_running ()
+      end
+    in
+    (Sys.signal Sys.sigint (Sys.Signal_handle handle), Sys.signal Sys.sigterm (Sys.Signal_handle handle))
+  in
+  let prev_int, prev_term = take_signals () in
+  let restore_signals () =
+    Sys.set_signal Sys.sigint prev_int;
+    Sys.set_signal Sys.sigterm prev_term
   in
   while (not (Queue.is_empty ready) && not (stopping ())) || Hashtbl.length running > 0 do
     while (not (Queue.is_empty ready)) && Hashtbl.length running < jobs && not (stopping ()) do
@@ -127,4 +164,5 @@ let run g ~selected ~jobs ~cache ~verbose ~keep_going ~on_start ~on_done =
     if Hashtbl.length running > 0 then reap ()
     else if Queue.is_empty ready then ()
   done;
-  { built = !built; cached = !cached; failed = !failed; aborted = !aborted_count }
+  restore_signals ();
+  { built = !built; cached = !cached; failed = !failed; aborted = !aborted_count; interrupted = !interrupted }