From 991e4423aae0748f8c7c5dcc2af6770a66f065b6 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Fri, 25 Sep 2026 07:19:52 +0700 Subject: [PATCH] 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-. 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 | 82 +++++++++++++++++++++++++++++++++++++++++------- test/test_dev.ml | 48 ++++++++++++++++++++++++++-- 2 files changed, 116 insertions(+), 14 deletions(-) diff --git a/lib/dev.ml b/lib/dev.ml index 693575a2..ca813039 100644 --- a/lib/dev.ml +++ b/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-]: 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-] 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 = - 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 dir = session_dir () in 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 = - 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 dir = session_dir () in 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 diff --git a/test/test_dev.ml b/test/test_dev.ml index 5be18307..7ee6b241 100644 --- a/test/test_dev.ml +++ b/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-], 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. *) - if status (request c "(:op \"abort\")") <> "ok" then - (try Unix.kill hpid Sys.sigkill with Unix.Unix_error _ -> ()); + than a report. The signal is for that case only. Through [aborted], + because an abort that worked can arrive as the socket closing. *) + (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;