From 997a6f19427a16d4f5f44e818d086458256bff62 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Thu, 3 Feb 2005 22:11:55 +0000 Subject: [PATCH] - ported to daemon_spec - used as example of exn_handler to avoid sigpipe kill processes holding mutexes --- helm/DEVEL/ocaml-http/examples/threads.ml | 58 +++++++++++++++-------- 1 file changed, 37 insertions(+), 21 deletions(-) diff --git a/helm/DEVEL/ocaml-http/examples/threads.ml b/helm/DEVEL/ocaml-http/examples/threads.ml index a73f422d8..01f6dae4c 100644 --- a/helm/DEVEL/ocaml-http/examples/threads.ml +++ b/helm/DEVEL/ocaml-http/examples/threads.ml @@ -19,29 +19,45 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) -let m = Mutex.create () in -let i = ref 10 in +open Http_types + +let m = Mutex.create () +let m_locked = ref true + +let critical f = + Mutex.lock m; + m_locked := true; + Lazy.force f; + m_locked := false; + Mutex.unlock m + + (** ocaml's Thread.unlock suspend the invoking process if the mutex is already + * unlocked, therefore we unlock it only if we know that it's currently locked + *) +let safe_unlock _ _ = if !m_locked then Mutex.unlock m + +let i = ref 10 let dump_i outchan = Http_daemon.respond ~body:(Printf.sprintf "i = %d\n" !i) outchan -in + let callback req outchan = match req#path with - | "/incr" -> - Mutex.lock m; - incr i; - dump_i outchan; - Unix.sleep 5; - Mutex.unlock m - | "/decr" -> - Mutex.lock m; - decr i; - dump_i outchan; - Unix.sleep 5; - Mutex.unlock m - | "/get" -> - Mutex.lock m; - dump_i outchan; - Mutex.unlock m + | "/incr" -> critical (lazy (incr i; dump_i outchan; Unix.sleep 5)) + | "/decr" -> critical (lazy (decr i; dump_i outchan; Unix.sleep 5)) + | "/get" -> critical (lazy (dump_i outchan)) | bad_request -> Http_daemon.respond_error outchan -in -Http_daemon.start' ~port:9999 ~mode:`Thread callback + +let spec = + { Http_daemon.default_spec with + port = 9999; + mode = `Thread; + callback = callback; + exn_handler = Some safe_unlock; + (** ocaml-http's default exn_handler is Pervasives.ignore. This means + * that threads holding the "m" mutex above may die without unlocking it. + * Using safe_unlock as an exception handler we ensure that "m" mutex is + * unlocked in case of exceptions (e.g. SIGPIPE) *) + } + +let _ = Http_daemon.main spec + -- 2.39.2