From 92a759539fe5c5a8ab50adfaafd0250271223a91 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Sun, 1 Dec 2002 16:32:46 +0000 Subject: [PATCH] - split threaded and non threaded implementations - factorized out code for initialization of server socket and 'standard' callback --- helm/DEVEL/ocaml-http/http_tcp_server.ml | 45 +++++++++++------------- 1 file changed, 20 insertions(+), 25 deletions(-) diff --git a/helm/DEVEL/ocaml-http/http_tcp_server.ml b/helm/DEVEL/ocaml-http/http_tcp_server.ml index 29cf3931e..33f06e8a0 100644 --- 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 -- 2.39.2