Commits

Dmitry Grebeniuk  committed 0153395

IO_Lwt.establish_server: ignoring SIGPIPE in server loop

  • Participants
  • Parent commits 9a8aae6

Comments (0)

Files changed (1)

    - to revised syntax,
    - more strict code (no more warnings),
    - added "wait_server"
+   - ignoring SIGPIPE in server loop
  *)
 
 type server =
 value wait_server server = server.wait_server
 ;
 
+value sys_signal_or_default signal beh =
+  try Sys.signal signal beh with
+  [ Invalid_argument _ -> Sys.Signal_default ]
+;
+
 value establish_server ?buffer_size ?(backlog=5) sockaddr f =
-  let sock = Lwt_unix.socket (Unix.domain_of_sockaddr sockaddr) Unix.SOCK_STREAM 0 in
+  let sock = Lwt_unix.socket
+    (Unix.domain_of_sockaddr sockaddr) Unix.SOCK_STREAM 0 in
   let () =
     ( Lwt_unix.setsockopt sock Unix.SO_REUSEADDR True
     ; Lwt_unix.bind sock sockaddr
   let (abort_waiter, abort_wakener) = Lwt.wait () in
   let (finish_waiter, finish_wakener) = Lwt.wait () in
   let abort_waiter = abort_waiter >>= fun [`Shutdown -> return `Shutdown] in
+  let old_sigpipe_beh = sys_signal_or_default Sys.sigpipe Sys.Signal_ignore in
+  let sigpipe_finally () =
+    ignore
+      ( (sys_signal_or_default Sys.sigpipe old_sigpipe_beh)
+        : Sys.signal_behavior
+      )
+  in
   let rec loop () =
     Lwt.pick
       [ Lwt_unix.accept sock >>= fun x -> return (`Accept x)
                 return ()
             ]
           ) >>= fun () ->
+          let () = sigpipe_finally () in
           return (Lwt.wakeup finish_wakener ())
       ]
   in
-  ( ignore (loop ())
+  ( ignore (Lwt.catch loop (fun e -> (sigpipe_finally (); raise e)))
   ; { shutdown = lazy (Lwt.wakeup abort_wakener `Shutdown)
     ; wait_server = finish_waiter
     }
 
 (********************************************************)
 
-(*
-value establish_server ?buffer_size ?backlog sa func =
-  Lwt_io.establish_server ?buffer_size ?backlog sa func
-;
-
-value shutdown_server = Lwt_io.shutdown_server
-;
-*)
-
-
 value run_and_ignore_result = Lwt.ignore_result
 ;
 
-
 (********************************************************)
 
 module Sequence_Sequential