diff --git a/test/programs/agent-auto.flan b/test/programs/agent-auto.flan new file mode 100644 index 0000000..6ab6374 --- /dev/null +++ b/test/programs/agent-auto.flan @@ -0,0 +1,28 @@ +;;;; The zero-argument (agent/start): a program that names no socket at all. +;;;; +;;;; 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 +;;;; 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 +;;;; not bind a second socket, and does not print a second line; a program that +;;;; got its listener from somewhere else and also asks for one by hand is the +;;;; case that has to keep working. +(import agent "vendor:agent") + +(defvar ticks i64) + +(defn tick [] i64 + (set ticks (+ ticks 1)) + ticks) + +(defn main [] i32 + (if (< (agent/start) 0) + (do (println "cannot listen") 1) + (do + (print (agent/start)) (println "") + (print (tick)) (println "") + (while (= (agent/wait 100) 0) 0) + (print (tick)) (println "") + 0))) diff --git a/test/programs/dev-loop.flan b/test/programs/dev-loop.flan index d92cec1..7fbf933 100644 --- a/test/programs/dev-loop.flan +++ b/test/programs/dev-loop.flan @@ -1,6 +1,12 @@ ;;;; What [flan dev] launches: a program with a loop, a function to redefine, -;;;; and a way to stop. The daemon overrides the socket path through the -;;;; environment, so the one written here is only what it falls back to. +;;;; and a way to stop. +;;;; +;;;; It names no socket. Under [flan dev] the daemon has already decided where +;;;; it wants to talk to this program and says so in FLAN_AGENT_SOCKET — which +;;;; overrode whatever the source named anyway — so the argument was only ever +;;;; a value nothing read. This is the shape a program should be written in, +;;;; and the whole daemon block in test_dev.ml runs against it, so a delivery +;;;; landing there is the zero-argument form working end to end. (import agent "vendor:agent") (defvar ticks i64) @@ -20,7 +26,7 @@ ticks) (defn main [] i32 - (agent/start "/tmp/flan-dev-fallback.sock") + (agent/start) (print (step)) (println "") (while (= (agent/wait 100) 0) 0) (print (step)) (println "") diff --git a/test/test_agent.ml b/test/test_agent.ml index 7fb1fe0..3f4131d 100644 --- a/test/test_agent.ml +++ b/test/test_agent.ml @@ -153,6 +153,122 @@ let () = "1\n1000\n1007\n" end; + (* ── (agent/start), with nothing named ──────────────────────────── *) + + (* The zero-argument form, run with no daemon anywhere: no + FLAN_AGENT_SOCKET in the environment, so the program has to choose a + path itself and then say which one. The printed line is not a nicety + here — it is the only thing that makes the socket reachable, and + everything below it in this block is reached *through* that line rather + than through a path the test picked in advance. If the sentence ever + changes shape, the connect fails and this says so. + + stderr and stdout are separate files on purpose. The program's numbers + are its output and the agent's line is not; a program whose stdout is + data would be corrupted by a sentence landing in it, and under [flan + dev] stdout is a pipe the editor reads. Asserting the transcript on fd 1 + is exactly the claim that the line did not go there. + + Three things are pinned at once, and they share a process because they + are the same startup: the path chosen and printed, the *second* + [(agent/start)] being a no-op rather than a second listener, and the + socket file being gone once the program exits. *) + let aout = tmp "auto.out" and aerr = tmp "auto.err" in + let at, al = Session.create ~file:"programs/agent-auto.flan" () in + let aexe = tmp "auto" in + ignore + (Build.executable ~opts:dev ~csrcs:al.Load.csrcs ~lflags:al.Load.lflags + at.Session.host ~out:aexe); + let aso = tmp "auto-tick.so" in + let ac = Session.eval at "(defn tick [] i64 1000)" in + ignore (Build.shared ~opts:dev ~ir:ac.Session.ir ~out:aso ()); + (* The variable this suite sets for every other program here, taken back + out: with it set the zero-argument form binds where it says and prints + nothing, which is the daemon's case and not this one. *) + let aenv = + Array.of_list + (List.filter + (fun kv -> + not (String.length kv >= 18 + && String.sub kv 0 18 = "FLAN_AGENT_SOCKET=")) + (Array.to_list (Unix.environment ()))) + in + let ofd name = + Unix.openfile name [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let a1 = ofd aout and a2 = ofd aerr in + let apid = Unix.create_process_env aexe [| aexe |] aenv Unix.stdin a1 a2 in + Unix.close a1; + Unix.close a2; + let said () = In_channel.with_open_bin aerr In_channel.input_all in + let prefix = "flan agent: listening on " in + let announced () = + List.filter + (fun l -> + String.length l > String.length prefix + && String.sub l 0 (String.length prefix) = prefix) + (String.split_on_char '\n' (said ())) + in + if not (await (fun () -> announced () <> [])) then begin + fail "(agent/start) never said where it was listening: %S" (said ()); + (try Unix.kill apid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let line = List.hd (announced ()) in + let apath = + String.sub line (String.length prefix) + (String.length line - String.length prefix) + in + (* 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 + 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; + if not (Filename.check_suffix apath ".sock") then + fail "the chosen path is not a socket name: %S" apath; + if not (await (fun () -> Sys.file_exists apath)) then + fail "nothing was bound at the path that was printed: %S" apath + else begin + (* Reached only through the printed line. *) + let r = send apath aso in + if r <> "ok\n" then fail "the announced socket refused a module: %S" r; + let astatus = ref (Unix.WEXITED 0) in + let reaped = + await ~ms:5000 (fun () -> + match Unix.waitpid [ Unix.WNOHANG ] apid with + | 0, _ -> false + | _, s -> astatus := s; true) + in + if not reaped then begin + (try Unix.kill apid Sys.sigkill with Unix.Unix_error _ -> ()); + fail "the program never took the delivery it was sent" + end + else begin + (* 0 is the second [(agent/start)] answering, and it is the whole of + the idempotence claim on this side: had it bound again, the + number would be the same but the socket the test is talking to + would be the older of two. The single announcement below is the + other half — one bind, one sentence. *) + let text = In_channel.with_open_bin aout In_channel.input_all in + if !astatus <> Unix.WEXITED 0 || text <> "0\n1\n1000\n" then + fail "(agent/start)\n got: %S\n wanted: %S" text + "0\n1\n1000\n"; + if List.length (announced ()) <> 1 then + fail "a second (agent/start) announced a second socket: %S" + (said ()); + (* And the file is gone. Nothing else removes it — there is no + daemon here and no directory that belongs to one — so this is the + program's own atexit and nothing else. *) + if Sys.file_exists apath then + fail "the socket outlived the program that bound it: %S" apath + end + end + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) + [ aexe; aso; aout; aerr ]; + (* ── The break loop, spec-conditions.md §2 ──────────────────────── *) (* The claim is that an unhandled [error] stops rather than dying, and can @@ -535,6 +651,13 @@ let () = | Unix.WEXITED c -> Printf.sprintf "exit %d" c | Unix.WSIGNALED c -> Printf.sprintf "signal %d" c | Unix.WSTOPPED c -> Printf.sprintf "stopped %d" c) + (* The other way out, and the one that skips atexit on purpose: [abort] + leaves by [_exit] so that it cannot hang on the loader lock, and the + socket is therefore unlinked by hand there. A file left here would + answer the next client with ECONNREFUSED — a program that is there + and refusing, rather than one that died. *) + else if Sys.file_exists lsock then + fail "abort left the agent socket behind: %S" lsock end; List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) diff --git a/vendor/agent/agent.flan b/vendor/agent/agent.flan index 34559bb..749eab4 100644 --- a/vendor/agent/agent.flan +++ b/vendor/agent/agent.flan @@ -2,7 +2,8 @@ ;;;; design: loading a redefinition and installing it are separate, because ;;;; only the program knows when it is between frames. ;;;; -;;;; (agent/start path) listen on a unix socket; once, at startup +;;;; (agent/start) listen somewhere sensible; once, at startup +;;;; (agent/start path) listen on that unix socket instead ;;;; (agent/poll) install whatever has arrived; returns how many ;;;; (agent/wait ms) the same, but waits for something first ;;;; @@ -10,12 +11,37 @@ ;;;; wait is for a headless test, where waiting is what makes a reload ;;;; deterministic rather than a race against the frame rate. ;;;; +;;;; The path was the ceremony. Under [flan dev] the daemon has already decided +;;;; where it wants to talk to the program and says so in FLAN_AGENT_SOCKET, so +;;;; whatever the source named was being overridden anyway; outside the daemon +;;;; any path will do as long as the program says which one it picked. So the +;;;; argument is now optional, and the zero-argument form is the one to write. +;;;; The explicit form stays for a program that wants to choose — a fixed path +;;;; something else is already configured to connect to. +;;;; ;;;; No aggregate crosses this boundary, so there is no shim: a Flan string is ;;;; already ptr+len and flan_agent_start takes it that way. -(declare start-raw [path string] i32 "flan_agent_start") +(declare start-at-raw [path string] i32 "flan_agent_start") +(declare start-auto-raw [] i32 "flan_agent_start_auto") (declare poll-raw [] i32 "flan_agent_poll") (declare wait-raw [ms i32] i32 "flan_agent_wait") -(defn start [path string] i32 (start-raw path)) +;;; Both answer 0 for "listening" and -1 for "could not". Starting twice is not +;;; an error and not a second listener: the C side answers 0 and leaves the +;;; first socket alone, so a program that gets a listener from somewhere else +;;; and also calls start is a program with one listener. +(defn start-at [path string] i32 (start-at-raw path)) +(defn start-auto [] i32 (start-auto-raw)) + +;;; The optional argument, which Flan has no other spelling for: a function +;;; takes the arity it declares, so the choice between the two above is made +;;; before the checker ever sees a call. Extra arguments are not silently +;;; dropped — they are spliced into [start-at], which then refuses them by its +;;; own arity, at the call site, in the usual words. +(defmacro start [& args] + (if (= (len args) 0) + `(start-auto) + `(start-at ~@args))) + (defn poll [] i32 (poll-raw)) (defn wait [ms i32] i32 (wait-raw ms)) diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index e1386b7..26ba7d8 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -571,6 +571,36 @@ static char condition_name[128]; int32_t flan_agent_poll(void); +/* The path this process actually bound, NUL-terminated, or "" if it never + * bound one. Written once in [start_on] between the successful bind and + * anything that could read it — the listener thread, the atexit handler and + * the orphan signal handler are all arranged after it is set. + * + * It is a copy rather than a [getenv] at use time because one of its readers + * is a signal handler: getenv is not async-signal-safe, and [orphan_die] can + * run on any thread at any instruction. It is also the only record of the path + * when the zero-argument form chose it, where there is no environment variable + * to read back. sun_path's size is the bound because that is where the string + * came from. */ +static char bound_sock[sizeof(((struct sockaddr_un *)0)->sun_path)]; + +/* 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: + * + * ordinary exit this handler, via atexit + * break-loop abort die_now, by hand, because it takes _exit + * orphaned child orphan_die, by hand, for the same reason + * + * Under [flan dev] the socket also sits inside the daemon's temp directory, + * but that directory is not removed today (FIX.org, "The daemon leaves its + * temp directory behind"), so this is the only thing that takes the socket + * away. Outside the daemon the path is under /tmp and nothing else would. */ +static void unlink_bound_sock(void) { + if (bound_sock[0] != '\0') 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 @@ -595,6 +625,10 @@ static _Noreturn void die_now(void) { const char *sock = getenv("FLAN_DEV_SOCK"); if (sock != NULL && *sock != '\0') unlink(sock); } + /* And this program's own agent socket, for the same reason and skipped by + * the same _exit. Empty unless [start_on] bound one, and then this does + * nothing. */ + unlink_bound_sock(); _exit(134); } @@ -1692,12 +1726,6 @@ static void *accept_loop(void *arg) { #define FLAN_ORPHAN_SIG SIGPWR #endif -/* Stashed at arming time rather than read from the environment in the handler: - * getenv is not async-signal-safe, and this path can run on any thread at any - * instruction. sun_path's size is the bound because that is where it came - * from. */ -static char orphan_sock[sizeof(((struct sockaddr_un *)0)->sun_path)]; - #if defined(FLAN_ORPHAN_SIG) /* Three calls, and the restraint is the point. This runs on whichever thread * the kernel picked, which may be the game thread halfway through a printf, @@ -1725,12 +1753,14 @@ static void orphan_die(int sig) { (void)sig; ignored = write(2, said, sizeof said - 1); (void)ignored; - if (orphan_sock[0] != '\0') unlink(orphan_sock); + if (bound_sock[0] != '\0') unlink(bound_sock); _exit(0); } #endif -static void watch_the_daemon(const char *sock) { +/* Called after the bind: the handler it arms unlinks [bound_sock], so it must + * not be able to fire before that is set. */ +static void watch_the_daemon(void) { #if defined(FLAN_ORPHAN_SIG) const char *want_s = getenv("FLAN_DEV_PARENT"); char *end; @@ -1751,16 +1781,57 @@ static void watch_the_daemon(const char *sock) { sa.sa_handler = orphan_die; sigfillset(&sa.sa_mask); if (sigaction(FLAN_ORPHAN_SIG, &sa, NULL) != 0) return; - strncpy(orphan_sock, sock, sizeof orphan_sock - 1); if (prctl(PR_SET_PDEATHSIG, FLAN_ORPHAN_SIG) != 0) return; /* The race, closed. Armed above, so from here on the kernel will tell us; * this asks whether it already should have. */ if ((long)getppid() != want) raise(FLAN_ORPHAN_SIG); -#else - (void)sock; #endif } +/* Bind [path], start the listener, and arrange the two things that depend on + * having bound: the socket's removal and the orphan watch. + * + * Three answers, not two, because the callers below need to tell "bound it + * just now" from "somebody already had": 1 is already started, 0 is bound + * here, -1 could not listen. Only the caller that chose the path itself cares, + * and it cares because it is the one that prints it. + * + * Starting twice is a no-op answering the first socket. That is the whole of + * the idempotence the zero-argument form needs: a program that gets the + * listener for free under [flan dev] and *also* writes [(agent/start ...)] of + * its own must not end up with two listeners, and the second call is the one + * that has to give way — the first is the one whose socket the daemon is + * already talking to. */ +static int32_t start_on(const char *path) { + struct sockaddr_un addr; + size_t len; + if (atomic_exchange(&started, 1)) return 1; + len = strlen(path); + if (len == 0 || len >= sizeof addr.sun_path) return -1; + memset(&addr, 0, sizeof addr); + addr.sun_family = AF_UNIX; + memcpy(addr.sun_path, path, len); + unlink(addr.sun_path); + listen_fd = socket(AF_UNIX, SOCK_STREAM, 0); + if (listen_fd < 0) return -1; + if (bind(listen_fd, (struct sockaddr *)&addr, sizeof addr) < 0) return -1; + if (listen(listen_fd, 4) < 0) return -1; + /* Before the listener thread and before either handler, so that nothing + * which unlinks it can run while it is still empty. */ + memcpy(bound_sock, addr.sun_path, len + 1); + atexit(unlink_bound_sock); + if (pthread_create(&listener, NULL, accept_loop, NULL) != 0) return -1; + /* 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(); + /* 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. */ + flan_break_hook = break_loop; + flan_trap_hook = trap_stop; + return 0; +} + /* [path] is a Flan string: ptr and len, not NUL-terminated. * * FLAN_AGENT_SOCKET overrides it. A program's source has to name some path, @@ -1769,32 +1840,43 @@ static void watch_the_daemon(const char *sock) { * and guessing wrong fails silently: everything compiles, the module is built, * and nothing ever receives it. */ int32_t flan_agent_start(const uint8_t *path, int64_t len) { - struct sockaddr_un addr; + char buf[sizeof(((struct sockaddr_un *)0)->sun_path)]; const char *env = getenv("FLAN_AGENT_SOCKET"); - if (atomic_exchange(&started, 1)) return 0; - if (env != NULL && env[0] != '\0') { - path = (const uint8_t *)env; - len = (int64_t)strlen(env); - } - if (len <= 0 || (size_t)len >= sizeof addr.sun_path) return -1; - memset(&addr, 0, sizeof addr); - addr.sun_family = AF_UNIX; - memcpy(addr.sun_path, path, (size_t)len); - unlink(addr.sun_path); - listen_fd = socket(AF_UNIX, SOCK_STREAM, 0); - if (listen_fd < 0) return -1; - if (bind(listen_fd, (struct sockaddr *)&addr, sizeof addr) < 0) return -1; - if (listen(listen_fd, 4) < 0) return -1; - if (pthread_create(&listener, NULL, accept_loop, NULL) != 0) return -1; - /* After the bind, because the path this hands over is the one that was - actually bound — the environment's override included — and 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(addr.sun_path); - /* 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. */ - flan_break_hook = break_loop; - flan_trap_hook = trap_stop; - return 0; + if (env != NULL && env[0] != '\0') return start_on(env) < 0 ? -1 : 0; + if (len <= 0 || (size_t)len >= sizeof buf) return -1; + memcpy(buf, path, (size_t)len); + buf[len] = '\0'; + return start_on(buf) < 0 ? -1 : 0; +} + +/* The zero-argument form: (agent/start), with nowhere named. + * + * Under [flan dev] there is a right answer and the daemon has already written + * it down — the same FLAN_AGENT_SOCKET the explicit form honours — so this + * binds there and says nothing. The daemon knows where it put the program's + * socket; a line about it would only go down the pipe the editor reads. + * + * Outside the daemon there is no right answer, so it invents one that no other + * program will collide with and prints it, because a socket nobody can name is + * a socket nobody can connect to. The pid makes it this process's; the clock + * makes a second run of the same program a different path rather than one that + * 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)]; + struct timespec ts; + int32_t r; + const char *env = getenv("FLAN_AGENT_SOCKET"); + if (env != NULL && env[0] != '\0') return start_on(env) < 0 ? -1 : 0; + 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)); + 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. */ + if (r == 0) { + fprintf(stderr, "flan agent: listening on %s\n", path); + fflush(stderr); + } + return r < 0 ? -1 : 0; } diff --git a/vendor/agent/flan_agent.web.c b/vendor/agent/flan_agent.web.c index 7745284..49332ef 100644 --- a/vendor/agent/flan_agent.web.c +++ b/vendor/agent/flan_agent.web.c @@ -64,6 +64,12 @@ int32_t flan_agent_start(const uint8_t *path, int64_t len) { return -1; } +/* The zero-argument form, which on a native build picks a socket path for + * itself. There is still nothing to bind here, so it answers exactly what the + * explicit form does and prints nothing: a path chosen for a socket that + * cannot exist would be a sentence about nothing. */ +int32_t flan_agent_start_auto(void) { return -1; } + int32_t flan_agent_poll(void) { return 0; } int32_t flan_agent_wait(int32_t ms) { (void)ms; return 0; }