JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

flan dev refuses at start a TMPDIR that is missing or too deep for a socket path, and a program with no main, and tells a program with no agent how to add one

Browse Source 
The dropped (agent/start ...) note named the wrong cause rather than being unreachable: an over-long socket path fails the agent's bind while it is linked. That case is now refused before anything is built, and the comments, the TODO entry and the fixture say so.
This commit is contained in:
Joseph Ferano 2026-09-25 10:43:33 +07:00
parent 2b42cecded
commit 146be41bd4
7 changed files with 259 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
TODO.org
View File

@ -1567,10 +1567,12 @@ builds. The fix, if it is ever felt, is a narrower gate.
** DONE The daemon's "has not called (agent/start ...)" note is unreachable
CLOSED: [2026-09-25]
Retired, with the matching arm of an evaluation's timeout. A running program
either links the agent, whose constructor binds the socket before =main=, or
links none and has its delivery refused; no reply names =(agent/start ...)= as
not yet called.
Retired, with the matching arm of an evaluation's timeout, because it named the
wrong cause: with the agent linked, its constructor binds the socket before
=main=, and the one way left to be unbound is a socket path over 107 bytes, which
=flan dev= refuses at start, naming TMPDIR. A program with no agent linked is
told it has none and how to add one. No reply says =(agent/start ...)= has not
been called.
** DONE The allocation registry
CLOSED: [2026-09-13]

4
lib/agent.ml
View File

@ -21,3 +21,7 @@
the compiler thread calling C, never the other way. *)
external request : string -> string option = "flan_agent_direct"
(** Whether this process links the agent. [false] in the same binaries where
[request] is [None]. *)
external present : unit -> bool = "flan_agent_present"

155
lib/dev.ml
View File

@ -122,6 +122,28 @@ let await ?(ms = 5000) f =
in
go ms
(* What a program needs so that code from the editor can reach it. Spelled once
because three replies give it: a delivery, an evaluation and the daemon's
own warning. Both lines compile as written. *)
let agent_howto =
"Import the agent with (import agent \"vendor:agent\") and call \
(agent/poll) once in each pass of the program's main loop, then start \
flan dev again."
let no_agent =
"the program has no agent, so nothing in it can receive code from the \
editor. " ^ agent_howto
(* Whether anything in this session can hand code to the program. A merged
build with no agent linked has no agent to call and never binds a socket,
and a connect to one answers "No such file or directory" about a path the
reader never chose; that is the case this names. *)
let agentless t = t.child = None && not (Agent.present ())
let unreachable t e =
if agentless t then no_agent
else "cannot reach the program: " ^ Unix.error_message e
(* Whether the program has bound the socket it receives modules on.
Cheap enough to ask before every request — one [stat] — and asked rather than
@ -160,8 +182,8 @@ let agent_check t =
otherwise repeat this on every keystroke's worth of polling. *)
t.agent_watch <- None;
Printf.eprintf
"flan dev: the program is not listening on %s — does it call \
(agent/start ...)?\n%!" t.agent
"flan dev: nothing is listening on %s, so code from the editor cannot \
reach the program. %s\n%!" t.agent agent_howto
end
(* ── Asking the agent ──────────────────────────────────────────────── *)
@ -797,10 +819,15 @@ let refusal ~parked reply =
of the last one.
A RUNNING program needs no note: the reply already says queued, and the
frame boundary is the next one it reaches. A running program whose agent
socket is not bound is not a third case: the agent package binds it in a
constructor, before [main], and a program that does not link the package
has nothing to queue a module on, so the delivery is refused instead. *)
frame boundary is the next one it reaches. That includes a running program
whose agent socket is not bound. The agent package binds it in a
constructor before [main], so the one way to be running and unbound with
the agent linked is a bind that failed — a socket path longer than
[max_socket_path], which [session_dir] refuses before building — and there
the module is still queued through the in-process call. A note saying the
program "has not called (agent/start ...)" named a cause that was not the
cause, so there is none. A program with no agent linked has nothing to
queue a module on, and its delivery is refused with [no_agent]. *)
let install_note t ~parked =
if parked then begin
let first = not t.park_noted in
@ -920,8 +947,10 @@ let eval t ~code ~origin ~pause =
| reply -> refused (refusal ~parked:parked_now reply)
| exception Unix.Unix_error (e, _, _) ->
refused
("cannot reach the program on " ^ t.agent ^ ": "
^ Unix.error_message e))
(if agentless t then no_agent
else
"cannot reach the program on " ^ t.agent ^ ": "
^ Unix.error_message e))
| exception Failure m -> refused m)
with e when not !accepted -> Session.restore t.session before; raise e)
(* Nothing to put back: the check itself raised, so [Session.eval] never
@ -972,6 +1001,7 @@ let eval t ~code ~origin ~pause =
let eval_expr t ~code ~origin ~pause =
match liveness t with
| Gone -> error gone
| (Live | Parked) when agentless t -> error no_agent
| Live | Parked ->
(* The same rollback [eval] takes, for the same reason and a smaller
cargo. A thunk is not a declaration and never joins the session, but the
@ -1252,7 +1282,7 @@ let eval_expr t ~code ~origin ~pause =
put the session back. *)
| reply -> refused (refusal ~parked:(liveness t = Parked) reply)
| exception Unix.Unix_error (e, _, _) ->
refused ("cannot reach the program: " ^ Unix.error_message e))
refused (unreachable t e))
| exception Failure m -> refused m)
| exception Loc.Error { Loc.dloc = l; dmsg = msg; _ } -> error ~loc:(Loc.to_string l) msg
@ -1938,7 +1968,7 @@ let run_render_thunk ?(stopped_only = false) ?at_stop t ~tag
| None -> if stopped_only then deliver_stopped_only t out else deliver t out)
with
| exception Unix.Unix_error (e, _, _) ->
Error ("cannot reach the program: " ^ Unix.error_message e)
Error (unreachable t e)
| "ok" ->
let rec wait ms =
(* Drained every tick for the reason [eval_expr]'s own wait spells
@ -2493,7 +2523,7 @@ type reg_entry =
let reg_at t ~addr : (reg_entry option, string) result =
match request t (Printf.sprintf "reg at %d" addr) with
| exception Unix.Unix_error (e, _, _) ->
Error ("cannot reach the program: " ^ Unix.error_message e)
Error (unreachable t e)
| text ->
let line = String.trim (List.hd (String.split_on_char '\n' text)) in
if line = "none" then Ok None
@ -2796,7 +2826,7 @@ let inspect_addr t ~addr ~want_type =
let reg_rows t ~verb =
match request t verb with
| exception Unix.Unix_error (e, _, _) ->
Error ("cannot reach the program: " ^ Unix.error_message e)
Error (unreachable t e)
| text ->
(match String.split_on_char '\n' text with
| [] -> Error "the program answered nothing"
@ -3160,7 +3190,7 @@ let choose_at t ~index ~name =
^ taken_note ~abandoned:(accepted reply = Some true) ]
| reply -> error (String.trim reply)
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e)
error (unreachable t e)
let choose t ~name =
match liveness t with
@ -3188,7 +3218,7 @@ let choose t ~name =
":note " ^ taken_note ~abandoned:(accepted reply = Some true) ]
| reply -> error (String.trim reply)
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e)
error (unreachable t e)
(* The other way out. The program exits 134 where it stopped, which ends this
daemon too — it owns the program's lifetime and has nothing left to serve.
@ -3215,7 +3245,7 @@ let abort t =
ok [ ":note " ^ Wire.quote "the program is exiting; flan dev ends with it" ]
| reply -> error (String.trim reply)
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e)
error (unreachable t e)
(* Run [main] again. The verb this file was missing, and the one everything
above it about [Parked] is in aid of.
@ -3662,7 +3692,7 @@ let watch_enable t ~on =
| "ok" -> ok [ (if on then ":watching t" else ":watching nil") ]
| reply -> error ("the program refused the watch request: " ^ reply)
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e)
error (unreachable t e)
(* [NAME <tab> VALUE] per line, after a header of [COUNT DROPPED].
@ -3712,7 +3742,7 @@ let watch_read t ~reset =
(if overflow then ":overflow t" else ":overflow nil") ]
| hdr :: _ -> error (String.trim hdr))
| exception Unix.Unix_error (e, _, _) ->
error ("cannot reach the program: " ^ Unix.error_message e)
error (unreachable t e)
(* [(:op "memory")] — which lines of this session's program allocate.
@ -4283,6 +4313,74 @@ let remove_session_dirs t =
remove t.dir;
remove (Build.workdir ())
(* The longest path a unix socket can be bound at: [sun_path] is 108 bytes on
Linux and the path is written into it with its terminating NUL. A longer one
fails at the bind, where the reason reaches nobody — the agent's constructor
drops it, and [connect] later answers "File name too long" with no path. *)
let max_socket_path = 107
let socket_fits ~what ~fix path =
let n = String.length path in
if n > max_socket_path then
failwith
(Printf.sprintf
"%s would be at %s, which is %d bytes long, and a unix socket path \
can be at most %d bytes. %s"
what path n max_socket_path fix)
(* The directory a session keeps its program, its modules and the agent's
socket in, checked before anything is built so that a TMPDIR that cannot
hold one is said once, at the start, in words. *)
let session_dir ~file ~sock =
let tmp = Filename.get_temp_dir_name () in
let dir = Filename.concat tmp (Printf.sprintf "flan-dev-%d" (Unix.getpid ())) in
let shorter =
Printf.sprintf
"Set TMPDIR to a shorter directory, for example: TMPDIR=/tmp flan dev %s"
(Filename.quote file)
in
if not (Sys.file_exists tmp && Sys.is_directory tmp) then
failwith
(Printf.sprintf
"the temporary directory %s does not exist, and flan dev builds the \
program there. Create it, or set TMPDIR to a directory that exists, \
for example: TMPDIR=/tmp flan dev %s"
tmp (Filename.quote file));
socket_fits ~what:"the program's agent socket" ~fix:shorter
(Filename.concat dir "agent.sock");
socket_fits ~what:"the editor's socket"
~fix:"Give flan dev -s a shorter path." sock;
dir
(* Made only once the program has been found to have something to run, so a
refusal leaves nothing behind in TMPDIR. *)
let make_session_dir ~file dir =
match Unix.mkdir dir 0o700 with
| () | exception Unix.Unix_error (Unix.EEXIST, _, _) -> ()
| exception Unix.Unix_error (e, _, _) ->
failwith
(Printf.sprintf
"cannot create %s: %s. flan dev builds the program under TMPDIR; set \
it to a directory you can write to, for example: TMPDIR=/tmp flan \
dev %s"
dir (Unix.error_message e) (Filename.quote file))
(* A session over a file with no [main] has nothing to run, and the build
would find that out at the link — as a missing symbol, or as the merged
build's rename finding nothing to rename. *)
let need_main ~file (session : Session.t) =
if not
(List.exists (fun (f : Tast.fn) -> f.Tast.name = "main")
session.Session.host.Tast.fns)
then
failwith
(Printf.sprintf
"%s has no main, so flan dev has nothing to run. A program starts at \
a function named main, for example:\n\n\
\ (defn main [] i32\n\
\ 0)"
file)
(* [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
@ -4296,13 +4394,12 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
src/game.flan] run from a project root would otherwise send back
"src/game.flan:12:7", which the editor can only resolve by guessing which
directory it was relative to. *)
let dir = session_dir ~file ~sock in
let given = file 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, _, _) -> ());
need_main ~file:given session;
make_session_dir ~file:given dir;
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
@ -4369,8 +4466,9 @@ let two_process ?(debug = false) ?(x86 = true) ~file ~sock () =
if not (await (fun () -> Sys.file_exists agent)) then begin
(try Unix.kill child Sys.sigterm with Unix.Unix_error _ -> ());
failwith
("the program never listened on " ^ agent
^ " — does it call (agent/start ...)?")
("the program did not open its agent socket at " ^ agent
^ ". Under --two-process every edit reaches the program through that \
socket. " ^ agent_howto)
end;
let t =
@ -5300,13 +5398,12 @@ let merged_serve () =
does not survive: there is one process from the first reply onwards. *)
let start_merged ?(debug = false) ?(x86 = true) ~file ~sock () =
let t0 = Unix.gettimeofday () in
let dir = session_dir ~file ~sock in
let given = file 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, _, _) -> ());
need_main ~file:given session;
make_session_dir ~file:given dir;
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

7
lib/dynload_stubs.c
View File

@ -219,6 +219,13 @@ CAMLprim value flan_program_wake(value unit) {
return Val_int(flan_merged_wake() == 0 ? 0 : 1);
}
/* Whether this process has an agent to call at all: the same weak symbol
* [flan_agent_direct] tests, asked without a request. */
CAMLprim value flan_agent_present(value unit) {
(void)unit;
return Val_bool(flan_agent_request != NULL);
}
CAMLprim value flan_agent_direct(value line) {
CAMLparam1(line);
CAMLlocal2(s, r);

11
test/programs/dev-noagent-running.flan
View File

@ -5,12 +5,13 @@
;;;; parked program is answered by the parking path. This one keeps running,
;;;; which is the state nothing had pinned: there is no agent in the process to
;;;; hand a module to and no socket to fall back on, so the daemon refuses the
;;;; delivery and says which socket it could not reach.
;;;; delivery.
;;;;
;;;; That is the honest answer for it. A program that *links* the agent has its
;;;; socket bound by the package's constructor before main, so a running
;;;; program with no socket is always this one; see TODO.org, "(agent/start)
;;;; takes no argument, and binds before main".
;;;; That is the honest answer for it: the reply says the program has no agent
;;;; and how to add one. A program that *links* the agent has its socket bound
;;;; by the package's constructor before main, and the one way that bind fails
;;;; — a socket path too long for a unix socket — is refused when flan dev
;;;; starts.
;;;;
;;;; So: no (import agent ...) anywhere, and a loop that outlasts the test.
(defn step [] i64 7)

2
test/programs/dev-nomain.flan Normal file
View File

@ -0,0 +1,2 @@
;;;; A file with no main: flan dev has nothing to run, and says so before building.
(defn helper [] i64 1)

152
test/test_dev.ml
View File

@ -4748,14 +4748,14 @@ let () =
contains_sub
(try In_channel.with_open_bin nlog In_channel.input_all
with Sys_error _ -> "")
"does it call (agent/start ...)?"
"(import agent \"vendor:agent\")"
in
ignore (await ~ms:30000 nlog_says);
(try Unix.kill npid Sys.sigkill with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] npid) with Unix.Unix_error _ -> ());
if not (nlog_says ()) then
fail
"a program without (agent/start ...) drew no warning from flan dev:\n%s"
"a program with no agent drew no warning from flan dev:\n%s"
(try In_channel.with_open_bin nlog In_channel.input_all
with Sys_error _ -> "");
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
@ -4767,20 +4767,12 @@ let () =
reply an editor gets for a redefinition, and it is here because that
reply was never pinned and this lane changed which of two it is.
[install_note] has a sentence for a RUNNING program whose socket is not
bound — queued, installs at its next [(agent/poll)], not at all if there
is never one. It was true of exactly one thing: a merged session whose
program links the agent, so the ring is reachable in-process, but has
not got to its [(agent/start ...)] yet. The constructor closed that
window, so nothing reaches the sentence any more; the late-agent row
below asserts its absence, and TODO.org's entry on the unreachable
agent-start note says the branch can be retired.
A program that does not link the agent at all never reached it either,
and this row is what says so rather than leaving it to be assumed. There
is no agent in this process to call and no socket to fall back to, so
the delivery is REFUSED — which is the honest answer and not the note:
"queued" would have promised a poll that has nothing to drain.
A program that does not link the agent at all has no agent in this
process to call and no socket to fall back to, so the delivery is
REFUSED, and the reply says the program has no agent and how to give it
one — both for a redefinition and for an expression. "Queued" would
have promised a poll that has nothing to drain, and "connect: No such
file or directory" names a path the reader never chose.
It needs the program to be running, which is why it is not folded into
the row above: dev-noagent.flan's main returns, so it parks within the
@ -4809,9 +4801,14 @@ let () =
\"programs/dev-noagent-running.flan\")"
in
let msg = Option.value ~default:"" (Wire.string_field r "message") in
(* Refused, and the reason names the socket it could not reach rather
than the compiler: the module built, and what failed is the hand-off
to a program that has no agent in it. *)
(* Refused, and the reason is the program's rather than the compiler's:
the module built, and what is missing is an agent to hand it to. The
fix it names is the import. *)
let names_the_fix m =
contains_sub m "has no agent"
&& contains_sub m "(import agent \"vendor:agent\")"
&& contains_sub m "(agent/poll)"
in
if status r = "ok" then
fail
"a redefinition for a program with no agent in it was answered \
@ -4819,9 +4816,20 @@ let () =
(match Wire.string_field r "note" with
| Some n -> Printf.sprintf " (note: %S)" n
| None -> "")
else if not (contains_sub msg "cannot reach the program on ") then
else if not (names_the_fix msg) then
fail "a delivery to a running agentless program was refused with: %S"
msg;
(* And an expression, which used to be answered with the connect's own
errno. *)
let r =
request gc
"(:op \"eval-expr\" :code \"(step)\" :file \
\"programs/dev-noagent-running.flan\")"
in
let msg = Option.value ~default:"" (Wire.string_field r "message") in
if status r = "ok" || not (names_the_fix msg) then
fail "an expression for a running agentless program was answered %s: %S"
(status r) msg;
(* And the session is still there afterwards, which is the rest of the
claim: a refusal is a reply, not the end. *)
(match request gc "(:op \"describe\")" with
@ -4843,6 +4851,65 @@ let () =
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
[ gsock; glog ];
(* ── What stops a session from starting, said at the start ─────────
Three things a session cannot start without, each refused before
anything is built, in both shapes, with the fix named: a TMPDIR that
does not exist (it was an uncaught ENOENT out of mkdir), one so deep
that the agent's socket path does not fit in a unix socket address
(the bind failed where nobody heard it, and every reply after that
said "File name too long" or asked about (agent/start ...)), and a
program with no main (a link error, or a sentence about the merged
build's internals). *)
let refused_at_start what ~tmpdir ~prog ~mode want =
let out = tmp "start-refusal.out" in
let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let env =
Array.append
[| "TMPDIR=" ^ tmpdir |]
(Array.of_list
(List.filter
(fun v -> not (String.starts_with ~prefix:"TMPDIR=" v))
(Array.to_list (Unix.environment ()))))
in
let argv =
Array.append [| flan; "dev"; prog; "-s"; tmp "start-refusal.sock" |] mode
in
let pid = Unix.create_process_env flan argv env Unix.stdin fd fd in
Unix.close fd;
let _, st = Unix.waitpid [] pid in
let said = In_channel.with_open_bin out In_channel.input_all in
(try Sys.remove out with Sys_error _ -> ());
let shape = if mode = [||] then "one process" else "--two-process" in
(match st with
| Unix.WEXITED 1 -> ()
| _ -> fail "%s (%s): flan dev did not exit 1: %S" what shape said);
List.iter
(fun w ->
if not (contains_sub said w) then
fail "%s (%s): the refusal does not say %S: %S" what shape w said)
want
in
let here = Filename.get_temp_dir_name () in
let deep =
Filename.concat here (String.make (max 1 (110 - String.length here)) 'd')
in
Unix.mkdir deep 0o700;
let missing = Filename.concat here "no-such-directory" in
let nomain = "programs/dev-nomain.flan" in
List.iter
(fun mode ->
refused_at_start "a TMPDIR too deep for a socket path" ~tmpdir:deep
~prog:"programs/dev-lateagent.flan" ~mode
[ "at most 107 bytes"; "TMPDIR=/tmp flan dev" ];
refused_at_start "a TMPDIR that does not exist" ~tmpdir:missing
~prog:"programs/dev-lateagent.flan" ~mode
[ missing ^ " does not exist"; "TMPDIR=/tmp flan dev" ];
refused_at_start "a program with no main" ~tmpdir:here ~prog:nomain
~mode [ "has no main"; "(defn main [] i32" ])
[ [||]; [| "--two-process" |] ];
(try Unix.rmdir deep with Unix.Unix_error _ -> ());
(* ── A build that fails is a refusal, not the end of the session ── *)
(* Evaluating runs a compiler, and a compiler can fail in ways the
@ -6751,36 +6818,33 @@ let () =
fail
"the first editor request waited %.1fs on a program whose agent \
starts late; the accept loop is gated on the agent again" ldt;
(* And the delivery, also inside the delay. It is taken, and it carries
no note about [(agent/start ...)]: that sentence is for a program
whose socket is not bound, and the constructor bound this one before
main. [install_note] answering nothing here is therefore the evidence
that the socket is up — the assertion is on the absence because the
absence is the claim.
It used to be the presence. The program's own start call is still
three seconds away, so this is the same moment it always was; what
changed is that the moment is no longer one in which the program
cannot be reached. lib/dev.ml's branch still says the true thing for
a program that does not link the agent at all (the agentless row
above), and TODO.org's entry on the unreachable agent-start note
records that a dev program which links it can no longer get
there. *)
(* The socket is up inside the delay, three seconds before the program's
own start call: the constructor bound it before main. Checked on the
file itself, at the path the daemon named in FLAN_AGENT_SOCKET — the
merged build execs in place, so its directory carries the daemon's
pid. *)
let agent_sock =
Filename.concat
(Filename.concat (Filename.get_temp_dir_name ())
(Printf.sprintf "flan-dev-%d" lpid))
"agent.sock"
in
(match (Unix.stat agent_sock).Unix.st_kind with
| Unix.S_SOCK -> ()
| _ -> fail "%s is not a socket" agent_sock
| exception Unix.Unix_error (e, _, _) ->
fail
"the agent socket was not bound before main: %s: %s" agent_sock
(Unix.error_message e));
(* And the delivery, also inside the delay. It is taken. *)
let r =
request lc
"(:op \"eval\" :code \"(defn step [] i64 9)\" :file \
\"programs/dev-lateagent.flan\")"
in
if status r <> "ok" then
fail "a redefinition sent before (agent/start ...): %s" (said r)
else begin
let note = Option.value ~default:"" (Wire.string_field r "note") in
if contains_sub note "(agent/start ...)" then
fail
"the agent socket was not bound before main, so a delivery was \
told to wait for a call the program had not made: %S" note
end;
(* The claim the note makes, checked against the program rather than
fail "a redefinition sent before (agent/start ...): %s" (said r);
(* The delivery, checked against the program rather than
against the reply: once the sleep is over and the program is polling,
the body that was queued is the one that runs. [await] because the
moment the agent comes up is the program's to choose, and each