diff --git a/lib/dev.ml b/lib/dev.ml index 9245ef7..c64738b 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -3019,9 +3019,31 @@ let two_process ?(debug = false) ?(x86 = false) ~file ~sock () = environment. Guessing instead would fail silently — everything compiles, the module is built, and nothing ever receives it. *) Unix.putenv "FLAN_AGENT_SOCKET" agent; + (* And who its parent is, which is the child's licence to end itself. + vendor/agent/flan_agent.c carries the argument at length; the half that + belongs here is that this daemon is the only thing that ever kills its + child, and it does so from a [Fun.protect ~finally] that a SIGKILL skips. + A harness that tears a failed daemon down the hard way, or a watchdog that + fires, therefore leaves a program with ppid 1 running a game loop nobody + can reach — which is where the orphans on this machine came from. The pid + rather than a flag because the child checks [getppid] against it to close + the window between the fork and its own arming, and "reparented to 1" is + not the same question under a subreaper. Set only here: a merged build + must never arm this, because there the parent is whoever typed [flan dev] + and not the session's owner. *) + Unix.putenv "FLAN_DEV_PARENT" (string_of_int (Unix.getpid ())); (* Through a pipe, so the program's own output can reach an editor instead of - only the terminal the daemon was started in. *) - let rd, wr = Unix.pipe ~cloexec:false () in + only the terminal the daemon was started in. + + [~cloexec:true] on the pair and the dup onto the child's fd 1 is what + actually gives it away: [create_process] dup2s [wr] onto the child's + stdout and dup2 clears the flag, so the write end survives the exec while + the read end — this daemon's own, and no business of the program's — does + not. It used to be inherited, which is why a child held the read end of + the pipe it was writing to; that also meant the pipe could never reach + EOF while the child lived, so "wait for EOF on the daemon's end" was never + the mechanism it looked like it could be. *) + let rd, wr = Unix.pipe ~cloexec:true () in let child = Unix.create_process exe [| exe |] Unix.stdin wr Unix.stderr in Unix.close wr; Unix.set_nonblock rd; diff --git a/test/test_dev.ml b/test/test_dev.ml index 622f313..ec75a89 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -3141,6 +3141,118 @@ let () = (try ignore (Unix.waitpid [] tpid) with Unix.Unix_error _ -> ()); List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ tsock; tout ]; + (* ── And the program must not outlive the daemon that owns it ──── *) + + (* The case above ends with [close], which is a daemon going away the + polite way: [two_process]'s [Fun.protect ~finally] runs and kills its + child on the way out. This is the other way, and it is the one that + actually happens — a harness tearing down a daemon it has given up on, + a watchdog firing, somebody with [kill -9]. SIGKILL runs no finally + block, so what used to be left behind was the program: ppid 1, a loop + with nobody to talk to, an agent socket nothing will ever connect to. + Eight of those were sitting on the machine this was written on, the + oldest six days old, and one had been minted by this suite. + + SIGKILL and not SIGTERM, and that is the difference between a test and a + test-shaped thing: SIGTERM lets the daemon tear down normally and kill + the child the way it always did, so the assertion below would be just as + green with the fix reverted. + + [dev-watch.flan] for the same reason, and it is the subtler half. The + daemon's read end of the program's stdout pipe is no longer inherited by + the program (see [two_process]), so a program that *prints* now takes + SIGPIPE on its next line once the daemon is gone and dies of that. That + is a welcome second net and it is not the mechanism: it does nothing for + a program that is quiet, which is most of them between frames. + dev-watch never writes to stdout — it spins on [agent/wait] and pushes + into the watch table — so the only thing that can end it here is the one + being tested. + + Its own daemon, because there is nothing left to ask a daemon after you + have killed it, and the source is one the suite has already built, so + the object cache answers and this costs a link. *) + let osock = tmp "orphan.sock" and oout = tmp "orphan.out" in + (try Sys.remove osock with Sys_error _ -> ()); + let ofd = + Unix.openfile oout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 + in + let opid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-watch.flan"; "-s"; osock; + "--two-process" |] + Unix.stdin ofd ofd + in + Unix.close ofd; + (* Gone, or a zombie nobody has collected yet. Both mean the process + stopped, and which one is visible depends on how promptly whoever + adopted the orphan gets round to reaping it — asserting only on the + /proc entry disappearing would make this flaky for a reason that has + nothing to do with what it tests. The state is the character two past + the last ')' and not the third field of a split, because the comm field + is parenthesised and may contain spaces. *) + let stopped_running pid = + match open_in (Printf.sprintf "/proc/%d/stat" pid) with + | exception Sys_error _ -> true + | ic -> + let line = try input_line ic with End_of_file -> "" in + close_in ic; + (match String.rindex_opt line ')' with + | Some i when i + 2 < String.length line -> line.[i + 2] = 'Z' + | _ -> true) + in + if not (listening ~pid:opid osock) then begin + fail "the orphan-watch daemon %s" !listen_why; + (try Unix.kill opid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + (* One round trip first, so that what is killed below is a daemon that + was demonstrably serving and a program that was demonstrably up. A + daemon that had already fallen over would strand nothing, and the + assertion would pass by having nothing to prove. *) + let oc = connect osock in + if status (Wire.parse (Wire.send oc "(:op \"describe\")"; Wire.recv oc)) + <> "ok" + then fail "the orphan-watch daemon would not describe itself"; + (* The program is a grandchild of this process, so [waitpid] on it is + ECHILD and /proc is the only place to look. [children] is the kernel's + own answer to "whose parent is this", which beats scanning /proc and + matching on a name — and it is read *before* the kill, because after + it the relationship it answers about no longer exists. *) + let kids = + match open_in (Printf.sprintf "/proc/%d/task/%d/children" opid opid) with + | exception Sys_error _ -> [] + | ic -> + let line = try input_line ic with End_of_file -> "" in + close_in ic; + List.filter_map int_of_string_opt (String.split_on_char ' ' line) + in + let program = + List.find_opt + (fun pid -> + match Unix.readlink (Printf.sprintf "/proc/%d/exe" pid) with + | link -> Filename.basename link = "program" + | exception Unix.Unix_error _ -> false) + kids + in + (try Unix.close oc with Unix.Unix_error _ -> ()); + (match program with + | None -> + fail "the --two-process daemon had no program child to strand"; + (try Unix.kill opid Sys.sigkill with Unix.Unix_error _ -> ()) + | Some child -> + (try Unix.kill opid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] opid) with Unix.Unix_error _ -> ()); + if not (await ~ms:5000 (fun () -> stopped_running child)) then begin + fail + "the program outlived the daemon that owned it: %d was still \ + running five seconds after the daemon was SIGKILLed" + child; + (try Unix.kill child Sys.sigkill with Unix.Unix_error _ -> ()) + end) + end; + (try ignore (Unix.waitpid [ Unix.WNOHANG ] opid) with Unix.Unix_error _ -> ()); + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ osock; oout ]; + (* A program that never calls [agent/start], which is the one condition on which the two shapes of [flan dev] deliberately disagree. [two_process] kills its child and [failwith]s: the program is a separate process, the diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 8006673..01a00f5 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -41,6 +41,7 @@ #include #include #include +#include #include #include #include @@ -49,6 +50,9 @@ #include #include #include +#if defined(__linux__) +#include +#endif typedef void (*install_fn)(void); @@ -1538,6 +1542,131 @@ static void *accept_loop(void *arg) { } } +/* ── Outliving the daemon, which this program must not do ──────────── */ + +/* Under [--two-process] the compiled program is a child of the daemon, and + * for the whole of its life the daemon is the only thing that will ever end + * it: the program is a game loop or a listener, it has no reason of its own to + * stop, and lib/dev.ml's [Fun.protect ~finally] is what kills it when the + * session closes. That finally block runs when the daemon exits. It does not + * run when the daemon is SIGKILLed — by a test harness tearing down after a + * failure, by a watchdog that fired, by anybody at all — and what is left + * behind is a program with ppid 1, sleeping, holding a window and a socket, + * waiting for requests from a process that no longer exists. Eight of those + * were found on one machine, the oldest six days old. Nothing would ever have + * woken them: there is no timeout anywhere in this file, and none should be + * added — a program between frames is supposed to wait indefinitely. + * + * So the child is told to die with its parent instead, which on Linux is one + * call. PR_SET_PDEATHSIG asks the kernel to deliver a signal to *this* process + * when the process that is currently its parent dies. It is exactly the right + * primitive and it has exactly one sharp edge, which is that it is armed from + * the child and so is armed a moment *after* the fork: if the parent died in + * that moment, the signal it would have sent has already not been sent, and + * the child waits forever having done everything right. The standard answer is + * the one below — arm, then ask who the parent is now, and if it is not the + * one that was expected, deliver the signal by hand. [getppid() == 1] is the + * form this idiom is usually written in and it is wrong here: under a systemd + * user session, or in a container with a subreaper, an orphan is reparented to + * the subreaper and not to init, so the test would pass and the child would + * still be stranded. The daemon therefore puts its own pid in the environment + * and this compares against that, which cannot be fooled by who does the + * adopting. + * + * FLAN_DEV_PARENT is a positive gate and is set by [two_process] and by + * nothing else. A merged build runs this same file and must never arm any of + * this: there the daemon *is* this process, its parent is whoever typed [flan + * dev] — a shell, an emacs, a terminal that is about to be closed — and none + * of those is the session's owner. A person who starts a daemon in one + * terminal and attaches an editor to it from another is doing a normal thing, + * and killing their live session because the shell exited would be a worse bug + * than the leak. Gating on the *absence* of a merged-build variable would have + * covered the same cases today and quietly stopped covering them the first + * time somebody added a third shape; this way the only process that arms is + * the one the daemon explicitly told to. + * + * The one gap left is the window before [agent/start]: a child SIGKILLed out + * from under during the first few milliseconds of its own startup is still + * stranded, because nothing has armed yet. It is not closed here because + * closing it means arming from flan_rt.c, which every program links and which + * would put a Linux-only prctl in the one file that also has to compile for + * wasm. The daemon already refuses to run a program that never reaches + * [agent/start], so every child that lives long enough to matter passes + * through here. */ + +#if defined(__linux__) && defined(SIGPWR) +#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, + * holding stdio's lock — so fprintf here would deadlock against itself and + * fflush(NULL) would deadlock against the other thread. write, unlink and + * _exit are on the async-signal-safe list and nothing else here is. + * + * Not flushing is a real cost and a small one: flan_rt_init sets stdout line + * buffered precisely so that a program's output is observable as it runs, so + * what is lost is at most a partial line. Losing it beats hanging. + * + * The socket is unlinked because this process bound it and no other process + * knows it is stale — the daemon that would have cleaned up is the thing that + * just died. Its directory is left alone: that belongs to the daemon, and + * tidying up someone else's directory from a signal handler is how a signal + * handler becomes a bug. + * + * Status 0, because nothing went wrong. The program did what it was told for + * as long as there was anybody to tell it. */ +static void orphan_die(int sig) { + static const char said[] = + "flan dev: the daemon that owns this program is gone, so the program is " + "stopping too\n"; + ssize_t ignored; + (void)sig; + ignored = write(2, said, sizeof said - 1); + (void)ignored; + if (orphan_sock[0] != '\0') unlink(orphan_sock); + _exit(0); +} +#endif + +static void watch_the_daemon(const char *sock) { +#if defined(FLAN_ORPHAN_SIG) + const char *want_s = getenv("FLAN_DEV_PARENT"); + char *end; + long want; + struct sigaction sa; + if (want_s == NULL || want_s[0] == '\0') return; + want = strtol(want_s, &end, 10); + if (end == want_s || *end != '\0' || want <= 0) return; + /* SIGPWR and not SIGTERM, and the collision it avoids is not hypothetical: + * lib/dev.ml's ordinary teardown kills this child with SIGTERM, and in + * --two-process the child's stderr *is* the daemon's stderr. A handler on + * SIGTERM would print "the daemon is gone" into the daemon's own output on + * every clean session close, which is both noise and a sentence that is only + * half true. A signal the program will never otherwise receive keeps the two + * deaths distinguishable, and leaves SIGTERM on its default disposition + * where the existing teardown already relies on it. */ + memset(&sa, 0, sizeof sa); + 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 +} + /* [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, @@ -1563,6 +1692,11 @@ int32_t flan_agent_start(const uint8_t *path, int64_t len) { 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. */