Take the abort, and refuse a name that is two requests

Every check of `abort' so far was of it being refused while the program runs.
The accepted path -- the one that ends a program -- was code that had never
run and answered `ok'. So the break block breaks its program once more, by
installing a `step' that errors into the loop that calls it, and takes the
exit: the daemon owns the program's lifetime, so no `close' is sent and the
daemon coming down on its own is the assertion.

And `restart' refuses a name with a control character in it. The agent's
contract is one line per request; a newline in a name is a second request
smuggled into the first. `completing-read' with require-match cannot produce
one, but the guarantee belongs to the end holding the socket, and an editor
is not the only thing that can speak to it.

lib/dev.ml

@@ -410,6 +410,13 @@ let break t =
    find it stopped, and re-open the prompt it had just answered. *)
 let choose t ~name =
   if not (alive t) then error "the program exited; restart flan dev"
+  else if String.exists (fun c -> Char.code c < 32 || Char.code c = 127) name then
+    (* The agent's contract is one line per request. A name carrying a newline
+       would be a second request smuggled into the first, and the guarantee is
+       this end's to keep: [completing-read] cannot produce one, but the daemon
+       is what holds the socket and an editor is not the only thing that can
+       speak to it. *)
+    error "a restart name cannot contain a control character"
   else
     match ask t ("restart " ^ name) with
     | reply when String.trim reply = "ok" ->

test/test_dev.ml

@@ -371,9 +371,42 @@ let () =
                 (Option.value ~default:(status r) (Wire.string_field r "message"))
         end
       end;
-      ignore (ask "(:op \"close\")");
+      (* ...and the other way out. Every check above is of an abort being
+         *refused*; the accepted path is the one that must not be left as code
+         that has never run, because it is the one that ends a program. Break
+         it once more — the daemon's own program calls [step] every time round
+         its loop, so a body that errors stops it — and take the exit. *)
+      (match
+         ask
+           "(:op \"eval\" :code \"(defn step [] i64 (restart-case (do (error (Missing {:id 9})) 0) (use-placeholder [] -1)))\" :file \"/tmp/buf.flan\")"
+       with
+       | r when status r <> "ok" ->
+         fail "installing a body that errors: %s"
+           (Option.value ~default:"" (Wire.string_field r "message"))
+       | _ ->
+         if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then
+           fail "the program never stopped on the body that errors"
+         else begin
+           let r = ask "(:op \"abort\")" in
+           if status r <> "ok" then
+             fail "abort was refused by a stopped program: %s"
+               (Option.value ~default:"" (Wire.string_field r "message"))
+         end);
       Unix.close c;
-      ignore (Unix.waitpid [] bpid)
+      (* No [close] op: an abort ends the program, and the daemon owns the
+         program's lifetime, so it comes down on its own. A daemon still
+         running here would be one waiting on a socket nobody will use. *)
+      if not
+           (await ~ms:5000 (fun () ->
+              match Unix.waitpid [ Unix.WNOHANG ] bpid with
+              | 0, _ -> false
+              | _ -> true
+              | exception Unix.Unix_error _ -> true))
+      then begin
+        fail "the daemon outlived the program it aborted";
+        (try Unix.kill bpid Sys.sigkill with Unix.Unix_error _ -> ());
+        (try ignore (Unix.waitpid [] bpid) with Unix.Unix_error _ -> ())
+      end
     end;
     List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
       [ sock; out; bsock; bout ];