Commits

Dmitry Grebeniuk  committed bbca70f

now server.wait_server gives either Lwt.t unit on normal shutdown or lwt error on exception in server loop

  • Participants
  • Parent commits f6a445c

Comments (0)

Files changed (1)

         : Sys.signal_behavior
       )
   in
+  let do_shutdown res =
+    let () = if server_debug then dbg "shutdown" else () in
+    Lwt_unix.close sock >>= fun () ->
+    let () = if server_debug then dbg "socket closed" else () in
+    (match sockaddr with
+      [ Unix.ADDR_UNIX path when path <> "" && path.[0] <> '\x00' ->
+          ( Unix.unlink path
+          ; return ()
+          )
+      | Unix.ADDR_UNIX _ | Unix.ADDR_INET _ ->
+          return ()
+      ]
+    ) >>= fun () ->
+    let () = sigpipe_finally () in
+    return (Lwt.wakeup finish_wakener res)
+  in
   let rec loop () =
     let () = if server_debug then dbg "loop" else () in
     Lwt.pick
           loop ()
       | `Shutdown ->
           let () = if server_debug then dbg "`Shutdown" else () in
-          Lwt_unix.close sock >>= fun () ->
-          let () = if server_debug then dbg "socket closed" else () in
-          (match sockaddr with
-            [ Unix.ADDR_UNIX path when path <> "" && path.[0] <> '\x00' ->
-                ( Unix.unlink path
-                ; return ()
-                )
-            | Unix.ADDR_UNIX _ | Unix.ADDR_INET _ ->
-                return ()
-            ]
-          ) >>= fun () ->
-          let () = sigpipe_finally () in
-          return (Lwt.wakeup finish_wakener ())
+          do_shutdown (`Ok ())
       | _ ->
           let () = if server_debug then dbg "not `Accept|`Shutdown" else () in
           raise Exit
              ( if server_debug
                then dbg "exception in loop: %s" (Printexc.to_string e)
                else ()
-             ; sigpipe_finally ()
-             ; raise e
+             ; do_shutdown (`Error e)
              )
           ) >>= fun () ->
         let () = if server_debug then dbg "after 'catch loop'" else () in
         return ()
       )
   ; { shutdown = lazy (Lwt.wakeup abort_wakener `Shutdown)
-    ; wait_server = finish_waiter
+    ; wait_server =
+        finish_waiter >>= fun res ->
+        match res with
+        [ `Ok () -> return ()
+        | `Error e -> error e
+        ]
     }
   )
 ;