Don't attempt read from closed fd in dune_rpc_lwt

This fixes a bug where RPC clients built with dune_rpc_lwt would crash
while disconnecting as they attempted to read from a channel whose
underlying file descriptor had been closed.

Also updates the dune-rpc-lwt expect test to expect the text "success"
to be printed by the client after its connection is closed. It wasn't
being printed prior to this change.

Signed-off-by: Stephen Sherratt <stephen@sherra.tt>

CHANGES.md

@@ -115,6 +115,9 @@ Unreleased
   would not be included whenever `(generate_opam_files true)` was set and the
   `.install` file wasn't yet generated. (#7547, @rgrinberg)
 
+- Fix bug where RPC clients built with dune-rpc-lwt would crash when closing
+  their connection to the server (#????, @gridbugs)
+
 3.7.1 (2023-04-04)
 ------------------
 

otherlibs/dune-rpc-lwt/src/dune_rpc_lwt.ml

@@ -42,35 +42,41 @@ module V1 = struct
       (struct
         type t = Lwt_io.input_channel * Lwt_io.output_channel
 
-        let read (i, _) =
-          let open Csexp.Parser in
-          let lexer = Lexer.create () in
-          let rec loop depth stack =
-            let* res = Lwt_io.read_char_opt i in
-            match res with
-            | None ->
-              Lexer.feed_eoi lexer;
-              Lwt.return_none
-            | Some c -> (
-              match Lexer.feed lexer c with
-              | Await -> loop depth stack
-              | Lparen -> loop (depth + 1) (Stack.open_paren stack)
-              | Rparen ->
-                let stack = Stack.close_paren stack in
-                let depth = depth - 1 in
-                if depth = 0 then
-                  let sexps = Stack.to_list stack in
-                  sexps |> List.hd |> Lwt.return_some
-                else loop depth stack
-              | Atom count ->
-                let* atom =
-                  let bytes = Bytes.create count in
-                  let+ () = Lwt_io.read_into_exactly i bytes 0 count in
-                  Bytes.to_string bytes
-                in
-                loop depth (Stack.add_atom atom stack))
-          in
-          loop 0 Stack.Empty
+        let read (i, o) =
+          (* The input and output channels share the same file descriptor. If
+             the output channel has been closed, reading from the input channel
+             will result in an error, so explicitly check if the output channel
+             is open before proceeding. *)
+          if Lwt_io.is_closed o then Lwt.return_none
+          else
+            let open Csexp.Parser in
+            let lexer = Lexer.create () in
+            let rec loop depth stack =
+              let* res = Lwt_io.read_char_opt i in
+              match res with
+              | None ->
+                Lexer.feed_eoi lexer;
+                Lwt.return_none
+              | Some c -> (
+                match Lexer.feed lexer c with
+                | Await -> loop depth stack
+                | Lparen -> loop (depth + 1) (Stack.open_paren stack)
+                | Rparen ->
+                  let stack = Stack.close_paren stack in
+                  let depth = depth - 1 in
+                  if depth = 0 then
+                    let sexps = Stack.to_list stack in
+                    sexps |> List.hd |> Lwt.return_some
+                  else loop depth stack
+                | Atom count ->
+                  let* atom =
+                    let bytes = Bytes.create count in
+                    let+ () = Lwt_io.read_into_exactly i bytes 0 count in
+                    Bytes.to_string bytes
+                  in
+                  loop depth (Stack.add_atom atom stack))
+            in
+            loop 0 Stack.Empty
 
         let write (_, o) = function
           | None -> Lwt_io.close o

otherlibs/dune-rpc-lwt/test/dune_rpc_lwt_tests.ml

@@ -118,7 +118,8 @@ let%expect_test "run and connect" =
     {|
     started session
     received ping. shutting down.
-    dune build finished with 0 |}]
+    dune build finished with 0
+    success |}]
 
 module Logger = struct
   (* A little helper to make the output from the client and server