- split threaded and non threaded implementations

- factorized out code for initialization of server socket and 'standard'
  callback

diff --git a/helm/DEVEL/ocaml-http/http_tcp_server.ml b/helm/DEVEL/ocaml-http/http_tcp_server.ml
index 29cf3931eba84f1a79277002001d2c908ef4f52a..33f06e8a0790cae1cd372d3a5410c4a2cc1c41b2 100644 (file)
--- a/helm/DEVEL/ocaml-http/http_tcp_server.ml
+++ b/helm/DEVEL/ocaml-http/http_tcp_server.ml
@@ -18,9 +18,7 @@ let wrap_callback_w_timeout ~callback ~timeout ~timeout_callback =
         ignore (Unix.alarm timeout);
         callback inchan outchan)
 
-  (** tcp_server which doesn't fork, requests are server sequentially and in the
-  same address space of the calling process *)
-let simple ~sockaddr ~timeout callback =
+let init_socket_and_callback sockaddr callback timeout =
   let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
   Unix.setsockopt suck Unix.SO_REUSEADDR true;
   Unix.bind suck sockaddr;
@@ -30,6 +28,23 @@ let simple ~sockaddr ~timeout callback =
       raise Timeout
   in
   let callback = wrap_callback_w_timeout ~callback ~timeout ~timeout_callback in
+  (suck, callback)
+
+  (** tcp_server which use Unix.establish_server which in turn forks a child for
+  each request *)
+let ocaml_builtin ~sockaddr ~timeout callback =
+  let timeout_callback signo =
+    if signo = Sys.sigalrm then
+      exit 2
+  in
+  Unix.establish_server
+    (wrap_callback_w_timeout ~callback ~timeout ~timeout_callback)
+    sockaddr
+
+  (** tcp_server which doesn't fork, requests are server sequentially and in the
+  same address space of the calling process *)
+let simple ~sockaddr ~timeout callback =
+  let (suck, callback) = init_socket_and_callback sockaddr callback timeout in
   while true do
     let (client, _) = Unix.accept suck in
       (* client is now connected *)
@@ -43,29 +58,9 @@ let simple ~sockaddr ~timeout callback =
     close_out outchan (* this close also inchan, because socket is the same *)
   done
 
-  (** tcp_server which use Unix.establish_server which in turn forks a child for
-  each request *)
-let ocaml_builtin ~sockaddr ~timeout callback =
-  let timeout_callback signo =
-    if signo = Sys.sigalrm then
-      exit 2
-  in
-  Unix.establish_server
-    (wrap_callback_w_timeout ~callback ~timeout ~timeout_callback)
-    sockaddr
-
-  (* TODO this is a cut-and-paste from 'simple' *)
   (** tcp_server which creates a new thread for each request to be served *)
 let thread ~sockaddr ~timeout callback =
-  let suck = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
-  Unix.setsockopt suck Unix.SO_REUSEADDR true;
-  Unix.bind suck sockaddr;
-  Unix.listen suck backlog;
-  let timeout_callback signo =
-    if signo = Sys.sigalrm then
-      raise Timeout
-  in
-  let callback = wrap_callback_w_timeout ~callback ~timeout ~timeout_callback in
+  let (suck, callback) = init_socket_and_callback sockaddr callback timeout in
   let callback (i, o) =
     try
       callback i o;
@@ -82,6 +77,6 @@ let thread ~sockaddr ~timeout callback =
     let (inchan, outchan) =
       (Unix.in_channel_of_descr client, Unix.out_channel_of_descr client)
     in
-    ignore (Thread.create callback (inchan, outchan));
+    Http_threaded_tcp_server.serve callback (inchan, outchan)
   done