A dev daemon started by a test dies with it, a daemon whose socket is gone ends cleanly, the Emacs daemon buffer asks before it is killed and closes the session, and a program's agent socket lives under TMPDIR and goes on a trap or fatal signal.

emacs/flan.el

@@ -900,6 +900,62 @@ It builds the program first, which for a cold project is most of this."
       (message "flan dev: the daemon exited (%s); see %s"
                (string-trim (or event "")) flan-daemon-buffer))))
 
+(defun flan--close-daemon ()
+  "Ask the daemon this Emacs started to end, and give it a moment to.
+For `kill-buffer-hook' on its buffer and for `kill-emacs-hook': either
+deletes the process outright, and a daemon killed that way never runs its
+own cleanup -- its socket, its temporary directory, and under
+--two-process the program it started.  `close' is its own way out.  Never
+signals, so the kill that called it always goes ahead."
+  (let ((proc flan--daemon)
+        (sock flan--daemon-socket))
+    (when (and (process-live-p proc) sock)
+      (if (and (process-live-p flan--connection)
+               (equal flan--socket sock))
+          ;; Connected to it: `flan-quit' is exactly this, with its state
+          ;; cleared as well.
+          (ignore-errors (flan-quit))
+        ;; Not connected, or connected to another session: a connection of
+        ;; its own, so the other session is left alone.
+        (ignore-errors
+          (let ((c (make-network-process
+                    :name "flan-close" :family 'local
+                    :service (flan--short-socket sock)
+                    :coding 'binary :noquery t)))
+            (unwind-protect
+                (progn
+                  (flan--send c '(:op "close"))
+                  (let ((deadline (+ (float-time) 2)))
+                    (while (and (process-live-p proc)
+                                (< (float-time) deadline))
+                      (accept-process-output proc 0.05))))
+              (delete-process c))))))))
+
+(add-hook 'kill-emacs-hook #'flan--close-daemon)
+
+(defun flan--daemon-of-this-buffer-p ()
+  "Whether the live daemon this Emacs started writes to the current buffer."
+  (and (process-live-p flan--daemon)
+       (eq (process-buffer flan--daemon) (current-buffer))))
+
+(defun flan--query-kill-daemon ()
+  "Ask before killing the buffer of a live daemon, as CIDER does for nREPL.
+For `kill-buffer-query-functions'.  A yes clears the process's own query,
+so Emacs does not ask a second time, and `flan--kill-daemon-buffer' then
+stops the daemon cleanly."
+  (or (not (flan--daemon-of-this-buffer-p))
+      (when (y-or-n-p
+             (format "flan dev is running %s; stop it and kill the buffer? "
+                     (file-name-nondirectory
+                      (or flan--file flan--daemon-socket "the program"))))
+        (set-process-query-on-exit-flag flan--daemon nil)
+        t)))
+
+(defun flan--kill-daemon-buffer ()
+  "Stop the daemon cleanly when its buffer is killed; see `flan--close-daemon'."
+  (when (flan--daemon-of-this-buffer-p)
+    (flan--close-daemon)))
+
 (defun flan--start-daemon (file socket)
   "Start `flan dev' on FILE listening on SOCKET, and return the process."
   (let* ((buf (get-buffer-create flan-daemon-buffer))
@@ -947,13 +1003,19 @@ It builds the program first, which for a cold project is most of this."
       ;; program runs, and `compilation-mode' would claim it as the output of
       ;; one finished command — killing the process on a `recompile', among
       ;; other things it has no business doing to a live session.
-      (flan--daemon-buffer-setup))
+      (flan--daemon-buffer-setup)
+      ;; Killing this buffer deletes its process, so the kill asks first and
+      ;; then tells the daemon to close.
+      (add-hook 'kill-buffer-query-functions #'flan--query-kill-daemon nil t)
+      (add-hook 'kill-buffer-hook #'flan--kill-daemon-buffer nil t))
     (make-process
      :name "flan-daemon" :buffer buf
      :command args
      ;; The daemon writes its ready line and the program's stderr to stderr,
      ;; and both belong in the same buffer in the order they happened.
-     :connection-type 'pipe :noquery t
+     ;; No :noquery: exiting Emacs with a session running asks once, through
+     ;; the usual list of live processes, and `kill-emacs-hook' then closes it.
+     :connection-type 'pipe
      :sentinel #'flan--daemon-sentinel)))
 
 (defun flan--connect-when-ready (socket proc)

emacs/test-flan.el

@@ -1592,7 +1592,63 @@ already rely on it — so nothing here is a stand-in for the real thing."
       ;; claim seen from the other side.
       (test-flan--check "and takes its socket with it"
                         (not (file-exists-p socket2))))
-    (ignore-errors (delete-file socket2)))
+    (ignore-errors (delete-file socket2))
+
+    ;; Killing the daemon's buffer asks first, as CIDER does, and a yes stops
+    ;; the daemon the way `flan-quit' does rather than deleting the process:
+    ;; the daemon, its program (--two-process, so it is a process of its own)
+    ;; and the socket all go.  A no leaves both the buffer and the daemon.
+    (let ((socket3 (concat socket "-killed-buffer"))
+          (asked 0)
+          (answer nil))
+      (ignore-errors (delete-file socket3))
+      (let ((flan-daemon-args (append flan-daemon-args '("--two-process"))))
+        (flan program socket3))
+      (let* ((proc flan--daemon)
+             (pid (process-id proc))
+             (kids (ignore-errors
+                     (mapcar #'string-to-number
+                             (split-string
+                              (with-temp-buffer
+                                (insert-file-contents
+                                 (format "/proc/%d/task/%d/children" pid pid))
+                                (buffer-string))))))
+             (gone (lambda (p)
+                     (let ((stat (format "/proc/%d/stat" p)))
+                       (or (not (file-exists-p stat))
+                           (with-temp-buffer
+                             (insert-file-contents stat)
+                             (re-search-forward ") \\(.\\)" nil t)
+                             (equal (match-string 1) "Z")))))))
+        (cl-letf (((symbol-function 'y-or-n-p)
+                   (lambda (&rest _) (setq asked (1+ asked)) answer)))
+          (test-flan--check "the daemon's program is a process of its own"
+                            kids)
+          (setq answer nil)
+          (kill-buffer flan-daemon-buffer)
+          (test-flan--check "killing the daemon's buffer asks, and no keeps both"
+                            (and (= asked 1)
+                                 (get-buffer flan-daemon-buffer)
+                                 (process-live-p proc)))
+          (setq answer t)
+          (kill-buffer flan-daemon-buffer)
+          (let ((deadline (+ (float-time) 5)))
+            (while (and (< (float-time) deadline)
+                        (not (and (funcall gone pid)
+                                  (cl-every gone kids))))
+              (sleep-for 0.05)))
+          (test-flan--check "and yes stops the daemon and its program"
+                            (and (= asked 2)
+                                 (not (get-buffer flan-daemon-buffer))
+                                 (null flan--daemon)
+                                 (funcall gone pid)
+                                 (cl-every gone kids)))
+          (test-flan--check "and removes its socket"
+                            (not (file-exists-p socket3)))
+          (setq asked 0)
+          (with-temp-buffer
+            (test-flan--check "no daemon, no question"
+                              (and (flan--query-kill-daemon) (= asked 0))))))))
 
   ;; ── One command, one session ──────────────────────────────────────────
   ;;

lib/dev.ml

@@ -5282,6 +5282,80 @@ let client_grace () =
      | None -> client_grace_default)
   | None -> client_grace_default
 
+(* ── Whether anything can still reach this session ─────────────────── *)
+
+(* A daemon whose socket file has been deleted, or replaced by another daemon
+   binding the same path, can never be connected to again: an editor finds a
+   session only by that path. So the accept loop looks at the path about once a
+   second and ends the session, cleanly, when it no longer names the file this
+   daemon bound.
+
+   The identity is taken with [stat] on the path right after the bind, never
+   from the listening fd (a socket fd's inode is sockfs's, not the file's), and
+   the watch starts only in [accept_loop], after the bind — so a session still
+   building cannot trip it. [stat] takes a path up to PATH_MAX, so a socket
+   bound through /proc/self/fd because its path is past 107 bytes is looked at
+   by that long path directly; the short symlink an editor connects through is
+   not what is checked. Both daemon shapes bind in this process, so
+   --two-process watches the same file the merged build does. *)
+type bound = { path : string; dev : int; ino : int }
+
+let bound_at sock =
+  let path =
+    if Filename.is_relative sock then Filename.concat (Sys.getcwd ()) sock
+    else sock
+  in
+  match Unix.stat path with
+  | s -> Some { path; dev = s.Unix.st_dev; ino = s.Unix.st_ino }
+  | exception Unix.Unix_error _ -> None
+
+let still_bound b =
+  match Unix.stat b.path with
+  | s -> s.Unix.st_dev = b.dev && s.Unix.st_ino = b.ino
+  | exception Unix.Unix_error _ -> false
+
+(* A test harness that starts a daemon names itself in FLAN_DEV_HARNESS
+   (test/watchdog.ml), and the daemon dies with its parent and ends when the
+   harness has gone. The parent half is PR_SET_PDEATHSIG, armed in [start].
+   The harness half is for a daemon whose parent is not the harness — one an
+   Emacs under test started — and is read by [accept_loop]. Opt-in only: a
+   daemon an editor or a shell starts must outlive them, as it always has. *)
+let harness () =
+  match Sys.getenv_opt "FLAN_DEV_HARNESS" with
+  | Some s ->
+    (match int_of_string_opt (String.trim s) with
+     | Some p when p > 0 -> Some p
+     | _ -> None)
+  | None -> None
+
+let alive pid =
+  match Unix.kill pid 0 with
+  | () -> true
+  | exception Unix.Unix_error (Unix.ESRCH, _, _) -> false
+  | exception Unix.Unix_error _ -> true
+
+(* Why the session can no longer be reached, if it cannot. *)
+let unreachable bound =
+  match bound with
+  | Some b when not (still_bound b) ->
+    Some
+      (Printf.sprintf "its socket %s was removed or replaced, so no editor can \
+                       reach it" b.path)
+  | _ ->
+    match harness () with
+    | Some pid when not (alive pid) ->
+      Some (Printf.sprintf "the test harness that started it (pid %d) has exited"
+              pid)
+    | _ -> None
+
+(* The socket file and its short symlink, removed on the way out only while
+   the path still names this daemon's socket: one that was replaced belongs to
+   the daemon that replaced it, and so does the symlink to it. *)
+let release_socket bound sock ~unlink_short =
+  let mine = match bound with Some b -> still_bound b | None -> true in
+  if mine then (try Unix.unlink sock with Unix.Unix_error _ -> ());
+  if mine || not (Sys.file_exists sock) then unlink_short sock
+
 (* [accept] would block past the program's own exit, so it is waited on with
    a timeout and the child checked each time round: a daemon whose program has
    finished has nothing left to do, and an editor waiting on it would wait
@@ -5298,18 +5372,29 @@ let client_grace () =
    hole: it reads the client, not the program, and all of an Emacs's windows
    share the one [flan--connection], so closing one of them changes
    nothing this loop can see. *)
-let accept_loop ?grace t ls =
+let accept_loop ?grace ?bound t ls =
   let grace = match grace with Some g -> g | None -> client_grace () in
   (* [served] arms the clock and [since] is when the last client let go — set
      when [serve] returns rather than when [accept] fires, so a connection that
      is held for an hour is an hour of the clock not running. *)
   let served = ref false and since = ref (Unix.gettimeofday ()) in
+  let reach_due = ref 0. in
+  let cut_off () =
+    let now = Unix.gettimeofday () in
+    if now < !reach_due then None
+    else begin reach_due := now +. 1.; unreachable bound end
+  in
   let rec go () =
     (* The other place the agent clock is read: between connections, which is
        where a session with no editor attached spends its time. *)
     agent_check t;
     match liveness t with
     | Gone when t.relaunch = None -> ()
+    | _ when (match cut_off () with
+        | Some why ->
+          Printf.eprintf "flan dev: this session is ending; %s\n%!" why;
+          true
+        | None -> false) -> ()
     | live ->
       (* A --two-process child that has ended can be started again, so the
          session waits as a parked one does, on the parked grace. *)
@@ -5614,6 +5699,7 @@ let two_process ?(debug = false) ?(sanitize = false) ?(x86 = true) ~file ~sock (
   let ls = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
   link_short_socket sock;
   Wire.bind_socket ls sock;
+  let bound = bound_at sock in
   Unix.listen ls 4;
   Printf.eprintf "flan dev: %s ready on %s (%.0fms)\n%!" file sock
     ((Unix.gettimeofday () -. t0) *. 1000.);
@@ -5625,9 +5711,8 @@ let two_process ?(debug = false) ?(sanitize = false) ?(x86 = true) ~file ~sock (
        | None -> ());
       (try Unix.close ls with Unix.Unix_error _ -> ());
       (try Unix.close t.stdout with Unix.Unix_error _ -> ());
-      (try Unix.unlink sock with Unix.Unix_error _ -> ());
-      unlink_short_socket sock)
-    (fun () -> accept_loop t ls);
+      release_socket bound sock ~unlink_short:unlink_short_socket)
+    (fun () -> accept_loop ?bound t ls);
   (* Here only when the loop returned: an exception out of it has already
      left through the [finally]. A child killed by a signal is the crash that
      keeps the directory. *)
@@ -6478,8 +6563,9 @@ let merged_setup () =
     let ls = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
     link_short_socket sock;
     Wire.bind_socket ls sock;
+    let bound = bound_at sock in
     Unix.listen ls 4;
-    merged_state := Some (t, ls, sock);
+    merged_state := Some (t, ls, sock, bound);
     Printf.eprintf "flan dev: %s ready on %s (%.0fms, one process)\n%!" file
       sock ((Unix.gettimeofday () -. t0) *. 1000.)
   with
@@ -6508,7 +6594,7 @@ let merged_setup () =
 let merged_serve () =
   match !merged_state with
   | None -> prerr_endline "flan dev: serve was called before setup"; exit 1
-  | Some (t, ls, sock) ->
+  | Some (t, ls, sock, bound) ->
     (* The agent is bound by the program on the main thread, which only starts
        once [merged_setup] has returned. So this does not wait for it: it arms
        the clock that eventually says it never came, and serves.
@@ -6529,15 +6615,14 @@ let merged_serve () =
        [eval] for what a delivery to such a program honestly reports. *)
     t.agent_watch <- Some (Unix.gettimeofday () +. 10.);
     let clean =
-      match accept_loop t ls with
+      match accept_loop ?bound t ls with
       | () -> true
       | exception e ->
         Printf.eprintf "flan dev: %s\n%!" (Printexc.to_string e);
         false
     in
     (try Unix.close ls with Unix.Unix_error _ -> ());
-    (try Unix.unlink sock with Unix.Unix_error _ -> ());
-    unlink_short_socket sock;
+    release_socket bound sock ~unlink_short:unlink_short_socket;
     (* The program is this process, so a program that crashed never gets here;
        the one end that does and is not clean is the loop raising. *)
     if clean then remove_session_dirs t;
@@ -6615,6 +6700,15 @@ let start_merged ?(debug = false) ?(sanitize = false) ?(x86 = true) ~file ~sock
    actually deleted. *)
 let start ?(debug = false) ?(sanitize = false) ?(merged = true) ?(x86 = true)
     ~file ~sock () =
+  (* Under a test harness only (see [harness]): SIGKILL when the parent dies,
+     which the kernel keeps across the exec into a merged build. A parent that
+     died before this was armed is caught by asking whether the harness is
+     still there; one that is not the harness is left to [accept_loop]. *)
+  (match harness () with
+   | Some pid ->
+     Spawn.die_with_parent ();
+     if not (alive pid) then exit 1
+   | None -> ());
   (* The sanitizers are LLVM passes, and the x86 backend's host is written
      by hand with no pass run over it. The modules a session sends are not
      instrumented on either backend; what is checked is the host and the

lib/spawn.ml

@@ -4,3 +4,6 @@ external dying : string -> string array -> int = "flan_spawn_dying"
 
 (** The host number of an OCaml signal number. *)
 external host_signal : int -> int = "flan_host_signal"
+
+(** Ask for SIGKILL when this process's parent dies; nothing off Linux. *)
+external die_with_parent : unit -> unit = "flan_die_with_parent"

lib/spawn_stubs.c

@@ -56,3 +56,15 @@ value flan_spawn_dying(value path, value argv) {
 value flan_host_signal(value s) {
   return Val_int(caml_convert_signal_number(Int_val(s)));
 }
+
+/* The same request made by this process for itself: SIGKILL when whatever is
+ * its parent now dies. Only `flan dev` under a test harness asks
+ * (FLAN_DEV_HARNESS, lib/dev.ml); the kernel keeps it across the exec into a
+ * merged build. */
+value flan_die_with_parent(value unit) {
+  (void)unit;
+#ifdef __linux__
+  prctl(PR_SET_PDEATHSIG, SIGKILL);
+#endif
+  return Val_unit;
+}

runtime/flan_rt.c

@@ -795,12 +795,17 @@ static void rt_flush_out(void) {
  * The two functions are kept saying the same thing on purpose. They are the
  * two ways a Flan program dies where it stands, and a difference between them
  * would be a difference nobody could predict from the outside. */
+/* Set by the dev agent once it has bound its own socket, to remove it: the
+ * [_exit] below skips the atexit handler that otherwise would. */
+void (*flan_die_hook)(void);
+
 static _Noreturn void rt_die(void) {
   const char *sock;
   rt_flush_out();
   fflush(stderr);
   sock = getenv("FLAN_DEV_SOCK");
   if (sock != NULL && *sock != '\0') unlink(sock);
+  if (flan_die_hook != NULL) flan_die_hook();
   _exit(134);
 }
 

test/programs/agent-auto.flan

@@ -2,7 +2,7 @@
 ;;;;
 ;;;; Under [flan dev] it binds where the daemon said, exactly as the explicit
 ;;;; form did, and nothing here can tell the difference. Run on its own — which
-;;;; is what test_agent.ml does with it — it picks a path under /tmp and prints
+;;;; is what test_agent.ml does with it — it picks a path under TMPDIR and prints
 ;;;; it to stderr, and that printed line is the only way anything could connect.
 ;;;;
 ;;;; The second start is here to be a no-op. It answers 0 like the first, does

test/test_agent.ml

@@ -242,7 +242,11 @@ let () =
       (* The shape is part of the claim: two programs started at once must not
          choose the same file, and the pid alone would not separate two runs of
          the same program in sequence. *)
-      let pid_part = Printf.sprintf "/tmp/flan-agent-%d-" apid in
+      (* Under TMPDIR, which the program inherited from this suite. *)
+      let pid_part =
+        Filename.concat (Filename.get_temp_dir_name ())
+          (Printf.sprintf "flan-agent-%d-" apid)
+      in
       if not (String.length apath > String.length pid_part
               && String.sub apath 0 (String.length pid_part) = pid_part)
       then fail "the chosen path is not this process's: %S" apath;
@@ -286,6 +290,41 @@ let () =
         end
       end
     end;
+    (* ── The socket goes with a program ended by a signal ──────────────
+
+       SIGTERM runs no atexit, so the agent removes its socket from a handler
+       of its own and then dies of the signal as before. *)
+    let terr = tmp "term.err" in
+    let t1 = ofd (tmp "term.out") and t2 = ofd terr in
+    let tpid = Unix.create_process_env aexe [| aexe |] aenv Unix.stdin t1 t2 in
+    Unix.close t1;
+    Unix.close t2;
+    let tpath () =
+      let text = In_channel.with_open_bin terr In_channel.input_all in
+      List.find_map
+        (fun l ->
+           if String.starts_with ~prefix l then
+             Some (String.sub l (String.length prefix)
+                     (String.length l - String.length prefix))
+           else None)
+        (String.split_on_char '\n' text)
+    in
+    (match
+       if await (fun () -> tpath () <> None) then tpath () else None
+     with
+     | None ->
+       fail "a program to be sent SIGTERM never announced its socket";
+       (try Unix.kill tpid Sys.sigkill with Unix.Unix_error _ -> ())
+     | Some p ->
+       ignore (await (fun () -> Sys.file_exists p));
+       Unix.kill tpid Sys.sigterm;
+       let _, st = Unix.waitpid [] tpid in
+       if st <> Unix.WSIGNALED Sys.sigterm then
+         fail "a program sent SIGTERM did not die of it";
+       if Sys.file_exists p then
+         fail "the socket outlived a program ended by SIGTERM: %S" p);
+    List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
+      [ terr; tmp "term.out" ];
     (* ── A path that cannot be bound ────────────────────────────────── *)
 
     (* The same program again, told to listen somewhere that does not exist.

test/test_dev.ml

@@ -5920,6 +5920,14 @@ let () =
            (try Unix.kill pid Sys.sigkill with Unix.Unix_error _ -> ())
          end
          else begin
+           (* Past two of the daemon's socket checks with no editor attached:
+              a socket reached through its directory is still its own. *)
+           Unix.sleepf 2.5;
+           (match Unix.waitpid [ Unix.WNOHANG ] pid with
+            | 0, _ -> ()
+            | _ -> fail "a deep TMPDIR (%s): the daemon ended with its socket \
+                         in place" shape
+            | exception Unix.Unix_error _ -> ());
            let c = connect dsock in
            let said r =
              Option.value ~default:(status r) (Wire.string_field r "message")
@@ -5955,6 +5963,163 @@ let () =
       [ [||]; [| "--two-process" |] ];
     Own_tmp.remove deep;
 
+    (* ── A daemon nothing can reach any more ends ──────────────────────
+
+       Three ways a session becomes unreachable, each in both shapes: the
+       process that started it is SIGKILLed (the daemon, and under
+       --two-process its program, die with it); the test harness named in
+       FLAN_DEV_HARNESS goes, though the daemon's own parent lives on (the
+       Emacs-started case); and its socket file is deleted. And one way it
+       does not: a socket left alone keeps the daemon running. *)
+    let gone pid =
+      match In_channel.with_open_bin (Printf.sprintf "/proc/%d/stat" pid)
+              In_channel.input_all with
+      | st ->
+        (match String.rindex_opt st ')' with
+         | Some i when i + 2 < String.length st -> st.[i + 2] = 'Z'
+         | _ -> false)
+      | exception Sys_error _ -> true
+    in
+    let children pid =
+      match In_channel.with_open_bin
+              (Printf.sprintf "/proc/%d/task/%d/children" pid pid)
+              In_channel.input_all with
+      | s -> List.filter_map int_of_string_opt (String.split_on_char ' ' (String.trim s))
+      | exception Sys_error _ -> []
+    in
+    let with_harness env =
+      Array.of_list
+        (env
+         @ List.filter
+             (fun v -> not (String.starts_with ~prefix:"FLAN_DEV_HARNESS=" v))
+             (Array.to_list (Unix.environment ())))
+    in
+    List.iter
+      (fun mode ->
+         let shape = if mode = [||] then "one process" else "--two-process" in
+         let argv s =
+           Array.append [| flan; "dev"; "programs/dev-pause.flan"; "-s"; s |] mode
+         in
+         (* The parent SIGKILLed. A harness process of its own, so that the
+            parent can be killed without killing this test. *)
+         let ksock = tmp "orphan-parent.sock" in
+         (try Sys.remove ksock with Sys_error _ -> ());
+         let rd, wr = Unix.pipe () in
+         (match Unix.fork () with
+          | 0 ->
+            Unix.close rd;
+            let d =
+              Unix.create_process flan (argv ksock) Unix.stdin Unix.stdout
+                Unix.stderr
+            in
+            let msg = string_of_int d ^ "\n" in
+            ignore (Unix.write_substring wr msg 0 (String.length msg));
+            Unix.close wr;
+            Unix.sleep 600;
+            Unix._exit 0
+          | h ->
+            Unix.close wr;
+            let ic = Unix.in_channel_of_descr rd in
+            let d = int_of_string (String.trim (input_line ic)) in
+            close_in ic;
+            if not (listening ~pid:d ksock) then
+              fail "a daemon under a harness (%s): %s" shape !listen_why;
+            let kids = children d in
+            if mode <> [||] && kids = [] then
+              fail "a daemon under a harness (%s): no program child found" shape;
+            Unix.kill h Sys.sigkill;
+            ignore (Unix.waitpid [] h);
+            if not (await ~ms:5000 (fun () -> gone d)) then begin
+              fail "a daemon (%s) outlived the process that started it" shape;
+              (try Unix.kill d Sys.sigkill with Unix.Unix_error _ -> ())
+            end;
+            List.iter
+              (fun k ->
+                 if not (await ~ms:5000 (fun () -> gone k)) then begin
+                   fail "a daemon's program (%s) outlived the daemon" shape;
+                   (try Unix.kill k Sys.sigkill with Unix.Unix_error _ -> ())
+                 end)
+              kids);
+         (try Sys.remove ksock with Sys_error _ -> ());
+
+         (* The harness gone, the parent alive. [sleep] stands in for it. *)
+         let hsock = tmp "orphan-harness.sock" in
+         (try Sys.remove hsock with Sys_error _ -> ());
+         let stand_in =
+           Unix.create_process "sleep" [| "sleep"; "600" |] Unix.stdin
+             Unix.stdout Unix.stderr
+         in
+         let d =
+           Unix.create_process_env flan (argv hsock)
+             (with_harness [ "FLAN_DEV_HARNESS=" ^ string_of_int stand_in ])
+             Unix.stdin Unix.stdout Unix.stderr
+         in
+         if not (listening ~pid:d hsock) then
+           fail "a daemon with a harness (%s): %s" shape !listen_why
+         else begin
+           Unix.kill stand_in Sys.sigkill;
+           ignore (Unix.waitpid [] stand_in);
+           let ended =
+             await ~ms:5000 (fun () ->
+               match Unix.waitpid [ Unix.WNOHANG ] d with
+               | 0, _ -> false
+               | _ -> true)
+           in
+           if not ended then
+             fail "a daemon (%s) outlived the test harness that started it" shape
+         end;
+         (try Unix.kill stand_in Sys.sigkill with Unix.Unix_error _ -> ());
+         (try Unix.kill d Sys.sigkill with Unix.Unix_error _ -> ());
+         (try ignore (Unix.waitpid [] d) with Unix.Unix_error _ -> ());
+         (try ignore (Unix.waitpid [] stand_in) with Unix.Unix_error _ -> ());
+         (try Sys.remove hsock with Sys_error _ -> ());
+
+         (* The socket: kept, the daemon stays; deleted, it ends, cleanly. *)
+         let ssock = tmp "orphan-socket.sock" in
+         (try Sys.remove ssock with Sys_error _ -> ());
+         let d =
+           Unix.create_process flan (argv ssock) Unix.stdin Unix.stdout
+             Unix.stderr
+         in
+         if not (listening ~pid:d ssock) then
+           fail "a daemon whose socket goes (%s): %s" shape !listen_why
+         else begin
+           let kids = children d in
+           Unix.sleepf 2.5;
+           (match Unix.waitpid [ Unix.WNOHANG ] d with
+            | 0, _ -> ()
+            | _ -> fail "a daemon (%s) ended with its socket in place" shape);
+           Sys.remove ssock;
+           let st = ref None in
+           let ended =
+             await ~ms:5000 (fun () ->
+               match Unix.waitpid [ Unix.WNOHANG ] d with
+               | 0, _ -> false
+               | _, s -> st := Some s; true)
+           in
+           if not ended then
+             fail "a daemon (%s) outlived its deleted socket" shape
+           else begin
+             if !st <> Some (Unix.WEXITED 0) then
+               fail "a daemon (%s) whose socket was deleted did not end cleanly"
+                 shape;
+             let dir =
+               Filename.concat (Filename.get_temp_dir_name ())
+                 (Printf.sprintf "flan-dev-%d" d)
+             in
+             if Sys.file_exists dir then
+               fail "a daemon (%s) whose socket was deleted left %s" shape dir;
+             List.iter
+               (fun k ->
+                  if not (await ~ms:5000 (fun () -> gone k)) then
+                    fail "the program (%s) outlived its daemon's socket" shape)
+               kids
+           end
+         end;
+         (try Unix.kill d Sys.sigkill with Unix.Unix_error _ -> ());
+         (try ignore (Unix.waitpid [] d) with Unix.Unix_error _ -> ()))
+      [ [||]; [| "--two-process" |] ];
+
     (* ── Prelude functions shadowed live keep the prelude's own calls ──
 
        [rand] and then [rand-int] redefined in a running program: the

test/watchdog.ml

@@ -76,6 +76,10 @@ let arm ?(seconds = 600) name =
   label := name;
   budget := seconds;
   deadline := Unix.gettimeofday () +. float_of_int seconds;
+  (* Every [flan dev] this binary starts, directly or from an Emacs it runs,
+     dies with its parent and ends once this process is gone (lib/dev.ml,
+     [harness]), so a run killed partway leaves no daemon behind. *)
+  Unix.putenv "FLAN_DEV_HARNESS" (string_of_int (Unix.getpid ()));
   backstop ()
 
 (* [f] under a tighter alarm, with the backstop restored afterwards however

vendor/agent/flan_agent.c

@@ -1023,14 +1023,17 @@ static int sock_dir_fd = -1;
 /* A socket file outlives the process that bound it, and a stale one answers
  * the next client with ECONNREFUSED — which reads like a program that is there
  * and refusing rather than one that has gone. So the bind registers its own
- * removal, and the three ways out of a program each unlink it:
+ * removal, and every way out of a program that runs any code unlinks it:
  *
  *   ordinary exit     this handler, via atexit
  *   break-loop abort  die_now, by hand, because it takes _exit
+ *   trap              rt_die in flan_rt.c, through [flan_die_hook]
  *   orphaned child    orphan_die, by hand, for the same reason
+ *   fatal signal      fatal_unlink: SIGTERM, SIGINT, SIGHUP, SIGQUIT and
+ *                     SIGABRT, while their disposition is still the default
  *
- * Outside a daemon that is the whole story, and the path is under /tmp where
- * nothing else would ever reclaim it.
+ * Outside a daemon that is the whole story, and the path is under TMPDIR where
+ * nothing else would ever reclaim it. SIGKILL is the one end nothing survives.
  *
  * Under [flan dev] none of the three is how a session usually ends, and this
  * is worth being exact about rather than claiming cover it does not give: the
@@ -1045,6 +1048,35 @@ static void unlink_bound_sock(void) {
   if (bound_sock[0] != '\0') unlink(bound_sock);
 }
 
+extern void (*flan_die_hook)(void);
+
+/* unlink and re-raise under the default disposition, so the process still
+ * ends by the signal it was sent: a parent waiting on it sees the same status
+ * as before. Both calls are async-signal-safe. */
+static void fatal_unlink(int sig) {
+  if (bound_sock[0] != '\0') unlink(bound_sock);
+  signal(sig, SIG_DFL);
+  raise(sig);
+}
+
+/* Only a signal nobody has claimed: a program, or the runtime a merged build
+ * carries, that installed its own handler keeps it. Called after the bind. */
+static void unlink_on_fatal_signals(void) {
+  static const int sigs[] = { SIGTERM, SIGINT, SIGHUP, SIGQUIT, SIGABRT };
+  size_t i;
+  for (i = 0; i < sizeof sigs / sizeof sigs[0]; i++) {
+    struct sigaction old, sa;
+    if (sigaction(sigs[i], NULL, &old) != 0) continue;
+    if ((old.sa_flags & SA_SIGINFO) != 0 || old.sa_handler != SIG_DFL) continue;
+    memset(&sa, 0, sizeof sa);
+    sa.sa_handler = fatal_unlink;
+    sigemptyset(&sa.sa_mask);
+    sa.sa_flags = SA_RESETHAND;
+    sigaction(sigs[i], &sa, NULL);
+  }
+  flan_die_hook = unlink_bound_sock;
+}
+
 /* Every way out of the break loop that is not a resume. [_exit] and not
  * [exit], because this runs on the game thread while the listener thread may
  * be inside [dlopen] holding the loader lock — and [exit] runs the atexit
@@ -2786,6 +2818,7 @@ static int32_t start_on(const char *path) {
   /* After the bind, because a program that is going to fail to listen should
      fail on its own terms rather than arrange its death first. */
   watch_the_daemon();
+  unlink_on_fatal_signals();
   /* From here an unhandled error stops rather than dying. Installed with the
    * socket and not before it: without a listener there is nobody to ask what
    * to do, and stopping forever is worse than the abort it replaces. */
@@ -2864,14 +2897,25 @@ int32_t flan_agent_start(const uint8_t *path, int64_t len) {
  * silently reuses a file it may not own. stderr rather than stdout, so a
  * program whose output is data stays data. */
 int32_t flan_agent_start_auto(void) {
-  char path[sizeof(((struct sockaddr_un *)0)->sun_path)];
+  /* Room for a TMPDIR too deep for sun_path; [start_on] binds such a path
+   * through its directory. */
+  char path[4096];
   struct timespec ts;
   int32_t r;
   const char *env = daemon_socket();
+  const char *dir = getenv("TMPDIR");
+  size_t dlen;
+  int n;
   if (env != NULL) return start_on(env) < 0 ? -1 : 0;
+  /* TMPDIR, as everything else Flan makes on the fly: a test run's own
+   * directory, or a user's, is removed with it. /tmp when unset. */
+  if (dir == NULL || dir[0] != '/') dir = "/tmp";
+  dlen = strlen(dir);
+  while (dlen > 1 && dir[dlen - 1] == '/') dlen--;
   if (clock_gettime(CLOCK_REALTIME, &ts) != 0) ts.tv_nsec = 0;
-  snprintf(path, sizeof path, "/tmp/flan-agent-%ld-%08lx.sock",
-           (long)getpid(), (unsigned long)(ts.tv_nsec & 0xffffffffL));
+  n = snprintf(path, sizeof path, "%.*s/flan-agent-%ld-%08lx.sock", (int)dlen,
+               dir, (long)getpid(), (unsigned long)(ts.tv_nsec & 0xffffffffL));
+  if (n < 0 || (size_t)n >= sizeof path) return -1;
   r = start_on(path);
   /* Only when this call is the one that bound: a second [(agent/start)] would
    * otherwise print a path it did not bind and nothing is listening on. */