An editor that leaves mid-reply is a closed connection, not a dead session

SIGPIPE's default action was killing the daemon outright. In the merged
build that is the program, the compiler and the listener at once, and the
socket file is left behind - so the next client got ECONNREFUSED on a path
that exists, which reads like anything but what it is.

Two halves: ignore the signal where the listening socket is bound, and
guard the reply write, because an [exception] case on a [match] covers the
scrutinee and not the branch body, so the EPIPE went past both handlers
below it and out of the accept loop.

test_emacs.ml keeps the daemon's wait status and the program's output on a
failure now, instead of removing the evidence before reading the exit code.
This commit is contained in:
Joseph Ferano 2026-09-14 07:59:03 +07:00
parent 330bfa1578
commit fbafee4957
2 changed files with 83 additions and 8 deletions

View File

@ -2410,13 +2410,39 @@ let serve t fd =
| r -> r
| exception e when not (fatal e) -> reply
in
Wire.send fd annotated;
if op = Some "close" then true else go ()
(* The write is guarded and the guard is not decoration: an [exception]
case on a [match] covers the scrutinee only, so before this an [EPIPE]
here went straight past the two below and out of the accept loop,
ending the session. An editor that left before its reply arrived is a
closed connection and nothing more, which is what [false] says. *)
(match Wire.send fd annotated with
| () -> if op = Some "close" then true else go ()
| exception Unix.Unix_error _ -> false)
| exception Wire.Closed -> false
| exception Unix.Unix_error _ -> false
in
go ()
(* An editor that goes away between its request and the reply to it leaves this
process writing into a socket with no reader, and a write into a socket with
no reader is SIGPIPE whose default action is to kill the process. In the
two-process daemon that would lose the session; in the merged build it kills
the program, the compiler and the listener together, and leaves the socket
file behind for the next client to get ECONNREFUSED on. That is not a
theoretical shape: `M-x flan-dev' reconnects a dead connection, Emacs tears
the old process down when it does, and a reply already on its way out lands
in the gap.
Ignored rather than handled, because [serve] already treats a failed write
as a closed connection: with the signal out of the way [Wire.send] raises
[EPIPE] like any other [Unix_error], the connection is dropped, and the
accept loop goes back to waiting for the next one. The program's own
listener in flan_agent.c reached the same conclusion from the other side and
passes MSG_NOSIGNAL; this is that decision for the half written in OCaml. *)
let ignore_sigpipe () =
try Sys.set_signal Sys.sigpipe Sys.Signal_ignore
with Invalid_argument _ -> ()
(* [accept] would block past the program's own exit, so it is waited on with
a timeout and the child checked each time round: a daemon whose program has
finished has nothing left to do, and an editor waiting on it would wait
@ -2511,6 +2537,7 @@ let two_process ?(debug = false) ~file ~sock () =
out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32;
host_ll; host_exe = exe; finished = false }
in
ignore_sigpipe ();
(try Unix.unlink sock with Unix.Unix_error _ -> ());
let ls = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Unix.bind ls (Unix.ADDR_UNIX sock);
@ -2925,6 +2952,7 @@ let merged_setup () =
out = Buffer.create 4096; n = 0; gen = 0; owners = Hashtbl.create 32;
host_ll; host_exe = exe; finished = false }
in
ignore_sigpipe ();
(try Unix.unlink sock with Unix.Unix_error _ -> ());
let ls = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Unix.bind ls (Unix.ADDR_UNIX sock);

View File

@ -63,9 +63,14 @@ let () =
else if not (have "clang" && have "llc") then
print_endline "emacs: skipped (no clang or llc on PATH)"
else begin
let sock = tmp "dev.sock" and out = tmp "prog.out" in
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ];
let sock = tmp "dev.sock" and out = tmp "prog.out" and err = tmp "dev.err" in
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out; err ];
let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
(* The daemon's stderr to a file rather than inherited: it carries the
"ready on" line and any OCaml backtrace, and a failure here wants both
quoted next to the client's complaint rather than interleaved with
whatever else dune was running. *)
let efd = Unix.openfile err [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
let flan = "../bin/main.exe" in
(* Absolute, because the client starts its own daemon at the end of the run
and does it from the program's directory rather than from this one. *)
@ -80,9 +85,10 @@ let () =
let pid =
Unix.create_process flan
[| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock |]
Unix.stdin fd Unix.stderr
Unix.stdin fd efd
in
Unix.close fd;
Unix.close efd;
(* Thirty seconds and not the 8s default: this waits on an llc-and-link of
the whole program, ~0.5s warm and 2s cold, worst measured at 6.8s with
this suite's other binaries running beside it. The watchdog bounds the
@ -113,20 +119,61 @@ let () =
in
(* The client disconnects at the end, which is what ends the daemon. If it
did not get that far because it failed nothing else will, so it is
stopped here rather than left waiting on a socket nobody will use. *)
stopped here rather than left waiting on a socket nobody will use.
The wait *status* is kept, and not thrown away as it used to be, because
it is the one fact that tells the two failure shapes apart. A daemon
that exited on its own runs its cleanup and unlinks the socket, and the
client then says "nothing is listening"; a daemon killed by a signal
never gets that far, leaves the socket file behind, and the client gets
an ECONNREFUSED it cannot explain. Two diagnoses of this flake have
already been wrong for want of this line. *)
let status = ref None in
if not (await ~ms:3000 (fun () ->
match Unix.waitpid [ Unix.WNOHANG ] pid with
| 0, _ -> false
| _ -> true
| _, st -> status := Some st; true
| exception Unix.Unix_error _ -> true))
then begin
(try Unix.kill pid Sys.sigterm with Unix.Unix_error _ -> ());
(try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ())
end;
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out; buf ];
let how =
match !status with
| Some (Unix.WEXITED n) -> Printf.sprintf "exited with status %d" n
| Some (Unix.WSIGNALED n) ->
Printf.sprintf "was killed by signal %d — nothing ran its cleanup, so \
the socket file is stale rather than gone" n
| Some (Unix.WSTOPPED n) -> Printf.sprintf "stopped on signal %d" n
| None -> "was still running when the client finished, and was terminated"
in
(* Read before the removal below, because on a failure this is the evidence
and the removal is what destroyed it last time. *)
let tail_of path =
match open_in_bin path with
| ic ->
let n = in_channel_length ic in
let want = min n 4000 in
seek_in ic (n - want);
let s = really_input_string ic want in
close_in ic;
s
| exception Sys_error _ -> "<no such file>"
in
let sock_left = Sys.file_exists sock in
let prog_out = if code = 0 then "" else tail_of out in
let daemon_err = if code = 0 then "" else tail_of err in
List.iter
(fun f -> try Sys.remove f with Sys_error _ -> ())
[ sock; out; err; buf ];
if code = 0 then print_endline "emacs: all tests passed"
else begin
Printf.printf "\nemacs client exited %d\n" code;
Printf.printf "the daemon %s\n" how;
Printf.printf "%s was %s after the run\n" sock
(if sock_left then "still there" else "gone");
Printf.printf "\n-- the program's own output, last 4k --\n%s\n" prog_out;
Printf.printf "\n-- the daemon's stderr, last 4k --\n%s\n" daemon_err;
exit 1
end
end