diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index 946e14d..63c7a5b 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -149,8 +149,16 @@ static uint64_t generation; void flan_dev_result_begin(void) { /* Odd first, and only then the reset: the counter has to say "in progress" - * before the buffer stops being the value it used to be. */ - __atomic_store_n(&generation, generation + 1, __ATOMIC_RELEASE); + * before the buffer stops being the value it used to be. + * + * The fence is the half of that a release *store* cannot do. A release store + * orders what comes before it, not what comes after, so the writes below — + * and every memcpy in [emit] — would be free to become visible ahead of the + * odd count, and a reader could see an even count either side of a copy it + * made while the buffer was being overwritten. Which is the bug this + * replaced, with more ceremony. So: mark it relaxed, fence, then write. */ + __atomic_store_n(&generation, generation + 1, __ATOMIC_RELAXED); + __atomic_thread_fence(__ATOMIC_RELEASE); result_len = 0; result_full = 0; } @@ -244,6 +252,12 @@ void flan_dev_result_end(void) { * [cap] is the caller's buffer. A value longer than it is truncated, which is * the only failure this can have and is a clamp rather than an overrun; the * agent sizes its buffer at RESULT_MAX so it does not arise. */ +/* What a caller's buffer has to be for the copy never to be truncated. The + * bound is declared in one place and asked for rather than written down twice: + * the agent's buffer and this one agreeing is the whole of "never truncated", + * and two literals in two files is how that stops being true. */ +uint64_t flan_dev_result_cap(void) { return RESULT_MAX; } + int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen, uint64_t *len) { for (int attempt = 0; attempt < 64; attempt++) { diff --git a/test/programs/agent-longname.flan b/test/programs/agent-longname.flan new file mode 100644 index 0000000..c1a7d2f --- /dev/null +++ b/test/programs/agent-longname.flan @@ -0,0 +1,15 @@ +;;;; The agent's condition_name[128], which had no coverage at all: it is on +;;;; the socket path, so nothing in the sanitizer corpus can reach it. +;;;; +;;;; The condition class here is 200 characters, so the copy into that buffer +;;;; has to clamp, and [status] answers with the 127 that fit. The name is ugly +;;;; on purpose — its length is the whole of the test. +(import agent "vendor:agent") + +(defstruct MissingYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY [id i32]) + +(defn main [] i32 + ;; The path is overridden by FLAN_AGENT_SOCKET; a program has to name one. + (agent/start "/tmp/flan-longname.sock") + (error (MissingYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY {:id 1})) + 0) diff --git a/test/programs/agent-queue.flan b/test/programs/agent-queue.flan index 23e25e9..6d98ec6 100644 --- a/test/programs/agent-queue.flan +++ b/test/programs/agent-queue.flan @@ -33,4 +33,11 @@ ;; is the whole claim: a ring that overwrote the slot it was reading ;; would answer with something else. (print (agent/poll)) (println "") + ;; Round two: one evaluated expression, whose rendering is longer + ;; than the 4K the dev runtime will hold. The program has to still be + ;; here afterwards for the value to be read back off the socket, so + ;; it waits a third time and leaves on end of file. + (stdin-byte) + (print (agent/poll)) (println "") + (stdin-byte) 0))))) diff --git a/test/test_agent.ml b/test/test_agent.ml index 1e9f4e4..86a4108 100644 --- a/test/test_agent.ml +++ b/test/test_agent.ml @@ -315,7 +315,11 @@ let () = in if Sys.command cc <> 0 then fail "could not build noinstall.so" else begin - let rfd, wfd = Unix.pipe () in + (* Close-on-exec, or the child inherits the write end and its own stdin + never reaches end of file: the program would sit in its last read + waiting for a byte only it could send. The read end is dup'd onto fd 0 + by [create_process], which clears the flag on the copy. *) + let rfd, wfd = Unix.pipe ~cloexec:true () in let qfd = Unix.openfile qout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in @@ -359,6 +363,51 @@ let () = (* Let it poll. Every slot the ring kept is installed here, so the number is how many survived — 64, not 65 and not some torn count. *) ignore (Unix.write wfd (Bytes.of_string "\n") 0 1); + if not (await (fun () -> has "64")) then + fail "the ring never drained: %S" (qtext ()) + else begin + (* ── The 4K result cap ─────────────────────────────────────── + + NEXT.md names this buffer twice as having no coverage at all, + because it is on the agent's path and so needs a socket. There is + a socket here. The value is a 5000-byte string literal, which is + longer than anything [emit] will keep, so what comes back is the + clamp and the ellipsis [result_end] puts there to say it clamped + — and it comes back through the seqlock's copy rather than off a + borrowed pointer. *) + let long = String.make 5000 'x' in + let ec = Session.eval_expr qt ("\"" ^ long ^ "\"") in + let eso = tmp "queue-eval.so" in + ignore (Build.shared ~opts:dev ~ir:ec.Session.ir ~out:eso ()); + let r = send qsock eso in + if r <> "ok\n" then fail "the eval module was not queued: %S" r; + ignore (Unix.write wfd (Bytes.of_string "\n") 0 1); + if not (await (fun () -> has "1")) then + fail "the eval thunk never ran: %S" (qtext ()) + else begin + let reply = send qsock "result" in + match String.index_opt reply '\n' with + | None -> fail "no result header: %S" reply + | Some i -> + let hdr = String.sub reply 0 i in + let body = + String.sub reply (i + 1) (String.length reply - i - 1) + in + (* Exactly the cap, ellipsis included: [result_end] makes room + for it rather than assuming there is any. *) + if String.length body <> 4096 then + fail "the 4K result cap: %d bytes back, header %S" + (String.length body) hdr; + if String.length body >= 3 + && String.sub body (String.length body - 3) 3 <> "..." then + fail "a clamped result did not say so: %S" + (String.sub body (String.length body - 8) 8); + if String.length body < 2 || String.sub body 0 2 <> "\"x" then + fail "the result is not the value that was rendered: %S" + (String.sub body 0 8) + end; + (try Sys.remove eso with Sys_error _ -> ()) + end; Unix.close wfd; let qstatus = ref (Unix.WEXITED 0) in let reaped = @@ -377,16 +426,75 @@ let () = (List.filter (fun l -> l <> "") (String.split_on_char '\n' (qtext ()))) in - if !qstatus <> Unix.WEXITED 0 || got <> "ready\nunloaded\n64" then + if !qstatus <> Unix.WEXITED 0 || got <> "ready\nunloaded\n64\n1" then fail "job ring\n got: %S\n wanted: %S" got - "ready\nunloaded\n64" + "ready\nunloaded\n64\n1" end end end; + (* ── condition_name[128] ────────────────────────────────────────── *) + + (* The other named buffer with no coverage at all, and it needs a socket + for the same reason: nothing but [status] ever reads it. The condition + class is 198 characters, so what comes back is the 127 that fit and a + terminator — a clamp, not an overrun, and now measured rather than + read. Aborting out of it also pins that the break loop's way out is + still exit status 134 now that it takes it with _exit. *) + let lsock = tmp "long.sock" and lout = tmp "long.out" in + (try Sys.remove lsock with Sys_error _ -> ()); + let lt, ll = Session.create ~file:"programs/agent-longname.flan" () in + let lexe = tmp "long" in + ignore + (Build.executable ~opts:dev ~csrcs:ll.Load.csrcs ~lflags:ll.Load.lflags + lt.Session.host ~out:lexe); + let lfd = Unix.openfile lout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let lenv = + Array.append (Unix.environment ()) [| "FLAN_AGENT_SOCKET=" ^ lsock |] + in + let lpid = Unix.create_process_env lexe [| lexe |] lenv Unix.stdin lfd lfd in + Unix.close lfd; + let stopped = ref "" in + if not + (await (fun () -> + Sys.file_exists lsock + && (stopped := send lsock "status"; + String.length !stopped > 8 + && String.sub !stopped 0 8 = "stopped "))) + then begin + fail "the long-named condition never stopped: %S" !stopped; + (try Unix.kill lpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let got = String.trim (String.sub !stopped 8 (String.length !stopped - 8)) in + if String.length got <> 127 then + fail "condition_name clamps at 127: got %d characters" + (String.length got); + if String.length got >= 7 && String.sub got 0 7 <> "Missing" then + fail "the clamped name is not the condition's: %S" got; + ignore (send lsock "abort"); + let lstatus = ref (Unix.WEXITED 0) in + let reaped = + await ~ms:5000 (fun () -> + match Unix.waitpid [ Unix.WNOHANG ] lpid with + | 0, _ -> false + | _, s -> lstatus := s; true) + in + if not reaped then begin + (try Unix.kill lpid Sys.sigkill with Unix.Unix_error _ -> ()); + fail "abort did not end the program" + end + else if !lstatus <> Unix.WEXITED 134 then + fail "abort left status %s, wanted exit 134" + (match !lstatus with + | Unix.WEXITED c -> Printf.sprintf "exit %d" c + | Unix.WSIGNALED c -> Printf.sprintf "signal %d" c + | Unix.WSTOPPED c -> Printf.sprintf "stopped %d" c) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ exe; so1; so2; sock; out; bsock; bout; bexe; qexe; qso; qsock; qout; - noinstall ]; + noinstall; lexe; lsock; lout ]; if !failures = 0 then print_endline "agent: all tests passed" else begin Printf.printf "\n%d failure(s)\n" !failures; diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 60f49f2..fedb300 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -56,7 +56,9 @@ typedef void (*call_fn)(void); * complete generation and no bytes, which leaves the daemon polling rather * than showing it half a value. */ #define RESULT_MAX 4096 -int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen, uint64_t *len); +int flan_dev_result_read(char *dst, uint64_t cap, uint64_t *gen, + uint64_t *len); +uint64_t flan_dev_result_cap(void); /* A ring the listener writes and the game thread reads. One producer, one * consumer, so two atomics and no lock — the game thread must never block on @@ -627,6 +629,14 @@ static void serve(int fd) { if (strcmp(line, "result") == 0) { uint64_t gen = 0, len = 0; char v[RESULT_MAX]; + /* The one thing that could make the copy truncate, checked where it + * would happen rather than trusted to two files holding the same + * number. */ + if (flan_dev_result_cap() > sizeof v) { + reply(fd, "err the agent's result buffer is smaller than the " + "runtime's\n"); + return; + } flan_dev_result_read(v, sizeof v, &gen, &len); char hdr[64]; int k = snprintf(hdr, sizeof hdr, "%llu %llu\n", (unsigned long long)gen,