X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Focaml-http%2Fhttp_tcp_server.ml;h=69da5c109ebd615364bea4e6b2c423a22e7e96a9;hb=b1fb6b8e1767d775bc452303629e95941d142bea;hp=29cf3931eba84f1a79277002001d2c908ef4f52a;hpb=9a072f192471daeca8cb409e991f0073b1d4271f;p=helm.git

diff --git a/helm/DEVEL/ocaml-http/http_tcp_server.ml b/helm/DEVEL/ocaml-http/http_tcp_server.ml
index 29cf3931e..69da5c109 100644
--- a/helm/DEVEL/ocaml-http/http_tcp_server.ml
+++ b/helm/DEVEL/ocaml-http/http_tcp_server.ml
@@ -18,9 +18,22 @@ 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 sockaddr =
+  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;
+  suck
+
+let init_callback callback timeout =
+  let timeout_callback signo =
+    if signo = Sys.sigalrm then
+      raise Timeout
+  in
+  wrap_callback_w_timeout ~callback ~timeout ~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 +43,26 @@ 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 *)
+  let suck = init_socket sockaddr in
+  let callback = init_callback callback timeout in
   while true do
     let (client, _) = Unix.accept suck in
       (* client is now connected *)
@@ -43,29 +76,11 @@ 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 suck = init_socket sockaddr in
+  let callback = init_callback callback timeout in
   let callback (i, o) =
     try
       callback i o;
@@ -82,6 +97,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