From def4414676791a0652923eff5b73570adb0462b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Lavergne?= Date: Mon, 7 Aug 2023 15:05:55 -0400 Subject: [PATCH] Remove window in which threads still got SIGINT/SIGHUP At least on OCaml 4.13.1's runtime, signals are spooled until any thread unblocks them, so we block them just before cloning, letting the thread inherit the mask, then we unblock. --- src/Tiny_httpd_server.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index f62331d2..6160d14b 100644 --- a/src/Tiny_httpd_server.ml +++ b/src/Tiny_httpd_server.ml @@ -935,7 +935,6 @@ module Unix_tcp_server_ = struct (* how to handle a single client *) let handle_client_unix_ (client_sock : Unix.file_descr) : unit = - ignore Unix.(sigprocmask SIG_BLOCK Sys.[ sigint; sighup ]); Unix.(setsockopt_float client_sock SO_RCVTIMEO self.timeout); Unix.(setsockopt_float client_sock SO_SNDTIMEO self.timeout); let oc = @@ -957,6 +956,7 @@ module Unix_tcp_server_ = struct try let client_sock, _ = Unix.accept sock in Unix.setsockopt client_sock Unix.TCP_NODELAY true; + ignore Unix.(sigprocmask SIG_BLOCK Sys.[ sigint; sighup ]); self.new_thread (fun () -> try handle_client_unix_ client_sock; @@ -964,7 +964,8 @@ module Unix_tcp_server_ = struct with e -> (try Unix.close client_sock with _ -> ()); Sem_.release 1 self.sem_max_connections; - raise e) + raise e); + ignore Unix.(sigprocmask SIG_UNBLOCK Sys.[ sigint; sighup ]); with e -> Sem_.release 1 self.sem_max_connections; _debug (fun k ->