A dev session removes its build directory when it closes, and the next session sweeps the ones whose process is gone

Every daemon left about 8MB in $TMPDIR/flan-dev-<pid>. A test_dev run left 300MB, and a few concurrent runs filled the tmpfs /tmp, after which every daemon died on its link before binding. The half-write test's abort also goes through [aborted] now, since an abort that worked can arrive as the socket closing.

lib/dev.ml

@@ -4241,6 +4241,72 @@ let accept_loop ?grace t ls =
   in
   go ()
 
+(* ── The session's directory ───────────────────────────────────────── *)
+
+(* Every session builds into [$TMPDIR/flan-dev-<pid>]: the host executable,
+   its IR or listing, one module per evaluation. About 8MB before the first
+   evaluation, and nothing used to remove it, so every daemon that ever ran
+   left one behind. On a machine whose /tmp is a tmpfs that is memory, and a
+   test run starts some forty daemons: enough of them at once filled /tmp, and
+   the daemons after that died before binding, on the link, with "No space
+   left on device" — the "fail to bind under load" flake.
+
+   Two halves. A session that ends through [close] removes its own directory
+   on the way out. One that does not — a signal, a program that died where it
+   stood through [_exit], a failed build — cannot, so the next session to start
+   removes every [flan-dev-<pid>] whose process no longer exists. A pid that
+   is alive keeps its directory whoever it is now: a reused pid costs one
+   directory kept too long, never one removed from under a session.
+
+   Only ESRCH counts as gone. EPERM is a live process that belongs to someone
+   else, and a directory in a shared /tmp that is not ours fails to remove
+   anyway. *)
+let dir_prefix = "flan-dev-"
+
+let session_dir_of pid =
+  Filename.concat (Filename.get_temp_dir_name ())
+    (Printf.sprintf "%s%d" dir_prefix pid)
+
+(* Best effort throughout: what cannot be removed stays. The chmod is for a
+   directory a session left read-only, which test_dev's cannot-write-a-module
+   case does on purpose. *)
+let rec remove_tree path =
+  match Unix.lstat path with
+  | { Unix.st_kind = Unix.S_DIR; _ } ->
+    (try Unix.chmod path 0o700 with Unix.Unix_error _ -> ());
+    (match Sys.readdir path with
+     | names -> Array.iter (fun n -> remove_tree (Filename.concat path n)) names
+     | exception Sys_error _ -> ());
+    (try Unix.rmdir path with Unix.Unix_error _ -> ())
+  | _ -> (try Unix.unlink path with Unix.Unix_error _ -> ())
+  | exception Unix.Unix_error _ -> ()
+
+let sweep_dead_sessions () =
+  let tmp = Filename.get_temp_dir_name () in
+  let own = Unix.getpid () and plen = String.length dir_prefix in
+  match Sys.readdir tmp with
+  | exception Sys_error _ -> ()
+  | names ->
+    Array.iter
+      (fun n ->
+         if String.length n > plen && String.sub n 0 plen = dir_prefix then
+           match int_of_string_opt (String.sub n plen (String.length n - plen)) with
+           | Some pid when pid > 0 && pid <> own ->
+             (match Unix.kill pid 0 with
+              | () -> ()
+              | exception Unix.Unix_error (Unix.ESRCH, _, _) ->
+                remove_tree (Filename.concat tmp n)
+              | exception Unix.Unix_error _ -> ())
+           | _ -> ())
+      names
+
+(* This process's directory, after clearing out the dead ones. *)
+let session_dir () =
+  sweep_dead_sessions ();
+  let dir = session_dir_of (Unix.getpid ()) in
+  (try Unix.mkdir dir 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
+  dir
+
 (* [debug] is off by default, which keeps [flan dev] exactly what it was: a
    -O2 host and -O2 modules. It is opt-in rather than always-on because a debug
    build is an -O0 build — [llvm.dbg.declare] describes an alloca and mem2reg
@@ -4256,11 +4322,7 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
      directory it was relative to. *)
   let file = try Unix.realpath file with Unix.Unix_error _ -> file in
   let session, l = Session.create ~debug ~x86 ~file () in
-  let dir =
+  let dir = session_dir () in
-    Filename.concat (Filename.get_temp_dir_name ())
-      (Printf.sprintf "flan-dev-%d" (Unix.getpid ()))
-  in
-  (try Unix.mkdir dir 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
   let exe = Filename.concat dir "program" in
   (* [keep] so the host's own IR survives the build. It is the text [llc] was
      actually given, not a second emission of it, which is the difference
@@ -4351,7 +4413,8 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
       (try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ());
       (try Unix.close ls with Unix.Unix_error _ -> ());
       (try Unix.close rd with Unix.Unix_error _ -> ());
-      (try Unix.unlink sock with Unix.Unix_error _ -> ()))
+      (try Unix.unlink sock with Unix.Unix_error _ -> ());
+      remove_tree dir)
     (fun () -> accept_loop t ls)
 
 (* ── One process: the program and the compiler in the same binary ──── *)
@@ -5234,6 +5297,7 @@ let merged_serve () =
        Printf.eprintf "flan dev: %s\n%!" (Printexc.to_string e));
     (try Unix.close ls with Unix.Unix_error _ -> ());
     (try Unix.unlink sock with Unix.Unix_error _ -> ());
+    remove_tree t.dir;
     (* [close] from the editor ends the session, and so now does an editor that
        stopped being there; in one process either means the program too — which
        is what the daemon did by killing its child. [_exit] for the loader-lock
@@ -5250,11 +5314,7 @@ let start_merged ?(debug = false) ?(x86 = true) ~file ~sock () =
   let t0 = Unix.gettimeofday () in
   let file = try Unix.realpath file with Unix.Unix_error _ -> file in
   let session, l = Session.create ~debug ~x86 ~file () in
-  let dir =
+  let dir = session_dir () in
-    Filename.concat (Filename.get_temp_dir_name ())
-      (Printf.sprintf "flan-dev-%d" (Unix.getpid ()))
-  in
-  (try Unix.mkdir dir 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
   let exe = Filename.concat dir "program" in
   (* The host's IR goes straight to its final home rather than being written
      into the build's working directory and moved: the merged link is spelled

test/test_dev.ml

@@ -216,6 +216,33 @@ let () =
        rewrites: a true statement about the backend and no test of the verb.
        The default itself is checked further down, on a daemon that does not
        need frames. *)
+    (* A session builds into [$TMPDIR/flan-dev-<pid>], about 8MB before its
+       first evaluation. Left behind by every daemon, those filled a tmpfs /tmp
+       under a few concurrent runs of this file, and every daemon after that
+       died on its link before binding. So: a dead session's directory is
+       swept by the next session to start, a live one's is not, and a session
+       that ends through [close] takes its own with it. The dead pid is a
+       process this test ran and reaped; this test's own pid is the live one. *)
+    let session_dir p =
+      Filename.concat (Filename.get_temp_dir_name ())
+        (Printf.sprintf "flan-dev-%d" p)
+    in
+    let dead =
+      let p =
+        Unix.create_process "true" [| "true" |] Unix.stdin Unix.stdout
+          Unix.stderr
+      in
+      ignore (Unix.waitpid [] p);
+      p
+    in
+    let plant p =
+      let d = session_dir p in
+      (try Unix.mkdir d 0o700 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
+      Out_channel.with_open_bin (Filename.concat d "program") (fun oc ->
+          output_string oc "left behind")
+    in
+    plant dead;
+    plant (Unix.getpid ());
     let pid =
       Unix.create_process flan
         [| flan; "dev"; "programs/dev-loop.flan"; "-s"; sock; "--llvm" |]
@@ -226,6 +253,15 @@ let () =
     if not (listening ~pid sock) then
       fail "the daemon %s" !listen_why
     else begin
+      if Sys.file_exists (session_dir dead) then
+        fail "a dead session's directory %s outlived the next session's start"
+          (session_dir dead);
+      if not (Sys.file_exists (session_dir (Unix.getpid ()))) then
+        fail "a live process's session directory was swept";
+      (try Sys.remove (Filename.concat (session_dir (Unix.getpid ())) "program")
+       with Sys_error _ -> ());
+      (try Unix.rmdir (session_dir (Unix.getpid ()))
+       with Unix.Unix_error _ -> ());
       (* The daemon owns the program's lifetime and kills it on [close], so
          every step waits for the program to have got there. "ok" from an eval
          means the module was queued, not that it has been installed. *)
@@ -797,6 +833,9 @@ let () =
          transcript is the claim — after everything the first run printed and
          before anything the second did. *)
       ignore (Unix.waitpid [] pid);
+      if Sys.file_exists (session_dir pid) then
+        fail "a session that ended through close left %s behind"
+          (session_dir pid);
       let text = Buffer.contents output in
       let wanted = "1\n5\n105\n777\npk\n106\n" in
       if text <> wanted then
@@ -5605,9 +5644,12 @@ let () =
            abort is refused by a program that is *running*, which is what a
            failure above would leave behind — and this fixture then polls for
            twenty seconds and parks, so the wait below would be a hang rather
-           than a report. The signal is for that case only. *)
+           than a report. The signal is for that case only. Through [aborted],
-        if status (request c "(:op \"abort\")") <> "ok" then
+           because an abort that worked can arrive as the socket closing. *)
-          (try Unix.kill hpid Sys.sigkill with Unix.Unix_error _ -> ());
+        (match aborted c with
+         | Some r when status r <> "ok" ->
+           (try Unix.kill hpid Sys.sigkill with Unix.Unix_error _ -> ())
+         | _ -> ());
         (try Unix.close c with Unix.Unix_error _ -> ());
         (try ignore (Unix.waitpid [] hpid) with Unix.Unix_error _ -> ())
       end;