From 1ca1f3dff9a9929e094d82217bc75f13f9fc00d7 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 4 Aug 2023 11:01:24 -0400 Subject: [PATCH 1/6] fix: wait for threads to terminate when shutting down server --- src/Tiny_httpd_server.ml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index e59fa360..b1d6fcd0 100644 --- a/src/Tiny_httpd_server.ml +++ b/src/Tiny_httpd_server.ml @@ -970,6 +970,9 @@ module Unix_tcp_server_ = struct k "Unix.accept or Thread.create raised an exception: %s" (Printexc.to_string e)) done; + + (* Wait for all threads to be done: this only works if all threads are done. *) + Sem_.acquire self.sem_max_connections.max self.sem_max_connections; ()); } end From a7516689b1183446d443362552cb57759447d519 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Lavergne?= Date: Mon, 7 Aug 2023 10:49:04 -0400 Subject: [PATCH 2/6] Stop listening after accept loop --- src/Tiny_httpd_server.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index b1d6fcd0..87ee9012 100644 --- a/src/Tiny_httpd_server.ml +++ b/src/Tiny_httpd_server.ml @@ -972,6 +972,7 @@ module Unix_tcp_server_ = struct done; (* Wait for all threads to be done: this only works if all threads are done. *) + Unix.close sock; Sem_.acquire self.sem_max_connections.max self.sem_max_connections; ()); } From d8234b0189258fd0a34f8cc86d7567d6c66375ef Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Lavergne?= Date: Mon, 7 Aug 2023 10:49:42 -0400 Subject: [PATCH 3/6] Don't let threads handle SIGINT/SIGHUP It's common for applications to use these signals to trigger a graceful shutdown. --- src/Tiny_httpd_server.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index 87ee9012..f62331d2 100644 --- a/src/Tiny_httpd_server.ml +++ b/src/Tiny_httpd_server.ml @@ -935,6 +935,7 @@ 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 = 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 4/6] 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 -> From b36ea35703ac4c634ef27f6d92424737f80d1642 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Lavergne?= Date: Tue, 8 Aug 2023 14:22:55 -0400 Subject: [PATCH 5/6] Clarify why we do SIGINT/SIGHUP shenanigans --- src/Tiny_httpd_server.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index 6160d14b..31ca7edf 100644 --- a/src/Tiny_httpd_server.ml +++ b/src/Tiny_httpd_server.ml @@ -956,6 +956,8 @@ module Unix_tcp_server_ = struct try let client_sock, _ = Unix.accept sock in Unix.setsockopt client_sock Unix.TCP_NODELAY true; + (* Block INT/HUP while cloning to avoid children handling them. + When thread gets them, our Unix.accept raises neatly. *) ignore Unix.(sigprocmask SIG_BLOCK Sys.[ sigint; sighup ]); self.new_thread (fun () -> try From 572168967f8a8331a67205123f9b395b575ff29f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Tue, 8 Aug 2023 14:41:58 -0400 Subject: [PATCH 6/6] remove last qtest --- src/Tiny_httpd_server.ml | 18 +----------------- tests/unit/dune | 2 +- tests/unit/t_server.ml | 23 +++++++++++++++++++++++ 3 files changed, 25 insertions(+), 18 deletions(-) create mode 100644 tests/unit/t_server.ml diff --git a/src/Tiny_httpd_server.ml b/src/Tiny_httpd_server.ml index 31ca7edf..17f5b364 100644 --- a/src/Tiny_httpd_server.ml +++ b/src/Tiny_httpd_server.ml @@ -349,22 +349,6 @@ module Request = struct end end -(*$R - let q = "GET hello HTTP/1.1\r\nHost: coucou\r\nContent-Length: 11\r\n\r\nsalutationsSOMEJUNK" in - let str = Tiny_httpd.Byte_stream.of_string q in - let r = Request.Internal_.parse_req_start ~get_time_s:(fun _ -> 0.) str in - match r with - | None -> assert_failure "should parse" - | Some req -> - assert_equal (Some "coucou") (Headers.get "Host" req.Request.headers); - assert_equal (Some "coucou") (Headers.get "host" req.Request.headers); - assert_equal (Some "11") (Headers.get "content-length" req.Request.headers); - assert_equal "hello" req.Request.path; - let req = Request.Internal_.parse_body req str |> Request.read_body_full in - assert_equal ~printer:(fun s->s) "salutations" req.Request.body; - () -*) - module Response = struct type body = [ `String of string @@ -967,7 +951,7 @@ module Unix_tcp_server_ = struct (try Unix.close client_sock with _ -> ()); Sem_.release 1 self.sem_max_connections; raise e); - ignore Unix.(sigprocmask SIG_UNBLOCK Sys.[ sigint; sighup ]); + ignore Unix.(sigprocmask SIG_UNBLOCK Sys.[ sigint; sighup ]) with e -> Sem_.release 1 self.sem_max_connections; _debug (fun k -> diff --git a/tests/unit/dune b/tests/unit/dune index 329becc8..c6944d20 100644 --- a/tests/unit/dune +++ b/tests/unit/dune @@ -1,5 +1,5 @@ (tests - (names t_util t_buf) + (names t_util t_buf t_server) (package tiny_httpd) (libraries tiny_httpd qcheck-core qcheck-core.runner test_util)) diff --git a/tests/unit/t_server.ml b/tests/unit/t_server.ml new file mode 100644 index 00000000..ef85e9be --- /dev/null +++ b/tests/unit/t_server.ml @@ -0,0 +1,23 @@ +open Test_util +open Tiny_httpd_server + +let () = + let q = + "GET hello HTTP/1.1\r\n\ + Host: coucou\r\n\ + Content-Length: 11\r\n\ + \r\n\ + salutationsSOMEJUNK" + in + let str = Tiny_httpd.Byte_stream.of_string q in + let r = Request.Internal_.parse_req_start ~get_time_s:(fun _ -> 0.) str in + match r with + | None -> failwith "should parse" + | Some req -> + assert_eq (Some "coucou") (Headers.get "Host" req.Request.headers); + assert_eq (Some "coucou") (Headers.get "host" req.Request.headers); + assert_eq (Some "11") (Headers.get "content-length" req.Request.headers); + assert_eq "hello" req.Request.path; + let req = Request.Internal_.parse_body req str |> Request.read_body_full in + assert_eq ~to_string:(fun s -> s) "salutations" req.Request.body; + ()