From 6ccd8314a338adfe44e0590201012035ceb47d87 Mon Sep 17 00:00:00 2001
From: craff <christophe@raffalli.eu>
Date: Mon, 29 Nov 2021 15:35:41 -1000
Subject: [PATCH 1/3] Unix.accept may raise an exception (typicall Unix.EINTR,
 even with sigpipe blocked ?) This avoids the server to stop

---
 src/Tiny_httpd.ml | 26 +++++++++++++++-----------
 1 file changed, 15 insertions(+), 11 deletions(-)

diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml
index 38f11ccc..7688d3c3 100644
--- a/src/Tiny_httpd.ml
+++ b/src/Tiny_httpd.ml
@@ -1088,17 +1088,21 @@ let run (self:t) : (unit,_) result =
     while self.running do
       (* limit concurrency *)
       Sem_.acquire 1 self.sem_max_connections;
-      let client_sock, _ = Unix.accept sock in
-      self.new_thread
-        (fun () ->
-           try
-             handle_client_ self client_sock;
-             Sem_.release 1 self.sem_max_connections;
-           with e ->
-             (try Unix.close client_sock with _ -> ());
-             Sem_.release 1 self.sem_max_connections;
-             raise e
-        );
+      try
+        let client_sock, _ = Unix.accept sock in
+        self.new_thread
+          (fun () ->
+            try
+              handle_client_ self client_sock;
+              Sem_.release 1 self.sem_max_connections;
+            with e ->
+              (try Unix.close client_sock with _ -> ());
+              Sem_.release 1 self.sem_max_connections;
+              raise e
+          );
+      with e ->
+        Printf.eprintf "accept raised an exception: %s"
+           (Printexc.to_string e)
     done;
     Ok ()
   with e -> Error e

From 50f225638dd20713e208eec55257ae5a0994bbf0 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Mon, 29 Nov 2021 22:37:19 -0500
Subject: [PATCH 2/3] Update src/Tiny_httpd.ml

---
 src/Tiny_httpd.ml | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml
index 7688d3c3..fc5cfb93 100644
--- a/src/Tiny_httpd.ml
+++ b/src/Tiny_httpd.ml
@@ -1101,8 +1101,7 @@ let run (self:t) : (unit,_) result =
               raise e
           );
       with e ->
-        Printf.eprintf "accept raised an exception: %s"
-           (Printexc.to_string e)
+        _debug (fun k->k "accept raised an exception: %s" (Printexc.to_string e))
     done;
     Ok ()
   with e -> Error e

From 19a4bad231226dd56d5444a7dac9a67b5d7a0e8c Mon Sep 17 00:00:00 2001
From: craff <christophe@raffalli.eu>
Date: Mon, 29 Nov 2021 23:38:28 -1000
Subject: [PATCH 3/3] use _debug and better message

---
 src/Tiny_httpd.ml | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml
index 7688d3c3..f0f95b6f 100644
--- a/src/Tiny_httpd.ml
+++ b/src/Tiny_httpd.ml
@@ -1101,8 +1101,9 @@ let run (self:t) : (unit,_) result =
               raise e
           );
       with e ->
-        Printf.eprintf "accept raised an exception: %s"
-           (Printexc.to_string e)
+        _debug (fun k -> k
+                  "Unix.accept or Thread.create raised an exception: %s"
+                  (Printexc.to_string e))
     done;
     Ok ()
   with e -> Error e